PCBINFO exec: display available PCBs in current PSB

The PCB exec maps the PCBs available to the exec, which are the PCBs for the executing PSB.

The mapping consists of displaying the type of PCB (IO, TP, or DB), the LTERM or DBD name that is associated, and other useful information. PCB mappings are created by placing DFSREXX0 in an early concatenation library and renaming it to an existing application with a PSB/DBD generation.

Figure 1. Example output of PCBINFO exec on a PSB without database PCBs 
 IMS PCB System Information Exec: PCBINFO
 System Date: 09/26/92    Time: 15:52:15
 
 PCB # 1: Type=IO, LTERM=T3270LC  Status=   UserID=         OutDesc=DFSMO2
          Date=91269 Time=1552155
 PCB # 2: Type=TP, LTERM=* NONE * Status=AD
 PCB # 3: Type=TP, LTERM=* NONE * Status=
 PCB # 4: Type=TP, LTERM=CTRL     Status=
 PCB # 5: Type=TP, LTERM=T3275    Status=
 EXEC PCBINFO ended with RC= 0
Figure 2. Example output of PCBINFO exec on a PSB with a database PCB 
 IMS PCB System Information Exec: PCBINFO
 System Date: 09/26/92    Time: 15:53:34
 
 PCB # 1: Type=IO, LTERM=T3270LC  Status=   UserID=         OutDesc=DFSMO2
          Date=89320 Time=1553243
 PCB # 2: Type=DB, DBD  =DI21PART Status=   Level=00 Opt=G
 EXEC PCBINFO ended with RC= 0

PCBINFO exec listing

/* REXX EXEC TO SHOW SYSTEM LEVEL INFO */
Address REXXTDLI
Arg Dest .
WTO=(Dest='WTO')
Call SayIt 'IMS PCB System Information Exec: PCBINFO'
Call SayIt 'System Date:' Date('U') '   Time:' Time()
Call Sayit ' '
/* A DFS3162 message is given when this exec is run because it does */
/* not know how many PCBs are in the list and it runs until it gets */
/* an error return code.  Note this does not show PCBs that are     */
/* available to the PSB by name only, in other words, not in the PCB list.     */
Msg='PCBINFO: Error message normal on DLIINFO.'
'WTP MSG'
Do i=1 by 1 until Result='LAST'
   Call SayPCB i
End
Exit 0
 
 
SayPCB: Procedure Expose WTO
   Arg PCB
   'DLIINFO DLIINFO #'PCB    /* Get PCB Address */
   If rc<0 Then Return 'LAST'   /* Invalid PCB Number */
   Parse Var DLIInfo  . . AIBAddr PCBAddr .
   PCBINFO=Storage(PCBAddr,255) /* Read PCB */
   TPPCB=(Substr(PCBInfo,13,1)='00'x) /* Date Field, must be TP PCB */
   If TPPCB then Do
      Parse Value PCBInfo with,
         LTERM 9 . 11 StatCode 13 CurrDate 17 CurrTime 21,
         InputSeq 25 OutDesc 33 UserID 41
      If LTERM='' then LTERM='* NONE *'
      CurrDate=Substr(c2x(CurrDate),3,5)
      CurrTime=Substr(c2x(CurrTime),1,7)
      If CurrDate¬='000000' then Do
         Call SayIt 'PCB #'Right(PCB,2)': Type=IO, LTERM='LTERM,
            'Status='StatCode 'UserID='UserID 'OutDesc='OutDesc
         Call SayIt '         Date='CurrDate 'Time='CurrTime
      End
      Else
         Call SayIt 'PCB #'Right(PCB,2)': Type=TP, LTERM='LTERM,
            'Status='StatCode
   End
   Else Do
      Parse Value PCBInfo with,
         DBDName 9 SEGLev 11 StatCode 13 ProcOpt 17 . 21 Segname . 29,
         KeyLen 33 NumSens 37
      KeyLen = c2d(KeyLen)
      NumSens= c2d(NumSens)
 
      Call SayIt 'PCB #'Right(PCB,2)': Type=DB, DBD  ='DBDName,
              'Status='StatCode 'Level='SegLev 'Opt='ProcOpt
   End
Return '
 
SayIt: Procedure Expose WTO
   Parse Arg Msg
   If WTO Then
      'WTO MSG'
   Else
      'ISRT IOPCB MSG'
Return