/*š****************************************************************€*/ /*š €*/ /*š5769SS1 V4R3M0 980729 RTVCLSRC Output 29/04/99 10:23:47 €*/ /*š €*/ /*šProgram name . . . . . . . . . . . . . . : QMNSRBND PN*/ /*šLibrary name . . . . . . . . . . . . . . : QSYS PL*/ /*šOriginal source file . . . . . . . . . . : SN*/ /*šLibrary name . . . . . . . . . . . . . . : SL*/ /*šOriginal source member . . . . . . . . . : SM*/ /*šSource file change €*/ /*š date/time . . . . . . . . . . . . . . : SC*/ /*šPatch option . . . . . . . . . . . . . . : *NOPATCH PO*/ /*šUser profile . . . . . . . . . . . . . . : *USER UP*/ /*šText . . . : TX*/ /*šOwner . . . . . . . . . . . . . . . . . : QSYS OW*/ /*šPatch change ID . . . . . . . . . . . . : 47516 PC*/ /*šPatch APAR ID . . . . . . . . . . . . . : PA*/ /*šUser mod flag . . . . . . . . . . . . . : *NO UM*/ /*š ED*/ /*š**************************************************************************€*/ /*šMR1 Mar'00 Bring code up to date with V4R4 changes. Make earlier changes€*/ /*š obvious. €*/ /*š**************************************************************************€*/ PGM PARM(&OPTION) DCL VAR(&LOOPCNT) TYPE(*DEC) LEN(3 0) VALUE(1) DCL VAR(&ENDSIND) TYPE(*CHAR) LEN(1) VALUE('N') DCL VAR(&CTLSBSD) TYPE(*CHAR) LEN(10) DCL VAR(&CTLSBSLIB) TYPE(*CHAR) LEN(10) DCL VAR(&FUNC) TYPE(*CHAR) LEN(10) VALUE('*ENTER ') DCL VAR(&CTIME) TYPE(*CHAR) LEN(8) DCL VAR(&TIMSEP) TYPE(*CHAR) LEN(1) DCL VAR(&MESSAGE) TYPE(*CHAR) LEN(7) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(16) DCL VAR(&NOTAUT) TYPE(*CHAR) LEN(1) VALUE('0') DCL VAR(&OPTION) TYPE(*CHAR) LEN(7) DCL VAR(&SBS) TYPE(*CHAR) LEN(10) DCL VAR(&MSGTXT) TYPE(*CHAR) LEN(1) DCL VAR(&ISAUTH) TYPE(*CHAR) LEN(1) VALUE('Y') DCL VAR(&UPNAME) TYPE(*CHAR) LEN(10) VALUE('*CURRENT ') DCL VAR(&SPCAUT) TYPE(*CHAR) LEN(20) VALUE('*SAVSYS *JOBCTL - ') DCL VAR(&NUMAUTH) TYPE(*CHAR) LEN(4) VALUE(X'00000002') DCL VAR(&INVLVL) TYPE(*CHAR) LEN(4) VALUE(X'00000001') DCL VAR(&ERRCOD) TYPE(*CHAR) LEN(4) VALUE(X'00000000') DCL VAR(&PRTSAUT) TYPE(*CHAR) LEN(20) VALUE('*ALLOBJ *IOSYSCFG- ') DCL VAR(&GRPJOB) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNUM) TYPE(*CHAR) LEN(6) DCL VAR(&GRPJOBLST) TYPE(*CHAR) LEN(1056) DCL VAR(&GRPJOBCNT) TYPE(*DEC) LEN(3 0) DCL VAR(&MYNAM) TYPE(*CHAR) LEN(10) DCL VAR(&MYUSR) TYPE(*CHAR) LEN(10) DCL VAR(&MYNUM) TYPE(*CHAR) LEN(6) DCL VAR(&JOBLST) TYPE(*DEC) LEN(4 0) DCL VAR(&DFT) TYPE(*CHAR) LEN(107) DCL VAR(&MSGQMD) TYPE(*CHAR) LEN(1) DCL VAR(&MSGSEV) TYPE(*CHAR) LEN(2) DCL VAR(&PROMPT) TYPE(*CHAR) LEN(1) DCL VAR(&CHECK) TYPE(*CHAR) LEN(1) DCL VAR(&CANCEL) TYPE(*CHAR) LEN(1) DCL VAR(&DELIVR) TYPE(*CHAR) LEN(7) DCL VAR(&STIME) TYPE(*CHAR) LEN(8) DCL VAR(&SNWS1) TYPE(*CHAR) LEN(10) DCL VAR(&UNMFS) TYPE(*CHAR) LEN(1) DCL VAR(&RETURNC) TYPE(*CHAR) LEN(1) DCL VAR(&PRTSYSI) TYPE(*CHAR) LEN(1) DCL VAR(&UNATBCK) TYPE(*CHAR) LEN(1) DCL VAR(&CPYR) TYPE(*CHAR) LEN(90) VALUE('5769-SS1 (C) COPYRIGHT- IBM CORP 1980, 1998. LICENSED MATERIAL - PROGRAM PROPERTY OF IBM') MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR2)) CHKAUT: CHGVAR VAR(&ENDSIND) VALUE('Y') CALL PGM(QSYCUSRS) PARM(&ISAUTH &UPNAME &SPCAUT &NUMAUTH &INVLVL- &ERRCOD) IF COND(&ISAUTH *EQ 'N') THEN(DO) SNDPGMMSG MSGID(CPF2351) MSGF(QCPFMSG) TOPGMQ(*PRV) - MSGTYPE(*ESCAPE) RETURN ENDDO SPECIALAUT: IF COND(&OPTION *EQ 'QMNRSTE') THEN(DO) CHKOBJ OBJ(RSTUSRPRF) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RSTLIB) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RSTDLO) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RSTCFG) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RSTAUT) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RST) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) IF COND(&NOTAUT *EQ '1') THEN(GOTO CMDLBL(ERROR)) ENDDO IF COND(&OPTION *EQ 'QSRRSTI') THEN(DO) CHKOBJ OBJ(RSTUSRPRF) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RSTLIB) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RSTCFG) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RSTAUT) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) IF COND(&NOTAUT *EQ '1') THEN(GOTO CMDLBL(ERROR)) ENDDO IF COND(&OPTION *EQ 'QSRRSTU') THEN(DO) CHKOBJ OBJ(RSTUSRPRF) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RSTLIB) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RSTDLO) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RSTCFG) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RST) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(RSTAUT) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) IF COND(&NOTAUT *EQ '1') THEN(GOTO CMDLBL(ERROR)) ENDDO IF COND(&OPTION *EQ 'QMNRSTN') THEN(DO) CHKOBJ OBJ(RSTLIB) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) IF COND(&NOTAUT *EQ '1') THEN(GOTO CMDLBL(ERROR)) ENDDO IF COND(&OPTION *EQ 'QMNSAVE') THEN(DO) CHKOBJ OBJ(SAVSYS) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(SAVLIB) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(SAVDLO) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(SAV) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) IF COND(&NOTAUT *EQ '1') THEN(GOTO CMDLBL(ERROR)) ENDDO IF COND(&OPTION *EQ 'QSRSAVI') THEN(DO) CHKOBJ OBJ(SAVSYS) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(SAVLIB) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) IF COND(&NOTAUT *EQ '1') THEN(GOTO CMDLBL(ERROR)) ENDDO IF COND(&OPTION *EQ 'QSRSAVU') THEN(DO) CHKOBJ OBJ(SAVSECDTA) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(SAVCFG) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(SAVLIB) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(SAVDLO) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(SAV) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) IF COND(&NOTAUT *EQ '1') THEN(GOTO CMDLBL(ERROR)) ENDDO IF COND(&OPTION *EQ 'QMNSAVN') THEN(DO) CHKOBJ OBJ(SAVLIB) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(GOTO CMDLBL(ERROR)) ENDDO IF COND(&OPTION *EQ 'QMNDSLO') THEN(DO) CHKOBJ OBJ(SAVSYS) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(SAVLIB) OBJTYPE(*CMD) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(QLPCRTDT) OBJTYPE(*PGM) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) CHKOBJ OBJ(QLPINLPP) OBJTYPE(*PGM) AUT(*USE) MONMSG MSGID(CPF9802) EXEC(CHGVAR VAR(&NOTAUT) VALUE('1')) IF COND(&NOTAUT *EQ '1') THEN(GOTO CMDLBL(ERROR)) ENDDO IF COND(&OPTION *EQ 'QSRDFT') THEN(DO) CHKOBJ OBJ(QUSRSYS) OBJTYPE(*LIB) AUT(*CHANGE) /*š MONMSG MSGID(CPF1022) EXEC(GOTO CMDLBL(END2))€*/ /*šRemoved for V4R4€*/ MONMSG MSGID(CPF9802) EXEC(GOTO CMDLBL(ERROR)) /*šAdded for V4R4€*/ CHKOBJ OBJ(QUSRSYS/QSRDFLTS) OBJTYPE(*DTAARA) AUT(*CHANGE) /*š MONMSG MSGID(CPF2189) EXEC(GOTO CMDLBL(END2))€*/ /*šRemoved for V4R4€*/ MONMSG MSGID(CPF2189) EXEC(GOTO CMDLBL(ERROR)) /*šAdded for V4R4€*/ MONMSG MSGID(CPF9802) EXEC(GOTO CMDLBL(ERROR)) /*šAdded for V4R4€*/ MONMSG MSGID(CPF9801) EXEC(GOTO CMDLBL(CRTDTA)) GOTO CMDLBL(CHGDTA) CRTDTA: RCVMSG MSGTYPE(*LAST) RMV(*YES) CALL PGM(QMNUIM) PARM(DFNDFT QGMNINFO &FUNC &DFT) CRTDTAARA DTAARA(QUSRSYS/QSRDFLTS) TYPE(*CHAR) LEN(200) - VALUE(&DFT) AUT(*USE) RCVMSG MSGTYPE(*LAST) RMV(*YES) GOTO CMDLBL(END2) CHGDTA: CALL PGM(QMNUIM) PARM(DFNDFT QGMNINFO &FUNC &DFT) CHGDTAARA DTAARA(QUSRSYS/QSRDFLTS) VALUE(&DFT) GOTO CMDLBL(END2) ENDDO CHKCTLSBS: CALL PGM(QMNSBS) PARM(&SBS &CTLSBSD &CTLSBSLIB) IF COND(&CTLSBSD *NE &SBS) THEN(DO) CALL PGM(QMNUIM) PARM(TFRJOB QGMNINFO &FUNC) RETURN ENDDO IF COND(&OPTION *EQ 'QMNRSTE') THEN(DO) CALL PGM(QMNUIM) PARM(RSTENT QGMNINFO &FUNC &DFT) ENDDO IF COND(&OPTION *EQ 'QSRRSTI') THEN(DO) CALL PGM(QMNUIM) PARM(RSTIBM QGMNINFO &FUNC &DFT) ENDDO IF COND(&OPTION *EQ 'QSRRSTU') THEN(DO) CALL PGM(QMNUIM) PARM(RSTUSR QGMNINFO &FUNC &DFT) ENDDO IF COND(&OPTION *EQ 'QMNRSTN') THEN(DO) CALL PGM(QMNUIM) PARM(RSTNON QGMNINFO &FUNC &DFT) ENDDO IF COND(&OPTION *EQ 'QMNSAVE') THEN(DO) CALL PGM(QMNUIM) PARM(SAVENT QGMNINFO &FUNC &DFT) ENDDO IF COND(&OPTION *EQ 'QSRSAVI') THEN(DO) CALL PGM(QMNUIM) PARM(SAVIBM QGMNINFO &FUNC &DFT) ENDDO IF COND(&OPTION *EQ 'QSRSAVU') THEN(DO) CALL PGM(QMNUIM) PARM(SAVUSR QGMNINFO &FUNC &DFT) ENDDO IF COND(&OPTION *EQ 'QMNSAVN') THEN(DO) CALL PGM(QMNUIM) PARM(SAVNON QGMNINFO &FUNC &DFT) ENDDO IF COND(&OPTION *EQ 'QMNDSLO') THEN(DO) CALL PGM(QMNUIM) PARM(SAVDSLO QGMNINFO &FUNC &DFT) ENDDO IF COND(&FUNC *EQ '*EXIT ') THEN(RETURN) IF COND(&FUNC *EQ '*PREV ') THEN(RETURN) CHGVAR VAR(&MSGQMD) VALUE(%SST(&DFT 1 1)) CHGVAR VAR(&MSGSEV) VALUE(%SST(&DFT 2 2)) CHGVAR VAR(&PROMPT) VALUE(%SST(&DFT 4 1)) CHGVAR VAR(&CHECK) VALUE(%SST(&DFT 5 1)) CHGVAR VAR(&DELIVR) VALUE(%SST(&DFT 46 7)) CHGVAR VAR(&STIME) VALUE(%SST(&DFT 53 8)) CHGVAR VAR(&SNWS1) VALUE(%SST(&DFT 61 10)) CHGVAR VAR(&UNMFS) VALUE(%SST(&DFT 101 1)) CHGVAR VAR(&RETURNC) VALUE(%SST(&DFT 102 1)) CHGVAR VAR(&PRTSYSI) VALUE(%SST(&DFT 103 1)) CHGVAR VAR(&UNATBCK) VALUE(%SST(&DFT 107 1)) IF COND(&PRTSYSI *EQ 'Y') THEN(DO) CALL PGM(QSYCUSRS) PARM(&ISAUTH &UPNAME &PRTSAUT &NUMAUTH - &INVLVL &ERRCOD) IF COND(&ISAUTH *EQ 'N') THEN(DO) SNDPGMMSG MSGID(CPF385F) MSGF(QCPFMSG) TOPGMQ(*PRV) - MSGTYPE(*ESCAPE) RETURN ENDDO CALL PGM(QMNUIM) PARM(PRTSYSINF QGMNINFO &FUNC &DFT) ENDDO IF COND(&UNATBCK *EQ 'Y') THEN(DO) CHGJOB INQMSGRPY(*SYSRPYL) ENDDO CHGMSGQ: IF COND((&DELIVR *EQ '*BREAK ') *AND (&MSGQMD *NE 'B')) - THEN(CHGMSGQ MSGQ(QSYSOPR) DLVRY(*BREAK) SEV(99)) IF COND((&DELIVR *EQ '*NOTIFY') *AND (&MSGQMD *NE 'N')) - THEN(CHGMSGQ MSGQ(QSYSOPR) DLVRY(*NOTIFY) SEV(99)) CHGVAR VAR(&ENDSIND) VALUE('N') DLYJOB: IF COND(&STIME *NE '*CURRENT') THEN(DO) IF COND(&PROMPT *EQ 'N') THEN(DO) /*šAdd additional delay if required (allows delay above 24 hours up to 9 days€*/ ADDDLY STARTTIME(&STIME) DELAY(0) PROMPT(Y) RTVSYSVAL SYSVAL(QTIME) RTNVAR(&CTIME) RTVJOBA TIMSEP(&TIMSEP) CHGVAR VAR(&MSGDTA) VALUE(&STIME *CAT (%SST(&CTIME 1 2)) *CAT - &TIMSEP *CAT (%SST(&CTIME 3 2)) *CAT &TIMSEP *CAT (%SST(&CTIME 5 2))) SNDPGMMSG MSGID(CPI3716) MSGF(QCPFMSG) MSGDTA(&MSGDTA) - TOPGMQ(*EXT) MSGTYPE(*STATUS) DLYJOB RSMTIME(&STIME) ENDDO ENDDO ENDSBS: IF COND(&PROMPT *EQ 'N') THEN(DO) ENDSBS SBS(*ALL) OPTION(*IMMED) MONMSG MSGID(CPF1035) EXEC(GOTO CMDLBL(ENDGRPJ)) MONMSG MSGID(CPF1001) EXEC(GOTO CMDLBL(DELAY)) ENDDO ELSE CMD(DO) ? ENDSBS ?*SBS(*ALL) ?*OPTION(*IMMED) MONMSG MSGID(CPF1035) EXEC(GOTO CMDLBL(ENDGRPJ)) MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(MON6801)) MONMSG MSGID(CPF1001) EXEC(GOTO CMDLBL(DELAY)) ENDDO ENDGRPJ: CHGVAR VAR(&JOBLST) VALUE(11) RTVGRPA GRPJOB(&GRPJOB) GRPJOBL(&GRPJOBLST) GRPJOBCNT(&GRPJOBCNT) RTVJOBA JOB(&MYNAM) USER(&MYUSR) NBR(&MYNUM) ZAPJOBS: IF COND(&GRPJOBCNT *EQ 0) THEN(GOTO CMDLBL(NOGRPJ)) CHGVAR VAR(&JOBNUM) VALUE(%SST(&GRPJOBLST &JOBLST 6)) CHGVAR VAR(&JOBLST) VALUE(&JOBLST + 66) IF COND(&JOBNUM *EQ &MYNUM) THEN(GOTO CMDLBL(NEXTJOB)) ENDJOB JOB(&JOBNUM/&MYUSR/&MYNAM) OPTION(*IMMED) NEXTJOB: CHGVAR VAR(&GRPJOBCNT) VALUE(&GRPJOBCNT - 1) GOTO CMDLBL(ZAPJOBS) NOGRPJ: /*šBump up delay from 5 to 30 seconds€*/ DLYJOB DLY(30) LOOP: ENDSBS SBS(*ALL) OPTION(*IMMED) MONMSG MSGID(CPF1035 CPF1001) EXEC(GOTO CMDLBL(DELAY)) GOTO CMDLBL(ENDSBSDONE) DELAY: RCVMSG MSGTYPE(*EXCP) RMV(*YES) IF COND(&LOOPCNT *LT 119) THEN(DO) DLYJOB DLY(15) CHGVAR VAR(&LOOPCNT) VALUE(&LOOPCNT + 1) GOTO CMDLBL(LOOP) ENDDO ELSE CMD(GOTO CMDLBL(ISS3712)) ENDSBSDONE: RCVMSG MSGTYPE(*LAST) RMV(*YES) GOTO CMDLBL(CALLPGM) CALLPGM: IF COND(&SNWS1 *NE '*NONE') THEN(DO) CALL PGM(QMNUIM) PARM(SAVEMVOFF QGMNINFO &FUNC &DFT) CHGVAR VAR(&RETURNC) VALUE(%SST(&DFT 102 1)) IF COND(&RETURNC *NE ' ') THEN(GOTO CMDLBL(ERROR2)) ENDDO IF COND(&UNMFS *EQ 'Y') THEN(DO) CALL PGM(QMNUIM) PARM(UNMOUNT QGMNINFO &FUNC &DFT) CHGVAR VAR(&RETURNC) VALUE(%SST(&DFT 102 1)) IF COND(&RETURNC *NE ' ') THEN(GOTO CMDLBL(ERROR2)) ENDDO CALL PGM(&OPTION) PARM(&DFT &CANCEL) MONMSG MSGID(CPF2361) EXEC(GOTO CMDLBL(ERROR2)) GOTO CMDLBL(SNDCMP) ERROR: CHGVAR VAR(&MESSAGE) VALUE(CPF386E) GOTO CMDLBL(END) ERROR2: RCVMSG MSGTYPE(*LAST) RMV(*NO) KEYVAR(&MSGKEY) MSGID(&MSGID) IF COND(&MSGID *EQ CPF2361) THEN(RMVMSG MSGQ(*PGMQ) - MSGKEY(&MSGKEY)) CHGVAR VAR(&MESSAGE) VALUE(CPF2361) IF COND(&MSGID *EQ CPF2408) THEN(GOTO CMDLBL(CNLENDS)) GOTO CMDLBL(END) SNDCMP: SNDPGMMSG MSGID(CPC2356) MSGF(QCPFMSG) TOPGMQ(*PRV) - MSGTYPE(*COMP) GOTO CMDLBL(END) ISS3712: SNDPGMMSG MSGID(CPA3712) MSGF(*LIBL/QCPFMSG) TOPGMQ(*EXT) - MSGTYPE(*INQ) RCVMSG PGMQ(*SAME) MSGQ(*PGMQ) MSGTYPE(*RPY) WAIT(*MAX) - RMV(*YES) MSG(&MSGTXT) IF COND(%SST(&MSGTXT 1 1) *EQ 'G') THEN(DO) CHGVAR VAR(&LOOPCNT) VALUE(1) GOTO CMDLBL(LOOP) ENDDO ELSE CMD(DO) CHGVAR VAR(&MESSAGE) VALUE(CPF2361) CHGVAR VAR(&CANCEL) VALUE('N') GOTO CMDLBL(END) ENDDO MON6801: RCVMSG PGMQ(*SAME) MSGQ(*PGMQ) MSGTYPE(*LAST) WAIT(*MAX) - RMV(*YES) IF COND((&OPTION *EQ 'QSRSAVU') *OR (&OPTION *EQ 'QSRRSTU')) - THEN(DO) SNDPGMMSG MSGID(CPA370A) MSGF(*LIBL/QCPFMSG) MSGDTA(&MSGID) - TOPGMQ(*EXT) MSGTYPE(*INQ) RCVMSG PGMQ(*SAME) MSGQ(*PGMQ) MSGTYPE(*RPY) WAIT(*MAX) - RMV(*YES) MSG(&MSGTXT) IF COND(%SST(&MSGTXT 1 1) *EQ 'G') THEN(GOTO CMDLBL(CALLPGM)) ELSE CMD(DO) CHGVAR VAR(&CANCEL) VALUE(Y) GOTO CMDLBL(END) ENDDO ENDDO ELSE CMD(DO) CHGVAR VAR(&CANCEL) VALUE(Y) GOTO CMDLBL(END) ENDDO END: IF COND(&SNWS1 *NE '*NONE') THEN(DO) CALL PGM(QMNUIM) PARM(SAVEMVON QGMNINFO &FUNC &DFT) ENDDO IF COND(&CANCEL *EQ N) THEN(DO) IF COND(&PROMPT *EQ 'Y') THEN(DO) ? STRSBS SBSD(&CTLSBSLIB/&CTLSBSD) MONMSG MSGID(CPF0000) ENDDO ELSE CMD(DO) STRSBS SBSD(&CTLSBSLIB/&CTLSBSD) MONMSG MSGID(CPF0000) ENDDO ENDDO IF COND(&ENDSIND *EQ 'Y') THEN(GOTO CMDLBL(CNLENDS)) IF COND(&MSGQMD *EQ 'H') THEN(CHGMSGQ MSGQ(QSYSOPR) DLVRY(*HOLD)- SEV(&MSGSEV)) ELSE CMD(IF COND(&MSGQMD *EQ 'N') THEN(CHGMSGQ MSGQ(QSYSOPR) - DLVRY(*NOTIFY) SEV(&MSGSEV))) ELSE CMD(IF COND(&MSGQMD *EQ 'D') THEN(CHGMSGQ MSGQ(QSYSOPR) - DLVRY(*DFT) SEV(&MSGSEV))) ELSE CMD(IF COND(&MSGQMD *EQ 'B') THEN(CHGMSGQ MSGQ(QSYSOPR) - DLVRY(*BREAK) SEV(&MSGSEV))) ELSE CMD(CHGMSGQ MSGQ(QSYSOPR) DLVRY(*SAME) SEV(&MSGSEV)) CNLENDS: + CHGVAR VAR(&CPYR) VALUE(&CPYR) /*šNot really worried about this error - not enough to fail the save, anyway€*/ /*šso resend it as information only.€*/ /*š IF COND(&MESSAGE *EQ 'CPF2361') THEN(SNDPGMMSG MSGID(CPF2361) - šSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*ESCAPE)) €*/ IF COND(&MESSAGE *EQ 'CPF2361') THEN(SNDPGMMSG MSGID(CPF2361) - MSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*INFO)) ELSE CMD(IF COND(&MESSAGE *EQ 'CPF386E') THEN(SNDPGMMSG - MSGID(CPF386E) MSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*ESCAPE))) END2: RETURN ENDPGM