|
midrange.com
Hey Folks!
A while back, someone requested information on how to tell if a job was
active or not (sorry, already toasted the originals so I can't specify
anything other than the mentioned "Brian & Dawn" below). We had a rather
lengthy discussion of data area utilization for this purpose, but Mr. David
Anderson may have a more elegant solution. He just reviewed a MIDRANGE-L
"digest" from a co-worker and offered the following (and YES, I already asked
him to join "the list" so please do not inundate him with similar requests).
I have stored the mentioned RPG for interested parties, but won't waste
David's bandwidth with it unless I receive too many requests. Please feel
free to write me directly at the address below if you need the RPG...
In a message dated 97-10-29 22:30:10 EST, DaveAnd@ix.netcom.com writes:
> A co-worker of mine gave me a printout from the Midrange mailing list
> that he has. You were answering a question for a "Brian & Dawn". They
> have a batch job that needs to know if another batch job is running.
> Unfortunately he didn't print the pages with their names on it, yours is
> the only one I have. If you can pass something on to them I would
> appreciate it. If not, let me know, and I'll try another way.
>
> I use AS/400 system API's to make sure that a job is not already running
> or waiting in a JOBQ to run, so that it won't run more than once.
>
> The following is a sample of how I use it, and attached is the RPG
> program I wrote to actually do the checking. It's generic, so it should
> work for anyone. This was written on a system running V3R1.
>
> /* See if TCP_SNDF is already running */
>
> PGM
>
> DCL VAR(&TGTJOB) TYPE(*CHAR) LEN(10)
> DCL VAR(&RTNCOD) TYPE(*CHAR) LEN(10)
>
> CHGVAR VAR(&TGTJOB) VALUE('TCP_SNDF')
> CHGVAR VAR(&RTNCOD) VALUE(' ')
>
> CALL PGM(TCPCHK) PARM(&TGTJOB &RTNCOD)
>
> IF COND(&RTNCOD *EQ '*INACTIVE') THEN(DO)
> SBMJOB CMD(CALL PGM(TCR001) PARM('TCPFILES')) +
> JOB(TCP_SNDF) JOBD(TCPJOBD) JOBQ(MACHH) OUTQ(*JOBD) +
> USER(MACHTCP) CURLIB(*USRPRF) INLLIBL(*JOBD)
> ENDDO
>
>
> I hope you don't mind this intrusion, but I like to help when I can.
> Who knows, maybe
> this will help you to.
>
> Dave Anderson
> DaveAnd@ix.netcom.com
> Sysco Food Services of Los Angeles, Inc.
Regards!
Dean Asmussen
Enterprise Systems Consulting, Inc.
Fuquay-Varina, NC USA
E-Mail: DAsmussen@aol.com
"Too many people expect wonders from democracy, when the most wonderful thing
of all is just having it." -- Walter Winchell
---------------------
Forwarded message:
From: DaveAnd@ix.netcom.com (David Anderson)
To: DAsmussen@aol.com
Date: 97-10-29 22:30:10 EST
Dean,
A co-worker of mine gave me a printout from the Midrange mailing list
that he has. You were answering a question for a "Brian & Dawn". They
have a batch job that needs to know if another batch job is running.
Unfortunately he didn't print the pages with their names on it, yours is
the only one I have. If you can pass something on to them I would
appreciate it. If not, let me know, and I'll try another way.
I use AS/400 system API's to make sure that a job is not already running
or waiting in a JOBQ to run, so that it won't run more than once.
The following is a sample of how I use it, and attached is the RPG
program I wrote to actually do the checking. It's generic, so it should
work for anyone. This was written on a system running V3R1.
/* See if TCP_SNDF is already running */
PGM
DCL VAR(&TGTJOB) TYPE(*CHAR) LEN(10)
DCL VAR(&RTNCOD) TYPE(*CHAR) LEN(10)
CHGVAR VAR(&TGTJOB) VALUE('TCP_SNDF')
CHGVAR VAR(&RTNCOD) VALUE(' ')
CALL PGM(TCPCHK) PARM(&TGTJOB &RTNCOD)
IF COND(&RTNCOD *EQ '*INACTIVE') THEN(DO)
SBMJOB CMD(CALL PGM(TCR001) PARM('TCPFILES')) +
JOB(TCP_SNDF) JOBD(TCPJOBD) JOBQ(MACHH) OUTQ(*JOBD) +
USER(MACHTCP) CURLIB(*USRPRF) INLLIBL(*JOBD)
ENDDO
I hope you don't mind this intrusion, but I like to help when I can.
Who knows, maybe
this will help you to.
Dave Anderson
DaveAnd@ix.netcom.com
Sysco Food Services of Los Angeles, Inc.
F*----------------------------------------------------------------
F* PROGRAM: TCPCHK
F* DESCRIPTION: THIS PROGRAM USES API'S TO DETERMINE IF A PARTICULAR
F* JOB IS ACTIVE, OR ON THE JOB QUEUE. IF THE JOB IS
F* ACTIVE, THIS PROGRAM RETURNS *ACTIVE IN THE RETURN
F* CODE FIELD. IF THE TARGET PROGRAM IS ON A JOB QUEUE,
F* *JOBQ IS RETURNED TO THE CALLING PROGRAM. IF THE TARGET
F* JOB IS NOT ACTIVE AND IS NOT ON A JOB QUEUE, *INACTIVE
F* IS RETURNED IN RTNCOD.
F*----------------------------------------------------------------
F* API routines used:
F*
F* QUSCRTUS -- Create user space
F* QUSLJOB -- Load job info into user space
F* QUSRTVUS -- Retrieve user space
F* QUSRJOBI -- Retrieve job information
F* QWCRSSTS -- Retrieve system status information
F*----------------------------------------------------------------
I*
I*----------------------------------------------------------------
I* DEFINE CONSTANTS
I*----------------------------------------------------------------
I*
I 'User Space for User -C @USPTX
I 'Jobs '
I*
I*----------------------------------------------------------------
I* DATA STRUCTURES
I*----------------------------------------------------------------
I*
IBINARY DS
I B 1 40SSIZE2
I B 5 80DTALG2
I B 9 120STRPO2
I B 13 160RCVLG2
I B 17 200@RCVLG
I B 21 240@BYTPR
I B 25 280@BYTAV
I B 29 320@MSKLN
I B 33 360@RCVLN
I B 37 400@SRCPR
I B 41 440@SRCDP
I*
I*----------------------------------------------------------------
I* Data structures for API QUSLJOB
I*----------------------------------------------------------------
I*
IINPUT2 DS
I 1 26 QJOBI
I 1 10 JOBNMI
I 11 20 USRNMI
I 21 26 JOBNOI
I 27 36 STATI
I 37 56 USRSP2
I 37 46 SNAME2
I 47 56 SLIBR2
I 57 64 FORMT2
I 65 65 JOBTYI
I B 69 720FLDRTN
I* 75 100 FLDNMI
IJOB100 DS
I 1 26 QJOBL
I 1 10 JOBNML
I 11 20 USRNML
I 21 26 JOBNOL
I 27 42 IJOBID
I 43 52 STATL
I 53 53 JOBTYP
* Generic header description
IHEADER DS
I 1 64 HDUSAR
I B 65 680HDGRSZ
I 69 72 HDRLLV
I 73 80 HDFMTN
I 81 90 HDAPI
I 91 103 HDDTTM
I 104 104 HDISTS
I B 105 1080HDSIZE
I B 109 1120HDIPOS
I B 113 1160HDIPSZ
I B 117 1200HDHDOS
I B 121 1240HDHDSZ
I B 125 1280HDDSOS
I B 129 1320HDDSIZ
I B 133 1360HDNOEN
I B 137 1400HDENSZ
I*
I*----------------------------------------------------------------
I* Data structures for API QUSRJOBI
I*----------------------------------------------------------------
I*
IINPUT3 DS
I B 1 40DTALG3
I 5 12 FORMT3
I 13 38 JOBNM3
IJOB200 DS
I B 1 40BYTRTN
I B 5 80BYTVAL
I 9 18 JOBNA3
I 19 28 USRNA3
I 29 34 JOBNB3
I 35 50 INTID3
I 51 60 JOBST3
I 61 61 JOBTY3
I 62 62 SUBTY3
I 63 72 SBSNA3
I B 73 760RUNPR3
I B 77 800POOLI3
I B 81 840CPUUS3
I B 85 880AUXRE3
I B 89 920INTRA3
I B 93 960RSPTI3
I 97 97 FNCTY3
I 98 107 FNCNA3
I 108 111 ACTJO3
I*
I*----------------------------------------------------------------
I* Data structure for API QSYRUSRI
I*----------------------------------------------------------------
I*
IERRCOD DS
I B 1 40BYTPRO
I B 5 80BYTAVA
I 9 15 EXCID
I 16 16 RSVD01
I 17 116 EXDTA
I*
IPSSRC SDS
I *STATUS PSTS
C*
C*----------------------------------------------------------------
C* Main Routune
C*----------------------------------------------------------------
C*
C EXSR SETUP
C*
C* Process the active jobs
C*
C MOVEL'*ACTIVE' STATI
C EXSR GETDTA
C*
C* If nothing found - try the jobs queued on the job queues.
C*
C RTNCOD IFEQ *BLANK
C MOVEL'*JOBQ ' STATI
C EXSR GETDTA
C ENDIF
C*
C* NORMAL END OF JOB
C*
C RTNCOD IFEQ *BLANK
C MOVEL'*INACTIV'RTNCOD
C MOVE 'E ' RTNCOD
C ENDIF
C*
C MOVE *ON *INLR
C*
C*----------------------------------------------------------------
C* ERROR HANDLING ROUTINE
C*----------------------------------------------------------------
C*
C *PSSR BEGSR
C*
C* Error processing an API call -
C*
C PSRACT IFEQ '*ABEND '
C Z-ADD999999999 INC
C MOVE *ON *INLR
C ENDIF
C*
C ENDSR
C*
C*----------------------------------------------------------------
C*
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-ADD8192 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 MOVELTGTJOB 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-ADD001 STRPO2
C Z-ADD140 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-ADDHDIPSZ 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-ADDHDENSZ DTALG2
C*
C 1 DO HDNOEN INC 60
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-ADD111 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 MOVELSTATI RTNCOD
C*
C ENDDO
C*
C ENDSR
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.
