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 thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2021 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.