********************************************************************
* 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)
Requires Free Membership to View
Register today to access targeted resources from our editorial writers and independent industry experts including news, tips, and advice to help you do your job more efficiently and effectively. Stay informed on the hottest topics and biggest challenges faced by IT professionals working with iSeries products and services.
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 :
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 :
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