PRCSPLF: PGM DCL VAR(&USRSPC) TYPE(*CHAR) LEN(10) VALUE(SPLF) DCL VAR(&USRSPCLIB) TYPE(*CHAR) LEN(10) + VALUE(QTEMP) /* We'll extract the attributes of the list into these... */ DCL VAR(&OFFSLSTDTA) TYPE(*DEC) LEN(9) DCL VAR(&NBRLSTE) TYPE(*DEC) LEN(7) DCL VAR(&SIZLSTE) TYPE(*DEC) LEN(5) /* Spoolfile attributes structure will go into here... */ DCL VAR(&SPLFSTRUCT) TYPE(*CHAR) LEN(1142) DCL VAR(&SPLFA) TYPE(*CHAR) LEN(80) /* Job/spoolfile internal IDs go here... */ DCL VAR(&INTJOBID) TYPE(*CHAR) LEN(16) DCL VAR(&INTSPLFID) TYPE(*CHAR) LEN(16) /* Job/spoolfile names are placed here... */ DCL VAR(&JOB) TYPE(*CHAR) LEN(10) DCL VAR(&USER) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6) DCL VAR(&SPLF) TYPE(*CHAR) LEN(10) /* The *splf + name from the current entry is here... */ /* These are used to convert the binary *splf number... */ DCL VAR(&SPLFNBR) TYPE(*DEC) LEN(4) DCL VAR(&SPLFNBR_C) TYPE(*CHAR) LEN(4) /* */ /* These are useful element attributes from the list. We use these fields */ /* as work fields to hold the list attributes extracted by RUSGENHDR... */ /* */ DCL VAR(&SPLFE) TYPE(*DEC) LEN(9) /* The *splf + entry is pointed to by this... */ DCL VAR(&SPLFELEN) TYPE(*DEC) LEN(5) /* The + *splf entry length is here... */ DCL VAR(&NBRSPLFE) TYPE(*DEC) LEN(7) /* The + number of *splf entries is here... */ /* */ /* The initial *usrspc structure from each entry goes here... */ /* */ DCL VAR(&USENT) TYPE(*CHAR) LEN(1000) /* Spoolfile attributes structure will go into here... */ DCL VAR(&SPLFA) TYPE(*CHAR) LEN(80) /* Date work will be done in these... */ DCL VAR(&QDAYOFWEEK) TYPE(*CHAR) LEN(4) DCL VAR(&QDATE) TYPE(*CHAR) LEN(6) DCL VAR(&QCENTURY) TYPE(*CHAR) LEN(1) DCL VAR(&CMP_DATE) TYPE(*CHAR) LEN(7) DCL VAR(&SPLFDAT) TYPE(*CHAR) LEN(8) /* Aged spoolfiles will be moved here (this is an *outq name)... */ DCL VAR(&DAYOFWEEK) TYPE(*CHAR) LEN(10) /* Omitted *outqs are listed in a *usridx. The *usridx work */ /* fields are here... */ DCL VAR(&NBRENT) TYPE(*CHAR) LEN(4) DCL VAR(&OUTQE) TYPE(*CHAR) LEN(1008) VALUE('The + *OMITOUTQ entry is retrieved into here + (if one exists)...') DCL VAR(&ENTLENOFFS) TYPE(*CHAR) LEN(1008) + VALUE('This is a *usridx control + structure. We won''t use this info + because we''re only interested in whether + an entry actually exists or not...') DCL VAR(&HEX0000) TYPE(*CHAR) LEN(4) + VALUE(X'00000000') /* Used to do a direct + comparisons against the *BINARY number + returned for how many entries meet the + search criteria. All we need to know is + whether that number is binary zeroes or + not... */ /*---------------------------------------------------------------------------*/ /* Global MONMSG... */ MONMSG MSGID(CPF0000 CPF9999) EXEC(GOTO + CMDLBL(STDERR)) /* */ /* Set our day-of-week and current date... */ /* */ RTVSYSVAL SYSVAL(QDAYOFWEEK) RTNVAR(&QDAYOFWEEK) IF COND(&QDAYOFWEEK *EQ '*SUN') THEN(CHGVAR + VAR(&DAYOFWEEK) VALUE('SUNDAY')) ELSE CMD(IF COND(&QDAYOFWEEK *EQ '*MON') + THEN(CHGVAR VAR(&DAYOFWEEK) VALUE('MONDAY'))) ELSE CMD(IF COND(&QDAYOFWEEK *EQ '*TUE') + THEN(CHGVAR VAR(&DAYOFWEEK) + VALUE('TUESDAY'))) ELSE CMD(IF COND(&QDAYOFWEEK *EQ '*WED') + THEN(CHGVAR VAR(&DAYOFWEEK) + VALUE('WEDNESDAY'))) ELSE CMD(IF COND(&QDAYOFWEEK *EQ '*THU') + THEN(CHGVAR VAR(&DAYOFWEEK) + VALUE('THURSDAY'))) ELSE CMD(IF COND(&QDAYOFWEEK *EQ '*FRI') + THEN(CHGVAR VAR(&DAYOFWEEK) VALUE('FRIDAY'))) ELSE CMD(IF COND(&QDAYOFWEEK *EQ '*SAT') + THEN(CHGVAR VAR(&DAYOFWEEK) + VALUE('SATURDAY'))) RTVSYSVAL SYSVAL(QDATE) RTNVAR(&QDATE) RTVSYSVAL SYSVAL(QCENTURY) RTNVAR(&QCENTURY) CVTDAT DATE(&QDATE) TOVAR(&QDATE) FROMFMT(*SYSVAL) + TOFMT(*YMD) TOSEP(*NONE) CHGVAR VAR(&CMP_DATE) VALUE(&QCENTURY *CAT &QDATE) CVTDAT DATE(&QDATE) TOVAR(&QDATE) FROMFMT(*YMD) + TOFMT(*MDY) TOSEP(*NONE) OFFSETDAT OPR(*SUB) DAS(7) DATE(&QDATE) + OFFSETDAT(&CMP_DATE) /* */ /* Create a *usrspc to put the list into... */ /* */ CRTUSRSPC USRSPC(&USRSPCLIB/&USRSPC) INLSIZE(1000000) + DELETE(*YES) /* */ /* And list some spoolfiles into it... */ /* We're gonna list 'em all here. We COULD pass in any selection */ /* we wanted as parms or whatever, but that's not what we're after in */ /* this program. We're gonna age these guys... */ /* */ LUSSPLF JOB(*BLANK) USRSPC(&USRSPCLIB/&USRSPC) + USER(*ALL) OUTQ(*ALL) FORM(*ALL) USRDTA(*ALL) /* */ /* Extract the attributes of the list that are useful to us... */ /* */ RUSGENHDR USRSPC(&USRSPCLIB/&USRSPC) + OFFSLSTDTA(&OFFSLSTDTA) NBRLSTE(&NBRLSTE) + SIZLSTE(&SIZLSTE) /* */ /* Put the list attributes into fields we can work with... */ /* Note: We COULD use the fields returned directly from RUSGENHDR, */ /* but we like to work with dedicated fields... */ /* */ CHGVAR VAR(&SPLFE) VALUE(&OFFSLSTDTA + 1) /* Offset + to start of list... */ CHGVAR VAR(&SPLFELEN) VALUE(&SIZLSTE) /* Length of + an entry... */ CHGVAR VAR(&NBRSPLFE) VALUE(&NBRLSTE) /* Number of + entries... */ /*-------------- Begin loop -----------------*/ NXT_SPLF: RTVUSRSPC USRSPC(&USRSPCLIB/&USRSPC) STRPOS(&SPLFE) + RTVLEN(&SPLFELEN) RCVVAR(&USENT) /* */ /* Extract the internal identifiers from the current list entry... */ /* */ CHGVAR VAR(&INTJOBID) VALUE(%SST(&USENT 51 16)) CHGVAR VAR(&INTSPLFID) VALUE(%SST(&USENT 67 16)) /* */ /* Translate internal identifiers to external form... */ /* */ TRNINTSPLF SPLFA(&SPLFA) INTJOBID(&INTJOBID) + INTSPLFID(&INTSPLFID) /* */ /* Extract the names from the &SPLFA structure from the translation... */ /* */ CHGVAR VAR(&JOB) VALUE(%SST(&SPLFA 41 10)) CHGVAR VAR(&USER) VALUE(%SST(&SPLFA 51 10)) CHGVAR VAR(&JOBNBR) VALUE(%SST(&SPLFA 61 6)) CHGVAR VAR(&SPLF) VALUE(%SST(&SPLFA 67 10)) CHGVAR VAR(&SPLFNBR) VALUE(%BIN(&SPLFA 77 4)) /* + Returned as BIN(4), so we first convert + to DEC... */ /* */ /* For each entry, we've gotten everything we need to know. */ /* So, now DO something to that spoolfile if it meets whatever criteria... */ /* */ /* All we're going to do in this example is get the date and move old ones */ /* to some aging *outqs... */ CHGVAR VAR(&SPLFNBR_C) VALUE(&SPLFNBR) RTVSPLFAST SPLFA(&SPLFSTRUCT) JOB(&JOBNBR/&USER/&JOB) + SPLFNAM(&SPLF) SPLFNBR(&SPLFNBR_C) /* Check the *splf *outq against the list of omitted *outqs... */ RTVUSRIDXE ENTRTV(&OUTQE) ENTLENOFFS(&ENTLENOFFS) + NBRENTRTV(&NBRENT) USRIDX(PRCSPLF) + SCHCTA('*OMITOUTQ ' *CAT %SST(&SPLFSTRUCT + 183 10) *CAT %SST(&SPLFSTRUCT 193 10)) + SCHCTALEN(30) SCHCTAOFFS(1) IF COND(&NBRENT *EQ &HEX0000) THEN(DO) /* This + is *NOT on an omitted *outq... */ IF COND(%SST(&SPLFSTRUCT 203 7) *LT &CMP_DATE) + THEN(DO) CHGSPLFA FILE(&SPLF) JOB(&JOBNBR/&USER/&JOB) + SPLNBR(&SPLFNBR_C) OUTQ(&DAYOFWEEK) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Date<' + *CAT %SST(&SPLFSTRUCT 203 7) *CAT '>') + TOPGMQ(*EXT) ENDDO ENDDO /* This is *NOT on an omitted *outq... */ /* */ /* Decrease our counter... */ /* */ CHGVAR VAR(&NBRSPLFE) VALUE(&NBRSPLFE - 1) /* */ /* If the counter reaches *zero, we finished the list... */ /* */ IF COND(&NBRSPLFE *GT 0) THEN(DO) /* */ /* ...otherwise, go back to get the next entry... */ /* */ CHGVAR VAR(&SPLFE) VALUE(&SPLFE + &SPLFELEN) GOTO CMDLBL(NXT_SPLF) ENDDO /*-------------- End loop -----------------*/ DLTUSRSPC USRSPC(&USRSPCLIB/&USRSPC) RETURN /* --------------------------------------------------------------- */ STDERR: MOVDIAGMSG MONMSG MSGID(CPF0000 MCH0000) RSNESCMSG MONMSG MSGID(CPF0000 MCH0000) ENDPGM