RGZDBRPFM: PGM PARM(&P_QF &P_FMBR &P_QLF &P_RCDFMT + &P_RUNTYP &P_QJOBQ) DCL VAR(&P_QF) TYPE(*CHAR) LEN(20) DCL VAR(&P_FMBR) TYPE(*CHAR) LEN(10) DCL VAR(&P_QLF) TYPE(*CHAR) LEN(32) DCL VAR(&P_RCDFMT) TYPE(*CHAR) LEN(10) DCL VAR(&P_RUNTYP) TYPE(*CHAR) LEN(10) DCL VAR(&P_QJOBQ) TYPE(*CHAR) LEN(20) /* */ /* These name the library/file (member) to process against... */ /* */ DCL VAR(&F) TYPE(*CHAR) LEN(10) DCL VAR(&FLIB) TYPE(*CHAR) LEN(10) DCL VAR(&FMBR) TYPE(*CHAR) LEN(10) /* */ /* These name the logical library/file (member) to reorganize by... */ /* */ DCL VAR(&LF) TYPE(*CHAR) LEN(10) DCL VAR(&LFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&LFMBR) TYPE(*CHAR) LEN(10) DCL VAR(&RCDFMT) TYPE(*CHAR) LEN(10) /* */ /* This tells what type of run this will be... */ /* */ DCL VAR(&RUNTYP) TYPE(*CHAR) LEN(10) /* */ /* This names the jobq for any SBMJOBs for ADDLFM... */ /* */ DCL VAR(&JOBQ) TYPE(*CHAR) LEN(10) DCL VAR(&JOBQLIB) TYPE(*CHAR) LEN(10) /* */ /* This names the library for temporary objects from this process... */ /* */ DCL VAR(&TMPLIB) TYPE(*CHAR) LEN(10) /* */ /* These help track recovery needs through the user-defined attribute... */ /* */ DCL VAR(&USRDFNATR) TYPE(*CHAR) LEN(10) /* The + User-defined attribute itself... */ DCL VAR(&COBJRTNLIB) TYPE(*CHAR) LEN(10) /* The + returned library name; not useful here + but required... */ DCL VAR(&COBJVARRCD) TYPE(*CHAR) LEN(22) /* The + 'variable record' used by the Change + Object Description API... */ /* These make up the 'variable record' above... */ DCL VAR(&COBJKEY) TYPE(*CHAR) LEN(4) + VALUE(X'00000009') /* Key'9' is + User-defined Attribute... */ DCL VAR(&COBJKEYLEN) TYPE(*CHAR) LEN(4) + VALUE(X'0000000A') /* This key is 10 + bytes long... */ DCL VAR(&COBJNBRRCD) TYPE(*CHAR) LEN(4) + VALUE(X'00000001') /* We're asking for + only a single record... */ /* */ /* These determine if this LF member is a join or not. An extracted value */ /* of *zero for &JREFNBR means this is *NOT a join file... */ /* */ DCL VAR(&JREFNBR_C) TYPE(*CHAR) LEN(4) /* The + character representation of the join + reference number... */ DCL VAR(&JREFNBR) TYPE(*DEC) LEN(9) /* The + numeric representation of the join + reference number... */ /* */ /* This tells us how many data members are referred to by an LF member... */ /* */ DCL VAR(&NBRDTAMBRS) TYPE(*DEC) LEN(2) /* */ /* These are list attributes from the List DBR *usrspc... */ /* */ DCL VAR(&OFFSLSTDTA) TYPE(*DEC) LEN(9) /* The + offset to the list data... */ DCL VAR(&NBRLSTE) TYPE(*DEC) LEN(7) /* The + number of list entries... */ DCL VAR(&SIZLSTE) TYPE(*DEC) LEN(5) /* The size + of a list entry... */ /* */ /* These are element attributes from the list... */ /* */ DCL VAR(&@_MBRE) TYPE(*DEC) LEN(9) /* The member + entry is pointed to by this... */ DCL VAR(&MBRELEN) TYPE(*DEC) LEN(5) /* The + member entry length is here... */ DCL VAR(&NBRMBRE) TYPE(*DEC) LEN(7) /* The + number of member entries is here... */ DCL VAR(&MBR) TYPE(*CHAR) LEN(10) /* The + dependent file member name from the + current entry is here... */ DCL VAR(&MBRF) TYPE(*CHAR) LEN(10) /* The + dependent file name from the current + entry is here... */ DCL VAR(&MBRFLIB) TYPE(*CHAR) LEN(10) /* The + dependent file library from the current + entry is here... */ /* */ /* DBF description info is returned here... */ /* */ DCL VAR(&DBFDT) TYPE(*CHAR) LEN(400) /* The DBF + template... */ DCL VAR(&DBF) TYPE(*CHAR) LEN(20) /* The actual + DBF name without overrides... */ /* */ /* The list entry is retrieved into here... */ /* */ DCL VAR(&USENT) TYPE(*CHAR) LEN(1000) /* The + user-space entry is received into here... */ /* */ /* A *LGL to track the result of CHGLF for later use... */ /* */ DCL VAR(&MAINT_OK) TYPE(*LGL) /* */ /* Used to pass LF owner name to ADDLFM... */ /* */ DCL VAR(&LFOWNER) TYPE(*CHAR) LEN(10) /* The + owner of the LF that we'll be adding + members to... */ /* */ /* These are used for receiving *DTAQ entries... */ /* */ DCL VAR(&RCVQFLDLEN) TYPE(*DEC) LEN(5) /* The + length of the received *dtaq entry... */ DCL VAR(&RCVQFLD) TYPE(*CHAR) LEN(256) /* The + *dtaq entry is received into here... */ DCL VAR(&DTAQKEY) TYPE(*CHAR) LEN(32) /* The + *dtaq entry key is set and then received + here... */ /* */ /* LF attributes we want to restore after reorg... */ /* */ DCL VAR(&MAINT) TYPE(*CHAR) LEN(6) DCL VAR(&RECOVER) TYPE(*CHAR) LEN(7) /*---------------------------------------------------------------------------*/ /* Global MONMSG... */ /*---------------------------------------------------------------------------*/ MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(STD_ERR)) /* */ /* Extract working values from parms and do an initial existence test... */ /* */ CHGVAR VAR(&F) VALUE(%SST(&P_QF 1 10)) CHGVAR VAR(&FLIB) VALUE(%SST(&P_QF 11 10)) CHGVAR VAR(&FMBR) VALUE(&P_FMBR) CHGVAR VAR(&LF) VALUE(%SST(&P_QLF 3 10)) CHGVAR VAR(&LFLIB) VALUE(%SST(&P_QLF 13 10)) CHGVAR VAR(&LFMBR) VALUE(%SST(&P_QLF 23 10)) IF COND(&LF *NE '*NONE') THEN(DO) CHKOBJ OBJ(&LFLIB) OBJTYPE(*LIB) CHKOBJ OBJ(&LFLIB/&LF) OBJTYPE(*FILE) CHKOBJ OBJ(&LFLIB/&LF) OBJTYPE(*FILE) MBR(&LFMBR) ENDDO CHGVAR VAR(&RCDFMT) VALUE(&P_RCDFMT) CHGVAR VAR(&RUNTYP) VALUE(&P_RUNTYP) CHGVAR VAR(&JOBQ) VALUE(%SST(&P_QJOBQ 1 10)) CHGVAR VAR(&JOBQLIB) VALUE(%SST(&P_QJOBQ 11 10)) ALCOBJ OBJ((&FLIB/&F *FILE *EXCL)) /* */ /* We use this library to store temporary objects in... */ /* */ RTVDTAARA DTAARA(RGZDBRPFM (1 10)) RTNVAR(&TMPLIB) IF COND(&TMPLIB *EQ 'QTEMP') THEN(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + MSGDTA('Temporary library cannot be + QTEMP. Check the RGZDBRPFM data area') + MSGTYPE(*ESCAPE) RETURN ENDDO /* */ /* This *msgq just helps track our progress... */ /* */ CRTMSGQ MSGQ(&TMPLIB/MBR) TEXT('Test list members') MONMSG MSGID(CPF0000) CLRMSGQ MSGQ(&TMPLIB/MBR) /* */ /* We list the DBR from the target file into a *usrspc. Since we want the */ /* *usrspc to have specific attributes, we'll delete any previously */ /* existing *usrspc of the same name and create our own. But before */ /* deleting, we'll verify that it isn't required for recovery... */ /* */ /* If one does not exist, initialize for recovery by setting the initial */ /* value for User-defined attribute as <*RCY>. We'll check the existing */ /* value of the object's *usrdfnatr to see if this run is going to step */ /* on a recovery-in-progress. Note that we skip that test if the *usrspc */ /* doesn't currently exist... */ /* */ RTVOBJD OBJ(&TMPLIB/&F) OBJTYPE(*USRSPC) + USRDFNATR(&USRDFNATR) MONMSG MSGID(CPF9801) EXEC(DO) CHGVAR VAR(&USRDFNATR) VALUE('*RCY') GOTO CMDLBL(CRT_USRSPC) ENDDO /* */ /* If one does exist, do not upset a recovery-in-progress... */ /* */ /* If the *usrspc USRDFNATR is set as *RCY, we can only do a *RECOVER. */ IF COND(&USRDFNATR *EQ '*RCY') THEN(DO) IF COND(&RUNTYP *EQ '*RECOVER') THEN(DO) GOTO CMDLBL(RUN_RCY) ENDDO ELSE CMD(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + MSGDTA('Object(' *CAT &TMPLIB *TCAT '/' + *CAT &F *TCAT ') type(*USRSPC) required + for recovery. Complete the recovery + process or delete it manually before + trying again') MSGTYPE(*ESCAPE) ENDDO ENDDO /* If the *usrspc USRDFNATR is otherwise, we can only do a *NORMAL. */ ELSE CMD(DO) IF COND(&RUNTYP *EQ '*NORMAL') THEN(DO) GOTO CMDLBL(CRT_USRSPC) ENDDO ELSE CMD(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Run + type(' *CAT &RUNTYP *TCAT ') not allowed + now. Either object(' *CAT &TMPLIB *TCAT + '/' *CAT &F *BCAT ') type(*USRSPC) does + not exist or it is in state(' *CAT + &USRDFNATR *TCAT ')') MSGTYPE(*ESCAPE) ENDDO ENDDO /* */ /* If we don't GOTO a processing point, we must have fallen through. And */ /* that means one of the error conditions exists. So... RETURN... */ /* (even if they are *ESCAPE messages. CYA.) */ /* */ RETURN /* */ /* ...otherwise, create one and continue... */ /* */ CRT_USRSPC: CRTUSRSPC USRSPC(&TMPLIB/&F) EXTATR(DBR) + INLSIZE(20480) DELETE(*YES) + TEXT('LUSDBFDBR for reorg') /* Set the user-defined attribute to note recovery... */ CHGVAR VAR(&COBJVARRCD) VALUE(&COBJNBRRCD *CAT + &COBJKEY *CAT &COBJKEYLEN *CAT &USRDFNATR) CHGOBJINF OBJ(&TMPLIB/&F) RTNLIB(&COBJRTNLIB) + OBJTYP(*USRSPC) OBJINF(&COBJVARRCD) /* */ /* Now list the DBR into the *usrspc... */ /* */ LUSDBFDBR USRSPC(&TMPLIB/&F) FORMAT(*MBR) + DBF(&FLIB/&F) MBR(&FMBR) /* */ /* Retrieve the *usrspc generic list header so we know how to process */ /* the list -- i.e., how many entries, how big they are, etc... */ /* */ RUSGENHDR USRSPC(&TMPLIB/&F) OFFSLSTDTA(&OFFSLSTDTA) + NBRLSTE(&NBRLSTE) SIZLSTE(&SIZLSTE) /* */ /* Extract basic list info... */ /* */ CHGVAR VAR(&@_MBRE) VALUE(&OFFSLSTDTA + 1) /* + Offset to start of list... */ CHGVAR VAR(&MBRELEN) VALUE(&SIZLSTE) /* Length of + an entry... */ CHGVAR VAR(&NBRMBRE) VALUE(&NBRLSTE) /* Number of + entries... */ /* */ /* This *dtaq helps us organize our LF rebuilds later... */ /* */ DLTDTAQ DTAQ(&TMPLIB/&F) MONMSG MSGID(CPF0000 MCH0000) /* We don't care if this fails + when the *dtaq doesn't exist yet because we want it + created with our specific attributes. We should + check for non-generic messages... */ CRTDTAQ DTAQ(&TMPLIB/&F) MAXLEN(2) FORCE(*YES) + SEQ(*KEYED) KEYLEN(30) TEXT('RGZDBRPFM LF + rebuilds') /* */ /* Loop through the list to remove members from all dependent LFs... */ /* */ NXT_MBR_R: RTVUSRSPC USRSPC(&TMPLIB/&F) STRPOS(&@_MBRE) + RTVLEN(&MBRELEN) RCVVAR(&USENT) /* */ /* Extract dependent LF member info from the current list entry... */ /* */ CHGVAR VAR(&MBRF) VALUE(%SST(&USENT 31 10)) /* If NO LFs exist, &MBRF will equal *NONE... */ IF COND(&MBRF *EQ '*NONE') THEN(GOTO + CMDLBL(DECR_CTR_1)) CHGVAR VAR(&MBRFLIB) VALUE(%SST(&USENT 41 10)) CHGVAR VAR(&MBR) VALUE(%SST(&USENT 51 10)) /* */ /* Extract the join reference number and convert to numeric... */ /* */ CHGVAR VAR(&JREFNBR_C) VALUE(%SST(&USENT 65 4)) CHGVAR VAR(&JREFNBR) VALUE(%BIN(&JREFNBR_C)) /* */ /* ...and remove the current member... UNLESS... the current member is for */ /* the LF that we're going to use to reorg by or this is a join file... */ /* */ /* Note: Multi-format LFs that refer to the same PF more than once will have */ /* an entry for each reference. Attempting to delete for each reference */ /* will give a failure after the first. Also, the processing needed to */ /* support the later ADDLFM is too complex for now. We do a RTVMBRD to */ /* see if multiple data members are referred to, and, if so, skip it... */ /* */ RTVMBRD FILE(&MBRFLIB/&MBRF) MBR(&MBR) + NBRDTAMBRS(&NBRDTAMBRS) MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(DECR_CTR_1)) IF COND(&NBRDTAMBRS *EQ 1) THEN(DO) /* We only handle LFs + with a single data member... */ IF COND((&MBRF *NE &LF *OR &MBR *NE &LFMBR) *AND &JREFNBR + *EQ 0) THEN(DO) /* We do not RMVM from any LF we're + using as the reorg keyfile, nor do we mess with join + LFs... */ RTVDBFDT DBFDT(&DBFDT) RTNDBF(&DBF) DBF(&MBRFLIB/&MBRF) /* */ /* We will try a couple ways to speed up access path rebuilds, by setting */ /* MAINT(*REBLD) and by RMVM and ADDLFM. If MAINT(*REBLD) is allowed for */ /* this LF, we want to change it back to MAINT(*IMMED) later to get us */ /* back to our current configuration. That means we have to save the */ /* current info someplace. We extract the attributes for MAINT() and */ /* RECOVER() now and put it on a keyed dtaq. The key is the LF/LIB names */ /* so we can easily find it. If MAINT(*REBLD) isn't allowed, we'll go */ /* with RMVM/ADDLFM and won't need to have the dtaq entry... */ /* */ CHGVAR VAR(&MAINT_OK) VALUE('1') CHGLF FILE(&MBRFLIB/&MBRF) MAINT(*REBLD) RECOVER(*NO) MONMSG MSGID(CPF7304) EXEC(DO) /* This LF does not allow + CHGLF this way. Fine... then we'll go with the RMVM + method... */ CHGVAR VAR(&MAINT_OK) VALUE('0') ENDDO /* If MAINT() changed ok, log it for later retrieval... */ IF COND(&MAINT_OK) THEN(DO) SNDDTAQKES SNDQ(&F) SNDQLIB(&TMPLIB) SNDQFLDLEN(2) + SNDQFLD(%SST(&DBFDT 22 1) *CAT + %SST(&DBFDT 178 1)) KEYLEN(30) + KEY(&MBRFLIB *CAT &MBRF *CAT &MBR) /* */ /* Log our progress... */ /* */ SNDMSG MSG('ChgLF Mbr:' *BCAT &MBR *BCAT 'File:' + *BCAT &MBRFLIB *TCAT '/' *CAT &MBRF) + TOMSGQ(&TMPLIB/MBR) ENDDO /* MAINT_OK... */ /* ...else try the RMVM/ADDLFM method... */ ELSE CMD(DO) /* Not MAINT_OK... */ RMVM FILE(&MBRFLIB/&MBRF) MBR(&MBR) MONMSG MSGID(CPF7310) EXEC(DO) SNDMSG MSG('Chk Mbr:' *BCAT &MBR *BCAT 'File:' *BCAT &MBRFLIB + *TCAT '/' *CAT &MBRF *BCAT '-- possible view') + TOMSGQ(&TMPLIB/MBR) /* RMVM not allowed for SQL + views... */ ENDDO /* */ /* Log our progress... */ /* */ SNDMSG MSG('Rmv Mbr:' *BCAT &MBR *BCAT 'File:' + *BCAT &MBRFLIB *TCAT '/' *CAT &MBRF) + TOMSGQ(&TMPLIB/MBR) ENDDO /* Not MAINT_OK... */ ENDDO ENDDO /* &NBRDTAMBRS *eq 1 */ ELSE CMD(DO) /* */ /* Log our progress... */ /* */ SNDMSG MSG('Skp Mbr:' *BCAT &MBR *BCAT 'File:' + *BCAT &MBRFLIB *TCAT '/' *CAT &MBRF *BCAT + '-- multi-format') TOMSGQ(&TMPLIB/MBR) ENDDO /* &NBRDTAMBRS *ne 1 */ /* */ /* Decrease our counter... */ /* */ DECR_CTR_1: CHGVAR VAR(&NBRMBRE) VALUE(&NBRMBRE - 1) /* */ /* If the counter reaches *zero, we finished the list... */ /* */ IF COND(&NBRMBRE *LE 0) THEN(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('End of + mbr rmv list reached') TOPGMQ(*EXT) GOTO CMDLBL(RGZ_MBR) ENDDO /* */ /* ...otherwise, go back to get the next entry... */ /* */ CHGVAR VAR(&@_MBRE) VALUE(&@_MBRE + &MBRELEN) GOTO CMDLBL(NXT_MBR_R) /* */ /* When we get to here, it's time to reorganize... */ /* */ RGZ_MBR: IF COND(&LF *EQ '*NONE') THEN(DO) RGZPFM FILE(&FLIB/&F) MBR(&FMBR) ENDDO ELSE CMD(DO) RGZPFM FILE(&FLIB/&F) MBR(&FMBR) KEYFILE(&LFLIB/&LF + &LFMBR) RCDFMT(&RCDFMT) ENDDO DLCOBJ OBJ((&FLIB/&F *FILE *EXCL)) /* */ /* After the reorg, we run through the list again. This time, we'll be */ /* adding the dependent LF members back into the LFs... */ /* */ /* */ /* Retrieve the *usrspc generic list header so we know how to process */ /* the list -- i.e., how many entries, how big they are, etc... */ /* */ /* We do the retrieve generic header here because we might be doing a */ /* recovery run and skipped the earlier retrieval. Besides, it's */ /* only a small amount of additional overhead... */ /* */ RUN_RCY: RUSGENHDR USRSPC(&TMPLIB/&F) OFFSLSTDTA(&OFFSLSTDTA) + NBRLSTE(&NBRLSTE) SIZLSTE(&SIZLSTE) /* */ /* Extract basic list info... */ /* */ CHGVAR VAR(&@_MBRE) VALUE(&OFFSLSTDTA + 1) /* + Offset to start of list... */ CHGVAR VAR(&MBRELEN) VALUE(&SIZLSTE) /* Length of + an entry... */ CHGVAR VAR(&NBRMBRE) VALUE(&NBRLSTE) /* Number of + entries... */ /* */ /* First, reinitialize our list pointer and counter... */ /* */ CHGVAR VAR(&@_MBRE) VALUE(&OFFSLSTDTA + 1) CHGVAR VAR(&NBRMBRE) VALUE(&NBRLSTE) /* */ /* Loop through the list again, this time to add... */ /* */ NXT_MBR_A: RTVUSRSPC USRSPC(&TMPLIB/&F) STRPOS(&@_MBRE) + RTVLEN(&MBRELEN) RCVVAR(&USENT) /* */ /* Extract dependent LF member info from the current list entry... */ /* */ CHGVAR VAR(&MBRF) VALUE(%SST(&USENT 31 10)) /* If NO LFs exist, &MBRF will equal *NONE... */ IF COND(&MBRF *EQ '*NONE') THEN(GOTO + CMDLBL(DECR_CTR_2)) CHGVAR VAR(&MBRFLIB) VALUE(%SST(&USENT 41 10)) CHGVAR VAR(&MBR) VALUE(%SST(&USENT 51 10)) /* */ /* Use the list entry to get the name of the PF... */ /* */ CHGVAR VAR(&F) VALUE(%SST(&USENT 1 10)) CHGVAR VAR(&FLIB) VALUE(%SST(&USENT 11 10)) CHGVAR VAR(&FMBR) VALUE(%SST(&USENT 21 10)) /* */ /* Extract the join reference number and convert to numeric... */ /* */ CHGVAR VAR(&JREFNBR_C) VALUE(%SST(&USENT 65 4)) CHGVAR VAR(&JREFNBR) VALUE(%BIN(&JREFNBR_C)) /* */ /* Submit each ADDLFM to a multi-threaded *jobq. (This allows multiple */ /* LF indexes to be rebuilt at the same time...) UNLESS... the current */ /* member is for the LF we reorged by or this is a join file... */ /* */ /* Note: Multi-format LFs that refer to the same PF more than once will have */ /* an entry for each reference. No need to ADDLFM for any but the first. */ /* But because these are sent to *batch, there's no good way to check. */ /* We'll just have to let it fail... UNLESS... it already exists... */ /* */ CHGVAR VAR(&MAINT_OK) VALUE('1') CHKOBJ OBJ(&MBRFLIB/&MBRF) OBJTYPE(*FILE) MBR(&MBR) MONMSG MSGID(CPF9815) EXEC(DO) CHGVAR VAR(&MAINT_OK) VALUE('0') ENDDO /* */ /* If a member exists, perhaps it's because we used CHGLF to reset the */ /* MAINT() and RECOVER() attributes. If so, we'll find a corresponding */ /* *dtaq entry. Otherwise, we assume the member exists because it was */ /* either the access path we're using to reorg by or it's a mbr that */ /* cannot be deleted, e.g., an SQL mbr or a mbr built over multiple PFs... */ /* */ /* Either way, we start here by assuming the MAINT() is okay to try... */ /* */ IF COND(&MAINT_OK) THEN(DO) IF COND((&MBRF *NE &LF *OR &MBR *NE &LFMBR) + *AND &JREFNBR *EQ 0) THEN(DO) CHGVAR VAR(&DTAQKEY) VALUE(&MBRFLIB *CAT &MBRF *CAT + &MBR) RCVDTAQKES RCVQ(&F) RCVQLIB(&TMPLIB) + RCVQFLDLEN(&RCVQFLDLEN) RCVQFLD(&RCVQFLD) + KEYLEN(30) KEY(&DTAQKEY) IF COND(&RCVQFLDLEN *EQ 0) THEN(DO) /* */ /* Log our progress... */ /* */ SNDMSG MSG('UnChgLF no *dtaq entry for Mbr:' *BCAT &MBR *BCAT + 'File:' *BCAT &MBRFLIB *TCAT '/' *CAT &MBRF) + TOMSGQ(&TMPLIB/MBR) ENDDO /* RCVQFLDLEN *eq 0... */ ELSE CMD(DO) /* RCVQFLDLEN *ne 0... */ /* */ /* Convert the MAINT() attribute... */ /* */ IF COND(%SST(&RCVQFLD 1 1) *EQ 'I') THEN(CHGVAR + VAR(&MAINT) VALUE('*IMMED')) ELSE CMD(IF COND(%SST(&RCVQFLD 1 1) *EQ 'D') + THEN(CHGVAR VAR(&MAINT) VALUE('*DLY'))) ELSE CMD(IF COND(%SST(&RCVQFLD 1 1) *EQ 'R') + THEN(CHGVAR VAR(&MAINT) VALUE('*REBLD'))) /* */ /* Convert the RECOVER() attribute... */ /* */ IF COND(%SST(&RCVQFLD 2 1) *EQ 'A') THEN(CHGVAR + VAR(&RECOVER) VALUE('*AFTIPL')) ELSE CMD(IF COND(%SST(&RCVQFLD 2 1) *EQ 'N') + THEN(CHGVAR VAR(&RECOVER) VALUE('*NO'))) ELSE CMD(IF COND(%SST(&RCVQFLD 2 1) *EQ 'S') + THEN(CHGVAR VAR(&RECOVER) VALUE('*IPL'))) CHGLF FILE(&MBRFLIB/&MBRF) MAINT(&MAINT) + RECOVER(&RECOVER) MONMSG MSGID(CPF0000 MCH0000) EXEC(DO) SNDMSG MSG('CHGLF failed for' *BCAT &MBRFLIB *TCAT + '/' *CAT &MBRF *BCAT 'during rebuild.') + TOMSGQ(&TMPLIB/MBR) ENDDO /* CHGLF MONMSG... */ /* */ /* Log our progress... */ /* */ SNDMSG MSG('UNChgLF Mbr:' *BCAT &MBR *BCAT 'File:' + *BCAT &MBRFLIB *TCAT '/' *CAT &MBRF) + TOMSGQ(&TMPLIB/MBR) ENDDO /* RCVQFLDLEN *ne 0... */ ENDDO /* IF LF tests fit... */ ENDDO /* MAINT_OK */ ELSE CMD(DO) /* not MAINT_OK... */ IF COND((&MBRF *NE &LF *OR &MBR *NE &LFMBR) + *AND &JREFNBR *EQ 0) THEN(DO) RTVOBJD OBJ(&MBRFLIB/&MBRF) OBJTYPE(*FILE) + OWNER(&LFOWNER) SBMJOB CMD(ADDLFM FILE(&MBRFLIB/&MBRF) MBR(&MBR) + DTAMBRS((&FLIB/&F (&FMBR)))) JOB(&MBRF) + JOBQ(&JOBQLIB/&JOBQ) USER(&LFOWNER) + LOG(*JOBD *JOBD *NOLIST) MSGQ(&TMPLIB/MBR) /* */ /* Log our progress... */ /* */ SNDMSG MSG('Add Mbr:' *BCAT &MBR *BCAT 'File:' + *BCAT &MBRFLIB *TCAT '/' *CAT &MBRF) + TOMSGQ(&TMPLIB/MBR) ENDDO /* IF LF tests fit... */ ENDDO /* not MAINT_OK */ /* */ /* Decrease our counter... */ /* */ DECR_CTR_2: CHGVAR VAR(&NBRMBRE) VALUE(&NBRMBRE - 1) /* */ /* If the counter reaches *zero, we've finished the list again... */ /* */ IF COND(&NBRMBRE *LE 0) THEN(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('End of + mbr add list reached') TOPGMQ(*EXT) GOTO CMDLBL(END_PGM) ENDDO /* */ /* ...otherwise, go back for the next entry... */ /* */ CHGVAR VAR(&@_MBRE) VALUE(&@_MBRE + &MBRELEN) GOTO CMDLBL(NXT_MBR_A) /* Set the user-defined attribute to note a completed operation... */ END_PGM: CHGVAR VAR(&USRDFNATR) VALUE('*COMPLETE') CHGVAR VAR(&COBJVARRCD) VALUE(&COBJNBRRCD *CAT + &COBJKEY *CAT &COBJKEYLEN *CAT &USRDFNATR) CHGOBJINF OBJ(&TMPLIB/&F) RTNLIB(&COBJRTNLIB) + OBJTYP(*USRSPC) OBJINF(&COBJVARRCD) RETURN STD_ERR: DLCOBJ OBJ((&FLIB/&F *FILE *EXCL)) MONMSG MSGID(CPF0000 MCH0000) MOVDIAGMSG MONMSG MSGID(CPF0000 MCH0000) RSNESCMSG MONMSG MSGID(CPF0000 MCH0000) RETURN ENDPGM