/******************************************************************/
/* APPCRED EXEC  - 6/90 - Alan Altmark    IBM        Endicott, NY */
/*                                                                */
/* APPCRED fn <ft> < ( FILE>                                      */
/*   fn   is the filename of a an unformatted GTRACE file         */
/*   ft   is the filetype.  Default is 'DATA'.                    */
/*   FILE option will write output to 'fn APPCRED A'              */
/*                                                                */
/*   Change local_lus variable to be names of your AVS gateways   */
/*   or other commonly-traced APPC LUs.                           */
/*                                                                */
/* This program is provided on an "as-is" basis.  No warranty is  */
/* expressed or implied.                                          */
/******************************************************************/
/*                                                                */
/* This program creates a report showing what AVS (or some other  */
/* APPC/VTAM application) is doing.  Instructions assume user     */
/* TPMAINT is a class C user, able to issue TRSOURCE and TRSAVE.  */
/*                                                                */
/* 1. Enable GTRACE reporting for AVS from TPMAINT                */
/*    CP TRSOURCE ID APPC TYPE GT FOR VMGROUP GCS ONLY AVS        */
/*    CP TRSAVE ID APPC DASD TO TPMAINT                           */
/*    CP TRSOURCE ENABLE ID APPC                                  */
/*                                                                */
/* 2. On VTAM:                                                    */
/*    VTAM F TRACE,TYPE=VTAM,OPT=(APPC,API,PIU),MODE=EXT          */
/*                                                                */
/* 3. On AVS:                                                     */
/*    ETRACE GTRACE                                               */
/*                                                                */
/* 4. Reproduce the problem                                       */
/*                                                                */
/* 5. On VTAM:                                                    */
/*    VTAM F NOTRACE,TYPE=VTAM,OPT=(APPC,API,PIU),MODE=EXT        */
/*                                                                */
/* 6. On AVS:                                                     */
/*    ETRACE GTRACE OFF                                           */
/*                                                                */
/* 7. On TPMAINT:                                                 */
/*    CP TRSOURCE DISABLE ID APPC                                 */
/*    CP TRSOURCE DROP ID APPC                                    */
/*    CP QUERY TRFILES *          Get spoolid of most recent file */
/*                                                                */
/*    FILEDEF GTOUT DISK fn DATA A (LRECL 328 RECFM VB            */
/*    TRACERED spoolid GTRACE ( FORMAT ALL                        */
/*                                                                */
/*    APPCRED fn                                                  */
/*                                                                */
/* Naturally, putting these steps in a exec is helpful, esp. if   */
/* you have AVS and VTAM SCIFed to you.                           */
/******************************************************************/
local_lus = 'N2E1AAVS N2E1AAVP'
 
arg fn ft  '(' opt
if fn = '' then do
  say 'Filename required'
  exit 24
end
Signal On Syntax
if ft = '' then ft = 'DATA'
call init
tofile = sign(find(opt,'FILE'))
showdata = sign(find(opt,'DATA'))
timestamp = sign(find(opt,'TIME'))
showvit = ^sign(find(opt,'NOVIT'))
showrh = sign(find(opt,'RH'))
showru = sign(find(opt,'RU'))
showth = sign(find(opt,'TH'))
showpiu = sign(find(opt,'PIU'))
if tofile then address command 'ERASE' fn 'APPCRED A'
'EXECIO * DISKR' fn ft '* (FINIS STEM TRACE.'
 
do i = 2 to trace.0
  parse var trace.i user 9 trlen 11 . +4 tod +8 . 23 eid 25 vitentry
  line = ''
  Select
    when eid = 'EFE1'x & ^showvit then nop
    when eid = 'EFE1'x & showvit then
      do
        line = ParseVIT(vitentry)
 
        do while vitentry <> ''
          parse var vitentry trdata 33 vitentry
          code = left(trdata,4)
        end
      end
    when eid = 'EFEF'x & ^showdata then nop
    when eid = 'EFEF'x & showdata then     /* Buffer trace entry */
      do
        parse var vitentry . 9 tod 17 fromlu +8 tolu +8 th +26 rh +3 ru
        parse value fromlu tolu with fromlu tolu .
 
 
        oef = c2d(substr(th,19,2))
        def = c2d(substr(th,21,2))
        if oef <> oef2 | def <> def2 then
          do   /* Direction change or new pair */
            if location(tolu) = 'REMOTE' then
              Call Display '['fromlu '---------->' tolu']'
            else
              Call Display '['tolu '<----------' fromlu']'
          end
        if showth then Call Display 'TH =' c2x(th)
        if showrh then Call Display 'RH =' c2x(rh)
        if showru then Call Display 'RU =' c2x(ru)
        rhb = c2b(rh)
        parse var rhb rri +1 rucat +2 . +1 fi +1 sdi +1 .
        pi = substr(rhb,16,1)
        rulength = c2d(right(th,2)) -3   /* minus 3 for RH */
 
        if sdi then
          do
            parse var ru sense +4 ru
            if timestamp then
              Call Display ' 'GetTod(tod) ' Sense =' c2x(sense)
            else
              Call Display ' Sense =' c2x(sense)
          end
 
        if rh = '830100'x & rulength = 0 then
          Call DIsplay '  [Isolated Pacing Response]'
 
        if rh = '830100'x & rulength > 0 then
          do
            parse var ru ipmflags +1 ipmwind +2 .
            ipmwind = 'Window='c2d(ipmwind)
            parse value c2b(ipmflags) with ipmtype +2 ipmreset +1 .
            Select
              when ipmtype = '00' then
         Call Display '  [Solicited Pacing Response:' ipmwind']'
              when ipmtype = '01' then
         Call Display '  [Reset Pacing Window:' ipmwind']'
              otherwise
         Call Display '  [Pacing Reset Ack:' ipmwind']'
            End
          end
 
        if rucat = '00' & rh <> '830100'x & oef <> 1 & def <> 1 then
          do
            if fi = 1 then
              do
                fml = c2d(left(ru,1))
                Call Decode_FM left(ru,fml+1)
                if fml < length(ru) then
                  Call Decode_Data substr(ru,fml+1)
               end
            else
              Call Decode_Data ru
          end
 
        do queued()
          parse pull z
          if z ^= '' then
            Call Display '   'z
        end
      end
    when eid = 'EFF1'x & ^showdata then nop
    when eid = 'EFF1'x & showdata then   /* VTAM API data trace entry */
        do
          parse var vitentry . +8 tod +8 fromlu +8 tolu +8 rest
          line = '   [API Data from' fromlu 'to' tolu':' strip(rest)']'
        end
    when eid = 'EF64'x then      /* AVS trace entry */
      nop
    otherwise
      line = 'Event ID =' c2x(eid)
  End
 
if line <> '' then
  Call Display line, tod
End
if tofile then
  'XEDIT' fn 'APPCRED'
Exit
Display:
  parse arg outline, tod
  if outline = '' then return
 
  if timestamp & tod <> '' then
    outline = GetTod(tod) outline
 
  if tofile then
    'EXECIO 1 DISKW' fn 'APPCRED A 0 V 255 (VAR OUTLINE'
  else
    say outline
return
 
ParseVIT: Procedure expose APPC_CONTROL. APPC_QUALIFY. LU62Msg. IND. i,
          showpiu RACRQST. RACTYPE. PIU_Discard.
Arg trdata 33 rest
null = d2c(0,8)
if trdata = '' then return
code = left(trdata,4)
line = ''
Select
  when find('ACA1 ACI1', code) > 0 then do
    parse var trdata 13 cntl 14 qual 15 . 25 convid 29 sense
    cntl = c2x(cntl)
    qual = c2x(qual)
    convid = c2x(convid)
    line = APPC_CONTROL.cntl || APPC_QUALIFY.qual 'start' convid
    if sense <> '00000000'x then
     line = line 'Sense='c2x(sense)
    line = line ParseVIT(rest)
  end
  when find('ACA2 ACI2', code) > 0 then do
    parse var trdata 9 mode 17 local_lu 25 remote_lu
    if mode <> null then
      line = line 'Mode='mode
    if local_lu <> null then
      line = line 'LLU='local_lu
    if remote_lu <> null then
      line = line 'RLU='remote_lu
  end
  when find('ACR1 ACP1', code) > 0 then do
   parse var trdata 13 cntl 14 qual 15 . 17 rcpri 19 rcsec 21 . 29 sense
    cntl = c2x(cntl)
    qual = c2x(qual)
    rc6 = '('c2x(rcpri)','c2x(rcsec)')'
    line = APPC_CONTROL.cntl || APPC_QUALIFY.qual 'done, RC='rc6
    if sense <> '00000000'x then
      line = line 'Sense='c2x(sense)
    line = line ParseVIT(rest)
  end
  when find('ACR2 ACP2', code) > 0 then do
   parse var trdata 13 cntl 14 . 15 rcv 17 . 21 rlen 25 .
    rcv = left(rcv,1)  /* Get rid of second byte */
    rcvmask = '804020100804'x
    rcvlist = ''
    do j = 1 to length(rcvmask)
      mask = substr(rcvmask,j,1)
      maskc = c2x(mask)
      if bitand(rcv,mask) = mask then
        rcvlist = rcvlist ind.maskc
    end
    rcvlist = translate(strip(rcvlist),'+',' ')
    line = word(rcvlist 'None',1)', Count='c2d(rlen)
  end
  when code = 'ACU1' then do
    parse var trdata 6 exitcode 7 . 9 subtype 13 . 17 id1 25 id2
    if exitcode = '0C'x then
      line = 'ATTN user exit ('subtype'), PLU='id1 'SLU='id2',',
             ParseVIT(rest)
    else
      line = 'TPEND user exit, Reason='c2x(subtype)', Pgm='id1
  end
  when code = 'ACU2' then do
    parse var trdata 9 mode 17 .
    line = 'Mode='mode
  end
  when code = 'ACSN' then do
    parse var trdata 9 convid +4 . +4 modname +4 . +4 sense +4 .
    line = 'Sense code' c2x(sense) 'returned to conv' c2x(convid)
  end
  when code = 'MU1' then do
    parse var trdata 6 muid 9 . 13 hsid +4 . 29 sense
    muid = c2x(muid)
    hsid = c2x(hsid)
    if LU62Msg.muid = '' then
      LU62Msg.muid = 'Unknown LU6.2 MU:' muid
 
    if hsid = '00000000' then hsid = left(' ',8)
    pfx = hsid':'LU62Msg.muid
    if sense = '00000000'x then
      line = '   ['pfx strip(ParseVIT(rest))']'
    else
      line = '   ['pfx c2x(sense) strip(ParseVIT(rest))']'
  end
  when code = 'MU2' then do
    parse var trdata  6 muid 9 . 13 dlen,
                     21 sescnt 23 seslim 25 . 29 delta 31 .
    sescnt = c2d(sescnt); seslim = c2d(seslim); delta = c2d(delta,2)
    if muid = '020502'x then
      do
        line = 'SesCnt='sescnt', SesLim='seslim', Delta='delta
        line = line ParseVIT(rest)
      end
  end
  when code = 'MU3' then do
    parse var trdata 9 mode 17 local_lu 25 remote_lu
    line = 'Mode='mode 'LLU='local_lu 'RLU='remote_lu
  end
  when code = 'DSCD' then do
    parse var trdata 6 reason 9 .
    module = ParseVIT(rest)
    reason = x2d(reason)
    line = '*Discarded PIU   Reason='x2d(reason) 'Module='module,
       PIU_Discard.module.reason
       /* value('PIU_Discard.'module'_'reason) */
  end
  when code = 'DSC2' then do
    parse var trdata 29 module
    line = module
  end
  when code = 'PIU ' & showpiu then do
    parse var trdata 13 data
    line = 'PIU ='c2x(data)
  end
  when code = 'PIU2' & showpiu then do
    parse var trdata 5 data
    line = '    ='c2x(data)
  end
  when code = 'MSG ' then do
    parse var trdata 8 s_u 9 . 13 msgid 17 . 25 dest
    Line = 'Message' msgid 'for' dest'-'s_u'...'
  end
  when code = 'MSGS' then do
    parse var trdata 9 dest 17 . 21 msgtext1
  end
  when code = 'MSG2' then do
    parse var trdata 5 msgtext2
    line = msgtext1 || msgtext2
  end
  when code = 'RACR' then do
    parse var trdata 6 racrqst +1 ractype +1 . 21 racsaf +4 racrc +4,
                                                            racreas
    parse value c2x(racrqst) c2x(ractype) with racrqst ractype .
    parse value c2d(racsaf)+0 c2d(racrc)+0 c2d(racreas)+0 with ,
          racsaf racrc racreas
 
    line = 'RACROUTE Request='racrqst.racrqst',Type='ractype.ractype,
           'SAF='d2x(racsaf)', RC='d2x(racrc)', Reason='d2x(racreas)
  end
  otherwise
nop
    /* line = 'Unknown trace type:' code "(X'"c2x(code)"')" */
end
return line
 
Init:
/* Set all global variables */
IND.00 = 'None'
IND.80 = 'Data'
IND.40 = 'Data_Complete'
IND.20 = 'Data_Incomplete'
IND.10 = 'Send'
IND.08 = 'Confirm'
IND.04 = 'Deallocate'
 
RACRQST.01 = 'Audit'
RACRQST.02 = 'Extract'
RACRQST.03 = 'List'
RACRQST.04 = 'Verify'
 
RACTYPE.00 = 'n/a'
RACTYPE.01 = 'Create'
RACTYPE.02 = 'Delete'
RACTYPE.03 = 'Encrypt'
RACTYPE.04 = 'Extract'
 
APPC_CONTROL.   = 'Unknown'
APPC_CONTROL.10 = 'ALLOC'
APPC_CONTROL.20 = 'RESETRCV'
APPC_CONTROL.30 = 'DEALLOC'
APPC_CONTROL.40 = 'OPRCNTL'
APPC_CONTROL.50 = 'PREPRCV'
APPC_CONTROL.60 = 'RCVFMH5'
APPC_CONTROL.70 = 'RECEIVE'
APPC_CONTROL.80 = 'REJECT'
APPC_CONTROL.90 = 'SEND'
APPC_CONTROL.A0 = 'SETSESS'
 
APPC_QUALIFY.00 = ''
APPC_QUALIFY.01 = '(ABNDPROG)'
APPC_QUALIFY.02 = '(ABNDSERV)'
APPC_QUALIFY.03 = '(ABNDTIME)'
APPC_QUALIFY.04 = '(ABNDUSER)'
APPC_QUALIFY.05 = '(ANY)'
APPC_QUALIFY.06 = '(CNOS)'
APPC_QUALIFY.07 = '(CONFIRM)'
APPC_QUALIFY.08 = '(CONFIRMED)'
APPC_QUALIFY.09 = '(DATA)'
APPC_QUALIFY.0A = '(DATACON)'
APPC_QUALIFY.0B = '(DATAFLU)'
APPC_QUALIFY.0C = '(DEFINE)'
APPC_QUALIFY.0D = '(DISPLAY)'
APPC_QUALIFY.0E = '(ERROR)'
APPC_QUALIFY.0F = '(FLUSH)'
APPC_QUALIFY.10 = '(RQSEND)'
APPC_QUALIFY.11 = '(SPEC)'
APPC_QUALIFY.12 = '(ACTSESS)'
APPC_QUALIFY.13 = '(DACTSESS)'
APPC_QUALIFY.14 = '(ALLOCD)'
APPC_QUALIFY.15 = '(IMMED)'
APPC_QUALIFY.16 = '(CONWIN)'
APPC_QUALIFY.17 = '(SESSION)'
APPC_QUALIFY.18 = '(CONVERSATION)'
APPC_QUALIFY.19 = '(SUSPEND)'
APPC_QUALIFY.1A = '(RESUME)'
LU62Msg.       = ''
LU62Msg.010101 = 'End_Conversation'
LU62Msg.010201 = 'PS_Copr_FMH5_Rcvd'
LU62Msg.010302 = 'Confirmed'
LU62Msg.010303 = 'Request_to_Send'
LU62Msg.010304 = 'Send_Data_Record'
LU62Msg.010305 = 'Send_Error'
LU62Msg.010306 = 'Send_Pacing_RSP'
LU62Msg.010501 = 'Allocate_RCB'
LU62Msg.010502 = 'Deallocate_RCB'
LU62Msg.010503 = 'Get_Session'
LU62Msg.010504 = 'Unbind_Protocol_Error'
LU62Msg.010505 = 'Reject_Session'
LU62Msg.010506 = 'Suspend_Session'
LU62Msg.010507 = 'Resume_Session'
LU62Msg.020101 = 'CNOS_Abort'
LU62Msg.020201 = 'CNOS_Cleanup'
LU62Msg.020501 = 'CNOS_Complete'
LU62Msg.020502 = 'Change_Sessions'
LU62Msg.030102 = 'Confirmed'
LU62Msg.030103 = 'Request_to_Send'
LU62Msg.030104 = 'Receive_Data'
LU62Msg.030105 = 'Receive_Error'
LU62Msg.030106 = 'Pacing_Rsp_Rcvd'
LU62Msg.030107 = 'Rsp_to_Request_to_Send'
LU62Msg.030108 = 'Initial_Pacing_Count'
LU62Msg.030109 = 'Deallocate_Abend_Rejected'
LU62Msg.030401 = 'Abort_HS'
LU62Msg.030501 = 'Attach_Header'
LU62Msg.030502 = 'Free_Session'
LU62Msg.030503 = '  Bid'
LU62Msg.030504 = '  Bid_Rsp'
LU62Msg.030505 = '  BIS_RQ'
LU62Msg.030506 = '  BIS_Reply'
LU62Msg.030507 = '  RTR_RQ'
LU62Msg.030508 = '  RTR_Rsp'
LU62Msg.040501 = 'Session_Activated'
LU62Msg.040502 = 'Session_Deactivated'
LU62Msg.040503 = 'Activate_Session_Rsp'
LU62Msg.040504 = 'CTERM_Deactivate_Session'
LU62Msg.040505 = 'LNS_LRM_Free_AMU'
LU62Msg.050101 = 'RCB_Allocated'
LU62Msg.050103 = 'Session_Allocated'
LU62Msg.050104 = 'Attach_Received'
LU62Msg.050105 = 'Conversation_Failure'
LU62Msg.050106 = 'Session_Rejected'
LU62Msg.050107 = 'Session_Suspended'
LU62Msg.050108 = 'Session_Resumed'
LU62Msg.050109 = 'Resume_Session_Flow'
LU62Msg.050301 = '  HS_PS_Connected'
LU62Msg.050302 = 'Yield_Session'
LU62Msg.050303 = '  Bid_Without_Attach'
LU62Msg.050304 = '  Bid_Rsp'
LU62Msg.050305 = '  BIS_RQ'
LU62Msg.050306 = '  BIS_Reply'
LU62Msg.050307 = '  RTR_RQ'
LU62Msg.050308 = '  RTR_Rsp'
LU62Msg.050401 = 'Activate_Session'
LU62Msg.050402 = 'Deactivate_Session'
LU62Msg.060201 = 'Modify_CNOS'
LU62Msg.060202 = 'Modify_DEFINE'
LU62Msg.060203 = 'Display_CNOS'
LU62Msg.060204 = 'Display_LUs'
LU62Msg.060205 = 'Display_Modes'
LU62Msg.060206 = 'Display_Convs'
LU62Msg.060401 = 'Modify_Profiles'
Syncpoint.0005 = 'Prepare'
Syncpoint.0006 = 'Request Commit'
Syncpoint.8006 = 'Request Commit'
Syncpoint.0007 = 'Committed'
Syncpoint.0008 = 'Forget'
Syncpoint.0009 = 'Heuristic_Mixed'
Syncpoint_Modifier.0000 = '- Request RECEIVE'
Syncpoint_Modifier.0001 = '- Request DEALLOCATE'
Syncpoint_Modifier.0002 = '- Request SEND'
synclvl.00 = 'None'
synclvl.01 = 'Confirm'
synclvl.10 = 'Syncpoint'
synclvl.11 = 'Reserved'
GDSID.1210 = 'Change Number of Sessions'
GDSID.1211 = 'Exchange Log Name'
GDSID.1213 = 'Compare States'
GDSID.12A0 = 'Workstation Display Passthrough'
GDSID.12E1 = 'Error Log'
GDSID.12E2 = 'PIP Subfield Data'
GDSID.12F1 = 'Null Data'
GDSID.12F2 = 'User Control Data'
GDSID.12F3 = 'Map Name'
GDSID.12F4 = 'Error Data'
GDSID.12F5 = 'PIP Data'
GDSID.12FF = 'User Data'
REQRSP.0 = 'Request'
REQRSP.1 = 'Response'
PIU_Discard. = ''
PIU_Discard.HSRV.1 = 'LE - Format error on request PIU'
PIU_Discard.HSRV.2 = 'LE - Format error on response PIU'
PIU_Discard.HSRV.3 = 'LE - PIU received in incorrect state'
PIU_Discard.HSRV.4 = 'LE - Insufficient Resources'
PIU_Discard.HSTR.1 = 'LE - PIU rcvd caused xmit control proto violation'
 
Call APILOAD 'VMREXTMR'
Call APILOAD 'VMREXMTR'
tmr_reason.vm_tmr_bad_min_format = 'Bad minuend format'
tmr_reason.vm_tmr_bad_sub_format = 'Bad subtrahend format'
tmr_reason.vm_tmr_bad_dif_format = 'Bad difference format'
tmr_reason.vm_tmr_bad_format_combination = 'Bad format combination'
tmr_reason.vm_tmr_bad_min_window_type = 'Bad minuend window type'
tmr_reason.vm_tmr_bad_sub_window_type = 'Bad subtrahend window type'
tmr_reason.vm_tmr_bad_dif_window_type = 'Bad difference window type'
tmr_reason.vm_tmr_bad_min_conversion_error = 'Minuend conversion error'
tmr_reason.vm_tmr_bad_sub_conversion_error = 'Subtrahend conversion error'
tmr_reason.vm_tmr_bad_dif_conversion_error = 'Difference conversion error'
tmr_reason.vm_tmr_bad_min_length = 'Bad minuend length'
tmr_reason.vm_tmr_bad_sub_length = 'Bad subtrahend length'
tmr_reason.vm_tmr_bad_dif_length = 'Bad difference length'
return
 
Syntax:
  say errortext(rc) 'on line' sigl':'
  say sourceline(sigl)
  say 'while processing trace record' i
  'DESBUF'
exit
 
Decode_FM: Procedure expose Synclvl. tofile fn
  parse arg fml 2 FMru
  fmtype = c2d(left(fmru,1))
  if fmtype = 5 then
    do
      Call DIsplay ' ATTACH'
      Call Decode_FMH5
    end
  else
    do
      parse var FMru 2 sense 6 gdserr 7 rest
      if gdserr = '00'x then
        Call Display ' FMH-7:  Sense='c2x(sense)
      else
        do
        call Display ' FMH-7:  Sense='c2x(sense)
        'GLOBALV SELECT SNADEBUG SETLP LOG_DATA' rest
        'LOGDATA'
        end
    end
return
 
Decode_Data:
  Procedure Expose Syncpoint. Syncpoint_Modifier. GDSID. tofile fn
 
  parse arg data
  if data = '' then return
  ll = c2d(left(data,2))
  If ll = 1 then
    do
      parse var data 5 PStype +2 PSmodifier +2 rest
      PStype = c2x(PStype)
      PSmodifier = c2x(PSmodifier)
      if find('0005 0006 8006', PStype) > 0 then
        Call Display '  [PS Header:' syncpoint.PStype,
                              syncpoint_modifier.PSmodifier']'
      else
        Call Display '  [PS Header:' syncpoint.PStype']'
      Call Decode_Data rest
    end
  else
    do
      userdata = substr(data,3,ll-2)
      parse var userdata gdsid +2 userdata
      gdsid = c2x(gdsid)
 
      Select
        when gdsid = '1210' then Call Decode_CNOS left(userdata,ll-4)
        when gdsid = '1211' then Call Decode_XLN left(userdata,ll-4)
        when gdsid = '12F1' then Call Display ' 'GDSID.gdsid
        otherwise
          Call Display ' 'GDSID.gdsid '('ll-4'):' left(userdata,ll-4)
      End
 
      if ll < length(data) then
        Call Decode_Data substr(data, ll+1)
    end
return
 
Decode_CNOS:
arg gdsvar
parse var gdsvar srvc_flag +1 reply_mod +1 action +1 drain +1 deact,
         +1 sesslim +2 conwin +2 conlose +2 modetype +1 modelen +1 mode
queue ' 'GDSID.gdsid':'
if srvc_flag = '02'x then
  queue '    Request'
else
  Select
    when reply_mod = '00'x then queue '    Reply: OK - No neg.'
    when reply_mod = '01'x then queue '    Reply: FAIL - Race'
    when reply_mod = '02'x then queue '    Reply: FAIL - Bad mode name'
    when reply_mod = '04'x then queue '    Reply: OK - Negotiated'
    when reply_mod = '05'x then queue '    Reply: FAIL - Limit is zero'
    otherwise  queue 'Reply:  unknown type ('c2x(reply_mod)')'
  End
 
if modetype = '00'x then modeinfo = 'mode' left(mode,c2d(modelen))
                    else modeinfo = 'all modes'
if action = '00'x then
  queue '    Set session limit for' modeinfo
else
  queue '    Close sessions for' modeinfo
 
queue '    Limit = ('c2d(sesslim)',' c2d(conwin)',' c2d(conlose)')'
 
return
 
Decode_XLN:
arg gdsvar
parse var gdsvar srvc_flag +1 spmflag +1 lunlen +1 rest
queue ' 'GDSID.gdsid':'
Select
  when srvc_flag = '02'x then queue '    Request'
  when srvc_flag = '08'x then queue '    Reply - Abnormal'
  otherwise                   queue '    Reply - Normal'
end
if bitand(spmflag,'01'x) = '01'x then queue '    Log is WARM'
                                 else queue '    Log is COLD'
lunlen = c2d(lunlen)
queue '    LU Name =' left(rest,lunlen)
loglen = c2d(substr(rest,lunlen+1,1))
queue '    Log Name =' substr(rest,lunlen+2,loglen)
return
 
Decode_FMH5:
  parse value c2b(substr(FMru, 4, 1)) with alreadyv 2 . 5 pipflag 6 .
  if pipflag then queue '   PIP data present = Yes'
             else queue '   PIP data present = No'
 
  if alreadyv then queue '   Userid already verified = Yes'
              else queue '   Userid already verified = No'
 
  if substr(FMru,6,1) = 'D0'x then queue '   Conv Type = Basic'
                              else queue '   Conv Type = Mapped'
  syncvar = left(c2b(substr(fmru,8,1)),2)
  queue '   Synclevel =' synclvl.syncvar
 
  offset = 9
  tpnl = c2d(substr(FMru, offset, 1))
  tpname = substr(FMru, offset+1, tpnl)
  if left(tpname,1) < ' ' then
    queue "   TPN = X'"c2x(tpname)"'"
  else
    queue "   TPN =" tpname
 
  offset = offset + tpnl + 1
  accsecinfol = c2d(substr(FMru, offset, 1))
  accsecinfo = substr(FMru, offset+1, accsecinfol)
 
  Call Decode_Security_Info accsecinfo
 
  offset = offset + accsecinfol + 1
  luwidl = c2d(substr(FMru, offset, 1))
  offset = offset + 1
  if luwidl <> 0 then
    do
      lunamel = c2d(substr(FMru, offset, 1))
      queue '   LU Name =' substr(FMru, offset+1, lunamel)
 
      offset = offset + lunamel + 1
      luw_inst = c2x(substr(FMru, offset, 6))
      luw_seq = c2x(substr(FMru, offset+6, 2))
      queue '   LUW Instance =' luw_inst
      queue '   LUW Sequence =' luw_seq
      offset = offset + 8
    end
 
  convcorl = c2d(substr(FMru, offset, 1))
  if convcorl <> 0 then
    queue '   Conv Corr =' c2x(substr(FMru, offset+1, convcorl))
  return
 
Decode_Security_Info:
  Procedure
  parse arg secparm
  if secparm = '' then return
  len = c2d(left(secparm,1))
  type = substr(secparm,2,1)
  data = substr(secparm,3,len-1)
 
  Select
    when type = '00'x then queue '   Profile =' data
    when type = '01'x then queue '   Password =' data
    when type = '02'x then queue '   Userid =' data
    otherwise              queue '   *UNKNOWN SEC SUBFIELD:' type
  end
 
  if len+2 > length(secparm) then return
  parse var secparm (len+2) secparm
  Call Deocde_Security_Info secparm
  return
Location: Procedure expose Local_LUs
  arg luname
  if wordpos(luname, local_lus) > 0 then
    return 'LOCAL'
  return 'REMOTE'
 
GetTod:
arg tod
signal on novalue
tod_format = vm_tmr_format_tod_absolute
  tod = x2c(tod)
  todl = length(tod)
 
tod2_format = vm_tmr_format_tod_relative
  tod2 = d2c(0,8)
  tod2l = length(tod2)
 
dif_format = vm_tmr_format_usa
  dif = left(' ',32)
  difl = length(dif)
  difl2 = 0
 
zero = 0
retcode = 0
reascode = 0
 
parse value diag(0) with 33 timezone +4 .    /* # of seconds difference from UTC */
dif_tz = c2d(timezone,4)
 
 
Call CSL 'DateTimeSubtract retcode reascode'   ,
         'tod  todl  tod_format      zero vm_tmr_window_none zero'  ,
         'tod2 tod2l tod2_format     zero vm_tmr_window_none zero'  ,
         'dif  difl  difl2 dif_format dif_tz vm_tmr_window_none zero'
 
if retcode <> 0 then
  do
    say 'Return code =' retcode
    say 'Reason =' tmr_reason.reascode
  end
else
  say 'Time =' left(dif, difl2)
  parse arg myTOD
  REXEC TODCVT' c2x(myTOD) '(STACK MICRO'
  pull tod
  return tod