7.121.3 SUBROUTINE Examples - Part 1
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
Subroutine variables are not locally scoped
Emulating local scoping by using a naming standard
Techniques for saving and restoring globally scoped variables
7.121.4 SUBROUTINE Examples - Part 2
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