QWCRJBLK - Retrieve Job Lock

Retrieve Job Lock


     **-- Header specifications:  --------------------------------**
     H Option( *SrcStmt )
     **-- Api error data structure:  -----------------------------**
     D ApiError        Ds
     D  AeBytPro                     10i 0 Inz( %Size( ApiError ))
     D  AeBytAvl                     10i 0 Inz
     D  AeMsgId                       7a
     D                                1a
     D  AeMsgDta                    128a
     **-- Global variables:  -------------------------------------**
     D Idx                            5i 0
     **-- Job lock information:  ---------------------------------**
     D JBLK0100        Ds         65535
     D  JlBytAvl                     10i 0
     D  JlBytRtn                     10i 0
     D  JlNbrObjLck                  10i 0
     D  JlOfsObjLck                  10i 0
     D  JlNbrLckObjRt                10i 0
     D  JlLckObjEntLn                10i 0
     **
     D LckInf          Ds                  Based( pLckInf )
     D  LiObjNam                     10a
     D  LiObjLib                     10a
     D  LiObjTyp                     10a
     D  LiObjExtAtr                  10a
     D  LiLckStt                     10a
     D                                2a
     D  LiLckSts                     10i 0
     D  LiMbrLcks                    10i 0
     D  LiLckCnt                     10i 0
     D  LiLckScp                      1a
     D                                2a
     D  LiThrId                       8a
     **-- Job id:  -----------------------------------------------**
     D JlJobId         Ds
     D  JiJobNam                     10a   Inz( '*' )
     D  JiUsrNam                     10a
     D  JiJobNbr                      6a
     D  JiIntJobId                   16a   Inz( *Blanks )
     D                                2a   Inz( *Allx'00' )
     D  JlThrInd                     10i 0 Inz( 2 )
     D  JlThrId                       8a
     **-- Retrieve job record locks:  ----------------------------**
     D RtvJobLck       Pr                  ExtPgm( 'QWCRJBLK' )
     D  JlRcvVar                  65535a         Options( *VarSize )
     D  JlRcvVarLen                  10i 0 Const
     D  JlFmtNam                      8a   Const
     D  JlJobId                      56a   Const
     D  JlFmtJobId                    8a   Const
     D  JlError                   32767a         Options( *VarSize )
     **
     **-- Mainline:  ---------------------------------------------**
     C                   CallP     RtvJobLck( JBLK0100
     C                                      : %Size( JBLK0100 )
     C                                      : 'JBLK0100'
     C                                      : JlJobId
     C                                      : 'JIDF0100'
     C                                      : ApiError
     C                                      )
     **
     C                   If        AeBytAvl    = *Zero
     C                   ExSr      PrcJobLck
     C                   EndIf
     **
     C                   Return
     **
     **-- Process job locks:  ------------------------------------**
     C     PrcJobLck     BegSr
     **
     C                   Eval      pLckInf     = %Addr( JBLK0100 ) +
     C                                           JlOfsObjLck
     **
     C                   For       Idx         = 1  to JlNbrLckObjRt
     **
     **-- Do whatever...
     **
     C                   If        Idx         < JlNbrLckObjRt
     C                   Eval      pLckInf     = pLckInf + JlLckObjEntLn
     C                   EndIf
     C                   EndFor
     **
     C                   EndSr



Dennis Lovelady wrote:

Thanks for sharing that code, Carsten.  Yeah, that looks useful in the
right places.  :)

Not to fault your code (which, again, I do appreciate!), I'm curious why
you don't use QSYSINC items for some of that stuff (like QUSEC, for example).
If it's because of variable data being left undefined (such as QUSED01), you
might find the following useful:

   *   PLEASE keep the next two lines TOGETHER!!!
  D/Copy qsysinc/qrpglesrc,qusec
  D QUSED01                     1024
   *   PLEASE keep the previous two lines TOGETHER!!!



Carsten Flensburg replied:

Well, it's partly due to the circumstance that I started coding APIs before
QSYSINC became an option and thus invented my own set of naming standards -
and partly due to the fact that I've run into some problems actually using the
library because of errors in the header files.

I also just checked the include file for the QWCRJBLK API and though it was
introduced just recently - V5R1- it still uses positional definition of the
structure subfields and defines numeric subfields as Binary instead of Integer
data type... - I prefer using the more recent options in both cases.

On the other hand - as I'm confronted with more and more C code and style -
I really start liking the idea of a general header file set to ease both the
use of APIs and functions and the maintainance of a global coding standard.
Speaking of RPG/IV I just don't think that QSYSINC - in general - has the
adequate level of quality yet.

Thanks to Carsten Flensburg & Dennis Lovelady