/*š****************************************************************€*/ /*š €*/ /*š5769SS1 V4R3M0 980729 RTVCLSRC Output 29/04/99 10:22:56 €*/ /*š €*/ /*šProgram name . . . . . . . . . . . . . . : QMNSAVE 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 . . . . . . . . . . . . : PC*/ /*šPatch APAR ID . . . . . . . . . . . . . : PA*/ /*šUser mod flag . . . . . . . . . . . . . : *NO UM*/ /*š ED*/ /*š**************************************************************************€*/ /*šMR1 Apr'99 Send 'Error occured with option' (CPF2361) as *INFO so this €*/ /*š pgm continues to run. €*/ /*šMR2 May'99 Still having problems with the timing of this program. The €*/ /*š system puts an entry on the history log to indicate that the €*/ /*š system is in a restricted state, but somehow this pgm is €*/ /*š being called before that happens (it shows up a few seconds €*/ /*š later). This pgm now loops to make sure the entry (CPF0968) €*/ /*š is there before running the save command. €*/ /*šMR3 Mar'00 One off reclaim storage before the upgrade to V4R4, LIV1 only€*/ /*šMR4 Apr'00 Removed above. €*/ /*š**************************************************************************€*/ PGM PARM(&DFT &CANCEL) DCL VAR(&CANCEL) TYPE(*CHAR) LEN(1) DCL VAR(&CLEAR) TYPE(*CHAR) LEN(5) DCL VAR(&COMMAND) TYPE(*CHAR) LEN(10) DCL VAR(&NXTCMD) TYPE(*CHAR) LEN(10) DCL VAR(&DEV) TYPE(*CHAR) LEN(43) DCL VAR(&DEVEND) TYPE(*CHAR) LEN(10) DCL VAR(&ERRFLAG) TYPE(*LGL) VALUE('0') DCL VAR(&MSGDATA) TYPE(*CHAR) LEN(150) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&MSGOFS) TYPE(*DEC) LEN(3) DCL VAR(&MSGTXT) TYPE(*CHAR) LEN(1) DCL VAR(&MSGRPL) TYPE(*CHAR) LEN(27) DCL VAR(&SAVCMD) TYPE(*CHAR) LEN(1000) DCL VAR(&TMPTAP1) TYPE(*CHAR) LEN(10) DCL VAR(&TMPTAP2) TYPE(*CHAR) LEN(10) DCL VAR(&PATH1) TYPE(*CHAR) LEN(28) DCL VAR(&PATH2) TYPE(*CHAR) LEN(28) DCL VAR(&PATH3) TYPE(*CHAR) LEN(28) DCL VAR(&PATH4) TYPE(*CHAR) LEN(28) DCL VAR(&DEVPATH) TYPE(*CHAR) LEN(112) DCL VAR(&DEVD) TYPE(*CHAR) LEN(7) DCL VAR(&QSYSLIB) TYPE(*CHAR) LEN(11) DCL VAR(&DFT) TYPE(*CHAR) LEN(107) DCL VAR(&MSGQMD) TYPE(*CHAR) LEN(1) DCL VAR(&PROMPT) TYPE(*CHAR) LEN(1) DCL VAR(&CHECK) TYPE(*CHAR) LEN(1) DCL VAR(&TAP1) TYPE(*CHAR) LEN(10) DCL VAR(&TAP2) TYPE(*CHAR) LEN(10) DCL VAR(&TAP3) TYPE(*CHAR) LEN(10) DCL VAR(&TAP4) TYPE(*CHAR) LEN(10) DCL VAR(&CPYR) TYPE(*CHAR) LEN(90) VALUE('5769-SS1 (C) COPYRIGHT- IBM CORP 1980, 1998. LICENSED MATERIAL - PROGRAM PROPERTY OF IBM') /*šVariables for checking the status of the subsystems MR2€*/ DCL VAR(&RESTRICTED) TYPE(*LGL) VALUE('0') DCL VAR(&LOOPCOUNT) TYPE(*DEC) LEN(3 0) VALUE(0) MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR)) /*šMake sure CPF0968 has appeared in the history log before continuing MR2€*/ CHKENDSBS: CHGVAR VAR(&LOOPCOUNT) VALUE(&LOOPCOUNT + 1) /*šIf it's been over an hour since trying to start this, then proceed anyway€*/ IF COND(&LOOPCOUNT > 12) THEN(GOTO CMDLBL(SETUP)) CALL PGM(CHKENDSBS) PARM(&RESTRICTED) MONMSG MSGID(CPF0000) /*šIf the system is in a restricted state, then proceed with the save€*/ IF COND(&RESTRICTED) THEN(GOTO CMDLBL(SETUP)) /*šOtherwise wait five minutes before trying again€*/ DLYJOB DLY(300) GOTO CMDLBL(CHKENDSBS) SETUP: CHGVAR VAR(&CANCEL) VALUE(N) CHGVAR VAR(&MSGQMD) VALUE(%SST(&DFT 1 1)) CHGVAR VAR(&PROMPT) VALUE(%SST(&DFT 4 1)) CHGVAR VAR(&CHECK) VALUE(%SST(&DFT 5 1)) CHGVAR VAR(&TAP1) VALUE(%SST(&DFT 6 10)) CHGVAR VAR(&TAP2) VALUE(%SST(&DFT 16 10)) CHGVAR VAR(&TAP3) VALUE(%SST(&DFT 26 10)) CHGVAR VAR(&TAP4) VALUE(%SST(&DFT 36 10)) CHGVAR VAR(&DEV) VALUE(&TAP1 *BCAT &TAP2 *BCAT &TAP3 *BCAT &TAP4) IF COND(&CHECK *EQ 'N') THEN(CHGVAR VAR(&CLEAR) VALUE(*ALL)) ELSE CMD(CHGVAR VAR(&CLEAR) VALUE(*NONE)) SAVSYS: CHGVAR VAR(&COMMAND) VALUE('SAVSYS ') CHGVAR VAR(&NXTCMD) VALUE('SAVLIB ') IF COND(&PROMPT *EQ 'N') THEN(DO) CHGVAR VAR(&SAVCMD) VALUE('SAVSYS DEV(' *CAT &DEV *CAT ') - CLEAR(' *CAT &CLEAR *CAT ') ENDOPT(*LEAVE)') ENDDO ELSE CMD(DO) CHGVAR VAR(&SAVCMD) VALUE('? SAVSYS ?*DEV(' *CAT &DEV *CAT ') - ??CLEAR(' *CAT &CLEAR *CAT ') ??ENDOPT(*LEAVE)') ENDDO VRYCFG CFGOBJ(&TAP1) CFGTYPE(*DEV) STATUS(*ON) MONMSG MSGID(CPD2639) CALL PGM(QCMDEXC) PARM(&SAVCMD 1000) MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(MON6801)) MONMSG MSGID(CPF3772) EXEC(GOTO CMDLBL(ISS3708)) MONMSG MSGID(CPF3767 CPF3768) EXEC(GOTO CMDLBL(ISS3710)) RCVMSG MSGTYPE(*LAST) RMV(*NO) MSGDTA(&MSGDATA) MSGID(&MSGID) IF COND(&MSGID *EQ CPC3702) THEN(DO) CHGVAR VAR(&MSGOFS) VALUE(85) GOTO CMDLBL(SWITCH) ENDDO ELSE CMD(GOTO CMDLBL(ERROR)) SAVLIB: CHGVAR VAR(&COMMAND) VALUE('SAVLIB ') CHGVAR VAR(&NXTCMD) VALUE('SAVDLO ') IF COND(&PROMPT *EQ 'N') THEN(DO) CHGVAR VAR(&SAVCMD) VALUE('SAVLIB LIB(*NONSYS) CLEAR(' *CAT - &CLEAR *CAT ') DEV(' *CAT &DEV *CAT ') TGTRLS(*CURRENT) - ENDOPT(*LEAVE) ACCPTH(*YES)') ENDDO ELSE CMD(DO) CHGVAR VAR(&SAVCMD) VALUE('? SAVLIB ?*LIB(*NONSYS) ??CLEAR(' - *CAT &CLEAR *CAT ') ?*DEV(' *CAT &DEV *CAT ') ?*TGTRLS(*CURRENT) - ??ENDOPT(*LEAVE) ??ACCPTH(*YES)') ENDDO CALL PGM(QCMDEXC) PARM(&SAVCMD 1000) MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(MON6801)) MONMSG MSGID(CPF3777) EXEC(GOTO CMDLBL(ISS3708)) MONMSG MSGID(CPF3767 CPF3768) EXEC(GOTO CMDLBL(ISS3710)) RCVMSG MSGTYPE(*LAST) RMV(*NO) MSGDTA(&MSGDATA) MSGID(&MSGID) IF COND(&MSGID *EQ CPC3707) THEN(DO) CHGVAR VAR(&MSGOFS) VALUE(23) GOTO CMDLBL(SWITCH) ENDDO ELSE CMD(GOTO CMDLBL(ERROR)) SAVDLO: CHGVAR VAR(&COMMAND) VALUE('SAVDLO') CHGVAR VAR(&NXTCMD) VALUE('SAV ') IF COND(&PROMPT *EQ 'N') THEN(DO) CHGVAR VAR(&SAVCMD) VALUE('SAVDLO DLO(*ALL) CLEAR(' *CAT &CLEAR - *CAT ') DEV(' *CAT &DEV *CAT ') TGTRLS(*CURRENT) - ENDOPT(*LEAVE)') ENDDO ELSE CMD(DO) CHGVAR VAR(&SAVCMD) VALUE('? SAVDLO ??DLO(*ALL) ??CLEAR(' *CAT - &CLEAR *CAT ') ?*TGTRLS(*CURRENT) ?*DEV(' *CAT &DEV *CAT ') - ??ENDOPT(*LEAVE)') ENDDO CALL PGM(QCMDEXC) PARM(&SAVCMD 1000) MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(MON6801)) MONMSG MSGID(CPF902E) EXEC(GOTO CMDLBL(ISS3708)) MONMSG MSGID(CPF3767 CPF3768) EXEC(GOTO CMDLBL(ISS3710)) RCVMSG MSGTYPE(*LAST) RMV(*NO) MSGDTA(&MSGDATA) MSGID(&MSGID) IF COND(&MSGID *EQ CPC9410) THEN(DO) CHGVAR VAR(&MSGOFS) VALUE(128) GOTO CMDLBL(SWITCH) ENDDO ELSE CMD(GOTO CMDLBL(ERROR)) SAV: CHGVAR VAR(&COMMAND) VALUE('SAV ') CHGVAR VAR(&NXTCMD) VALUE('NOMORE ') CHGVAR VAR(&QSYSLIB) VALUE('''/QSYS.LIB/') CHGVAR VAR(&DEVD) VALUE('.DEVD ''') CHGVAR VAR(&PATH1) VALUE(&QSYSLIB *CAT &TAP1 *TCAT &DEVD) IF COND(&TAP2 *NE ' ') THEN(DO) CHGVAR VAR(&PATH2) VALUE(&QSYSLIB *CAT &TAP2 *TCAT &DEVD) ENDDO IF COND(&TAP3 *NE ' ') THEN(DO) CHGVAR VAR(&PATH3) VALUE(&QSYSLIB *CAT &TAP3 *TCAT &DEVD) ENDDO IF COND(&TAP4 *NE ' ') THEN(DO) CHGVAR VAR(&PATH4) VALUE(&QSYSLIB *CAT &TAP4 *TCAT &DEVD) ENDDO CHGVAR VAR(&DEVPATH) VALUE(&PATH1 *BCAT &PATH2 *BCAT &PATH3 - *BCAT &PATH4) IF COND(&PROMPT *EQ 'N') THEN(DO) CHGVAR VAR(&SAVCMD) VALUE('SAV OBJ((''/*'') (''/QSYS.LIB'' - *OMIT) (''/QDLS'' *OMIT)) CLEAR(' *CAT &CLEAR *CAT ') DEV(' *CAT - &DEVPATH *CAT ') UPDHST(*YES) ENDOPT(*UNLOAD) ') ENDDO ELSE CMD(DO) CHGVAR VAR(&SAVCMD) VALUE('? SAV ??OBJ((''/*'') (''/QSYS.LIB'' - *OMIT) (''/QDLS'' *OMIT)) ??CLEAR(' *CAT &CLEAR *CAT ') ?*DEV(' - *CAT &DEVPATH *CAT ') ??UPDHST(*YES) ??ENDOPT(*UNLOAD)- ') ENDDO CALL PGM(QCMDEXC) PARM(&SAVCMD 1000) MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(MON6801)) MONMSG MSGID(CPF3767 CPF3768) EXEC(GOTO CMDLBL(ISS3710)) MONMSG MSGID(CPF3837) /*šIf problems with the IPCS folders, + š carry on without failing€*/ VRYCFG CFGOBJ(&TAP1) CFGTYPE(*DEV) STATUS(*OFF) MONMSG MSGID(CPD2640) NOMORE: IF COND(&ERRFLAG *EQ '0') THEN(GOTO CMDLBL(END)) ERROR: SNDPGMMSG MSGID(CPF2361) MSGF(QCPFMSG) TOPGMQ(*PRV) + MSGTYPE(*INFO) GOTO CMDLBL(END) SWITCH: CHGVAR VAR(&DEVEND) VALUE(%SST(&MSGDATA &MSGOFS 10)) IF COND(&TAP2 = ' ') THEN(DO) ENDDO ELSE CMD(IF COND(&TAP3 = ' ') THEN(DO)) IF COND(&DEVEND *EQ &TAP2) THEN(DO) CHGVAR VAR(&TMPTAP1) VALUE(&TAP1) CHGVAR VAR(&TAP1) VALUE(&TAP2) CHGVAR VAR(&TAP2) VALUE(&TMPTAP1) ENDDO ENDDO ELSE CMD(IF COND(&TAP4 = ' ') THEN(DO)) IF COND(&DEVEND *EQ &TAP2) THEN(DO) CHGVAR VAR(&TMPTAP1) VALUE(&TAP1) CHGVAR VAR(&TAP1) VALUE(&TAP2) CHGVAR VAR(&TAP2) VALUE(&TAP3) CHGVAR VAR(&TAP3) VALUE(&TMPTAP1) ENDDO ELSE CMD(IF COND(&DEVEND *EQ &TAP3) THEN(DO)) CHGVAR VAR(&TMPTAP1) VALUE(&TAP2) CHGVAR VAR(&TAP2) VALUE(&TAP1) CHGVAR VAR(&TAP1) VALUE(&TAP3) CHGVAR VAR(&TAP3) VALUE(&TMPTAP1) ENDDO ENDDO ELSE CMD(DO) IF COND(&DEVEND *EQ &TAP2) THEN(DO) CHGVAR VAR(&TMPTAP1) VALUE(&TAP1) CHGVAR VAR(&TAP1) VALUE(&TAP2) CHGVAR VAR(&TAP2) VALUE(&TAP3) CHGVAR VAR(&TAP3) VALUE(&TAP4) CHGVAR VAR(&TAP4) VALUE(&TMPTAP1) ENDDO ELSE CMD(IF COND(&DEVEND *EQ &TAP3) THEN(DO)) CHGVAR VAR(&TMPTAP1) VALUE(&TAP1) CHGVAR VAR(&TMPTAP2) VALUE(&TAP2) CHGVAR VAR(&TAP1) VALUE(&TAP3) CHGVAR VAR(&TAP2) VALUE(&TAP4) CHGVAR VAR(&TAP3) VALUE(&TMPTAP1) CHGVAR VAR(&TAP4) VALUE(&TMPTAP2) ENDDO ELSE CMD(IF COND(&DEVEND *EQ &TAP4) THEN(DO)) CHGVAR VAR(&TMPTAP1) VALUE(&TAP1) CHGVAR VAR(&TAP1) VALUE(&TAP4) CHGVAR VAR(&TAP4) VALUE(&TAP3) CHGVAR VAR(&TAP3) VALUE(&TAP2) CHGVAR VAR(&TAP2) VALUE(&TMPTAP1) ENDDO ENDDO CHGVAR VAR(&DEV) VALUE(&TAP1 *CAT &TAP2 *CAT &TAP3 *CAT &TAP4) GOTO CMDLBL(NXTCMD) NXTCMD: IF COND(&COMMAND *EQ 'SAVSYS') THEN(GOTO CMDLBL(SAVLIB)) ELSE CMD(IF COND(&COMMAND *EQ 'SAVLIB') THEN(GOTO - CMDLBL(SAVDLO))) ELSE CMD(IF COND(&COMMAND *EQ 'SAVDLO') THEN(GOTO CMDLBL(SAV))) ELSE CMD(IF COND(&COMMAND *EQ 'SAV') THEN(GOTO CMDLBL(NOMORE))) SAMCMD: IF COND(&COMMAND *EQ 'SAVSYS') THEN(GOTO CMDLBL(SAVSYS)) ELSE CMD(IF COND(&COMMAND *EQ 'SAVLIB') THEN(GOTO - CMDLBL(SAVLIB))) ELSE CMD(IF COND(&COMMAND *EQ 'SAVDLO') THEN(GOTO - CMDLBL(SAVDLO))) ELSE CMD(IF COND(&COMMAND *EQ 'SAV') THEN(GOTO CMDLBL(SAV))) ISS3708: CHGVAR VAR(&ERRFLAG) VALUE('1') RCVMSG MSGTYPE(*EXCP) RMV(*NO) MSGDTA(&MSGDATA) MSGID(&MSGID) IF COND(&MSGID *EQ CPF3772) THEN(CHGVAR VAR(&MSGOFS) VALUE(85)) ELSE CMD(IF COND(&MSGID *EQ CPF3777) THEN(CHGVAR VAR(&MSGOFS) - VALUE(23))) ELSE CMD(IF COND(&MSGID *EQ CPF902E) THEN(CHGVAR VAR(&MSGOFS) - VALUE(128))) CHGVAR VAR(&MSGRPL) VALUE(&MSGID *CAT &COMMAND *CAT &NXTCMD) SNDPGMMSG MSGID(CPA3708) MSGF(*LIBL/QCPFMSG) MSGDTA(&MSGRPL) - 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) IF COND(&COMMAND *EQ 'SAV') THEN(GOTO CMDLBL(NOMORE)) ELSE CMD(GOTO CMDLBL(SWITCH)) ENDDO ELSE CMD(GOTO CMDLBL(NOMORE)) ISS3710: RCVMSG MSGTYPE(*EXCP) RMV(*NO) MSGDTA(&MSGDATA) MSGID(&MSGID) CHGVAR VAR(&MSGRPL) VALUE(&MSGID *CAT &COMMAND *CAT &NXTCMD) SNDPGMMSG MSGID(CPA3710) MSGF(*LIBL/QCPFMSG) MSGDTA(&MSGRPL) - 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(NXTCMD)) ELSE CMD(IF COND(%SST(&MSGTXT 1 1) *EQ 'R') THEN(GOTO - CMDLBL(SAMCMD))) ELSE CMD(GOTO CMDLBL(NOMORE)) MON6801: RCVMSG PGMQ(*SAME) MSGQ(*PGMQ) MSGTYPE(*LAST) WAIT(*MAX) - RMV(*YES) 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(NXTCMD)) ELSE CMD(DO) CHGVAR VAR(&CANCEL) VALUE(Y) GOTO CMDLBL(NOMORE) ENDDO END: VRYCFG CFGOBJ(&TAP1) CFGTYPE(*DEV) STATUS(*OFF) MONMSG MSGID(CPD2640) /*šAnything else that needs doing while the box is in a restricted state €*/ /*š RCLSTG SELECT(*DBXREF)€*/ /*šFor example€*/ /*š MONMSG MSGID(CPF0000) €*/ /*šSpool the joblog so any problems can be looked at later. €*/ DSPJOBLOG OUTPUT(*PRINT) MONMSG MSGID(CPF0000) /*šPower down the system & restart to apply ptfs added since last time €*/ PWRDWNSYS OPTION(*IMMED) DELAY(3600) RESTART(*YES) IPLSRC(B) RETURN CHGVAR VAR(&CPYR) VALUE(&CPYR) ENDPGM