H FJobChsr CF E WORKSTN F SFILE(JobChsrS1:SFLRRN) F PREFIX ( D ) *-------------------------------------------------- * Procedure definition *-------------------------------------------------- D PR_JobChsr PR extpgm('JOBCHSR') D PQSpcNam 20a const Qual *usrspc name D PQJob 26a Qual job name *-------------------------------------------------- * Procedure Interface *-------------------------------------------------- D PR_JobChsr PI D PQSpcNam 20a const Qual *usrspc name D PQJob 26a Qual job name *-------------------------------------------------- * Used to describe the 'List Jobs' user space... *-------------------------------------------------- D*COPY QSYSINC/QRPGLESRC,QUSLJOB D QUSLJOB C 'QUSLJOB' ***************************************************************** *Type Definition for the JOBL0100 format. ***************************************************************** DQUSL010002 DS based( LstPtr ) D* Qus JOBL0100 D QUSJNU 1 10 D* Job Name Used D QUSUNU 11 20 D* User Name Used D QUSJNBRU 21 26 D* Job Number Used D QUSIJI 27 42 D* Internal Job Id D QUSTATUS00 43 52 D* Status D QUSJT00 53 53 D* Job Type D QUSJS 54 54 D* Job Subtype /EJECT *-------------------------------------------------- * Used to describe the 'List Jobs' user space... *-------------------------------------------------- DQUSH0100 DS based( SpcPtr ) D* Qus Generic Header 0100 D QUSUA 1 64 D* User Area D QUSSGH 65 68B 0 D* Size Generic Header D QUSSRL 69 72 D* Structure Release Level D QUSFN 73 80 D* Format Name D QUSAU 81 90 D* Api Used D QUSDTC 91 103 D* Date Time Created D QUSIS 104 104 D* Information Status D QUSSUS 105 108B 0 D* Size User Space D QUSOIP 109 112B 0 D* Offset Input Parameter D QUSSIP 113 116B 0 D* Size Input Parameter D QUSOHS 117 120B 0 D* Offset Header Section D QUSSHS 121 124B 0 D* Size Header Section D QUSOLD 125 128B 0 D* Offset List Data D QUSSLD 129 132B 0 D* Size List Data D QUSNBRLE 133 136B 0 D* Number List Entries D QUSSEE 137 140B 0 D* Size Each Entry D QUSSLI 150 150 D* Subset List Indicator /EJECT D/COPY QSYSINC/QRPGLESRC,QUSEC /EJECT *-------------------------------------------------- * Used to receive parm values... *-------------------------------------------------- D QSpcNam S 20 D QJob S 26 D SPC_NAME S 20 D SPC_SIZE S 9B 0 INZ(1) *-------------------------------------------------- * Used to receive replies from external messages... *-------------------------------------------------- D SpcPtr S * D LstPtr S * *-------------------------------------------------- * Used to receive replies from external messages... *-------------------------------------------------- D DS D MSGRPY 1 1 *-------------------------------------------------- * Fields used in calculations *-------------------------------------------------- D SFLRRN S 5p 0 SFL relative rec nbr D LST_STATUS S 1 List status D APINAM S 10 API name *-------------------------------------------------- * Constants used in calculations *-------------------------------------------------- * Constants used for indicator identification D CANCEL C CONST(03) D EXIT C CONST(12) D SFLDsp C CONST(81) D SFLEnd C CONST(82) D ExitRD C CONST(90) D ERR C CONST(98) * * Constants used for general work * D ERRMSG C CONST('Error detected (C G)') *-------------------------------------------------- /EJECT *-------------------------------------------------- * MAIN Section... *-------------------------------------------------- * * Get parms into some working areas... * C eval QSpcNam = PQSpcNam C eval QJob = PQJob C eval SPC_NAME = QSpcNam * * Get a resolved pointer to the User Space for performance * C call 'QUSPTRUS' C parm SPC_NAME C parm SpcPtr C parm QUSEC * * Check for errors on QUSPTRUS * C if QUSBAVL > 0 C eval APINAM = 'QUSPTRUS' C exsr APIERR C end * * Pick a position for our list window... * C eval DSTRROW = 2 C eval DSTRCOL = 2 * * Create the window... * C write JobChsrW1 * * Prepare the subfile... * C eval SFLRRN = *zero C eval *in(SFLDsp) = *off SFLDSP C eval *in(SFLEnd) = *off SFLEND C write JobChsrC1 * * Fill the subfile from our jobs *usrspc... * C exsr LoadSFL * * Process the subfile request... * C eval *in(ExitRD) = *off SFLEND C dou *in(ExitRd) C exsr ProcSFL C enddo DOU *in(ExitRd) * * Return whatever has been placed in QJob... * C eval PQJob = QJob C return *-------------------------------------------------- /EJECT *-------------------------------------------------- * LoadSFL: Load the subfile from our JobChsr file... *-------------------------------------------------- C LoadSFL begsr * * Do until the list is complete * C eval LST_STATUS = QUSIS C dou LST_STATUS = 'C' * * If valid information was returned * C if QUSIS = 'C' or QUSIS = 'P' * * and list entries were found * C if QUSNBRLE > 0 * * set LSTPTR to the first byte of the User Space * C eval LSTPTR = SpcPtr + QUSOLD * * and process all of the entries * C do QUSNBRLE * * Write the subfile record for this job/task... * C eval DJOB = QUSJNU C eval DJOBUSR = QUSUNU C eval DJOBNBR = QUSJNBRU * * Write the subfile record for this job/task... * C eval SFLRRN = SFLRRN + 1 C write JobChsrS1 * * after each entry, increment LSTPTR to the next entry * C eval LSTPTR = LstPtr + QUSSEE C enddo QUSNBRLE C endif QUSNBRLE > 0 * * If all entries in this User Space have been processed, check * if more entries exist than can fit in one User Space * C if QUSIS = 'P' * * by resetting LSTPTR to the start of the User Space * C eval LSTPTR = SPCPTR * * and if the continuation handle in the Input Parameter Header is * blank, then set the List status to Complete * C if QUSSLI = *BLANKS C eval LST_STATUS = 'C' C else QUSSLI = *BLANKS * * Else, call QSYLOBJP reusing the User Space to get more * list entries (...we MIGHT do this someday)... * C eval LST_STATUS = QUSIS C endif QUSSLI = *BLANKS C endif QUSIS = 'P' C else QUSIS = 'C' or 'P' * * And if an unexpected status, log an error (not shown) and exit * C exsr DONE C endif QUSIS = 'C' or 'P' C enddo LST_STATUS = 'C' * * No subfile records written... C if SFLRRN = *zero C eval *in(SFLDsp) = *off SFLDSP C else C eval *in(SFLDsp) = *on SFLDSP C endif C endsr *-------------------------------------------------- /EJECT *-------------------------------------------------- * ProcSFL: Process the subfile requests... *-------------------------------------------------- C ProcSFL begsr * * Write the subfile control record... C exfmt JobChsrC1 * C if *in(CANCEL) or *in(EXIT) C eval *inlr = *on C else * * Read the initial record from our JobChsr file... * C dou DSELECT <> *blank or %eof(JobChsr) C readc JobChsrS1 C enddo DSELECT <> *blank * C if %eof(JobChsr) C eval QJob = '*NONE' C else C eval QJob = DJOB + DJOBUSR + DJOBNBR C endif * C eval *in(ExitRD) = *on Quit SFL process C eval *inlr = *on * C endif C endsr *-------------------------------------------------- /EJECT ***************************************************************** C APIERR BEGSR * * Log any error encountered, and exit the program * C APINAM DSPLY C QUSEI DSPLY C EXSR DONE C ENDSR ***************************************************************** C DONE BEGSR * * Exit the program * C EVAL *INLR = '1' C RETURN C ENDSR /EJECT