Re: LCKW Problem

["Carsten Flensburg" <flensburg@xxxxxxxxxx>]

----- Original Message -----
From: "Dennis Lovelady" <dlovelady@dtcc.com>
To: <midrange-l@midrange.com>
Sent: Monday, October 28, 2002 1:17 PM
Subject: Re: LCKW Problem


>
> Cool!
>
> Thanks, Simon!
>
> My current client just converted to V5R1 over the past weekend, so maybe
> I'll have a chance to check that API out.  Sounds like a very worthwhile
> investigation.

- Here's a sample:

     **-- 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