7 92 3 SUBROUTINE Examples Part 1

LANSA Technical

7.92.3 SUBROUTINE Examples - Part 1

Executing a SUBROUTINE

Executing a SUBROUTINE with parameters

Executing a SUBROUTINE with numeric literal as parameters

Executing a SUBROUTINE with alphanumeric literals as parameters

Executing a SUBROUTINE with system variables as parameters

Using SUBROUTINE to reduce coding

Using SUBROUTINE to print employee details

Techniques for documenting SUBROUTINES using the BBUSE template

Recursion

Subroutine variables are not locally scoped

Emulating local scoping by using a naming standard

Techniques for saving and restoring globally scoped variables

7.92.4 SUBROUTINE Examples - Part 2

Executing a SUBROUTINE

This is an example of how to execute a subroutine without passing any parameters:

EXECUTE    SUBROUTINE(SUB1)
SUBROUTINE NAME(SUB1)
*          <<Logic>>
ENDROUTINE 
 

Executing a SUBROUTINE with parameters

To pass parameters to a subroutine, use the WITH_PARMS() parameter in the EXECUTE command. You must make sure the EXECUTE command passes the same number of fields or values (WITH_PARMS) as the SUBROUTINE is expecting:

EXECUTE    SUBROUTINE(SUB1) WITH_PARMS(#EMPNO)
EXECUTE    SUBROUTINE(SUB2) WITH_PARMS(#GIVENAME #SURNAME)
EXECUTE    SUBROUTINE(SUB3) WITH_PARMS(#SALARY #TOTAL)
SUBROUTINE NAME(SUB1) PARMS((#EMP1 *RETURNED))
CHANGE     FIELD(#EMP1) TO(A0088)
ENDROUTINE 
SUBROUTINE NAME(SUB2) PARMS((#NAME1 *RETURNED) (#NAME2 *RETURNED))
CHANGE     FIELD(#NAME1) TO(JOHN)
CHANGE     FIELD(#NAME2) TO(COOK)
ENDROUTINE 
SUBROUTINE NAME(SUB3) PARMS((#WAGES *RECEIVED) (#SUM *RETURNED))
CHANGE     FIELD(#WAGES) TO(230000)
CHANGE     FIELD(#SUM) TO('#WAGES * 1.1')
ENDROUTINE
 

In this example, any field specified with *RETURNED, like #EMP1, will be mapped back to #EMPNO when the subroutine completes.

If a function is coded with this logic then the final result for each subroutine for fields #EMPNO, #GIVENAME, #SURNAME and #TOTAL will be:

    #EMPNO = A0080
    #GIVENAME = John
    #SURNAME = COOK
    #TOTAL = 253,000.00
 

Executing a SUBROUTINE with numeric literal as parameters

In this example, subroutine A receives two numeric values, one passed in field #STD_NUM and a second one as a numeric literal (0.75). The subroutine makes a calculation and returns a value in the field #DISCOUNT.

DEFINE     FIELD(#DISCOUNT) TYPE(*DEC) LENGTH(10) DECIMALS(2) LABEL(DISCOUNT) EDIT_CODE(3)
DEFINE     FIELD(#Q) REFFLD(#STD_NUM)
DEFINE     FIELD(#N) TYPE(*DEC) LENGTH(3) DECIMALS(2)
DEFINE     FIELD(#D) TYPE(*DEC) LENGTH(10) DECIMALS(2) EDIT_CODE(3)
BEGIN_LOOP 
REQUEST    FIELDS(#STD_NUM)
EXECUTE    SUBROUTINE(A) WITH_PARMS(#STD_NUM 0.75 #DISCOUNT)
DISPLAY    FIELDS(#DISCOUNT)
CHANGE     FIELD(#DISCOUNT) TO(#ZEROS)
END_LOOP   
SUBROUTINE NAME(A) PARMS((#Q *RECEIVED) (#N *RECEIVED) (#D *RETURNED))
CHANGE     FIELD(#D) TO('#Q * #N')
ENDROUTINE
 

A problem can occur if fields for *RECEIVED or *RETURNED parameters in a subroutine are not defined in the same field format (e.g. Length, type) with fields or literals that are used in the EXECUTE command as in  this example:

DEFINE     FIELD(#DISCOUNT) TYPE(*DEC) LENGTH(10) DECIMALS(2) LABEL(DISCOUNT) EDIT_CODE(3)
DEFINE     FIELD(#Q) REFFLD(#STD_NUM)
DEFINE     FIELD(#N) REFFLD(#STD_NUM)
DEFINE     FIELD(#D) TYPE(*DEC) LENGTH(10) DECIMALS(2) EDIT_CODE(3)
BEGIN_LOOP 
EXECUTE    SUBROUTINE(A) WITH_PARMS(1234 0.75 #DISCOUNT)
DISPLAY    FIELDS(#DISCOUNT)
CHANGE     FIELD(#DISCOUNT) TO(#ZEROS)
END_LOOP   
SUBROUTINE NAME(A) PARMS((#Q *RECEIVED) (#N *RECEIVED) (#D *RETURNED))
CHANGE     FIELD(#D) TO('#Q * #N')
ENDROUTINE
 

Field #N is defined as packed 7,0

The literal 0.75 is passed to the subroutine, but this does not match the number of decimals that the subroutine is expecting for field #N.

As a result, the field #N received into the subroutine will incorrectly contain the value zero.

To work correctly, field #N should be defined as follows:

DEFINE     FIELD(#N) TYPE(*DEC) LENGTH(3) DECIMALS(2)
 

Executing a SUBROUTINE with alphanumeric literals as parameters

In this example, subroutine STDNAME concatenates two strings from fields #STRING1 and #STRING2 into field #TEXT, which is mapped back (*RETURNED) into #CTEXT:

DEFINE     FIELD(#OPTION) TYPE(*CHAR) LENGTH(1)
DEFINE     FIELD(#CTEXT) TYPE(*CHAR) LENGTH(30) LABEL('Text')
BEGIN_LOOP 
REQUEST    FIELDS(#OPTION)
CASE       OF_FIELD(#OPTION)
WHEN       VALUE_IS('= C')
EXECUTE    SUBROUTINE(STDNAME) WITH_PARMS(WILSON COOKSON #CTEXT)
DISPLAY    FIELDS(#CTEXT)
OTHERWISE  
MESSAGE    MSGTXT('Not a valid option')
ENDCASE    
END_LOOP   
SUBROUTINE NAME(STDNAME) PARMS((#STRING1 *RECEIVED) (#STRING2 *RECEIVED) (#TEXT *RETURNED))
DEFINE     FIELD(#STRING1) TYPE(*CHAR) LENGTH(10)
DEFINE     FIELD(#STRING2) TYPE(*CHAR) LENGTH(10)
DEFINE     FIELD(#TEXT) TYPE(*CHAR) LENGTH(30)
USE        BUILTIN(CONCAT) WITH_ARGS(#STRING1 #STRING2) TO_GET(#TEXT)
ENDROUTINE 
 

Executing a SUBROUTINE with system variables as parameters

It is also possible to pass system variables as parameters. In this example the system variable *FUNCTION:

DEFINE     FIELD(#TEMP) REFFLD(#FUNCTION)
DEFINE     FIELD(#TEMP2) REFFLD(#STD_TEXT)
DEFINE     FIELD(#TEXT) TYPE(*CHAR) LENGTH(20)
BEGIN_LOOP 
EXECUTE    SUBROUTINE(VARIABLE) WITH_PARMS(*FUNCTION #STD_TEXT)
DISPLAY    FIELDS(#STD_TEXT)
MESSAGE    MSGTXT('Not a valid option')
END_LOOP   
SUBROUTINE NAME(VARIABLE) PARMS((#TEMP *RECEIVED) (#TEMP2 *RETURNED))
CHANGE     FIELD(#TEXT) TO('Function name:')
USE        BUILTIN(CONCAT) WITH_ARGS(#TEXT #TEMP) TO_GET(#TEMP2)
ENDROUTINE 
 

Using SUBROUTINE to reduce coding

SUBROUTINEs are a very useful way to reduce the amount of RDML code and at the same time make it simpler and easier to understand. Consider this case where the CHANGE command is used to add values to a working list:

CHANGE     FIELD(#EMPNO) TO(A0090)
CHANGE     FIELD(#NAME) TO('Fred')
CHANGE     FIELD(#SALARY) TO(23456.78)
ADD_ENTRY  TO_LIST(#LIST)
CHANGE     FIELD(#EMPNO) TO(A0070)
CHANGE     FIELD(#NAME) TO('Mary')
CHANGE     FIELD(#SALARY) TO(43456.78)
ADD_ENTRY  TO_LIST(#LIST)
CHANGE     FIELD(#EMPNO) TO(A0072)
CHANGE     FIELD(#NAME) TO('William')
CHANGE     FIELD(#SALARY) TO(33456.78)
ADD_ENTRY  TO_LIST(#LIST)
 

By changing the code to use a subroutine which receives the values we want to add to the working list, the function becomes neater and the code more structured:

EXECUTE    SUBROUTINE(ADDTOLIST) WITH_PARMS(A0090 'Fred' 23456.78)
EXECUTE    SUBROUTINE(ADDTOLIST) WITH_PARMS(A0070 'Mary' 43456.78)
EXECUTE    SUBROUTINE(ADDTOLIST) WITH_PARMS(A0072 'William' 33456.78)
SUBROUTINE NAME(ADDTOLIST) PARMS((#EMPNO *RECEIVED) (#NAME *RECEIVED) (#SALARY *RECEIVED))
ADD_ENTRY  TO_LIST(#LIST)
ENDROUTINE 
 

Using SUBROUTINE to print employee details

Similar to other examples, in this one we use a subroutine to execute a PRINT of employee details selected from PSLMST:

Using a subroutine to print a line is a useful method for handling those situations where it is necessary to print the same line in several different parts of the same LANSA function.

DEFINE     FIELD(#D1) REFFLD(#EMPNO)
DEFINE     FIELD(#D2) REFFLD(#SURNAME)
DEFINE     FIELD(#D3) REFFLD(#GIVENAME)
DEFINE     FIELD(#OPTION) TYPE(*CHAR) LENGTH(2)
DEF_LIST   NAME(#LIST1) FIELDS(#EMPNO #SURNAME #GIVENAME)
BEGIN_LOOP 
REQUEST    FIELDS(#OPTION)
CASE       OF_FIELD(#OPTION)
WHEN       VALUE_IS('= A')
SELECT     FIELDS(#EMPNO #SURNAME #GIVENAME) FROM_FILE(PSLMST)
ADD_ENTRY  TO_LIST(#LIST1)
EXECUTE    SUBROUTINE(PRINT) WITH_PARMS(#EMPNO #SURNAME #GIVENAME)
ENDSELECT  
OTHERWISE  
CALL       PROCESS(MYPROC)
ENDCASE    
DISPLAY    FIELDS(#EMPNO #SURNAME #GIVENAME) BROWSELIST(#LIST1)
END_LOOP   
SUBROUTINE NAME(PRINT) PARMS((#D1 *RECEIVED) (#D2 *RECEIVED) (#D3 *RECEIVED))
DEF_LINE   NAME(#NAME) FIELDS(#D1 #D2 #D3)
PRINT      LINE(#NAME)
ENDROUTINE