Tweet
Wrkjobscde
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
Comment