QGYOLSPL - Open List of Spooled Files

QGYOLSPL - Open List of Spooled Files h NoMain *-------------------------------------------------------------------------------------------- * Program . . : LSTSPLF Author . . : Rick Chevalier * Date . . . . : 6/04/2002 * Purpose . . : Generate a list of selected spool files *-------------------------------------------------------------------------------------------- * Modifications: Date/Prgrmmr *-------------------------------------------------------------------------------------------- * None to this point. *-------------------------------------------------------------------------------------------- *-------------------------------------------------------------------------------------------- * File definitions *-------------------------------------------------------------------------------------------- *-------------------------------------------------------------------------------------------- * External procedure prototypes *-------------------------------------------------------------------------------------------- * Open list of spooled files d OpnLstSplF Pr ExtPgm('QGY/QGYOLSPL') d 32000 Receiver variable d 10i 0 Receiver var length d 80 List information d 10i 0 Nbr of rec to retur d 1024 Sort information d 1024 Filter information d 26 Qualified job name d 8 Format of list d 256 Error code *-------------------------------------------------------------------------------------------- * Internal procedure prototypes *-------------------------------------------------------------------------------------------- d LstSplF Pr 4 d 80 List information d * Const Receiver variable d 10i 0 Receiver var length d 10i 0 Options(*Omit: *NoPass) Nbr of rec to retur d 26 Options(*Omit: *NoPass) Qualified job name d 1024 Options(*Omit: *NoPass) Filter information d 1024 Options(*Omit: *NoPass) Sort information d 8 Options(*NoPass) Format of list *-------------------------------------------------------------------------------------------- * LstSplF - Open list of selected spool files *-------------------------------------------------------------------------------------------- p LstSplF b Export d LstSplF pi 4 d pLstInf 80 d pRcvVar@ * Const d pRcvLen 10i 0 d pNbrRtn 10i 0 Options(*Omit: *NoPass) d pQualJob 26 Options(*Omit: *NoPass) d pFltrInf 1024 Options(*Omit: *NoPass) d pSortInf 1024 Options(*Omit: *NoPass) d pLstFmt 8 Options(*NoPass) * Variables for optional parameters and pointers d lsRcvVar s 32000 Based(pRcvVar@) d lsLstInf ds 80 List information d liTotRec 10i 0 Inz(0) d liRecTrn 10i 0 Inz(0) d liReqHdle 4 d liRecLen 10i 0 Inz(0) d liInfCmp 1 d liCrtDtTm 13 d liStsInd 1 d liRsv1 1 d liInfRtnLen 10i 0 Inz(0) d liRec1 10i 0 Inz(0) d liRsv2 40 d lsNbrRtn s 10i 0 Inz(1) d lsSortInf ds 1024 Sort information d siNbrKeys 10i 0 Inz(0) d siStrPos 10i 0 Inz(0) d siFldLen 10i 0 Inz(0) d siDtaTyp 5i 0 Inz(x'00') d siSrtOrd 1 Inz(x'00') d siRsv1 1 Inz(x'00') d lsFltrInf ds 1024 Filter information d* fiNbrUsr 10i 0 d* fiUsrNme 60 d* fiNbrOutQ 10i 0 d* fiOutQ 100 d* fiFrmType 10 d* fiUsrDta 10 d* fiNbrSts 10i 0 d* fiSplSts 60 d* fiNbrDev 10i 0 d* fiDevNme 60 d lsQualJob s 26 d lsLstFmt s 8 Inz('OSPL0300') * Error structure d lsErrCd ds 256 d lsErrPrv 10i 0 Inz(256) d lsErrAvl 10i 0 Inz(0) d lsErrID 7 d lsErrDta 132 *-------------------------------------------------------------------------------------------- * Calculations *-------------------------------------------------------------------------------------------- /Free // If job information is passed us it If %Parms > 4 And %Addr(pQualJob) <> *Null; lsQualJob = pQualJob; EndIf; // If filter information is passed us it If %Parms > 5 And %Addr(pFltrInf) <> *Null; lsFltrInf = pFltrInf; EndIf; // If sort information is passed us it If %Parms > 6 And %Addr(pSortInf) <> *Null; lsSortInf = pSortInf; EndIf; // If list format value is passed us it If %Parms > 7 And %Addr(pLstFmt) <> *Null; lsLstFmt = pLstFmt; EndIf; CallP OpnLstSplF(lsRcvVar: pRcvLen: lsLstInf: pNbrRtn: lsSortInf: lsFltrInf: lsQualJob: lsLstFmt: lsErrCd); // Place list information into return parameter pLstInf = lsLstInf; Return liReqHdle; /End-Free p LstSplF e h nomain *-------------------------------------------------------------------------------------------- * Program . . : RtvLstEnt Author . . : Rick Chevalier * Date . . . . : 6/05/2002 * Purpose . . : Retrieve entry or entries from a generated list *-------------------------------------------------------------------------------------------- * Modifications: Date/Prgrmmr *-------------------------------------------------------------------------------------------- * None to this point. *-------------------------------------------------------------------------------------------- * Required Parameter Group: * 1 Parm 1 Input Char(10) * 2 Parm 2 Input Dec(5,0) * 3 Parm 3 Input Binary(4) * 4 Parm 4 Input * *-------------------------------------------------------------------------------------------- * Internal procedure prototypes *-------------------------------------------------------------------------------------------- d RtvLstEnt pr d 4 List handle d * Const Receiver variable d 10i 0 Receiver length d 10i 0 Records to return d 10i 0 Starting record d 80 List information *-------------------------------------------------------------------------------------------- * External procedure prototypes *-------------------------------------------------------------------------------------------- d GetLstEnt pr ExtPgm('QGY/QGYGTLE') d 32000 Receiver variable d 10i 0 Receiver length d 4 List handle d 80 List information d 10i 0 Records to return d 10i 0 Starting record d 256 Error information *-------------------------------------------------------------------------------------------- * Internal procedure *-------------------------------------------------------------------------------------------- p RtvLstEnt b export d RtvLstEnt pi d LstHdl 4 d RcvVar@ * Const d RcvLen 10i 0 d NbrToRtn 10i 0 d StartRec 10i 0 d ListInfo 80 d RcvVar s 32000 Based(RcvVar@) * API standard error structure d Error ds 256 d Provid 10i 0 Inz(128) d Avail 10i 0 Inz(0) d ErrID 7 d ErrData 128 a /Free CallP GetLstEnt(RcvVar: RcvLen: LstHdl: ListInfo: NbrToRtn: StartRec: Error); /End-Free p RtvLstEnt e h BndDir('RMVSPLF') DftActGrp(*No) ActGrp(*Caller) *-------------------------------------------------------------------------------------------- * Program . . : RMVSPLF Author . . : Rick Chevalier * Date . . . . : 6/04/2002 * Purpose . . : Remove selected spool files *-------------------------------------------------------------------------------------------- * Modifications: Date/Prgrmmr *-------------------------------------------------------------------------------------------- * None to this point. *-------------------------------------------------------------------------------------------- *-------------------------------------------------------------------------------------------- * File definitions *-------------------------------------------------------------------------------------------- *-------------------------------------------------------------------------------------------- * External procedure prototypes *-------------------------------------------------------------------------------------------- * Open list of spooled files d LstSplF Pr 4 d 80 List information d * Const Receiver variable d 10i 0 Receiver var length d 10i 0 Options(*Omit: *NoPass) Nbr of rec to retur d 26 Options(*Omit: *NoPass) Qualified job name d 1024 Options(*Omit: *NoPass) Filter information d 1024 Options(*Omit: *NoPass) Sort information d 8 Options(*NoPass) Format of list * Retrieve additional list entries d RtvLstEnt pr d 4 List handle d * Const Receiver variable d 10i 0 Receiver length d 10i 0 Records to return d 10i 0 Starting record d 80 List information * Close list d CloseList Pr ExtPgm('QGY/QGYCLST') d 4 Request handle d 128 Error code * Process or run a command. dprccmd pr * d 32702 Command string d 1 options(*nopass: *omit) Prompt type * Send a message to the program message queue. d SndPgmMsg pr 4 d 7 Message ID d 20 Qualified msg file d * Const Message data d 10 Options(*NoPass) Message type d 10 Options(*NoPass) Stack entry d 9b 0 Options(*NoPass) Stack counter *-------------------------------------------------------------------------------------------- * Internal procedure prototypes *-------------------------------------------------------------------------------------------- *-------------------------------------------------------------------------------------------- * Data definitions *-------------------------------------------------------------------------------------------- * Program entry parameter definitions d pFile s 10 d pJob s 26 d pUsrLst ds 52 d pNbrUsr 5i 0 Overlay(pUsrLst: 1) d pUsers 50 Overlay(pUsrLst: 3) d pDltDate s 7 d pOutQLst ds 102 d pNbrOutQ 5i 0 Overlay(pOutQLst: 1) d pOutQs 100 Overlay(pOutQLst: 3) d pFrmType s 10 d pUsrDta s 10 d pStsLst ds 52 d pNbrSts 5i 0 Overlay(pStsLst: 1) d pStatus 50 Overlay(pStsLst: 3) d pDevLst ds 52 d pNbrDev 5i 0 Overlay(pDevLst: 1) d pDevices 50 Overlay(pDevLst: 3) * Parameters for call to SndPgmMsg d spmMsgID s 7 Inz(' ') d spmMsgF s 20 Inz(' ') d spmMsgDta@ s * Inz(%Addr(spmMsgDta)) d spmMsgDta s 1024 d spmMsgTyp s 10 Inz('*INFO') d spmStkEnt s 10 Inz('*') d spmStkCtr s 9b 0 Inz(3) * Parameters for call to LstSplF d lsRcvVar@ s * d lsRcvVar s 32000 Receiver variable d lsRcvLen s 10i 0 Inz(%Size(lsRcvVar)) Receiver var length d lsLstInf ds 80 List information d liTotRec 10i 0 Inz(0) d liNbrRtn 10i 0 Inz(0) d liReqHdle 4 d liRecLen 10i 0 Inz(0) d liInfCmp 1 d liCrtDtTm 13 d liStsInd 1 d liRsv1 1 d liInfRtnLen 10i 0 Inz(0) d liRec1 10i 0 Inz(0) d liRsv2 40 d lsNbrRtn s 10i 0 Inz(50) Nbr of ent to retur d lsSortInf ds 1024 Sort parameters d siNbrKeys 10i 0 Inz(0) d siStrPos 10i 0 Inz(0) d siFldLen 10i 0 Inz(0) d siDtaTyp 5b 0 Inz(x'00') d siSrtOrd 1 Inz(x'00') d siRsv1 1 Inz(x'00') d lsFltrInf s 1024 Filter parameters d lsQualJob s 26 Qualified job name d lsLstFmt s 8 Returned list forma * Returned spool entry information d spRcvVar@ s * d spRcvVar ds Based(spRcvVar@) d spJobNme 10 d spUsrNme 10 d spJobNbr 6 d spSplNme 10 d spSplNbr 10i 0 d spSts 10i 0 d spDteOpn 7 d spTmeOpn 6 d spSplSch 1 d spSysNme 10 d spUsrDta 10 d spFrmType 10 d spOutQ 10 d spOutQLib 10 d spAuxStg 10i 0 d spSplSize 10i 0 d spSizeMlt 10i 0 d spTotPgs 10i 0 d spCpyRmn 10i 0 d spPrty 1 d spRsv1 3 * Error structure d lsErrCd ds 256 d lsErrPrv 10i 0 Inz(256) d lsErrAvl 10i 0 Inz(0) d lsErrID 7 d lsErrDta 132 * Returned list handle d LstHdl s 4 * Miscellaneous variables d DltCmd s 32702 d Start s 10i 0 Inz(1) d x s 10i 0 d y s 10i 0 d EndOfList s n Inz(*Off) End of list flag d DltEntry s n Inz(*Off) Delete entry flag d NbrRmv s 10i 0 Number removed d NbrRead s 10i 0 Number read d ds 4 d Bin4 10i 0 Convert from 2 to 4 d chrBin4 4 Overlay(Bin4) Substring field *-------------------------------------------------------------------------------------------- * Calculations *-------------------------------------------------------------------------------------------- /Free // Format input parameters for list generation lsQualJob = pJob; Bin4 = pNbrUsr; lsFltrInf = chrBin4; y = 5; For x = 1 to pNbrUsr; %Subst(lsFltrInf: y) = %Subst(pUsers: (x * 10) - 9: 10); y = y + 12; EndFor; Bin4 = pNbrOutQ; %Subst(lsFltrInf: y) = chrBin4; y = y + 4; For x = 1 to pNbrOutQ; %Subst(lsFltrInf: y) = %Subst(pOutQs: (x * 20) - 19: 20); y = y + 20; EndFor; %Subst(lsFltrInf: y: 10) = pFrmType; y = y + 10; %Subst(lsFltrInf: y :10) = pUsrDta; y = y + 10; Bin4 = pNbrSts; %Subst(lsFltrInf: y) = chrBin4; y = y + 4; For x = 1 to pNbrSts; %Subst(lsFltrInf: y) = %Subst(pStatus: (x * 10) - 9: 10); y = y + 12; EndFor; Bin4 = pNbrDev; %Subst(lsFltrInf: y) = chrBin4; y = y + 4; For x = 1 to pNbrDev; %Subst(lsFltrInf: y) = %Subst(pDevices: (x * 10) - 9: 10); y = y + 12; EndFor; // Begin list generation lsRcvVar@ = %Addr(lsRcvVar); LstHdl = LstSplF(lsLstInf: lsRcvVar@: lsRcvLen: lsNbrRtn: lsQualJob: lsFltrInf); // If no entries are returned set end of list flag If liNbrRtn <= 0; EndOfList = *On; EndIf; // Substring return field into it's parts DoW Not EndOfList; spRcvVar@ = %Addr(lsRcvVar); // Process list entries For x = 1 to liNbrRtn; // File and date are not selected by the API. Check relationships // and set delete flag accordingly. Select; When pFile = *Blanks or pFile = spSplNme; Select; When pDltDate = *Zeros; DltEntry = *On; When pDltDate <> *Zeros and spDteOpn < pDltDate; DltEntry = *On; When pDltDate <> *Zeros and spDteOpn >= pDltDate; DltEntry = *Off; EndSl; When pFile <> spSplNme; DltEntry = *Off; EndSl; // If entry matches selection criteria remove it If DltEntry; DltCmd = 'DLTSPLF FILE(' + %TrimR(spSplNme) + ') JOB(' + spJobNbr + '/' + %TrimR(spUsrNme) + '/' + %TrimR(spJobNme) + ') SPLNBR(' + %Char(spSplNbr) + ')'; PrcCmd(DltCmd); NbrRmv += 1; EndIf; spRcvVar@ = spRcvVar@ + liRecLen; EndFor; // If list is not complete retrieve next group of list entries NbrRead += liNbrRtn; If (NbrRead < liTotRec and liStsInd = '2') or (liStsInd <> '2' and liStsInd <> '3'); Start = Start + liNbrRtn; Clear lsRcvVar; lsNbrRtn = %Size(lsRcvVar)/liRecLen; CallP RtvLstEnt(LstHdl: lsRcvVar@: lsRcvLen: lsNbrRtn: Start: lsLstInf); // If list is complete set end of list flag Else; EndOfList = *On; EndIf; EndDo; // Close the list CallP CloseList(LstHdl: lsErrCd); // Send completion message spmMsgDta = %Char(NbrRmv) + ' spool file entries removed.'; CallP SndPgmMsg(spmMsgID: spmMsgF: spmMsgDta@: spmMsgTyp :spmStkEnt :spmStkCtr); *InLR = *On; /End-Free *-------------------------------------------------------------------------------------------- * Define - Define key lists and parameter lists *-------------------------------------------------------------------------------------------- c Define BegSr c *Entry PList c Parm pFile c Parm pJob c Parm pUsrLst c Parm pDltDate c Parm pOutqLst c Parm pFrmType c Parm pUsrDta c Parm pStsLst c Parm pDevLst c EndSr h nomain *-------------------------------------------------------------------------------------------- * Program . . : PRCCMD Author . . : Rick Chevalier * Date . . . . : 1/19/2000 * Purpose . . : Process or run a command. *-------------------------------------------------------------------------------------------- * Modifications: Date/Prgrmmr *-------------------------------------------------------------------------------------------- * None to this point. *-------------------------------------------------------------------------------------------- * Required Parameter Group: * 1 Source command string Input Char(*) * Optional Parameter Group: * 2 Processing type Input Char(1) * '0' - Never prompt the command * '1' - Always prompt the command * Dft '2' - Prompt the command if selective prompting characters are present in the comman * '3' - Show help *-------------------------------------------------------------------------------------------- * Internal procedure prototypes *-------------------------------------------------------------------------------------------- * Prototype for process command procedure (PrcCmd) d PrcCmd pr * d 32702 Command d 1 options(*nopass: *omit) Prompt type *-------------------------------------------------------------------------------------------- * External procedure prototypes. *-------------------------------------------------------------------------------------------- * Send program message. dsndpgmmsg pr 4 d##_msgid 7 d##_msgf 20 d##_msgdta@ * const d##_msgtyp 10 options(*nopass) Defaults to *DIAG *-------------------------------------------------------------------------------------------- * Process command (QCAPCMD) API. Check or run a CL command. *-------------------------------------------------------------------------------------------- pprccmd b export dprccmd pi * d##_cmd 32702 d##_pmttyp 1 options(*nopass: *omit) Default = 2 * 1 Length of source command string Input Binary(4) * 2 Options control block Input Char(*) * 3 Options control block length Input Binary(4) * 4 Options control block format Input Char(8) * 5 Changed command string Output Char(*) * 6 Length available for changed command string Input Binary(4) * 7 Length of changed command string available to return Output Binary(4) * 8 Error code I/O Char(*) d##_cmdlen s 9b 0 d##_ocb ds d ##_typprc 9b 0 inz(2) Type of processing d ##_dbcs 1 inz('0') DBCS data handling d ##_pmtact 1 Prompter action d ##_cmdstx 1 inz('0') Command syntax d ##_msgkey 4 inz(*blanks) Msg retrieve key d ##_reserve 9 inz(x'000000000000000000') Reserved d##_ocblen s 9b 0 inz(20) d##_ocbfmt s 8 inz('CPOP0100') d##_chgcmd s 32702 d##_chglen s 9b 0 d##_chgavl s 9b 0 inz(32702) d##_error ds d ##_erbp 1 4B 0 inz(128) Bytes provided d ##_erba 5 8B 0 Bytes available d ##_erexid 9 15 Exception ID d ##_erexdta 17 116 Exception data d##_msgf s 20 inz('QCPFMSG *LIBL ') * Parameter list for API call. c qcapcmd plist c parm ##_cmd c parm ##_cmdlen c parm ##_ocb c parm ##_ocblen c parm ##_ocbfmt c parm ##_chgcmd c parm ##_chglen c parm ##_chgavl c parm ##_error * Determine the length of the command string to process. c eval ##_cmdlen = %len(%trim(##_cmd)) * Determine the length of the command string to process. c if (%parms = 2 and %addr(##_pmttyp) = *null) or c %parms = 1 c eval ##_pmtact = '2' c else c eval ##_pmtact = ##_pmttyp c endif * Process command. c call 'QCAPCMD' qcapcmd * If no error return address of attribute information. c if ##_erexid = *blanks c return %addr(##_chgcmd) * Send error message to job log and return null address. c else c callp sndpgmmsg(##_erexid: ##_msgf: c %addr(##_erexdta)) c return *null c endif pprccmd e h nomain *-------------------------------------------------------------------------------------------- * Program . . : SNDPGMMSG Author . . : Rick Chevalier * Date . . . . : 12/11/2000 * Purpose . . : Send a program message. *-------------------------------------------------------------------------------------------- * Modifications: Date/Prgrmmr *-------------------------------------------------------------------------------------------- * None to this point. *-------------------------------------------------------------------------------------------- * Parameter definitions * 1 Message identifier Input Char(7) * 2 Qualified message file name Input Char(20) * 3 Message data or immediate text Input Char(*) * 4 Message type Input Char(10) * 5 Call stack counter Input Binary(4) *-------------------------------------------------------------------------------------------- * Internal procedure prototypes. *-------------------------------------------------------------------------------------------- dsndpgmmsg pr 4 d##_msgid 7 d##_msgf 20 d##_msgdta@ * const d##_msgtyp 10 options(*nopass) d##_stkent 10 options(*nopass) d##_stkctr 9b 0 options(*nopass) *-------------------------------------------------------------------------------------------- * Send program message. *-------------------------------------------------------------------------------------------- psndpgmmsg b export dsndpgmmsg pi 4 d##_msgid 7 d##_msgf 20 d##_msgdta@ * const d##_msgtypi 10 options(*nopass) d##_stkenti 10 options(*nopass) d##_stkctri 9b 0 options(*nopass) * Additional API parameters. * 4 Length of message data or immediate text Input Binary(4) * 6 Call stack entry Input Char(*) or Pointer * 7 Call stack counter Input Binary(4) * 8 Message key Output Char(4) * 9 Error code I/O Char(*) * Parameters for Send Program Message (QMHSNDPM) API d##_msgdta ds 1024 based(##_msgdta@) d##_dtalen s 9b 0 d##_msgtyp s 10 d##_stkent s 10 inz('*') d##_stkctr s 9b 0 d##_msgkey s 4 d##_error ds 128 d ##_erbp 1 4B 0 inz(0) Bytes provided d ##_erba 5 8B 0 inz(0) Bytes available d ##_erexid 9 15 Exception ID d ##_erexdta 17 116 Exception data c eval ##_dtalen = %len(%trimr(##_msgdta)) * If message type is passed use it. If not default to *DIAG. c if %parms >= 4 c eval ##_msgtyp = ##_msgtypi c else c eval ##_msgtyp = '*DIAG' c endif * If stack entry is passed use it. If not default to current entry (*). c if %parms >= 5 c eval ##_stkent = ##_stkenti c else c eval ##_stkent = '*' c endif * If stack counter is passed use it. If not default to 0. c if %parms >= 6 c eval ##_stkctr = ##_stkctri c else c eval ##_stkctr = 0 c endif * Send message. c call 'QMHSNDPM' c parm ##_msgid c parm ##_msgf c parm ##_msgdta c parm ##_dtalen c parm ##_msgtyp c parm ##_stkent c parm ##_stkctr c parm ##_msgkey c parm ##_error c return ##_msgkey psndpgmmsg e Thanks to Rick Chevalier