How to tell from a CL program if a job is active or not?
Steve
The DSPSBSJOB command is not a native AS/400 command.
Gary Feinstein
Charles,
I hope you find the following excerpt useful. It was sent to the
midrange mailing list by Dean Asmussen some time ago.
Gary Feinstein
AS/400 System Administrator
Planet Hollywood International Inc.
Charles M. Wilt wrote:
>
> I need to be able to do something in a CL program that will tell me if a
> particular job is active. What is the best way to do this?
>
> --
> Charles Wilt
> Miami Luken, Inc.
> Springboro, OH. 45066
> e-mail: charle...@worldnet.no.spam.att.net
> --remove the .no.spam
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, Dav...@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
> Dav...@ix.netcom.com
> Sysco Food Services of Los Angeles, Inc.
Regards!
Dean Asmussen
Enterprise Systems Consulting, Inc.
Fuquay-Varina, NC USA
E-Mail: DAsm...@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: Dav...@ix.netcom.com (David Anderson)
To: DAsm...@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
Dav...@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
Njal Fisketjon (Njål Fisketjøn)
On 20 Nov 1997 23:08:39 GMT, "Charles M. Wilt"
<charle...@worldnet.no.spam.att.net> wrote:
>I need to be able to do something in a CL program that will tell me if a
>particular job is active. What is the best way to do this?
>
Call the QUSRJOBI API.
Martin Neugebauer
--------------BF77260B7898AA793E844BAD
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 8bit
Here is an example:
...
DCL VAR(&C4) TYPE(*CHAR) LEN(4)
DCL VAR(&JOBID) TYPE(*CHAR) LEN(26)
/*-------------------------------------------------------------------*/
/* Variablen für API */
/*-------------------------------------------------------------------*/
DCL VAR(&APISTR) TYPE(*CHAR) LEN(512) /* +
Returnstring */
DCL VAR(&APISTRLEN) TYPE(*CHAR) LEN(4) +
VALUE(X'0200') /* Stringlength 512 */
DCL VAR(&APIFMT) TYPE(*CHAR) LEN(10) +
VALUE(JOBI0100) /* Formatname */
DCL VAR(&APIJOBID) TYPE(*CHAR) LEN(16) /* +
interne JobID */
DCL VAR(&APIERROR) TYPE(*CHAR) LEN(16) /* +
Errorcode */
...
CHGVAR VAR(&JOBID) VALUE(&JOBNAME *CAT &USER *CAT +
&JOBNBR)
/*-------------------------------------------------------------------*/
/* API 'QUSRJOBI´ - Retrieve Job Information */
/*-------------------------------------------------------------------*/
CHGVAR VAR(&APISTR) VALUE(' ')
CHGVAR VAR(&APIFMT) VALUE(JOBI0100) /* Formatname */
CHGVAR VAR(&APISTRLEN) VALUE(X'0200') /* +
Stringlength 512 */
CHGVAR VAR(&C4) VALUE(X'0000')
CHGVAR VAR(%SST(&APIERROR 1 4)) VALUE(&C4) /* +
Return no Errors */
CALL PGM(QUSRJOBI) PARM(&APISTR &APISTRLEN +
&APIFMT &JOBID &APIJOBID &APIERROR)
/* Jobstatus ? --------------*/
CHGVAR VAR(&JOBSTATUS) VALUE(%SST(&APISTR 51 10))
IF COND(&JOBSTATUS = *JOBQ *OR &JOBSTATUS = +
*ACTIVE) THEN(DO)
...
Hope this helps, Martin.
--------------BF77260B7898AA793E844BAD
Content-Type: text/html; charset=us-ascii
Content-Transfer-Encoding: 7bit
<HTML>
Njal Fisketjon (Njål Fisketjøn) wrote:
<BLOCKQUOTE TYPE=CITE>On 20 Nov 1997 23:08:39 GMT, "Charles M. Wilt"
<BR><charle...@worldnet.no.spam.att.net> wrote:
<P>>I need to be able to do something in a CL program that will tell me
if a
<BR>>particular job is active. What is the best way to do this?
<BR>>
<P>Call the QUSRJOBI API.</BLOCKQUOTE>
Here is an example:
<P><TT>...</TT>
<BR><TT>
DCL VAR(&C4) TYPE(*CHAR)
LEN(4)</TT>
<BR><TT>
DCL VAR(&JOBID) TYPE(*CHAR)
LEN(26)</TT>
<BR><TT>/*-------------------------------------------------------------------*/</TT>
<BR><TT>/* Variablen für API
*/</TT>
<BR><TT>/*-------------------------------------------------------------------*/</TT>
<BR><TT>
DCL VAR(&APISTR) TYPE(*CHAR)
LEN(512) /* +</TT>
<BR><TT>
Returnstring */</TT>
<BR><TT>
DCL VAR(&APISTRLEN) TYPE(*CHAR)
LEN(4) +</TT>
<BR><TT>
VALUE(X'0200') /* Stringlength 512 */</TT>
<BR><TT>
DCL VAR(&APIFMT) TYPE(*CHAR)
LEN(10) +</TT>
<BR><TT>
VALUE(JOBI0100) /* Formatname */</TT>
<BR><TT>
DCL VAR(&APIJOBID) TYPE(*CHAR)
LEN(16) /* +</TT>
<BR><TT>
interne JobID */</TT>
<BR><TT>
DCL VAR(&APIERROR) TYPE(*CHAR)
LEN(16) /* +</TT>
<BR><TT>
Errorcode */</TT><TT></TT>
<P><TT>...</TT><TT></TT>
<P><TT>CHGVAR VAR(&JOBID) VALUE(&JOBNAME
*CAT &USER *CAT +</TT>
<BR><TT>
&JOBNBR)</TT>
<BR><TT>/*-------------------------------------------------------------------*/</TT>
<BR><TT>/* API 'QUSRJOBI´ - Retrieve Job Information
*/</TT>
<BR><TT>/*-------------------------------------------------------------------*/</TT>
<BR><TT>
CHGVAR VAR(&APISTR) VALUE(' ')</TT>
<BR><TT>
CHGVAR VAR(&APIFMT) VALUE(JOBI0100) /* Formatname
*/</TT>
<BR><TT>
CHGVAR VAR(&APISTRLEN) VALUE(X'0200') /* +</TT>
<BR><TT>
Stringlength 512 */</TT>
<BR><TT>
CHGVAR VAR(&C4) VALUE(X'0000')</TT>
<BR><TT>
CHGVAR VAR(%SST(&APIERROR 1 4)) VALUE(&C4)
/* +</TT>
<BR><TT>
Return no Errors */</TT>
<BR><TT>
CALL PGM(QUSRJOBI) PARM(&APISTR
&APISTRLEN +</TT>
<BR><TT>
&APIFMT &JOBID &APIJOBID &APIERROR)</TT>
<BR><TT> </TT>
<BR><TT>/* Jobstatus ? --------------*/</TT>
<BR><TT>
CHGVAR VAR(&JOBSTATUS) VALUE(%SST(&APISTR
51 10))</TT>
<BR><TT>
IF COND(&JOBSTATUS
= *JOBQ *OR &JOBSTATUS = +</TT>
<BR><TT>
*ACTIVE) THEN(DO)</TT>
<BR><TT>...</TT>
<BR><TT></TT> <TT></TT>
<P>Hope this helps, Martin.</HTML>
--------------BF77260B7898AA793E844BAD--
Charles M. Wilt
Thanks,
I have saved your message for future reference. But for my current
problem, I remembered that the job gets an exclusive lock on a unique
member of a physical file. I decided to just use an ALCOBJ command and
look for a failure message.