4.7.2 JSMLSAEXT

The JSMDIRECT program can only internally execute a LANSA function. If a 3GL program needs to be executed or more flexibility is needed when calling the LANSA program, then the JSMLSAEXT program needs to be created.

The source code for this exit program is stored in QCLSRC in the JSM library.

 

/* JSM LANSA/3GL EXIT PROGRAM */

 

PGM PARM(&SERVICE &SERVERHOST &HOST &PORT &REMOTEUSER &REMOTEADDR +

         &PROCESS &FUNCTION &PARTITION &LANGUAGE &PROGRAM &RDMLX +

         &CONTINUE &MESSAGE)

 

DCL VAR(&SERVICE)    TYPE(*CHAR) LEN(30)

DCL VAR(&SERVERHOST) TYPE(*CHAR) LEN(80)

DCL VAR(&HOST)       TYPE(*CHAR) LEN(80)

DCL VAR(&PORT)       TYPE(*CHAR) LEN(5)

DCL VAR(&REMOTEUSER) TYPE(*CHAR) LEN(30)

DCL VAR(&REMOTEADDR) TYPE(*CHAR) LEN(45)

 

DCL VAR(&REQUEST)    TYPE(*CHAR) LEN(10) VALUE(RUN)

DCL VAR(&PROCESS)    TYPE(*CHAR) LEN(10)

DCL VAR(&FUNCTION)   TYPE(*CHAR) LEN(10)

DCL VAR(&PARTITION)  TYPE(*CHAR) LEN(3)

DCL VAR(&LANGUAGE)   TYPE(*CHAR) LEN(4)

DCL VAR(&PROGRAM)    TYPE(*CHAR) LEN(32)

DCL VAR(&RDMLX)      TYPE(*CHAR) LEN(1)

DCL VAR(&CONTINUE)   TYPE(*CHAR) LEN(1)

DCL VAR(&MESSAGE)    TYPE(*CHAR) LEN(256)

 

DCL VAR(&PARM01)     TYPE(*CHAR) LEN(256)

DCL VAR(&PARM02)     TYPE(*CHAR) LEN(256)

DCL VAR(&PARM03)     TYPE(*CHAR) LEN(256)

DCL VAR(&PARM04)     TYPE(*CHAR) LEN(256)

DCL VAR(&PARM05)     TYPE(*CHAR) LEN(256)

DCL VAR(&PARM06)     TYPE(*CHAR) LEN(256)

DCL VAR(&PARM07)     TYPE(*CHAR) LEN(256)

DCL VAR(&PARM08)     TYPE(*CHAR) LEN(256)

DCL VAR(&PARM09)     TYPE(*CHAR) LEN(256)

DCL VAR(&PARM10)     TYPE(*CHAR) LEN(256)

 

DCL VAR(&TASKID)     TYPE(*CHAR) LEN(8)

DCL VAR(&PCTYPE)     TYPE(*CHAR) LEN(1) VALUE(N)

DCL VAR(&DEVELOPER)  TYPE(*CHAR) LEN(1) VALUE(N)

DCL VAR(&ALLOWMSGS)  TYPE(*CHAR) LEN(1) VALUE(N)

DCL VAR(&PCNAME)     TYPE(*CHAR) LEN(10)

DCL VAR(&DATESRC)    TYPE(*CHAR) LEN(1) VALUE(S)

DCL VAR(&BDEBUG)     TYPE(*CHAR) LEN(1) VALUE(N)

DCL VAR(&BDEBUGDEV)  TYPE(*CHAR) LEN(10)

DCL VAR(&BDEBUGMSG)  TYPE(*CHAR) LEN(10)

DCL VAR(&XRUNADPRM)  TYPE(*CHAR) LEN(512)

 

DCL VAR(&CTIME)      TYPE(*CHAR) LEN(6)

DCL VAR(&JOBMSG)     TYPE(*CHAR) LEN(100)

DCL VAR(&MSGID)      TYPE(*CHAR) LEN(7)

DCL VAR(&MSGKEY)     TYPE(*CHAR) LEN(4)

 

MONMSG MSGID(CPF0000)

 

/* DEFAULT VALUE FOR CONTINUE IS 'Y' */

/* CHGVAR VAR(&CONTINUE) VALUE('N') */

/* CHGVAR VAR(&MESSAGE)  VALUE('I do not know you') */

/* GOTO END */

 

/* CALLSUBR SUBR(LOGSTR) */

 

IF COND(&PROGRAM *NE ' ') THEN(DO)

  /* CALL RPG */

  CALL &PROGRAM

  GOTO END

ENDDO

 

IF COND(&RDMLX *EQ 'Y') THEN(DO)

  /* CHANGE REQUEST TO RUN RDMLX */

  CHGVAR VAR(&REQUEST) VALUE(X_RUN)

ENDDO

 

IF COND(&PROCESS *NE ' ' *AND &FUNCTION *NE ' ') THEN(DO)

 

  IF COND(&REQUEST *EQ 'RUN') THEN(DO)

    /* CALL LANSA V10 OR V11 */

    CALL PGM(LANSA) PARM(&REQUEST &PROCESS &FUNCTION +

                         &PARM01 &PARM02 &PARM03 &PARM04 &PARM05 +

                         &PARM06 &PARM07 &PARM08 &PARM09 &PARM10 +

                         &PARTITION &LANGUAGE &TASKID &PCTYPE +

                         &DEVELOPER &ALLOWMSGS &PCNAME &DATESRC +

                         &BDEBUG &BDEBUGDEV &BDEBUGMSG)

    MONMSG MSGID(DCM0000) EXEC(DO)

      SNDPGMMSG MSG('LANSA RDML has ended abnormally')

    ENDDO

    GOTO END

  ENDDO

 

  IF COND(&REQUEST *EQ 'X_RUN') THEN(DO)

    /* CALL LANSA V11 - RDMLX */

    CALL PGM(LANSA) PARM(&REQUEST &PROCESS &FUNCTION +

                         &PARM01 &PARM02 &PARM03 &PARM04 &PARM05 +

                         &PARM06 &PARM07 &PARM08 &PARM09 &PARM10 +

                         &PARTITION &LANGUAGE &TASKID &PCTYPE +

                         &DEVELOPER &ALLOWMSGS &PCNAME &DATESRC +

                         &BDEBUG &BDEBUGDEV &BDEBUGMSG &XRUNADPRM)

    MONMSG MSGID(DCM0000) EXEC(DO)

      SNDPGMMSG MSG('LANSA RDMLX has ended abnormally')

    ENDDO

    GOTO END

  ENDDO

 

ENDDO

 

SNDPGMMSG MSG('No program or function specified for execution')

 

END:

 

/* LANSA REPLACE LIBRARY LIST ON EXIT OPTION ENABLED  */

/* CALLSUBR SUBR(RMVMSG) */

/* LANSA RECLAIM RESOURCES ON EXIT OPTION NOT ENABLED */

RCLRSC

/* CALLSUBR SUBR(LOGEND) */

 

/* =================================================================== */

/* SUBROUTINES                                                         */

/* =================================================================== */

 

SUBR SUBR(LOGSTR)

  /* START TIME */

  RTVSYSVAL SYSVAL(QTIME) RTNVAR(&CTIME)

  CHGVAR VAR(&JOBMSG) VALUE('JSMLSAEXT START' *BCAT &CTIME)

  SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&JOBMSG)

  SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&FUNCTION)

  /* RESET JOB INFO */

  CALL PGM(LOGJOBINFO) PARM('*YES      ')

ENDSUBR

 

SUBR SUBR(LOGEND)

  /* LOG JOB INFO */

  CALL PGM(LOGJOBINFO) PARM('*NO       ')

  /* END TIME */

  RTVSYSVAL SYSVAL(QTIME) RTNVAR(&CTIME)

  CHGVAR VAR(&JOBMSG) VALUE('JSMLSAEXT END' *BCAT &CTIME)

  SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&JOBMSG)

ENDSUBR

 

SUBR SUBR(RMVMSG)

  /* LANSA REPLACE LIBRARY LIST ON EXIT OPTION ENABLED                    */

  /* Remove LANSA's CPC2101 Library list changed. message                 */

  /* http://www-01.ibm.com/support/docview.wss?uid=nas8N1016727           */

  /* MSGKEY is 4-byte unsigned incrementing integer                       */

  /* Each job has a limited number of program messages when               */

  /* 4,294,967,293 has been reached the OS terminates the job             */

  CHGVAR VAR(&MSGID) VALUE(' ')

  SNDPGMMSG MSG('TEXT') TOPGMQ(*SAME) KEYVAR(&MSGKEY)

  RMVMSG MSGKEY(&MSGKEY)

  CHGVAR %BIN(&MSGKEY 1 4)  (%BIN(&MSGKEY 1 4) - 1)

  RCVMSG PGMQ(*SAME (*)) MSGKEY(&MSGKEY) RMV(*NO) MSGID(&MSGID)

  IF COND(&MSGID *EQ 'CPC2101') THEN(DO)

    /* CPC2101 Library list changed. */

    RCVMSG PGMQ(*SAME (*)) MSGKEY(&MSGKEY) RMV(*YES) MSGID(&MSGID)

  ENDDO

ENDSUBR

 

ENDPGM