Page History

/ *JSM LANSAJSM LANSA/RPG 終了プログラム */
 
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)
 
/*  CONTINUECONTINUE のデフォルト値は '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)
  /*  RPG 呼び出し */
  CALL &PROGRAM
  GOTO END
ENDDO
 
IF COND(&RDMLX *EQ 'Y') THEN(DO)
  /* RDMLX RDMLX 実行要求を変更 */
  CHGVAR VAR(&REQUEST) VALUE(X_RUN)
ENDDO
 
IF COND(&PROCESS *NE ' ' *AND &FUNCTION *NE ' ') THEN(DO)
 
  IF COND(&REQUEST *EQ 'RUN') THEN(DO)
    /* LANSA V10 または 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)
    /  LANSA V11 呼び出し - RDMLX *  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 は終了オプションが有効時、ライブラリ・リストを置換  */
/* CALLSUBR SUBR(RMVMSG) */
/* LANSA は終了オプションが無効時、リソースを再利用 */
RCLRSC
/* CALLSUBR SUBR(LOGEND) */
 
/* =================================================================== */
/* サブルーチン                                                         */
/* =================================================================== */
 
SUBR SUBR(LOGSTR)
  /* 開始時間 */
  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)
  /* ジョブ情報のリセット */
  CALL PGM(LOGJOBINFO) PARM('*YES      ')
ENDSUBR
 
SUBR SUBR(LOGEND)
  /* ジョブ情報のログ */
  CALL PGM(LOGJOBINFO) PARM('*NO       ')
  /* 終了時間 */
  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 は終了オプションが有効時、ライブラリ・リストを置換           */
  /* LANSA の CPC2101 ライブラリ・リスト変更メッセージ                 */
  /* http://www-01.ibm.com/support/docview.wss?uid=nas8N1016727     */
  /* MSGKEY は 4 バイト符号なしのインクリメント整数                    */
  /* 各ジョブのプログラム・メッセージ数に制限があり、               　　*/
  /* 4,294,967,293 に達すると、OS がジョブを終了             　　　　　*/
  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 SAME (*)) MSGKEY(&MSGKEY) RMV(*NO) MSGID(&MSGID)
  IF COND(&MSGID *EQ 'CPC2101') THEN(DO)
    /* CPC2101 ライブラリ・リスト変更 */
    RCVMSG PGMQ(*SAME SAME (*)) MSGKEY(&MSGKEY) RMV(*YES) MSGID(&MSGID)
  ENDDO
ENDSUBR
 
ENDPGM