QWCLSCDE - Retrieve Job Schedule Entries

Retrieve Job Schedule Entries ******************************************************************** * PROGRAM : JOBSCDER * DESCRIPTION : Retrieve Job Schedule Entries, sort by Time * AUTHOR : Joe Marx * * NOTES : Written for Sox Remedation * * APIs Used: QWCLSCDE - Retrieve Job Schedule Entries * QLGSORT - Sort List * QUSCRTUS - Create User Space * QUSDLTUS - Delete User Space * QUSPTRUS - Retrieve From User Space w/ Pointer * QWCRNETA - Retrieve Network Attributes * QMHSNDPM - Send Message * * * MAINTENANCE PROGRAMMER, PROJECT #, AND DESCRIPTION. * ----------- --------------------------------------- * 10/26/2004 Joe Marx - Created ******************************************************************** FQSYSPRT O F 132 PRINTER OFLIND(*INOF) * DATE FORMATS -------------------------------------------- D FORMATMDY S D DATFMT(*MDY) D FORMATUSA S D DATFMT(*USA) D FORMATYMD S D DATFMT(*YMD) D FORMATISO S D DATFMT(*ISO) D PGM_INFO SDS D PGM_NAME *PROC D PGM_STATUS *STATUS D PGM_USER 254 263 * DELETE USER SPACE D DELETESPACE PR EXTPGM('QUSDLTUS') D 20 D 116 * CREATE USER SPACE D USERSPACE PR EXTPGM('QUSCRTUS') D 20 D 10 D 10I 0 D 1 D 10 D 50 D 10 D 116 D 10 * GET A RESOLVED POINTER TO THE USER SPACE D GETPOINTER PR EXTPGM('QUSPTRUS') D 20 CONST D * D 116 *** API for List of Job Schedule Entries D JobSch PR EXTPGM('QWCLSCDE') D 20 CONST D 8 CONST D 10 CONST D 16 CONST D 116 *** QCMD DCOMMAND PR EXTPGM('QCMDEXC') D CMDSTRING 3000 CONST OPTIONS(*VARSIZE) D CMDLENGTH 15P 5 CONST D CMDOPT 3 CONST OPTIONS(*NOPASS) D SendMsg PR extpgm('QMHSNDPM') D MsgID 7 const D MsgFile 20 const D MsgDta 80 const D MsgDtaLen 10i 0 const D MsgType 10 const D MsgQ 10 const D MsgQNbr 10i 0 const D MsgKey 4 D ErrorDS 16 *** API Error Handling D DS D APIERROR 116 D BYTPRV 9B 0 OVERLAY(APIERROR) INZ(16) D BYTAVA 9B 0 OVERLAY(APIERROR:5) D MSGID 7 OVERLAY(APIERROR:9) D ERR### 1 OVERLAY(APIERROR:16) D MSGDTAE 100 OVERLAY(APIERROR:17) * GENERIC LIST HEADER D SPCPTR S * D QUSH0100 DS BASED(SPCPTR) D QUSUA 64 USER AREA D QUSSGH 10I 0 HEADER SIZE D QUSSRL 4 RELEASE LEVEL D QUSFN 8 FORMAT NAME D QUSAU 10 API USED D QUSDTC 13 DATE/TIME CREATED D QUSIS 1 INFO STATUS D QUSSUS 10I 0 SIZE USER SPACE D QUSOIP 10I 0 OFSET INPUT PARM D QUSSIP 10I 0 INPUT PARM SIZE D QUSOHS 10I 0 OFFSET HDR SECTION D QUSSHS 10I 0 HEADER SECTION SIZE D QUSOLD 10I 0 OFFSET LIST DATA D QUSSLD 10I 0 SIZE LIST DATA D QUSNBRLE 10I 0 NUMBER LIST ENTRIES D QUSSEE 10I 0 SIZE EACH ENTRY D QUSSIDLE 10I 0 CCSID LIST ENT D QUSCID 2 COUNTRY ID D QUSLID 3 LANGUAGE ID D QUSSLI 1 SUBSET LIST INDICO D QUSERVED00 42 RESERVED D JS_PTR S * D JS S 1 BASED(JS_PTR) DIM(32767) D JS_Detail DS 1156 Based(JS_PTR) D JS_Char1 1 Overlay(JS_Detail:1) D JS_Job 10 Overlay(JS_Detail:*Next) D JS_Entry 10 Overlay(JS_Detail:*Next) D JS_SchDate 10 Overlay(JS_Detail:*Next) D JS_SchDays 70 Overlay(JS_Detail:*Next) D JS_SchTime 6 Overlay(JS_Detail:*Next) D JS_Freq 10 Overlay(JS_Detail:*Next) D JS_DayofMon 50 Overlay(JS_Detail:*Next) D JS_Recovery 10 Overlay(JS_Detail:*Next) D JS_NextDate 10 Overlay(JS_Detail:*Next) D JS_Status 10 Overlay(JS_Detail:*Next) D JS_JobqNam 10 Overlay(JS_Detail:*Next) D JS_JobqLib 10 Overlay(JS_Detail:*Next) D JS_UsrPrf 10 Overlay(JS_Detail:*Next) D JS_LastDate 10 Overlay(JS_Detail:*Next) D JS_LastTime 6 Overlay(JS_Detail:*Next) D JS_Text 50 Overlay(JS_Detail:*Next) D JS_Fill1 23 Overlay(JS_Detail:*Next) D JS_JobqStatus 10 Overlay(JS_Detail:*Next) D JS_DatesOmit 200 Overlay(JS_Detail:*Next) D JS_JobdNam 10 Overlay(JS_Detail:*Next) D JS_JobdLib 10 Overlay(JS_Detail:*Next) D JS_UsrPrf2 10 Overlay(JS_Detail:*Next) D JS_MsgQNam 10 Overlay(JS_Detail:*Next) D JS_MsgQlib 10 Overlay(JS_Detail:*Next) D JS_SaveEnt 10 Overlay(JS_Detail:*Next) D JS_LastSubN 10 Overlay(JS_Detail:*Next) D JS_LastSubU 10 Overlay(JS_Detail:*Next) D JS_LastSubJ 6 Overlay(JS_Detail:*Next) D JS_LastAttD 10 Overlay(JS_Detail:*Next) D JS_LastAttT 6 Overlay(JS_Detail:*Next) D JS_LastAttS 10 Overlay(JS_Detail:*Next) D JS_Fill2 2 Overlay(JS_Detail:*Next) D JS_Len 4 0 Overlay(JS_Detail:*Next) D JS_Command 512 Overlay(JS_Detail:*Next) * Sort Block DSORTBLOCK DS D BLOCKLEN 1 4B 0 INZ(0) D REQTYPE 5 8B 0 INZ(8) D RSVP1 9 12B 0 INZ(0) D OPTIONS 13 16B 0 INZ(0) D RECLEN 17 20B 0 INZ(0) D RECCOUNT 21 24B 0 INZ(0) D OFF2KEY 25 28B 0 INZ(80) D NBROFKEYS 29 32B 0 INZ(0) D OFF2NLSI 33 36B 0 INZ(0) D OFF2IFL 37 40B 0 INZ(0) D NBRINF 41 44B 0 INZ(0) D OFF2OFL 45 48B 0 INZ(0) D NBROUTF 49 52B 0 INZ(0) D KEYENTLEN 53 56B 0 INZ(16) D NLSSLEN 57 60B 0 INZ(290) D IFELEN 61 64B 0 INZ(0) D OFELEN 65 68B 0 INZ(0) D OFF2NBM 69 72B 0 INZ(0) D OFF2VLRA 73 76B 0 INZ(0) D RSVP2 77 80B 0 INZ(0) D KEYINF 16A DIM(MaxKey) * Sort Block IO DSORTIOBLOC DS D IOTYPE 1 4B 0 INZ(0) D RSVP3 5 8B 0 INZ(0) D IORECLEN 9 12B 0 INZ(0) D IORECCNT 13 16B 0 INZ(0) * Sort INFO Data Structure DKEYINFDS DS D KEYSTART 1 4B 0 D KEYSIZE 5 8B 0 D KEYDTATYP 9 12B 0 D KEYASCDESC 13 16B 0 *---------------------------------------------------------------- * QWCRNETA Retrieve network attribute - get system name * See SYSTEM PROGRAMMER'S INTERFACE REFERENCE for API detail. *---------------------------------------------------------------- D vsd s 5u 0 START OF DATA D vso s 5u 0 START OFFSET * Load number of attributes to retrieve and attribute name D vapiky ds D vnkfld 10i 0 inz(1) D vkarry 11 inz('SYSNAME') * Number of keys returned and offset to attribute data D vrcvr1 ds 200 inz D vnkyrt 10i 0 D voffna 10i 0 D vrcvln s 10i 0 inz(200) * Network Attribute Information Table returned D vnait ds inz D vrtatt 1 10 D vrttyp 11 11 D vrtsta 12 12 D vrtlen 10i 0 * User Defined Variables D JS_Format S 20 INZ('SCDL0200') D JS_Name S 8 INZ('*ALL') D JS_Handle S 10 INZ(' ') D SPC_LIB S 10 INZ('QTEMP ') D EXT_ATTR S 10 INZ D SPACE_SIZE S 10I 0 INZ(500000) D SPACE_INIT S 1 INZ(X'00') D SPACE_AUT S 10 INZ('*ALL') D SPACE_TEXT S 50 INZ('MEDI001R TEXT') D SPACE_RPL S 10 INZ('*YES') D SPACEDOMAN S 10 INZ('*USER') D SPACENAME S 20 INZ('MEDI001R QTEMP ') D TIMES S 7 0 D COUNT S 7 0 D LLEN S 7 0 D Ljob S 10 D COUNT2 S 7 0 D #Status S 3A D #Date S 10A D #Command S 31A D #Time S 6 0 D #Frequency S 10A D MAXKEY C 4 D EXITER S 1A D NOTUSED S 16A D RETURNSIZE S 9B 0 D SIZELIST S 9B 0 D SYSNAME S 8 D #str S 4 0 D #end S 4 0 D #Len S 4 0 D CMDSTRING S 3000 VARYING D CMDLENGTH S 15 5 D MsgDta s 80 D MsgKey s 4 ** Initial Startup C EXSR INIT ** Main Processing C EXSR Main ** Special Processing C EXSR Special * Send Message that Job has completed. C*** CALLP COMMAND( CMDSTRING : %LEN(CMDSTRING)) C eval MsgDta = 'AS/400 Batch Job Schedule - C has printed' C callp SendMsg ('CPF9898': C 'QCPFMSG QSYS': C MsgDta: C %len(MsgDta): C '*ESCAPE': C '*': C 2: C MsgKey: C ApiError) ** End Program C EVAL *INLR = *ON *============================================================== * Subroutine - Main * This subroutine processing.... *============================================================== C Main begsr ** Print Header at least 1 time.... C EXCEPT HEAD1 ** RETRIEVE DATABASE FILE DESCRIPTION USING USER SPACE ** CREATE USER SPACE C CALLP USERSPACE(SPACENAME : C EXT_ATTR : SPACE_SIZE : C SPACE_INIT : SPACE_AUT : C SPACE_TEXT : SPACE_RPL : C APIERROR : SPACEDOMAN ) ** RETRIEVE WRKJOBSCDE API - QWCLSCDE C CALLP JOBSCH(SPACENAME : C JS_Format : JS_Name : C JS_Handle : APIERROR ) * GET A RESOLVED POINTER TO THE USER SPACE * RECEIVES HEADER INFO FROM USER SPACE C CALLP GETPOINTER(SPACENAME : SPCPTR : C APIERROR) C * SET JS_PTR TO THE FIRST BYTE OF THE USER SPACE C EVAL JS_PTR = SPCPTR * Initial Sort API c EXSR $InzSort * Initial Sort List c EXSR $SortList * DELETE ALL USER SPACES BEFORE EXITING PROGRAM C CALLP DELETESPACE(SPACENAME : APIERROR ) * Print Totals C EXSR @@HEAD C EXCEPT TOT1 C EndSr *============================================================== * Subroutine - Special * This subroutine processing.... *============================================================== C Special begsr ** Print Header at least 1 time.... C EXCEPT HEAD2 ** RETRIEVE DATABASE FILE DESCRIPTION USING USER SPACE ** CREATE USER SPACE C CALLP USERSPACE(SPACENAME : C EXT_ATTR : SPACE_SIZE : C SPACE_INIT : SPACE_AUT : C SPACE_TEXT : SPACE_RPL : C APIERROR : SPACEDOMAN ) ** RETRIEVE WRKJOBSCDE API - QWCLSCDE C CALLP JOBSCH(SPACENAME : C JS_Format : JS_Name : C JS_Handle : APIERROR ) * GET A RESOLVED POINTER TO THE USER SPACE * RECEIVES HEADER INFO FROM USER SPACE C CALLP GETPOINTER(SPACENAME : SPCPTR : C APIERROR) C * SET JS_PTR TO THE FIRST BYTE OF THE USER SPACE C EVAL JS_PTR = SPCPTR * Initial Sort API c EXSR $InzSort * Initial Sort List c EXSR $SortList2 * DELETE ALL USER SPACES BEFORE EXITING PROGRAM C CALLP DELETESPACE(SPACENAME : APIERROR ) * Print Totals C EXSR @@HEAD2 C EXCEPT TOT2 C EndSr *============================================================== * Subroutine - Init * This subroutine Initializes the Program *============================================================== C Init begsr C call 'QWCRNETA' RETRIEVE SPACE C parm vrcvr1 C parm 200 vrcvln C parm vnkfld NUMBER OF KEYS C parm vkarry KEY ARRAY C parm ApiError C voffna add 1 vso START OFFSET C voffna add 1 vso START OFFSET C eval vnait = %subst(vrcvr1:vso:16) LOAD NAIT DST C vso add 16 vsd START OF DATA C vrtlen subst vrcvr1:vsd SYSNAME EXTRACT SYSNAM c Endsr *============================================================== * Subroutine - @@HEAD * Check for Overflow - Reprints Heading *============================================================== C @@HEAD begsr c if *inOF = *on C EXCEPT HEAD1 c Eval *inOF = *off c EndIf C Endsr *============================================================== * Subroutine - @@HEAD2 * Check for Overflow - Reprints Heading for Special *============================================================== C @@HEAD2 begsr c if *inOF = *on C EXCEPT HEAD1 c Eval *inOF = *off c EndIf C Endsr *============================================================== * Subroutine - InzSort * This subroutine Initializes the Sort API *============================================================== c $InzSort begsr * Initialize the key fields to sort on. * Load JS_Freq field as key field, 06 byte, Char, ascending sequence. c eval KeyStart = 107 c eval KeySize = 10 c eval KeyDtaTyp = 2 c eval KeyAscDesc = 1 c eval KeyInf(1) = KeyInfDs * Load JS_schTime field as key field, 06 byte, Char, ascending sequence. c eval KeyStart = 101 c eval KeySize = 06 c eval KeyDtaTyp = 2 c eval KeyAscDesc = 1 c eval KeyInf(2) = KeyInfDs * Load JS_Job field as key field, 10 byte, char , ascending sequence. c eval KeyStart = 1 c eval KeySize = 10 c eval KeyDtaTyp = 6 c eval KeyAscDesc = 1 c eval KeyInf(3) = KeyInfDs * Load other sort parameters. c eval BlockLen = 80 + 16 * MaxKey c eval NbrOfKeys = 3 Variable c eval RecLen = %size(JS_Detail) * Initialize Sort I/O API fields. c eval IORecLen = RecLen c eval IORecCnt = 1 * All done initializing. c ENDSR *============================================================== * Subroutine - SortList * This subroutine sorts the List *============================================================== c $SortList begsr * First step - Initialize the sort routine. c call 'QLGSORT' c parm SortBlock c parm NotUsed c parm NotUsed c parm SizeList c parm ReturnSize c parm ApiError * Next step - write records to I/O routine. c eval IOType = 1 * INCREMENT JS_PTR TO THE FIRST LIST ENTRY C EVAL JS_PTR = %ADDR(JS(QUSOLD + 1)) C FOR TIMES=1 BY 1 TO QUSNBRLE c call 'QLGSRTIO' c parm SortIOBloc c parm JS_Detail c parm NotUsed c parm SizeList c parm NotUsed c parm ApiError C EVAL JS_PTR = %ADDR(JS(QUSSEE + 1)) C Endfor * Next step - Signal end of input, clear JS_DETAIL for reload. c eval IOType = 2 c call 'QLGSRTIO' c parm SortIOBloc c parm JS_Detail c parm NotUsed c parm SizeList c parm NotUsed c parm ApiError * Final step - write the records back to the subfile. c eval IOType = 3 C EVAL JS_PTR = %ADDR(JS(QUSOLD + 1)) C FOR TIMES=1 BY 1 TO QUSNBRLE c call 'QLGSRTIO' c parm SortIOBloc c parm NotUsed c parm JS_Detail c parm IORecLen c parm NotUsed c parm ApiError * Set up Date of Run.... C Eval #DATE = JS_SCHDATE C Select C WHEN JS_SCHDATE = '*NONE' C and JS_SchDays <> '*ALL' C Eval #DATE = 'USER DEF' C WHEN JS_SCHDATE = '*NONE' C and JS_SchDays = '*ALL' C Eval #DATE = '*All' C EndSL * Set up #Status... C Eval #Status = %subst(JS_Status:1:3) * Set up #Time..... C Move JS_SCHTIME #Time * Set up #command..... C Eval #COMMAND = %subst(JS_COMMAND:1:31) C If %subst(JS_COMMAND:1:9) = 'CALL PGM(' C Eval #str = %scan('/': JS_Command ) C Eval #end = %scan(')': JS_Command ) * check if library with program(meaning / comes after program) C If #str > #end C or #str = 0 C Eval #COMMAND = %subst(JS_COMMAND: 10 C :(#End-1) - 9) C Else C Eval #COMMAND = %subst(JS_COMMAND: #str+1 C :(#End-1)-#Str) C Endif C Endif C Eval #LEN = %len(%trim(JS_COMMAND)) C If #LEN > LLEN C Eval LLEN = #LEN C Eval LJOB = JS_Job C Endif C EVAL COUNT = COUNT + 1 C EXSR @@HEAD C EXCEPT DET1 C EVAL JS_PTR = %ADDR(JS(QUSSEE + 1)) C ENDFOR c endsr *============================================================== * Subroutine - SortList2 * This subroutine sorts the List *============================================================== c $SortList2 begsr * First step - Initialize the sort routine. c call 'QLGSORT' c parm SortBlock c parm NotUsed c parm NotUsed c parm SizeList c parm ReturnSize c parm ApiError * Next step - write records to I/O routine. c eval IOType = 1 * INCREMENT JS_PTR TO THE FIRST LIST ENTRY C EVAL JS_PTR = %ADDR(JS(QUSOLD + 1)) C FOR TIMES=1 BY 1 TO QUSNBRLE c call 'QLGSRTIO' c parm SortIOBloc c parm JS_Detail c parm NotUsed c parm SizeList c parm NotUsed c parm ApiError C EVAL JS_PTR = %ADDR(JS(QUSSEE + 1)) C Endfor * Next step - Signal end of input, clear JS_DETAIL for reload. c eval IOType = 2 c call 'QLGSRTIO' c parm SortIOBloc c parm JS_Detail c parm NotUsed c parm SizeList c parm NotUsed c parm ApiError * Final step - write the records back to the subfile. c eval IOType = 3 C EVAL JS_PTR = %ADDR(JS(QUSOLD + 1)) C FOR TIMES=1 BY 1 TO QUSNBRLE c call 'QLGSRTIO' c parm SortIOBloc c parm NotUsed c parm JS_Detail c parm IORecLen c parm NotUsed c parm ApiError * Set up Date of Run.... C Eval #DATE = JS_SCHDATE C Select C WHEN JS_SCHDATE = '*NONE' C and JS_SchDays <> '*ALL' C Eval #DATE = 'USER DEF' C WHEN JS_SCHDATE = '*NONE' C and JS_SchDays = '*ALL' C Eval #DATE = '*All' C EndSL * Set up #Status... C Eval #Status = %subst(JS_Status:1:3) * Set up #Time..... C Move JS_SCHTIME #Time * Set up #command..... C Eval #COMMAND = %subst(JS_COMMAND:1:31) C If %subst(JS_COMMAND:1:9) = 'CALL PGM(' C Eval #str = %scan('/': JS_Command ) C Eval #end = %scan(')': JS_Command ) C Eval #COMMAND = %subst(JS_COMMAND:#str+1 C :(#End-1)-#Str) C Endif * Set up #Frequency.... C Eval #Frequency = '*SUNDAY' c If %scan('*SUN' : JS_SchDays) > 0 C EVAL COUNT2 = COUNT2 + 1 C EXSR @@HEAD2 C EXCEPT DET2 c Endif C EVAL JS_PTR = %ADDR(JS(QUSSEE + 1)) C ENDFOR c endsr OQSYSPRT E HEAD1 01 O + 50 'Job Schedule List' O E HEAD1 1 O + 1 'Date of Report....:' O *Date y + 1 O 120 'PAGE......:' O PAGE Z 132 O E HEAD1 1 O + 1 'Program Name......:' O PGM_NAME + 1 O 120 'UserId....:' O PGM_USER 132 O E HEAD1 2 O + 1 'System Name.......:' O SYSNAME + 1 O E HEAD1 1 O +0 'Opt Job' O +4 'Status' O +2 'Date' O +7 'Time' O +5 'Frequency' O +2 'Description' O +40 'Program/Command' O E HEAD1 1 O +0 '--------------------' O +0 '--------------------' O +0 '--------------------' O +0 '--------------------' O +0 '--------------------' O +0 '--------------------' O +0 '------------' O E DET1 1 O JS_Job +0 O #Status +1 O #Date +5 O #Time +1 ' : : ' O JS_Freq +1 O JS_Text +1 O #Command +1 O E TOT1 3 O +0 'COUNT:' O COUNT 4 +2 O*** E TOT1 1 O*** +0 'Longest Length of Command:' O*** LLEN 4 +2 O*** LJOB +2 OQSYSPRT E HEAD2 01 O + 46 'Special Job Schedule List' O E HEAD2 1 O + 1 'Date of Report....:' O *Date y + 1 O 120 'PAGE......:' O PAGE Z 132 O E HEAD2 1 O + 1 'Program Name......:' O PGM_NAME + 1 O 120 'UserId....:' O PGM_USER 132 O E HEAD2 2 O + 1 'System Name.......:' O SYSNAME + 1 O E HEAD2 1 O +0 'Opt Job' O +4 'Status' O +2 'Date' O +7 'Time' O +5 'Frequency' O +2 'Description' O +40 'Program/Command' O E HEAD2 1 O +0 '--------------------' O +0 '--------------------' O +0 '--------------------' O +0 '--------------------' O +0 '--------------------' O +0 '--------------------' O +0 '------------' O E DET2 1 O JS_Job +0 O #Status +1 O #Date +5 O #Time +1 ' : : ' O #Frequency +1 O JS_Text +1 O #Command +1 O E TOT2 3 O +0 'COUNT:' O COUNT2 4 +2 Thanks to Joe Marx