PGM PARM(&MENU &MNULIB &RTNCOD) /*---------------------------------------------------------*/ /* MN01 : テスト・メニユー */ /*---------------------------------------------------------*/ DCL VAR(&MSG) TYPE(*CHAR) LEN(80) DCL VAR(&MENU) TYPE(*CHAR) LEN(10) DCL VAR(&MNULIB) TYPE(*CHAR) LEN(10) DCL VAR(&RTNCOD) TYPE(*CHAR) LEN(2) /* + 戻りコード */ DCLF FILE(QTROBJ/MN01) DCL VAR(&CALCMD) TYPE(*CHAR) LEN(512) DCL VAR(&MSGCMD) TYPE(*CHAR) LEN(512) DCL VAR(&USRNO) TYPE(*CHAR) LEN(7) DCL VAR(&MNUCMD) TYPE(*CHAR) LEN(124) DCL VAR(&WAIT) TYPE(*DEC) LEN(5 0) VALUE(0) DCL VAR(&MSGLEN) TYPE(*DEC) LEN(5 0) VALUE(80) DCL VAR(&CMDLEN) TYPE(*DEC) LEN(5 0) VALUE(557) DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4) DCL VAR(&LONGCMD) TYPE(*CHAR) LEN(1) DCL VAR(&CMDSTACK) TYPE(*CHAR) LEN(400) DCL VAR(&CMD557) TYPE(*CHAR) LEN(557) DCL VAR(&SX) TYPE(*DEC) LEN(4 0) VALUE(-3) DCL VAR(&CMDPMT) TYPE(*CHAR) LEN(153) DCL VAR(&FLD4) TYPE(*CHAR) LEN(4) DCL VAR(&CPYRGT) TYPE(*CHAR) LEN(80) + VALUE(' - (C) COPYRIGHT OFFICE QUATTRO 1994') MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR)) CHKOBJ OBJ(QTEMP/MSGDTAQ) OBJTYPE(*DTAQ) MONMSG MSGID(CPF9800) EXEC(DO) CRTDTAQ DTAQ(QTEMP/MSGDTAQ) MAXLEN(128) TEXT('MENU + MSG DTAQ') AUT(*ALL) RMVMSG CLEAR(*ALL) ENDDO CHKOBJ OBJ(QTEMP/CMDDTAQ) OBJTYPE(*DTAQ) MONMSG MSGID(CPF9800) EXEC(DO) CRTDTAQ DTAQ(QTEMP/CMDDTAQ) MAXLEN(557) + TEXT('CMD-STACK DTAQ') AUT(*ALL) RMVMSG CLEAR(*ALL) ENDDO CALL PGM(QRCVDTAQ) PARM('MSGDTAQ ' 'QTEMP ' + 80 &ERRMSG &WAIT) IF COND(&ERRMSG *EQ ' ') THEN(CHGVAR + VAR(&ERRMSG) VALUE(&CPYRGT)) CALL PGM(QRCVDTAQ) PARM('CMDDTAQ ' 'QTEMP ' + 557 &CMD557 &WAIT) IF COND(%SST(&CMD557 1 4) *NE ' ') THEN(CHGVAR + VAR(&SX) VALUE(%SST(&CMD557 1 4))) CHGVAR VAR(&CMDSTACK) VALUE(%SST(&CMD557 5 400)) CHGVAR VAR(&CMDLIN) VALUE(%SST(&CMD557 405 153)) OVRDSPF FILE(MN01) SHARE(*YES) RTVOUTQ: RTVJOBA OUTQ(&OUTQ) DSPLY: SNDF RCDFMT(MN01) DSPCMD: SNDRCVF RCDFMT(MENUFMT) CHGVAR VAR(&RTNCOD) VALUE(X'0000') /* 再表示要求 */ CHGVAR VAR(&ERRMSG) VALUE(' ') /*----------------------*/ /* 機能キー */ /*----------------------*/ CF03: IF COND(&IN03 *EQ '1') THEN(DO) CHGVAR VAR(&RTNCOD) VALUE(X'FFFF') /* 終了要求 */ RETURN ENDDO CF04: IF COND(&IN04 *EQ '1') THEN(DO) CHGVAR &CALCMD VALUE('?' *CAT &CMDLIN) CALL PGM(QCMDCHK) PARM(&CALCMD 512) MONMSG MSGID(CPF6801) EXEC(DO) GOTO ERROR ENDDO MONMSG MSGID(CPF0006) EXEC(DO) GOTO ERROR ENDDO GOTO CMDEXEC ENDDO CF05: IF COND(&IN05 *EQ '1') THEN(DO) WRKACTJOB GOTO ENDPGM ENDDO CF06: IF COND(&IN06 *EQ '1') THEN(DO) DSPMSG GOTO ENDPGM ENDDO CF09: IF COND(&IN09 *EQ '1') THEN(DO) CHGVAR VAR(&SX) VALUE(&SX + 4) IF COND(&SX *GT 400) THEN(CHGVAR VAR(&SX) + VALUE(1)) CHGVAR VAR(&KEYVAR) VALUE(%SST(&CMDSTACK &SX 4)) IF COND((&SX *EQ 1) *AND (&KEYVAR *EQ ' ')) + THEN(GOTO ENDPGM) IF COND(&KEYVAR *EQ ' ') THEN(DO) GOTO ENDPGM ENDDO RCVMSG MSGKEY(&KEYVAR) RMV(*NO) MSG(&MSGCMD) CHGVAR VAR(&CALCMD) VALUE(&MSGCMD) CHGVAR VAR(&CMDLIN) VALUE(&CALCMD) IF COND(%SST(&CALCMD 154 350) *NE ' ') THEN(DO) CHGVAR VAR(%SST(&CMDLIN 151 3)) VALUE('...') CHGVAR VAR(&LONGCMD) VALUE('X') ENDDO CHGVAR VAR(&CMDPMT) VALUE(&CMDLIN) GOTO ENDPGM ENDDO CF10: IF COND(&IN10 *EQ '1') THEN(DO) CALL QCMD GOTO ENDPGM ENDDO CF12: IF COND(&IN12 *EQ '1') THEN(DO) CHGVAR VAR(&RTNCOD) VALUE(X'FFFE') /* 取消要求 */ RETURN ENDDO HELP: IF COND(&IN19 *EQ '1') THEN(DO) CALL OPMENUJ GOTO ENDPGM ENDDO HOME: IF COND(&IN25 *EQ '1') THEN(DO) CHGVAR VAR(&RTNCOD) VALUE(X'FFFC') /* HOME 要求 */ RETURN ENDDO /*----------------------*/ /* 選択オプション */ /*----------------------*/ IF COND((%SST(&CMDLIN 1 1) *GE '0') *AND + (%SST(&CMDLIN 1 1) *LE '9')) THEN(DO) IF COND(%SST(&CMDLIN 1 3) *EQ '90 ') THEN(SIGNOFF) IF COND(%SST(&CMDLIN 2 1) *EQ ' ') THEN(DO) CHGVAR VAR(&USRNO) VALUE('USR000' *TCAT + %SST(&CMDLIN 1 1)) ENDDO ELSE CMD(DO) CHGVAR VAR(&USRNO) VALUE('USR00' *TCAT + %SST(&CMDLIN 1 2)) ENDDO RTVMSG MSGID(&USRNO) MSGF(MN01) MSG(&MNUCMD) MONMSG MSGID(CPF2400) EXEC(DO) SNDPGMMSG MSGID(CPD6A64) MSGF(QCPFMSG) TOPGMQ(*SAME) + MSGTYPE(*DIAG) GOTO ERROR ENDDO IF COND((%SST(&MNUCMD 1 12) *EQ ' メッセージ ') + *OR (%SST(&MNUCMD 1 12) = ' ')) + THEN(DO) SNDPGMMSG MSGID(CPD6A64) MSGF(QCPFMSG) TOPGMQ(*SAME) + MSGTYPE(*DIAG) GOTO ERROR ENDDO CALL PGM(QCMDEXC) PARM(&MNUCMD 124) GOTO ERROR OPTEND: ENDDO /*----------------------*/ /* コマンド実行 */ /*----------------------*/ CHGVAR VAR(&CALCMD) VALUE(&CMDLIN) CMDEXEC: CALL PGM(QCMDEXC) PARM(&CALCMD 512) SNDPGMMSG MSG(&CALCMD) TOPGMQ(*SAME) MSGTYPE(*RQS) CHGVAR VAR(&KEYVAR) VALUE(' ') RCVMSG PGMQ(*SAME) MSGTYPE(*RQS) RMV(*NO) + KEYVAR(&KEYVAR) IF COND(&KEYVAR *NE ' ') THEN(DO) CHGVAR VAR(&CMDSTACK) VALUE(&KEYVAR *CAT &CMDSTACK) CHGVAR VAR(&SX) VALUE(-3) ENDDO ERROR: RCVMSG RMV(*NO) MSG(&MSG) SNDMSG: SNDPGMMSG MSG(&MSG) TOPGMQ(*EXT) MSGTYPE(*DIAG) CALL PGM(QSNDDTAQ) PARM('MSGDTAQ ' 'QTEMP ' + &MSGLEN &MSG) ENDPGM: CHGVAR VAR(&FLD4) VALUE(&SX) CHGVAR VAR(&CMD557) VALUE(&FLD4 *CAT &CMDSTACK *CAT + &CMDPMT) CALL PGM(QSNDDTAQ) PARM('CMDDTAQ ' 'QTEMP ' + &CMDLEN &CMD557) ENDPGM