7 121 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