|
midrange.com
Sorry Rob!. Here it is:
¹
*---------------------------------------------------------------------------------------------
¹ *
¹ * PROGRAM : CHKACTJOB
¹ *
¹
*---------------------------------------------------------------------------------------------
¹ * API routines used:
¹ *
¹ * QUSCRTUS -- Create user space
¹ * QUSLJOB -- Load job info into user space
¹ * QUSRTVUS -- Retrieve user space
¹ * QUSRJOBI -- Retrieve job information
¹ * QWCRSSTS -- Retrieve system status information
¹ *
¹
*---------------------------------------------------------------------------------------------
¹ *
¹ * Define constants
¹
*---------------------------------------------------------------------------------------------
¹ *
D @USPTX C CONST('User Space for User -
D Jobs ')
¹ *
¹
*---------------------------------------------------------------------------------------------
¹ * Data structures
¹
*---------------------------------------------------------------------------------------------
¹ *
D BINARY DS
D SSIZE2 1 4B 0
D DTALG2 5 8B 0
D STRPO2 9 12B 0
D RCVLG2 13 16B 0
D @RCVLG 17 20B 0
D @BYTPR 21 24B 0
D @BYTAV 25 28B 0
D @MSKLN 29 32B 0
D @RCVLN 33 36B 0
D @SRCPR 37 40B 0
D @SRCDP 41 44B 0
¹ *
¹
*---------------------------------------------------------------------------------------------
¹ * Data structures for API QUSLJOB
¹
*---------------------------------------------------------------------------------------------
¹ *
D INPUT2 DS
D QJOBI 1 26
D JOBNMI 1 10
D USRNMI 11 20
D JOBNOI 21 26
D STATI 27 36
D USRSP2 37 56
D SNAME2 37 46
D SLIBR2 47 56
D FORMT2 57 64
D JOBTYI 65 65
D FLDRTN 69 72B 0
¹ D* 75 100 FLDNMI
D JOB100 DS
D QJOBL 1 26
D JOBNML 1 10
D USRNML 11 20
D JOBNOL 21 26
D IJOBID 27 42
D STATL 43 52
D JOBTYP 53 53
¹ * Generic header description
D HEADER DS
D HDUSAR 1 64
D HDGRSZ 65 68B 0
D HDRLLV 69 72
D HDFMTN 73 80
D HDAPI 81 90
D HDDTTM 91 103
D HDISTS 104 104
D HDSIZE 105 108B 0
D HDIPOS 109 112B 0
D HDIPSZ 113 116B 0
D HDHDOS 117 120B 0
D HDHDSZ 121 124B 0
D HDDSOS 125 128B 0
D HDDSIZ 129 132B 0
D HDNOEN 133 136B 0
D HDENSZ 137 140B 0
¹ *
¹
*---------------------------------------------------------------------------------------------
¹ * Data structures for API QUSRJOBI
¹
*---------------------------------------------------------------------------------------------
¹ *
D INPUT3 DS
D DTALG3 1 4B 0
D FORMT3 5 12
D JOBNM3 13 38
D JOB200 DS
D BYTRTN 1 4B 0
D BYTVAL 5 8B 0
D JOBNA3 9 18
D USRNA3 19 28
D JOBNB3 29 34
D INTID3 35 50
D JOBST3 51 60
D JOBTY3 61 61
D SUBTY3 62 62
D SBSNA3 63 72
D RUNPR3 73 76B 0
D POOLI3 77 80B 0
D CPUUS3 81 84B 0
D AUXRE3 85 88B 0
D INTRA3 89 92B 0
D RSPTI3 93 96B 0
D FNCTY3 97 97
D FNCNA3 98 107
D ACTJO3 108 111
¹ *
¹
*---------------------------------------------------------------------------------------------
¹ * Data structure for API QSYRUSRI
¹
*---------------------------------------------------------------------------------------------
¹ *
D ERRCOD DS
D BYTPRO 1 4B 0
D BYTAVA 5 8B 0
D EXCID 9 15
D RSVD01 16 16
D EXDTA 17 116
¹ *
D PSSRC SDS
D PSTS *STATUS
¹ *
¹
*---------------------------------------------------------------------------------------------
¹ * MAIN ROUTINE
¹
*---------------------------------------------------------------------------------------------
¹ *
C EXSR SETUP
¹ *
¹ * Process the active jobs
¹ *
C MOVEL '*ACTIVE' STATI
C EXSR GETDTA
¹ *
¹ * If nothing found - try the jobs queued on the job queues.
¹ *
C RTNCOD IFEQ *BLANK
C MOVEL '*JOBQ ' STATI
C EXSR GETDTA
C ENDIF
¹ *
¹ * Normal end of job
¹ *
C RTNCOD IFEQ *BLANK
C MOVEL '*INACTIV' RTNCOD
C MOVE 'E ' RTNCOD
C ENDIF
¹ C*
C MOVE *ON *INLR
¹ C*
¹
C*---------------------------------------------------------------------------------------------
¹ C* *PSSR - Error handling routine
¹
C*---------------------------------------------------------------------------------------------
¹ C*
C *PSSR BEGSR
¹ C*
¹ C* Error processing an API call -
¹ C*
C PSRACT IFEQ '*ABEND '
C Z-ADD 999999999 INC
C MOVE *ON *INLR
C ENDIF
¹ C*
C ENDSR
¹ C*
¹
C*---------------------------------------------------------------------------------------------
¹ C* SETUP - Data setup
¹
C*---------------------------------------------------------------------------------------------
¹ C*
C SETUP BEGSR
¹ C*
C *ENTRY PLIST
C PARM TGTJOB 10
C PARM RTNCOD 10
¹ C*
C TGTJOB IFEQ *BLANKS
C MOVEL '*ERROR' RTNCOD
C ENDIF
¹ C*
C MOVE *BLANK RTNCOD
¹ C*
¹ C* User space initialization values.
¹ C*
C MOVEL 'USRJOB' SNAME2
NAME
C MOVEL 'QTEMP' SLIBR2
LIBRARY
C MOVE ' ' INZCHR 1
INITIAL VALUE
C MOVEL ' ' EXTATR 10
ATTRIBUTE
C MOVEL '*ALL' SAUTH 10
PUBLIC AUTH.
C MOVEL @USPTX STEXT 50
TEXT
C Z-ADD 8192 SSIZE2
SIZE
C MOVE ' ' INZCHR 1
INITIAL VALUE
C MOVEL '*YES' SREPL 4
REPLACE?
¹ C*
¹ C* User space retrieval initialization value.
¹ C*
C MOVEL '*YES' REPLC 10
Replace Usr Spc
C MOVE *BLANKS ERRCOD
C MOVE *ZEROS BYTPRO
C MOVE *ZEROS BYTAVA
¹ C*
¹ C* Create user space for user jobs
¹ C*
C CALL 'QUSCRTUS' 56
C PARM USRSP2
C PARM EXTATR
C PARM SSIZE2
C PARM INZCHR
C PARM SAUTH
C PARM STEXT
C PARM REPLC
C PARM ERRCOD
¹ C*
C *IN56 CASEQ *ON *PSSR
C ENDCS
¹ C*
C ENDSR
¹ C*
¹
C*---------------------------------------------------------------------------------------------
¹ C* GETDTA - Fill user space with job information
¹
C*---------------------------------------------------------------------------------------------
¹ C*
C GETDTA BEGSR
¹ C*
C MOVEL 'JOBL0100' FORMT2
C MOVEL TGTJOB JOBNMI
C MOVEL '*ALL' USRNMI
C MOVEL '*ALL' JOBNOI
¹ C*
C MOVE *BLANKS ERRCOD
C MOVE *ZEROS BYTPRO
C MOVE *ZEROS BYTAVA
¹ C*
C CALL 'QUSLJOB'
C PARM USRSP2
C PARM FORMT2
C PARM QJOBI
C PARM STATI
C PARM ERRCOD
¹ C*
C *IN56 CASEQ *ON *PSSR
C ENDCS
¹ C*
¹ C* Set up the user profile extract data space header
¹ C*
C Z-ADD 001 STRPO2
C Z-ADD 140 DTALG2
¹ C*
¹ C* Load the data space header
¹ C*
C CALL 'QUSRTVUS' 56
C PARM USRSP2
C PARM STRPO2
C PARM DTALG2
C PARM HEADER
C PARM ERRCOD
¹ C*
¹ C* Load the offsets to the input data section
¹ C*
C HDIPOS ADD 1 STRPO2
C Z-ADD HDIPSZ DTALG2
¹ C*
¹ C* Load the input data from header
¹ C*
C MOVE *BLANKS ERRCOD
C MOVE *ZEROS BYTPRO
C MOVE *ZEROS BYTAVA
¹ C*
C CALL 'QUSRTVUS' 56
C PARM USRSP2
C PARM STRPO2
C PARM DTALG2
C PARM INPUT2
C PARM ERRCOD
¹ C*
¹ C* Process the detail data
¹ C*
¹ C* Load the offsets to the entry data section
¹ C*
C HDDSOS ADD 1 STRPO2
C Z-ADD HDENSZ DTALG2
¹ C*
C 1 DO HDNOEN INC 6 0
¹ C*
¹ C* Load the input data from header
¹ C*
C MOVE *BLANKS ERRCOD
C MOVE *ZEROS BYTPRO
C MOVE *ZEROS BYTAVA
¹ C*
C CALL 'QUSRTVUS' 56
C PARM USRSP2
C PARM STRPO2
C PARM DTALG2
C PARM JOB100
C PARM ERRCOD
¹ C*
¹ C* Get the detail information for the job - QUSRJOBI
¹ C*
C MOVEL 'JOBI0200' FORMT3
C MOVEL '*INT ' JOBNM3
C MOVE IJOBID INTID3
C Z-ADD 111 DTALG3
¹ C*
C MOVE *BLANKS ERRCOD
C MOVE *ZEROS BYTPRO
C MOVE *ZEROS BYTAVA
¹ C*
C MOVEL '*SKIP ' PSRACT 8
C CALL 'QUSRJOBI' 56
C PARM JOB200
C PARM DTALG3
C PARM FORMT3
C PARM JOBNM3
C PARM INTID3
C PARM ERRCOD
¹ C*
C *IN56 CASEQ *ON *PSSR
C ENDCS
¹ C*
¹ C* Flag the status based on the type of run... ACTIVE or JOBQ
¹ C*
C MOVEL STATI RTNCOD
¹ C*
C ENDDO
¹ C*
C ENDSR
Peter Vidal
PALL Aeropower Corp.
Senior Programmer Analyst
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
