H dftactgrp( *no ) OPTION(*NODEBUGIO) ACTGRP('MONITOR') H bnddir( 'QC2LE':'UTILITIES') F******************************************************************** fsycontrol if e k disk usropn * * Defined variables * d AEJobIsRunning... d s n inz('0') d AEJobIsOnHold... d s n inz('0') d AllText s 10 Inz('*ALL') d AnySunday s d inz(D'1999-06-13') d backendjobname s 4 inz d BackHalf s 256 inz varying d CRLF c CONST(X'0d25') d CreateDateISO s D d CT# s 10i 0 inz d Currenttime s t inz d DayOfWeek s 10i 0 inz d DecimalJobNumber... d s 8 0 inz d DecimalSpoolNumber... d s 6 0 inz d defaultemailaddresses... d s 2000 varying inz d defaultMaxSpools... d s 10i 0 inz(1000) d defaultStartTime... d s t inz(t'06.30.00') d defaultEndTime... d s t inz(t'16.00.00') d delayMinutes s 3 0 inz(60) d EndOfDay s t inz(t'17.30.00') d EndOfDayOvertime... d s t inz(t'00.30.00') d EntryFmt s 10 inz('*FIRST') d ErrorCode s 7 inz d ErrorReturned s n inz d Error s 4 0 inz d FTLIn1S s 10i 0 inz d Format s 8 inz('SBSI0200') d foundme s 10i 0 inz d foundmessage s 10i 0 inz d foundOutQ s 10i 0 inz d foundOutQueue s 10i 0 inz d FoundInSyspoolp... d s 10i 0 inz d FoundSpool s n inz('1') d i s 10i 0 inz d IgnoreJobs s 10 dim(2000) d IJ# s 10i 0 inz d InMonthEnd s n inz d InYearEnd s n inz d IResetTheWebserverStamp... d s z inz d IsodateIn s 8 inz d IsoFromDate s d inz d IsoToDate s d inz d IsThereAnError s n inz d JC# s 10i 0 inz d jobended s 132 inz d JobendedInError... d s n inz d jobqlibrary s 20a inz d jobqName s 20a inz('QGPL/QINTER') d jobstarted s 132 inz d KeepLooping s n inz('1') d LogMessages s 512 varying inz('CPF1124 CPF1164') d LenRtnVals s 10i 0 Inz(%SIZE(RtnValsDS)) d MaxItemLines s 10i 0 Inz(32766) d message s 2000 varying d MD# s 10i 0 inz d mm# s 3 0 inz d MinutesToWaitB4Resend... d s 10i 0 inz(5) d MMDDYY s 6 0 d MQ# s 10i 0 inz d MS# s 10i 0 inz d MyContacts s 512 varying d MyFullMessage s 256 d MySpoolStatus s 08 inz d MySQLDate s 20 varying d MySQLJobname s 20 varying d MyWorkJobQueue s 20 inz d MyWorktime s t inz d MyTableName s 36 inz d NamValue s 10a Inz('SYSNAME') d NbrVals s 10i 0 Inz(1) d NumberOfDays s 10i 0 inz d NumberOfSeconds... d s 10i 0 inz d NumberofRDYSpools... d s 10i 0 d objectlib s 20a inz d outmessage s 200 inz d outsubject s 80 inz d outqname s 20a inz d oq# s 10i 0 inz d PR# s 10i 0 inz d ReturnSystemName... d s 8 inz d RowCount s 10i 0 inz d ReceiveVr2 s 100 d RelRecNbr s 4 0 d RelRecHi# s 4 0 d UserSpaceOut s 20 d SendMessageAfterHours... d s 1 inz('Y') d SB# s 10i 0 inz d SpaceVal s 1 inz(*BLANKS) d SpaceAuth s 10 inz('*CHANGE') d SpaceText s 50 inz(*BLANKS) d SpaceRepl s 10 inz('*YES') d SpaceAttr s 10 inz(*BLANKS) d sleepseconds s 10i 0 inz(120) d sf s 10I 0 inz(1) d size s 10I 0 inz d SpoolNumber s 6a inz d start s 10i 0 inz(1) d StartOfDay s t inz(t'07.30.00') d StringSize s 4 0 inz(244) d subject s 44 varying d systemname s 08 inz d systemstring s 25 inz varying d TodayISO s d d totalMinutes s 10i 0 inz d TRStsE s 10i 0 inz d UsrSpcName s 20 inz d UsrSpcName2 s 20 inz d Workemailaddresses... d s 2000 varying inz d workemail s 128 inz d workCell s 10 0 inz d workCellprovider... d s 10 inz d WorkGUID s 26 inz d WorkJobName s 20 inz d WorkMaxSpools s 10 0 inz d WorkOutQueue s 10 inz d Worktype s 10 inz * * ---- external procedure calls * d $GetSubsystemStatus... d pr extpgm('QWDRSBSD') d StringBack 244 const d StringBackSize... d 4 0 const d APIFormat 08 const d APISubsystem 20 const d APIError 4 0 const * * CrtUsrSpc: Create User Space for OS/400 API's * d $QUSCRTUS pr extpgm('QUSCRTUS') d UsrSpc_ 20A const d ExtAttr_ 10A const d InitialSize_ 10I 0 const d InitialVal_ 1A const d PublicAuth_ 10A const d Text_ 50A const d Replace_ 10A const d ErrorCode_ 32766A options(*nopass: *varsize) * * --- Prototype for API Retrive User Space * d $QUSRTVUS pr extpgm( 'QUSRTVUS' ) d QRtvUserSpace_... d 20 d QRtvStartingPosition_... d 10i 0 d QRtvLengthOfData_... d 10i 0 d QRtvReceiverVariable_... d 32048 d QRtvError_... d 256 * --- Prototype for API Retrive List Job * d $QUSLJOB pr extpgm( 'QUSLJOB' ) d QJobUserSpace_... d 20 d QJobFormatName_... d 8 d QJobJobName_... d 26 d QFldStatus_... d 10 d QFldError_... d 256 d QJobType_... d 1 d QNbrFldRtn_... d 10i 0 d QKeyFldRtn_... d 10i 0 dim( 100 ) * * --- Prototype for get jobqueue information * d $GetJobq pr EXTPGM('QSPRJOBQ') d RECIEVER_ 144A d RCVRLEN_ 10I 0 const d FORMAT_ 8A const d JOBQ_ 20A consT d ERROR_ 116A **-- List objects: --------------------------------------------- d $ListObjects pr ExtPgm( 'QUSLOBJ' ) d userspace_ 20a Const d format_ 8a Const d objectlib_ 20a Const d type_ 10a Const * d $qcmdexc pr extpgm( 'QCMDEXC' ) d os400_cmd_ 5000A options( *varsize ) const d cmdlength_ 15P 5 const **-- Userspace pointer: ------------------------------------------ d $Userspace pr ExtPgm( 'QUSRTVUS' ) d userspace_ 20a Const d start_ 10i 0 Const d Length_ 10i 0 Const d Returned_ 32767a Options( *VarSize ) * d $QUSLSPL pr extpgm('QUSLSPL') * required parameters d UsrSpc_ 20A const d Format_ 8A const d UserName_ 10A const d QualOutQ_ 20A const d FormType_ 10A const d UserData_ 10A const * optional group 1: d ErrorCode_ 32766A options(*nopass: *varsize) * optional group 2: d QualJob_ 26A options(*nopass) const d FieldKeys_ 10I 0 options(*nopass: *varsize) d dim(9999) d NumFields_ 10I 0 options(*nopass) const * optional group 3: d AuxStgPool_ 10I 0 options(*nopass) const * optional group 4: d JobSysName_ 8A options(*nopass) const d StartCrtDate_ 7A options(*nopass) const d StartCrtTime_ 6A options(*nopass) const d EndCrtDate_ 7A options(*nopass) const d EndCrtTime_ 6A options(*nopass) const * d $QUSDLTUS pr extpgm('QUSDLTUS') d UsrSpc_ 20A const d ErrorCode_ 32766A options(*varsize) * d $QUSPTRUS pr extpgm('QUSPTRUS') d UsrSpc_ 20A const d Pointer_ * * Delay - sleep function d $sleep pr 10i 0 ExtProc( 'sleep' ) d seconds_ 10u 0 Value **-- Retrieve object description: ------------------------------- d $RtvObjD Pr ExtPgm( 'QUSROBJD' ) d RoRcvVar 32767a Options( *VarSize ) d RoRcvVarLen 10i 0 Const d RoFmtNam 8a Const d RoObjNamQ 20a Const d RoObjTyp 10a Const d RoError 32767a Options( *VarSize ) **-- Create Space: --------------------------------------------- d $CreateSpace Pr ExtPgm( 'QUSCRTUS' ) d UserSpaceOut 20a Const d SpaceAttr 10 Const d SpaceLen 10i 0 Const d SpaceVal 1a Const d SpaceAuth 10a Const d SpaceText 50a Const d SpaceRepl 10a Const d APIErrorDs 32767a Options( *VarSize ) d $getSystemName... d PR ExtPgm('QWCRNETA') d RcvVar_ 32766A OPTIONS(*VARSIZE) d RcvVarLen_ 10i 0 const d NbrNetAtr_ 10i 0 const d AttrNames_ 10a const d ErrorCode_ 256a /copy qprcsrc,COMMAND_CP /copy qprcsrc,GETGUID_CP /copy qprcsrc,ROUTER_CP /copy qprcsrc,SDEMAIL_CP /copy qprcsrc,SPL2PDF_CP /copy qprcsrc,USRDATA_CP * * --- Data Structures * d p_UsrSpc s * d dsLH ds based(p_UsrSpc) d qualified d Filler1 103A d Status 1A d Filler2 12A d HdrOffset 10I 0 d HdrSize 10I 0 d ListOffset 10I 0 d ListSize 10I 0 d NumEntries 10I 0 d EntrySize 10I 0 * d p_Entry s * d dsSF ds based(p_Entry) d qualified d JobName 10A d UserName 10A d JobNumber 6A d SplfName 10A d SplfNbr 10I 0 d SplfStatus 10I 0 d OpenDate 7A d OpenTime 6A d Schedule 1A d SysName 10A d UserData 10A d FormType 10A d OutQueue 10A d OutQueueLib 10A d AuxPool 10I 0 d SplfSize 10I 0 d SizeMult 10I 0 * d TotalPages 10I 0 d CopiesLeft 10I 0 d Priority 1A d Reserved 3A d RtnValsDS ds d RtnNbrVals 10i 0 d RtnOffVals 10i 0 d RtnAtrNam 10a d RtnDtaTyp 1a d RtnInfSts 1a d RtnAtrLen 10i 0 d RtnSystem 8a * d ErrRtn ds d ErrBytPrv 10i 0 Inz(%SIZE(ErrRtn)) d ErrBytAvl 10i 0 Inz(0) d ErrMsgId 7a d ErrResved 1a d ErrMsgDta 256a ****************************************************************** dQUSA0100 ds d QUsrSpcOffset... d 10i 0 d QUSAreserved... d 10i 0 d QUsrSpcEntries... d 10i 0 d QUsrSpcEntrieSize... d 10i 0 dLJOBINPUT ds qualified d JobName... d 10 d UserName... d 10 d JobNumber... d 6 d Status... d 10 d UserSpace... d 10 d UserSpaceLibrary... d 10 d Format... d 8 d JobType... d 1 d Reserved01... d 3 d Reserved02... d 10i 0 * dLJOB100 ds qualified d JobName... d 1 10 d UserName... d 11 20 d JobNumber... d 21 26 d InternalJobId... d 27 42 d Status... d 43 52 d JobType... d 53 53 d JobSubType... d 54 54 d Reserved01... d 55 56 * dLJOB200 ds qualified d JobName... d 10 d UserName... d 10 d JobNumber... d 6 d InternalJobId... d 16 d Status... d 10 d JobType... d 1 d JobSubType... d 1 d Reserved01... d 2 d JobInfoStatus... d 1 d Reserved02... d 3 d NumberOfFieldsReturned... d 10i 0 d ReturnedData... d 1000 * dLJOB200KEY ds qualified d KeyNumber01... d 10i 0 d NumberOfKeys... d 10i 0 * dLJOBKEYINFO ds qualified d LengthOfInformation... d 10i 0 d KeyField... d 10i 0 d TypeOfData... d 1 d Reserved01... d 3 d LengthOfData... d 10i 0 d KeyData... d 1000 * * APIErrDef Standard API error handling structure. * * dQUSEC ds d ErrorBytesProvided... d 10i 0 d ErrorBytesAvailble... d 10i 0 d ErrorExceptionId... d 7 d ErrorReserved... d 1 * dAPIError ds d APIErrorProvied... d LIKE( ErrorBytesProvided ) d INZ( %LEN( APIError ) ) d APIErrorAvailble... d LIKE( ErrorBytesAvailble ) d APIErrorMessageID... d LIKE( ErrorExceptionId ) d APIErrorReserved... d LIKE( ErrorReserved ) d APIErrorInformation... d 240A d APIErrorDS ds Qualified d BytesP 10I 0 inz(%size(apiErrorDS)) d BytesA 10I 0 inz(0) d Messageid 7 d Reserved 1 d messagedta 128 dMyJobQDS ds Qualified d BytesReturned 10i 0 d BytesAvailable 10i 0 d JobQName 10 d JobQLib 10 d OppControlled 10 d AuthorityChk 10 d NumberOfJobs 10i 0 d JobqStatus 10 d SubsystemName 10 d SubsystemLib 10 d Description 50 d Sequence# 10i 0 d MaximumActive 10i 0 d CurrentActive 10i 0 d MaxActPri1 10i 0 d MaxActPri2 10i 0 d MaxActPri3 10i 0 d MaxActPri4 10i 0 d MaxActPri5 10i 0 d MaxActPri6 10i 0 d MaxActPri7 10i 0 d MaxActPri8 10i 0 d MaxActPri9 10i 0 d ActJobsPri1 10i 0 d ActJobsPri2 10i 0 d ActJobsPri3 10i 0 d ActJobsPri4 10i 0 d ActJobsPri5 10i 0 d ActJobsPri6 10i 0 d ActJobsPri7 10i 0 d ActJobsPri8 10i 0 d ActJobsPri9 10i 0 d ActJobsPri10 10i 0 d RlsJObsOnQ1 10i 0 d RlsJObsOnQ2 10i 0 d RlsJObsOnQ3 10i 0 d RlsJObsOnQ4 10i 0 d RlsJObsOnQ5 10i 0 d RlsJObsOnQ6 10i 0 d RlsJObsOnQ7 10i 0 d RlsJObsOnQ8 10i 0 d RlsJObsOnQ9 10i 0 d RlsJObsOnQ10 10i 0 d SchJobsOnQ1 10i 0 d SchJobsOnQ2 10i 0 d SchJobsOnQ3 10i 0 d SchJobsOnQ4 10i 0 d SchJobsOnQ5 10i 0 d SchJobsOnQ6 10i 0 d SchJobsOnQ7 10i 0 d SchJobsOnQ8 10i 0 d SchJobsOnQ9 10i 0 d SchJobsOnQ10 10i 0 d HldJobsOnQ1 10i 0 d HldJobsOnQ2 10i 0 d HldJobsOnQ3 10i 0 d HldJobsOnQ4 10i 0 d HldJobsOnQ5 10i 0 d HldJobsOnQ6 10i 0 d HldJobsOnQ7 10i 0 d HldJobsOnQ8 10i 0 d HldJobsOnQ9 10i 0 d HldJobsOnQ10 10i 0 d ListJOBQ ds qualified d Object 10 d Library 10 d ObjectType 10 d InfoStatus 1 d ExtObjAttrib 10 d Description 50 d ds d StartPosit 10i 0 d StartLen 10i 0 d SpaceLen 10i 0 d ReceiveLen 10i 0 d MessageKey 10i 0 d MsgDtaLen 10i 0 d MsgQueNbr 10i 0 * d GENDS ds d OffsetHdr 10i 0 overlay(GENDS:1) d NbrInList 10i 0 overlay(GENDS:9) d SizeEntry 10i 0 overlay(GENDS:13) ? * ? * Data structures d GENDS2 ds qualified d Filler1 116 d OffsetHdr 10i 0 d SizeHeader 10i 0 d OffsetList 10i 0 d Filler2 4 d NbrInList 10i 0 d SizeEntry 10i 0 * d dsEC ds qualified d BytesProvided 10I 0 inz(%size(dsEC)) d BytesAvail 10I 0 inz(0) d MessageID 7A d Reserved 1A d MessageData 240A // used to store max spool number override d MyMaxSpool ds qualified inz d WholeString 20 dim(1000) overlay(MyMaxSpool:*next) d OutQname 10 overlay(WholeString:1) d Maximum 10i 0 overlay(WholeString:*next) // used to ignore JOBQs d SkipJobQs ds qualified inz d WholeString 20 dim(100) overlay(SkipJobQs:*next) d JobQueue 20 overlay(WholeString:1) // used to sort the contacts d Contacts ds qualified inz d WholeString 522 dim(100) overlay(Contacts:*next) d Name 512 overlay(WholeString:1) d Sequence 10 0 overlay(WholeString:*next) * // jobs to check if running d SentMessages ds dim(1000) qualified inz d Message 256 overlay(SentMessages:1) d messagetime Z overlay(SentMessages:*next) * // subsystem to make sure they are running d Subsystems ds dim(1000) qualified inz d Name 20 overlay(Subsystems:1) * // userprofiles to ingnore when looking @ *DISABLED profiles d Profiles ds dim(1000) qualified inz d Name 20 overlay(Profiles:1) * d SubsystemDS ds 20 qualified inz d Subsystem 10 overlay(SubsystemDS:1) d Library 10 overlay(SubsystemDS:*next) d ReturnStringDS ds 244 inz qualified d Status 07 overlay(ReturnStringDS:53) * * check data on unatcached jobs * d c1 ds Dim(32766) Qualified Inz d program 10 d description 30 d code 1 * * Date structure for retriving userspace info * d InputDs DS d UserSpace 1 20 d SpaceName 1 10 d SpaceLib 11 20 d InpFileLib 29 48 d InpFFilNam 29 38 d InpFFilLib 39 48 d InpRcdFmt 49 58 * d ListProfilesDS ds qualified d Object 10 d Library 10 d ObjectType 10 d InfoStatus 1 d ExtObjAttrib 10 d Description 50 **-- Object description structure OBJD0400: ----------------------------** d ObjectDs ds qualified inz d ObjDscLen 10i 0 d ObjDscSiz 10i 0 d ObjNam 10 d ObjLib 10 d ObjTyp 10 d ObjRtnLib 10 d ObjAsp 10i 0 d ObjOwnr 10 d ObjDmn 2 d ObjCrtDat 13 d ObjChgDat 13 * d ObjAtr 10 d ObjTxt 50 d ObjSrcFil 10 d ObjSrcLib 10 d ObjSrcMbr 10 * d ObjSrcChgDat 13 d ObjSrcSavDat 13 d ObjSrcRstDat 13 d ObjCrtUsr 10 d ObjCrtSys 8 d ObjResDat 7 d ObjSavSiz 10i 0 d ObjSavSeq 10i 0 d ObjStg 10 d ObjSavCmd 10 d ObjSavVolId 71 d ObjSavDvc 10 d ObjSavFil 10 d ObjSavLib 10 d ObjSavLvl 9 d ObjCompiler 16 d ObjLvl 8 d ObjUsrChg 1 d ObjLicPgm 16 d ObjPtf 10 d ObjApar 10 * start of four d ObjUseDat 7 d ObjUsgInf 1 d ObjUseDay 10i 0 d ObjSiz 10i 0 d ObjSizMlt 10i 0 d ObjCprSts 1 d ObjAlwChg 1 d ObjChgByPgm 1 d ObjUsrAtr 10 d ObjOvrflwAsp 1 d ObjSavActDat 7 d ObjSavActTim 6 d ObjAudVal 10 d ObjPrmGrp 10 *----------------------------------------------------------------- * program status dataarea *----------------------------------------------------------------- d PgmSts SDS d P1User 254 263 d @PGM *PROC d @JOB 244 253 *--------------------------------------------------------------* * work fields * *--------------------------------------------------------------* d Variables ds d Q 1 inz( '''' ) d Count 15 0 inz( 0 ) d KeyCount 15 0 inz( 0 ) d EndPos 15 0 inz( 0 ) d JobbStatus 4 inz( ' ' ) d Subsystem 20 inz( ' ' ) d ReturnCode 1 inz( ' ' ) d FormatName 8 inz( ' ' ) d QualifedJobName... d 26 inz( ' ' ) d JobStatus 10 inz( ' ' ) d JobType 1 inz( ' ' ) d NbrOfFldRtn 10i 0 inz( 0 ) d KeyFldRtn 10i 0 inz( 0 ) dim( 100 ) d StartingPosition... d 10i 0 inz( 0 ) d LengthOfData... d 10i 0 inz( 0 ) d KeyStartingPosition... d 10i 0 inz( 0 ) d KeyLengthOfData... d 10i 0 inz( 0 ) d ReceiverVariable... d 32048 d OS400_Cmd 5000 inz( ' ' ) d CmdLength 15P 5 inz( %size( OS400_Cmd ) ) d True 1 inz( *on ) d False 1 inz( *off ) * /free Exec Sql Set Option --Naming = *Sys, Commit = *None, SRTSEQ = *LANGIDUNQ; // get system name $getsystemName(RtnValsDS: LenRtnVals: NbrVals: NamValue: ErrRtn); ReturnSystemName = RtnSystem; // nothing ever turns keeplooping off, so it loops till someone ends it reset keeplooping; dow keeplooping; // load defaults in the loop -- changes to sycontrol exsr $LoadDefaults; // reach out and get the system logs //exsr $GetSystemLogs; // // Create a user space // size = 10000; // Create a user space UsrSpcName = 'DSPJOB QTEMP '; $QUSCRTUS(UsrSpcName: 'USRSPC': size: x'00': '*ALL': 'Temp User Space for QUSLJOB API': '*YES': APIError); // look thru wrkactjob for errors exsr $CheckStatusOfJob; // delete user space $QUSDLTUS(UsrSpcName: dsEC); // check JobQueues for jobs in error exsr $CheckJobQueues; // delete user space $QUSDLTUS(UsrSpcName: dsEC); // check list of sbsystems active exsr $CheckSubsystems; // look thru unattached jobs to find errors exsr $CheckUnattachedJobs; // look for *Disable Profiles exsr $CheckUserProfiles; // check outqueues exsr $CheckOutQueues; // sleep for variable time (delay job) $sleep(sleepseconds); enddo; *inlr = *on; // ************************************************************* // load the defaults from sycontrol begsr $loadDefaults; if not %open(sycontrol); open sycontrol; endif; // get jobQ's to Skip clear SkipJobQs; reset MQ#; setll (@PGM:'IGNOREJOBQ' ) sycontrol; dou %eof(sycontrol); reade (@PGM:'IGNOREJOBQ') sycontrol; if not%eof(sycontrol); // load array with the ignore JOB queues MQ#+=1; SkipJobQs.JobQueue(MQ#) = %trim(SYVALUEC); endif; enddo; // get max spools by outqueue clear IgnoreJobs; reset MS#; setll (@PGM: 'OVRMAXSPL') sycontrol; dou %eof(sycontrol); reade (@PGM: 'OVRMAXSPL') sycontrol; if not%eof(sycontrol); // load array with the ignore jobs MS#+=1; MyMaxSpool.OutQname(MS#) = %trim(SYVALUEC); monitor; MyMaxSpool.Maximum(MS#) = SYVALUED; on-error; MyMaxSpool.Maximum(MS#) = defaultMaxSpools; endmon; endif; enddo; chain (@PGM: 'WORKHOURS') sycontrol; if %found(sycontrol); defaultStartTime = %time(SYTIME1:*hms); defaultEndTime = %time(SYTIME2:*hms); endif; chain (@PGM: 'MSGRESEND') sycontrol; if %found(sycontrol); DelayMinutes = SYVALUED; endif; // load the subsystems to verify they are running clear subsystems; reset sb#; setll (@PGM: 'SUBSYSTEM') sycontrol; dou %eof(sycontrol); reade (@PGM: 'SUBSYSTEM') sycontrol; if not %eof(sycontrol); sb#+=1; subsystems(sb#).name = %trim(%subst(SYVALUEC:1:20)); endif; enddo; // load user profiles to ignore when looking for *DISABLED clear profiles; reset pr#; setll (@PGM: 'PROFILE') sycontrol; dou %eof(sycontrol); reade (@PGM: 'PROFILE') sycontrol; if not %eof(sycontrol); pr#+=1; profiles(pr#).name = %trim(%subst(SYVALUEC:1:20)); endif; enddo; if %open(sycontrol); close sycontrol; endif; endsr; // ************************************************************* // check status of an job begsr $CheckStatusOfJob; reset AEJOBisRunning; reset AEJOBisOnHold; // run API to fill user space with information about all iSeries job FormatName = 'JOBL0200'; QualifedJobName = '*ALL ' + '*ALL ' + '*ALL '; JobStatus = '*ACTIVE'; JobType = '*'; NbrOfFldRtn = 2; KeyFldRtn( 1 ) = 0101; KeyFldRtn( 2 ) = 1906; $QUSLJOB( UsrSpcName : FormatName : QualifedJobName : JobStatus : APIError : JobType : NbrOfFldRtn : KeyFldRtn ); // if error message from the retrieve job API then dump program if APIErrorMessageID <> ' '; dump; ReturnCode = True; leavesr; endif; // run API to get user space attribute StartingPosition = 125; LengthOfData = 16; $QUSRTVUS( UsrSpcName : StartingPosition : LengthOfData : ReceiverVariable : APIError ); QUSA0100 = ReceiverVariable; // if error message from the retrieve user space API then dump program if APIErrorMessageID <> ' '; dump; ReturnCode = True; leavesr; endif; // preperation to read from user space StartingPosition = QUsrSpcOffset + 1; LengthOfData = QUsrSpcEntrieSize; // read from user space for count = 1 to QUsrSpcEntries; $QUSRTVUS( UsrSpcName : StartingPosition : LengthOfData : ReceiverVariable : APIError ); LJOB200 = ReceiverVariable; if APIErrorMessageID <> ' '; dump; ReturnCode = True; leavesr; endif; // check status of job JobbStatus = ' '; Subsystem = ' '; LJobKeyInfo = LJob200.ReturnedData; // Job type // A The job is an autostart job. // B The job is a batch job. // I The job is an interactive job. // M The job is a subsystem monitor job. // R The job is a spooled reader job. // S The job is a system job. // W The job is a spooled writer job. // X The job is the SCPF system job. // Job subtype // D The job is a batch immediate job. // E The job started with a procedure start request. // F The job is an AS/400 Advanced 36 machine server job. // J The job is a prestart job. // P The job is a print driver job. // T The job is a System/36 multiple requester terminal (MRT) job. // U The job is an alternate spool user. KeyStartingPosition = 1; KeyLengthOfData = LJobKeyInfo.LengthOfInformation; for keycount = 1 to LJob200.NumberOfFieldsReturned; LJobKeyInfo = %subst( LJob200.ReturnedData : KeyStartingPosition : KeyLengthOfData ); KeyLengthOfData = LJobKeyInfo.LengthOfInformation; LJobKeyInfo = %subst( LJob200.ReturnedData : KeyStartingPosition : KeyLengthOfData ); Endpos = LJobKeyInfo.LengthOfData; if LJobKeyInfo.KeyField = 0101; JobbStatus = %subst( LJobKeyInfo.KeyData : 1 : Endpos ); elseif LJobKeyInfo.KeyField = 1906; Subsystem = %subst( LJobKeyInfo.KeyData : 1 : Endpos ); endif; KeyStartingPosition = KeyStartingPosition + KeyLengthOfData; endfor; if ljob200.jobname = 'AEJOB' and LJOB200.JOBTYPE = 'A'; AEJOBisRunning = *on; if Jobbstatus = 'HLD'; AEJOBisOnHold = *on; ENDIF; endif; // if job in message wait then email message to address in // variable email address -- Skip printer jobs if Jobbstatus = 'MSGW' and LJOB200.JOBTYPE <> 'W' and LJOB200.JOBTYPE <> 'R' and %lookup(ljob200.jobname:IgnoreJobs) = 0; outsubject = 'Job ' + %trim(ljob200.jobname) + ' is in *MSGW'; outmessage = 'Job in Message wait: ' + %trim(ljob200.jobname) + ' ' + %trim(ljob200.username) + ' ' + %trim(ljob200.jobnumber); workjobname = %trim(ljob200.jobname) + %trim(ljob200.username); exsr $sendusermessage; endif; StartingPosition = StartingPosition + LengthOfData; endfor; // get the system name exec sql values current server into :SystemName; if AEJOBisRunning = *off and SystemName = 'S215B43V'; outsubject = 'AEJOB not running'; outmessage = 'Job AEJOB not running in Subsystem AESBS'; exsr $sendusermessage; endif; if AEJOBisOnHold = *on and SystemName = 'S215B43V'; outsubject = 'AEJOB is HELD'; outmessage = 'Job AEJOB HELD in Subsystem AESBS'; exsr $sendusermessage; endif; endsr; // ************************************************************* // Look for jobqueues on HOLD begsr $CheckJobQueues; worktype = '*JOBQ'; // Create a user space UsrSpcName = 'JOBQS QTEMP '; $QUSCRTUS(UsrSpcName: 'USRSPC': size: x'00': '*ALL': 'Temp User Space for JOB queues': '*YES': APIError); ObjectLib = '*ALL ' + '*ALL'; // // List all the outqueues to the user space // $ListObjects( UsrSpcName: 'OBJL0200' : ObjectLib : WorkType); // // Retrive header entry and process the user space // StartPosit = 125; StartLen = 16; $UserSpace(UsrSpcName : StartPosit : StartLen : GENDS); StartPosit = OffsetHdr + 1; StartLen = %size(ListJOBQ); for count = 1 to NbrInList; $UserSpace( UsrSpcName : StartPosit : StartLen : ListJOBQ); StartPosit += SizeEntry; // skip the JOBQ's we are told to skip If %lookup(ListJOBQ.Object:SkipJobQs.jobqueue) > *zeros; iter; endif; jobqlibrary = ListJOBQ.Object + %trim(ListJOBQ.Library); $GetJobQ(MyJobQDS :%SIZE(MyJobQDS ):'JOBQ0200': jobqlibrary:apierror); if MyJobQDS.JobqStatus = 'HELD'; Outsubject = 'JobQ ' + %trim(MyJobQDS.JobQName) + ' is HELD '; Outmessage = 'Please logon to system and check status of this JobQ'; workjobname = %trim(jobqlibrary); exsr $sendusermessage; endif; endfor; endsr; // ************************************************************* // ************************************************************* // Check the outqueues begsr $CheckOutQueues; worktype = '*OUTQ'; // Create a user space UsrSpcName = 'OUTQS QTEMP '; $QUSCRTUS(UsrSpcName: 'USRSPC': size: x'00': '*ALL': 'Temp User Space for JOB queues': '*YES': APIError); ObjectLib = '*ALL ' + '*ALL'; // // List all the outqueues to the user space // $ListObjects( UsrSpcName: 'OBJL0200' : ObjectLib : WorkType); // // Retrive header entry and process the user space // StartPosit = 125; StartLen = 16; $UserSpace(UsrSpcName : StartPosit : StartLen : GENDS); StartPosit = OffsetHdr + 1; StartLen = %size(ListJOBQ); for count = 1 to NbrInList; $UserSpace( UsrSpcName : StartPosit : StartLen : ListJOBQ); StartPosit += SizeEntry; OutQname = ListJOBQ.Object + %trim(ListJOBQ.Library); exsr $GetSPLFList; endfor; endsr; //=========================================== // $GetSPLFList - Get Spooled File List //=========================================== begsr $GetSPLFList; // set this to zero to let OS/400 handle errors dsEC.BytesProvided = 0; // make space for (approx) 10000 spooled files to be listed size = %size(dsLH) + 512 + (%size(dsSF) * 10000); // create a user space // List spooled files to the user space // Get a pointer to the returned user space UsrSpcName2 = 'SPOOLS QTEMP '; // Create a user space $QUSCRTUS(UsrSpcName2: 'USRSPC': size: x'00': '*ALL': 'Temp User Space for QUSLSPL API': '*YES': dsEC); // List spooled files to the user space monitor; $QUSLSPL(UsrSpcName2: 'SPLF0300': '*ALL': OutQName: '*ALL': '*ALL': dsEC); on-error; // delete user space monitor; $QUSDLTUS(UsrSpcName2: dsEC); on-error; endmon; leavesr; endmon; // Get a pointer to the returned user space $QUSPTRUS(UsrSpcName2: p_UsrSpc); // Loop through list, for each spooled file, display the // Status: 1=RDY , 2=OPN, 3=CLO, 4=SAV, 5=WRT, 6=HLD, // 7=MSGW, 8=PND, 9=PRT,10=FIN,11=SND,12=DFR p_Entry = p_UsrSpc + dsLH.ListOffset; sf = 1; reset NumberofRDYSpools; dow sf <= dsLH.NumEntries; // currently only count status = 1 ready if dsSF.SplfStatus = 1; NumberOfRDYSpools+=1; else; if dsSF.SplfStatus = 7; Outsubject = 'Spooled File in *MSGW '; Outmessage = 'Please check outQ: ' + %trim(ListJOBQ.Library) + '/' + %trim(ListJOBQ.Object); workjobname = %trim(ListJOBQ.Object) + %trim(ListJOBQ.Library); exsr $sendusermessage; endif; endif; // see if there is an overrode defaultmax spool for this // outQueue if so replace foundme = %lookup(ListJOBQ.Object:MyMaxSpool.OutQname); if foundme > 0; workMaxSpools = MyMaxSpool.Maximum(foundme); else; WorkMaxSpools = defaultMaxSpools; endif; // maximum number of spooled file check if NumberOfRDYSpools >= WorkMaxSpools; Outsubject = 'Maximum Spooled files in OUTQ '; Outmessage = 'Please check outQ: ' + %trim(ListJOBQ.Library) + '/' + %trim(ListJOBQ.Object); workjobname = %trim(ListJOBQ.Object) + %trim(ListJOBQ.Library); exsr $sendusermessage; endif; p_Entry += dsLH.EntrySize; sf +=1; enddo; // delete user space $QUSDLTUS(UsrSpcName2: dsEC); endsr; //=========================================== // make sure list of subystems are active begsr $CheckSubsystems; for count = 1 to sb#; subsystemDS = subsystems(count).name; clear ReturnStringDS; format = 'SBSI0200'; $GetSubsystemStatus(ReturnStringDS:StringSize: Format:SubsystemDS:error); if ReturnStringDS.status <> '*ACTIVE'; Outsubject = 'Subsystem ' + %trim(%subst(subsystemDS:1:10)) + ' is Not Active '; Outmessage = 'Please start subsystem'; exsr $sendusermessage; endif; endfor; endsr; // ************************************************************* // $GetSystemLogs - get the system log information begsr $GetSystemLogs; Exec Sql declare global temporary table MyWorkFile (mystring char(132)) with replace; // OVRPRTF FILE(QPDSPLOG) HOLD(*YES) OVRSCOPE(*JOB) OneThousandLong = 'OVRPRTF FILE(QPDSPLOG) HOLD(*YES) ' + ' OVRSCOPE(*JOB) MAXRCDS(*NOMAX)'; monitor; runcommand(OneThousandLong); on-error; endmon; // DSPLOG PERIOD((000001 070914) (*AVAIL *CURRENT)) OUTPUT(*PRINT) MSGID(CPF1124 // CPF1164) MMDDYY = %dec(%date():*mdy); OneThousandLong = 'DSPLOG PERIOD((000001 ' + %trim(%editc(MMDDYY:'X')) + ') (*AVAIL *CURRENT))' + ' OUTPUT(*PRINT) MSGID(' + %trim(LogMessages) + ')'; monitor; runcommand(OneThousandLong); on-error; endmon; // CPYSPLF FILE(QPDSPLOG) TOFILE(QTEMP/MYWORKFILE) SPLNBR(*LAST) OneThousandLong = 'CPYSPLF FILE(QPDSPLOG) ' + ' TOFILE(QTEMP/MYWORKFILE) ' + ' SPLNBR(*LAST) '; monitor; runcommand(OneThousandLong); on-error; endmon; // dltSPLF FILE(QPDSPLOG) SPLNBR(*LAST) OneThousandLong = 'dltSPLF FILE(QPDSPLOG) SPLNBR(*LAST) '; monitor; runcommand(OneThousandLong); on-error; endmon; // DLTOVR FILE(QPDSPLOG) LVL(*JOB) OneThousandLong = 'DLTOVR FILE(QPDSPLOG) LVL(*JOB) '; monitor; runcommand(OneThousandLong); on-error; endmon; endsr; //=========================================== // $CheckUserProfiles (*DISABLED) //=========================================== begsr $CheckUserProfiles; APIErrorDS.BytesP = 116; Spacename = 'PROFILES'; SpaceLib = 'QTEMP'; // // Create the user space // $CreateSpace( Userspace : SpaceAttr : 4096 : SpaceVal : SpaceAuth : SpaceText : SpaceRepl: APIErrorDs); // find all files in the passed in Library ObjectLib = '*ALL ' + '*ALL'; WorkType = '*USRPRF'; // // List all the outqueues to the user space // $ListObjects( Userspace : 'OBJL0200' : ObjectLib : WorkType); // // Retrive header entry and process the user space // StartPosit = 125; StartLen = 16; $UserSpace( Userspace : StartPosit : StartLen : GENDS); StartPosit = OffsetHdr + 1; StartLen = %size(ListProfilesDS); // ? // Do for number of outqueues in the userspace // B1 for count = 1 to NbrInList; $UserSpace( Userspace : StartPosit : StartLen : ListProfilesDS); StartPosit += SizeEntry; // retrieve the device description $RtvObjD( ObjectDS : %Size( ObjectDS ) : 'OBJD0400' : ListProfilesDS.Object + ListProfilesDS.library : ListProfilesDS.ObjectType : ApiErrorDS ); // get user profile status -- enabled or disabled ProfileDataDS = GetUserProfileData(ListProfilesDS.Object); if ProfileDataDS.Status = '*DISABLED' and %lookup(ListProfilesDS.Object:Profiles(*).name) = *zeros; Outsubject = 'userid ' + %trim(ListProfilesDS.Object) + ' is *Disabled.'; Outmessage = 'Please *ENABLE Profile'; exsr $sendusermessage; endif; endfor; endsr; //=========================================== // $CheckUnattachedJobs //=========================================== begsr $CheckUnattachedJobs; exec sql declare C1 scroll cursor for select uJKEY, UJDSC , ujcst from UJBCTL where ujcst not in ('1', '3', '4') for read only; exec sql open C1; exec sql fetch first from C1 for :MaxItemLines rows into :C1; exec sql get diagnostics :RowCount = ROW_COUNT; DoW RowCount <> 0; For I = 1 to RowCount; OutSubject = 'Unattached Job in Error'; OutMessage = 'Job: ' + %trim(c1(i).program) + '-' + %trim(c1(i).description) + ' In status ' + %trim(c1(i).code); exsr $sendusermessage; EndFor; exec sql fetch next from C1 for :MaxItemLines rows into :C1; exec sql get diagnostics :RowCount = ROW_COUNT; EndDo; exec sql close C1; endsr; // ************************************************************* // send messages to users // ************************************************************* begsr $sendusermessage; // get the system name exec sql values current server into :SystemName; OutSubject = %trim(ReturnSystemName) +'-' + %trim(OutSubject); MyFullMessage = OutSubject + OutMessage; // check last time you sent this message against value in delayMinutes foundmessage = %lookup(MyFullMessage:sentmessages(*).Message); if foundmessage > *zeros; totalMinutes = %diff(%timestamp: sentmessages(foundmessage).messagetime:*minutes); if totalminutes > delayminutes; // send message IsThereAnError = RouteOutput(@PGM: 'MESSAGE': @PGM: OutSubject: OutMessage: 0); sentmessages(foundmessage).messagetime = %timestamp(); endif; else; // send message IsThereAnError = RouteOutput(@PGM: 'MESSAGE': @PGM: OutSubject: OutMessage: 0); MM#+=1; sentmessages(mm#).message = MyFullMessage; sentmessages(mm#).messagetime = %timestamp(); endif; endsr; /end-free