LISTACTG.RPG

LISTACTG.RPG

* This program illustrates the use of the "Open List of
* Activation Group Attributes" API. It will generate the
* list asynchronously (i.e., in the background).

 
     d RcvrDS          ds
     d   ActGrpName                  10
     d   Reserved1                    6
     d   ActGrpNbr                   10i 0
     d   NbrActvtns                  10i 0
     d   NbrHeaps                    10i 0
     d   StcStgSize                  10i 0
     d   HeapStgSiz                  10i 0
     d   RootPgmNam                  10
     d   RootPgmLib                  10
     d   RootPgmTyp                   1
     d   AGrpState                    1
     d   SharedAGrp                   1
     d   InUse                        1
     d   Reserved2                    4

     d RcvrLen         s             10i 0 Inz(%size(RcvrDS))
     d Recs2Retrn      s             10i 0
     d FormatName      s             10
     d QJobName        s             26
     d IntJobID        s             16


     d ListInfoDS      ds
     d   TotalRecs                   10i 0
     d   RecsRtrnd                   10i 0
     d   Handle                       4
     d   RecLength                   10i 0
     d   InfoComplt                   1
     d   DateTime                    13
     d   ListStatus                   1
     d                                1
     d   InfoLength                  10i 0
     d   FirstRec                    10i 0
     d                               40

     d Rec#2Retrn      s             10i 0

     d #IgnoreErr      c                   Const(x'0000000800000000')
     d #ResendErr      c                   Const(x'0000000000000000')


      *  Build list of activation groups and wait for first entry.
     c                   Call      'QWVOLAGP'
     c                   Parm                    RcvrDS
     c                   Parm                    RcvrLen
     c                   Parm                    ListInfoDS
     c                   Parm      1             Recs2Retrn
     c                   Parm      'RAGA0100'    FormatName
     c                   Parm      '*'           QJobName
     c                   Parm                    IntJobID
     c                   Parm      #ResendErr    ErrorCode         8



      *  Process list of activation groups.

     c                   Eval      Rec#2Retrn = 1
     c                   DoW       0 = 0

      *  Show activation group number and name.
     c     ActGrpNbr     Dsply                   ActGrpName


      *            Get next activation group record.
     c                   Eval      Rec#2Retrn = Rec#2Retrn + 1

      *            If this check is not made and we ask for a
      *            record (ie, message) number that is greater
      *            than the total number of records (ie, messages)
      *            built by the server job, we will get an error.
     c                   If        ListStatus = '2'  and
     c                             Rec#2Retrn > TotalRecs
     c                   Leave
     c                   EndIf


     c                   Call      'QGYGTLE'
     c                   Parm                    RcvrDS
     c                   Parm                    RcvrLen
     c                   Parm                    Handle
     c                   Parm                    ListInfoDS
     c                   Parm      1             Recs2Retrn
     c                   Parm                    Rec#2Retrn
     c                   Parm      #ResendErr    Error             8


      *            Check for end of records.
     c                   If        RecsRtrnd < 1
     c                   Leave
     c                   EndIf


     c                   EndDo


      *  Close list (ie, cleanup server job).
     c                   Call      'QGYCLST'
     c                   Parm                    Handle
     c                   Parm      #ResendErr    Error             8


     c                   MoveL     '1'           *InLR
     c                   Return