7 92 3 SUBROUTINE Examples Part 1

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

previous page start next page