Page History
...
Example 1: From a CL (control language) program place the value of field COMPNO (company number) and ACCTYP (account type) onto the exchange list. Run a LANSA function and get back a field called TOTAMOUNT from the exchange list.
...
DCL &COMPNO *DEC (3 0)
...
DCL &ACCTYP *CHAR 5
...
DCL &TOTAMOUNT *DEC (13 2)
...
CALL M@EXCHL ('CLR')
...
CALL M@EXCHL ('PUT' 'COMPNO P0030' &COMPNO ACCTYP A0050' &ACCTYP )
...
LANSA RUN ... etc .....
...
CALL M@EXCHL ('GET' 'TOTAMOUNT P0132' &TOTAMOUNT)
Example 2: Do the same thing from RPG.
...
E ATR 1 3 15
...
C*
...
C* CLEAR THE LIST
...
C*
...
C CALL 'M@EXCHL'
...
C PARM 'CLR'
...
A@EXCH 3
...
C*
...
C* PUT TO THE LIST
...
C*
...
C CALL 'M@EXCHL'
...
C PARM 'PUT'
...
A@EXCH
C PARM ATR,01
...
C PARM COMPNO 30
...
C PARM ATR,02
...
C PARM ACCTYP 5
...
C*
...
C* INVOKE THE FUNCTION
...
C*
...
C CALL 'LANSA'
...
C ---------- ETC -----------
...
C ---------- ETC -----------
...
C ---------- ETC -----------
...
C*
...
C* GET FROM THE LIST
...
C*
...
C* NOTE: The field is named "TOTAMOUNT" in the exchange
...
C* list, but is actually returned into a field
...
C* called TOTAMT.
...
C CALL 'M@EXCHL'
...
C PARM 'GET'
...
A@EXCH
C PARM ATR,03
...
C PARM TOTAMT 132
...
C*
...
C MOVE '1' *INLR
...
C RETRN
...
**
...
COMPNO P0030
...
ACCTYP A0050
...
TOTAMOUNT P0132
Example 3: Write a CL program that is to receive the name of a file and library from the exchange list, copy the file to tape and place a return code back onto the exchange list.
...
COPYTAPE: PGM
...
DCL &FILE *CHAR 10
...
DCL &LIBRARY *CHAR 10
...
DCL &RETCODE *CHAR 1
...
CALL M@EXCHL ('GET' 'FILE A0100' &FILE 'LIBRARY A0100' &LIBRARY )
...
CALL M@EXCHL ('CLR')
...
CHGVAR &RETCODE 'Y'
...
CPYTOTAP ... etc .....
...
MONMSG (CPF0000 MCH0000) EXEC(CHGVAR &RETCODE 'N')
...
CALL M@EXCHL ('PUT' 'RETCODE A0010' &RETCODE)
...
ENDPGM
Example 4: Write the RDML code required to display a screen panel, input the file and library name, call the CL program in example 3 and act upon the return code.
...
DEFINE #FILE *CHAR 10
...
DEFINE #LIBRARY *CHAR 10
...
DEFINE #RETCODE *CHAR 1
...
REQUEST FIELDS(#FILE #LIBRARY)
...
EXCHANGE FIELDS(#FILE #LIBRARY)
...
CALL PGM(COPYTAPE) PGM_EXCH(*YES)
...
IF ('#RETCODE *NE Y')
...
MESSAGE MSGTXT('Copy to tape failed')
...
ENDIF