/* REXX */
/*                                       */
/* AUTHOR: Charles Fenton                */
/*                                       */
/*********************************************************************/
/* DISPLAY FACITLITY INFORMATION TO TERMINAL                         */
/*********************************************************************/
/* trace r? */
LASTUPD = '06/10/2010'                       /* date of last update  */
/*********************************************************************/
/* Change summary:                                                   */
/*   2010/06/10 - CLF, added full variable and tested it.            */
/*   2014/03/14 - CLF, Chgd "^=" to "<>".                            */
/*********************************************************************/
PGMNAME = 'CATC1004 03/14/14'
null =
Numeric digits 10                           /* dflt of 9 not enough  */
Parse source opsys . exec_name . exdsn .
Parse upper arg full option
junk = msg(off)
Address ISPEXEC 'VGET (ACPNAME)'
if ACPNAME = "" then ,
  If SysVar('SysEnv') <> "FORE" Then ,
    Address ISPEXEC 'ISPEXEC SELECT CMD(CACC1000 ACP)'
  else do
    if "OK" = sysdsn("'"exdsn"(CACC1000)'") then,
      Address TSO "ex '"exdsn"(CACC1000)' 'ACP'"
    else,
      Address ISPEXEC 'ISPEXEC SELECT CMD(CACC1000 ACP)'
  end
/*  Address TSO "%CACC1000 'ACP'"*/
If SysVar('SysEnv') = "FORE" Then do
  "ALLOC FILE(facall) UNIT(SYSALLDA) NEW TRACKS SPACE(2,1) DELETE",
        " REUSE LRECL(80) RECFM(F B) BLKSIZE(3120)"
  "ALLOC FILE(report) UNIT(SYSALLDA) NEW TRACKS SPACE(2,1) DELETE",
        " REUSE LRECL(80) RECFM(F B) BLKSIZE(3120)"
  end
Address ISPEXEC 'VGET (ACPNAME ACPVERS)'
if ACPNAME <> 'TSS' then do
  say PGMNAME 'Top Secret Job running on the wrong system'
  say PGMNAME ACPNAME ACPVERS
  exit 20
  end
Address TSO 'Newstack'
call Select_and_Sort
If SysVar('SysEnv') <> "FORE" Then do
  queue 'READY'
  queue '  TSS MODIFY(FACILITY(ALL))'
  end
do i = 1 to FMXNAME.0
  fld1 = left(word(FMXNAME.i,1),8)
  fld2 = left(word(FMXNAME.i,3),2)
  fld3 = word(FMXNAME.i,4)
  queue 'TSS9500I FACILITY='fld1'  ID='fld2'  MODE='fld3
end
queue 'TSS0300I  MODIFY   FUNCTION SUCCESSFUL'
If SysVar('SysEnv') <> "FORE" Then do
  queue 'READY'
  queue 'END'
  end
quenr = queued()
Address TSO "EXECIO" queued() "DISKW FACALL (FINIS"
If SysVar('SysEnv') <> "FORE" Then do
  say PGMNAME 'The number of records queued for FACALL is' quenr
  end
If SysVar('SysEnv') <> "FORE" Then ,
  queue 'READY'
do i = 1 to FMXNAME.0
  call Process_Facility word(FMXNAME.i,2)
  If SysVar('SysEnv') = "FORE" Then ,
    queue ' '
end
If SysVar('SysEnv') <> "FORE" Then ,
  queue 'END'
quenr = queued()
Address TSO "EXECIO" queued() "DISKW REPORT (FINIS"
If SysVar('SysEnv') <> "FORE" Then do
  say PGMNAME 'The number of records queued is for FACLIST' quenr
  end
Address TSO 'Newstack'
If SysVar('SysEnv') = "FORE" Then do
  address ISPEXEC "LMINIT DATAID(TEMP) DDNAME(FACALL)"
  address ISPEXEC "VIEW DATAID("temp")"
  address ISPEXEC "LMFREE DATAID("temp")"
  address TSO "FREE FI(FACALL)"
  address ISPEXEC "LMINIT DATAID(TEMP) DDNAME(REPORT)"
  address ISPEXEC "VIEW DATAID("temp")"
  address ISPEXEC "LMFREE DATAID("temp")"
  address TSO "FREE FI(REPORT)"
  end
/*********************************************************************/
/* Done looking at all control blocks                                */
/*********************************************************************/
Exit 0                                       /* End CACC1001 - RC 0  */
Process_Facility:
arg x
FMXJOBTP = Storage(D2x(x + 32),1)
FMXFLAGA = Storage(D2x(x + 26),1)
FMXNAME  = Storage(D2x(x),8)
If SysVar('SysEnv') <> "FORE" Then ,
  queue '  TSS MODIFY(FACILITY('strip(FMXNAME,t)'))'
queue 'TSS9550I FACILITY DISPLAY FOR' FMXNAME
FMXIPGM  = Storage(D2x(x + 8),8)
FMXDACID = Storage(D2x(x + 16),8)
if substr(FMXDACID,1,1) = '00'x then FMXDACID = left(' ',8)
FMXMAXU  = right(C2d(Storage(D2x(x + 24),2)),5,'0')
FMXGJOBT = right(C2d(Storage(D2x(x + 33),1)),3,'0')
FMXLOGID = Storage(D2x(x + 39),2)
queue 'TSS9551I INITPGM='FMXIPGM 'ID='FMXLOGID 'TYPE='FMXGJOBT
FMXUSE   =
FMXINAC  = 'ACTIVE'
FMXNPRF  = 'SHRPRF'
FMXSUBA  = 'NOASUBM'
FMXTENV  =
FMXNOAB  = 'ABEND'
FMXMACE  = 'SUAS'
FMXXDEF  = 'NOXDEF'
If bitand(FMXFLAGA,'80'x) = '80'x then FMXUSE   = 'IN-USE,'
If bitand(FMXFLAGA,'40'x) = '40'x then FMXINAC  = 'INACT'
If bitand(FMXFLAGA,'20'x) = '20'x then FMXNPRF  = 'NOSHRPRF'
If bitand(FMXFLAGA,'10'x) = '10'x then FMXSUBA  = 'ASUBM'
If bitand(FMXFLAGA,'08'x) = '08'x then FMXTENV  =
If bitand(FMXFLAGA,'04'x) = '04'x then FMXNOAB  = 'NOABEND'
If bitand(FMXFLAGA,'02'x) = '02'x then FMXMACE  = 'MULTIUSER'
If bitand(FMXFLAGA,'01'x) = '01'x then FMXXDEF  = 'XDEF'
DATA = FMXUSE||FMXINAC','FMXNPRF','FMXSUBA','FMXNOAB
DATA = DATA','FMXMACE','FMXXDEF
queue 'TSS9552I ATTRIBUTES='left(DATA,60) /*C2x(FMXFLAGA)*/
FMXLUM   = 'NOLUMSG'
FMXSTM   = 'NOSTMSG'
FMXNDUP  = 'SIGN(M)'
FMXPSDO  =
FMXDTP   =
FMXNINS  = 'INSTDATA'
FMXRNDP  = 'NORNDPW'
FMXNAUT  = 'AUTHINIT'
FMXFLAGB = Storage(D2x(x + 27),1)
If bitand(FMXFLAGB,'80'x) = '80'x then FMXLUM   = 'LUMSG'
If bitand(FMXFLAGB,'40'x) = '40'x then FMXSTM   = 'STMSG'
If bitand(FMXFLAGB,'20'x) = '20'x then FMXNDUP  = 'SIGN(S)'
If bitand(FMXFLAGB,'10'x) = '10'x then FMXPSDO  =
If bitand(FMXFLAGB,'08'x) = '08'x then FMXDTP   =
If bitand(FMXFLAGB,'04'x) = '04'x then FMXNINS  = 'NOINST'
If bitand(FMXFLAGB,'02'x) = '02'x then FMXRNDP  = 'RNDPW'
If bitand(FMXFLAGB,'01'x) = '01'x then FMXNAUT  = 'NOAUTHI'
DATA = FMXLUM','FMXSTM','FMXNDUP','FMXNINS','FMXRNDP','FMXNAUT
queue 'TSS9552I ATTRIBUTES='left(DATA,60) /*C2x(FMXFLAGB)*/
FMXTPWP  =
FMXNMEN  = 'NOPROMPT'
FMXAUDT  = 'NOAUDIT'
FMXNRES  = 'RES'
FMXMRO   =
FMXWPW   = 'NOWARNPW'
FMXTPUT  = 'NOTSOC'
FMXCT    = 'LCFCMD'
FMXFLAGC = Storage(D2x(x + 28),1)
If bitand(FMXFLAGC,'80'x) = '80'x then FMXTPWP  =
If bitand(FMXFLAGC,'40'x) = '40'x then FMXNMEN  = 'PROMPT'
If bitand(FMXFLAGC,'20'x) = '20'x then FMXAUDT  = 'AUDIT'
If bitand(FMXFLAGC,'10'x) = '10'x then FMXNRES  = 'NORES'
If bitand(FMXFLAGC,'08'x) = '08'x then FMXMRO   =
If bitand(FMXFLAGC,'04'x) = '04'x then FMXWPW   = 'WARNPW'
If bitand(FMXFLAGC,'02'x) = '02'x then FMXTPUT  = 'TSOC'
If bitand(FMXFLAGC,'01'x) = '01'x then FMXCT    = 'LCFTRANS'
DATA = FMXNMEN','FMXAUDT','FMXNRES','FMXWPW','FMXTPUT','FMXCT
queue 'TSS9552I ATTRIBUTES='left(DATA,60) /*C2x(FMXFLAGC)*/
FMXMUC   = 'MSGLC'
FMXTRAC  = 'NOTRACE'
FMXEODI  = 'NOEODINIT'
FMXNIJU  = 'IJU'
FMXDPW   = 'NODORMPW'
FMXNPWR  = 'NONPWR'
FMXIMSX  =
FMXVSIO  =
FMXFLAGD = Storage(D2x(x + 29),1)
If bitand(FMXFLAGD,'80'x) = '80'x then FMXMUC   = 'NOMSGLC'
If bitand(FMXFLAGD,'40'x) = '40'x then FMXTRAC  = 'TRACE'
If bitand(FMXFLAGD,'20'x) = '20'x then FMXEODI  = 'EODINIT'
If bitand(FMXFLAGD,'10'x) = '10'x then FMXNIJU  = 'NOIJU'
If bitand(FMXFLAGD,'08'x) = '08'x then FMXDPW   = 'DORMPW'
If bitand(FMXFLAGD,'04'x) = '04'x then FMXNPWR  = 'NPWR'
If bitand(FMXFLAGD,'02'x) = '02'x then FMXIMSX  =
If bitand(FMXFLAGD,'01'x) = '01'x then FMXVSIO  =
DATA = FMXMUC','FMXTRAC','FMXEODI','FMXNIJU','FMXDPW','FMXNPWR
queue 'TSS9552I ATTRIBUTES='left(DATA,60) /*C2x(FMXFLAGD)*/
FMXNLUP  = 'LUUPD'
FMXEX40  =
FMXEX20  =
FMXEX10  =
FMXEX08  =
FMXEX04  =
FMXEX02  =
FMXEX01  =
FMXFLAGE = Storage(D2x(x + 30),1)
If bitand(FMXFLAGE,'80'x) = '80'x then FMXNLUP  = 'NOLUUPD'
If bitand(FMXFLAGE,'40'x) = '40'x then FMXEX40  =
If bitand(FMXFLAGE,'20'x) = '20'x then FMXEX20  =
If bitand(FMXFLAGE,'10'x) = '10'x then FMXEX10  =
If bitand(FMXFLAGE,'08'x) = '08'x then FMXEX08  =
If bitand(FMXFLAGE,'04'x) = '04'x then FMXEX04  =
If bitand(FMXFLAGE,'02'x) = '02'x then FMXEX02  =
If bitand(FMXFLAGE,'01'x) = '01'x then FMXEX01  =
DATA = FMXNLUP
queue 'TSS9552I ATTRIBUTES='left(DATA,60) /*C2x(FMXFLAGE)*/
DATA =
FMXMODE  = Storage(D2x(x + 36),1)
If bitand(FMXMODE,'80'x) = '80'x then MODE     = 'DORM'
If bitand(FMXMODE,'40'x) = '40'x then MODE     = 'WARN'
If bitand(FMXMODE,'20'x) = '20'x then MODE     = 'FAIL'
If bitand(FMXMODE,'30'x) = '30'x then MODE     = 'IMPL'
If bitand(FMXMODE,'08'x) = '08'x then FMXEX08  =
If bitand(FMXMODE,'04'x) = '04'x then FMXEX04  =
If bitand(FMXMODE,'02'x) = '02'x then FMXEX02  =
If bitand(FMXMODE,'01'x) = '01'x then FMXEX01  =
DATALOG  =
FMXLOG   = Storage(D2x(x + 37),1)
If bitand(FMXLOG,'80'x) = '80'x then DATALOG = strip(DATALOG',ACCESS',b,',')
If bitand(FMXLOG,'40'x) = '40'x then DATALOG = strip(DATALOG',',b,',')
If bitand(FMXLOG,'10'x) = '10'x then DATALOG = strip(DATALOG',',b,',')
If bitand(FMXLOG,'04'x) = '04'x then DATALOG = strip(DATALOG',',b,',')
If bitand(FMXLOG,'02'x) = '02'x then DATALOG = strip(DATALOG',INIT',b,',')
If bitand(FMXLOG,'08'x) = '08'x then DATALOG = strip(DATALOG',SMF',b,',')
If bitand(FMXLOG,'01'x) = '01'x then DATALOG = strip(DATALOG',MSG',b,',')
If bitand(FMXLOG,'20'x) = '20'x then DATALOG = strip(DATALOG',SEC9',b,',')
If        FMXLOG        = '00'x then DATALOG = strip(DATALOG'NONE',b,',')
FMXDOWN  = Storage(D2x(x + 55),1)
If        FMXDOWN        = '00'x then DOWN     = 'GLOBAL'
If        FMXDOWN        = '04'x then DOWN     = 'WAIT'
If        FMXDOWN        = '08'x then DOWN     = 'BYPASS'
If        FMXDOWN        = '12'x then DOWN     = 'FAIL'
If        FMXDOWN        = '16'x then DOWN     = 'NORMAL'
DATA = FMXNLUP
queue 'TSS9553I MODE='MODE'  DOWN='DOWN'  LOGGING='DATALOG
FMXKUA   = C2X(Storage(D2x(x + 41),1))
FMXKEY   = X2D(substr(FMXKUA,1,1))
FMXUACID = X2D(substr(FMXKUA,2,1))
FMXLOKTM = right(C2d(Storage(D2x(x + 38),1)),3,'0')
if FMXDACID = ' ' then FMXDACID = left('*NONE*',8)
DATA = FMXUACID 'LOCKTIME='FMXLOKTM
DATA = DATA 'DEFACID='FMXDACID 'KEY='FMXKEY
queue 'TSS9554I UIDACID='left(DATA,63) /*FMXKUA*/
FMXPRFTP = right(C2d(Storage(D2x(x + 54),1)),3,'0')
FMXMAXS =
if FMXGJOBT = 4 then Call CICS
else if FMXMACE  = 'MULTIUSER' then,
  queue 'TSS9566I MAXUSER='FMXMAXU'  PRFT='FMXPRFTP
queue 'TSS0300I  MODIFY   FUNCTION SUCCESSFUL'
If SysVar('SysEnv') <> "FORE" Then ,
  queue 'READY'
return
 
/*   CICS Routine                                                    */
CICS:
FMXSITF1 = Storage(D2x(x + 44),1)
FMXSITF2 = Storage(D2x(x + 45),1)
FMXSITF3 = Storage(D2x(x + 46),1)
FMXSITF4 = Storage(D2x(x + 47),1)
FMXCSMXT = right(C2d(Storage(D2x(x + 52),2)),3,'0')
/* TSS9560I FACMATRX=xxx      EXTSEC=xxx      EJBRPRFX=xxxxxxxxxxxxxxxx */
FMXEXTYU =
FMXEXTYR =
FMXEXTY  = 'EXTSEC=NO '
FMXSITCY = 'FACMATRX=NO '
FMX@EXTA = C2d(Storage(D2x(x + 60),4))
FMXEJBRP = Storage(D2x(FMX@EXTA),16)
If bitand(FMXSITF1,'08'x) = '08'x then FMXEXTYU =
If bitand(FMXSITF1,'04'x) = '04'x then FMXEXTYR =
If bitand(FMXSITF1,'02'x) = '02'x then FMXEXTY  = 'EXTSEC=YES'
If bitand(FMXSITF1,'01'x) = '01'x then FMXSITCY = 'FACMATRX=YES'
queue 'TSS9560I' FMXSITCY'      'FMXEXTY'      EJBRPRFX='FMXEJBRP
 
/* TSS9561I XJCT=xxx XFCT=xxx XCMD=xxx XDCT=xxx XTRAN=xxx XDB2=xxx XEJB=xxx */
FMXJCT   = 'XJCT=NO '
FMXFCT   = 'XFCT=NO '
FMXCMD   = 'XCMD=NO '
FMXDCT   = 'XDCT=NO '
FMXTRAN  = 'XTRAN=NO '
FMXDB2   = 'XDB2=NO '
FMXEJB   = 'XEJB=NO '
If bitand(FMXSITF1,'80'x) = '80'x then FMXJCT   = 'XJCT=YES'
If bitand(FMXSITF1,'40'x) = '40'x then FMXFCT   = 'XFCT=YES'
If bitand(FMXSITF1,'20'x) = '20'x then FMXCMD   = 'XCMD=YES'
If bitand(FMXSITF1,'10'x) = '10'x then FMXDCT   = 'XDCT=YES'
If bitand(FMXSITF2,'08'x) = '08'x then FMXTRAN  = 'XTRAN=YES'
If bitand(FMXSITF2,'40'x) = '40'x then FMXDB2   = 'XDB2=YES'
If bitand(FMXSITF4,'80'x) = '80'x then FMXEJB   = 'XEJB=YES'
queue 'TSS9561I' FMXJCT FMXFCT FMXCMD FMXDCT FMXTRAN FMXDB2 FMXEJB
 
/* TSS9561I XTST=xxx XPSB=xxx XPCT=xxx XPPT=xxx XAPPC=xxx XUSER=xxx */
FMXTST   = 'XTST=NO '
FMXPSB   = 'XPSB=NO '
FMXPCT   = 'XPCT=NO '
FMXPPT   = 'XPPT=NO '
FMXAPPC  = 'XAPPC=NO '
FMXUSER  = 'XUSER=NO '
If bitand(FMXSITF2,'80'x) = '80'x then FMXUSER  = 'XUSER=YES'
If bitand(FMXSITF2,'20'x) = '20'x then FMXAPPC  = 'XAPPC=YES'
If bitand(FMXSITF2,'10'x) = '10'x then FMXTST   = 'XTST=YES'
If bitand(FMXSITF2,'04'x) = '04'x then FMXPSB   = 'XPSB=YES'
If bitand(FMXSITF2,'02'x) = '02'x then FMXPPT   = 'XPPT=YES'
If bitand(FMXSITF2,'01'x) = '01'x then FMXPCT   = 'XPCT=YES'
queue 'TSS9561I' FMXTST FMXPSB FMXPCT FMXPPT FMXAPPC FMXUSER
 
/* TSS9564I PCTEXTSEC=xxxxxxxx    PCTCMDSEC=xxxxxxxx  PCTRESSEC=xxxxxxxx */
FMXPPCT  = 'PCTEXTSEC=HONOR   '
FMXCPCT  = 'PCTCMDSEC=HONOR   '
FMXRPCT  = 'PCTRESSEC=HONOR   '
If bitand(FMXSITF3,'80'x) = '80'x then FMXRPCT  = 'PCTRESSEC=OVERRIDE'
If bitand(FMXSITF3,'02'x) = '02'x then FMXPPCT  = 'PCTEXTSEC=OVERRIDE'
If bitand(FMXSITF3,'04'x) = '04'x then FMXCPCT  = 'PCTCMDSEC=OVERRIDE'
queue 'TSS9564I' FMXPPCT'    'FMXCPCT'  'FMXRPCT
 
/* TSS9565I DSNCHECK=xxx  LTLOGOFF=xxxxxxx  RLP=xxx  SLP=xxx  PCLOCK=xxx */
FMXLTSO  =
FMXLTDC  =
FMXCDSN  = 'DSNCHECK=NO '
FMXLTLG  =
FMXRLP   = 'RLP=NO '
FMXSLP   = 'SLP=NO '
FMXPCLT  = 'PCLOCK=NO '
If bitand(FMXSITF3,'20'x) = '20'x then FMXLTSO  = 'LTLOGOFF=SIGNOFF'
If bitand(FMXSITF3,'10'x) = '10'x then FMXLTDC  =
If bitand(FMXSITF3,'08'x) = '08'x then FMXLTLG  = 'LTLOGOFF=YES    '
If bitand(FMXSITF3,'28'x) = '00'x then FMXLTLG  = 'LTLOGOFF=NO     '
If bitand(FMXSITF3,'01'x) = '01'x then FMXCDSN  = 'DSNCHECK=YES'
If bitand(FMXSITF4,'20'x) = '20'x then FMXPCLT  = 'PCLOCK=YES'
If bitand(FMXSITF4,'10'x) = '10'x then FMXSLP   = 'SLP=YES'
If bitand(FMXSITF4,'08'x) = '08'x then FMXRLP   = 'RLP=YES'
queue 'TSS9565I' FMXCDSN'  'FMXLTSO||FMXLTLG'  'FMXRLP'  'FMXSLP'  'FMXPCLT
 
/* TSS9566I MAXUSER=nnnnn  PRFT=nnn  MAXSIGN=nnn,xxxxx */
FMXRTRY  = 'KILL'
If bitand(FMXSITF4,'04'x) = '04'x then FMXRTRY  = 'RETRY'
FMXMAXS = ' MAXSIGN='FMXCSMXT','FMXRTRY
queue 'TSS9566I MAXUSER='FMXMAXU'  PRFT='FMXPRFTP FMXMAXS
 
/* TSS9567I CICSCACHE=SESSLIFE,AUDIT,0512 */
FMXCACHS = right(C2d(Storage(D2x(FMX@EXTA + 16),2)),4,'0')
FMXFLAGF = Storage(D2x(x + 31),1)
FMXCACHR = 'SESSLIFE'
FMXCATF  = 'AUDIT'
FMXDIAG  =
FMXHIUD  =
If bitand(FMXFLAGF,'80'x) = '80'x then FMXCACHR = 'TASKLIFE'
If bitand(FMXFLAGF,'20'x) = '20'x then FMXCATF  = 'NOAUDIT'
If bitand(FMXSITF4,'02'x) = '02'x then FMXDIAG  =
If bitand(FMXSITF4,'01'x) = '01'x then FMXHIUD  =
queue 'TSS9567I CICSCACHE='FMXCACHR','FMXCATF','FMXCACHS
queue 'TSS0300I  MODIFY   FUNCTION SUCCESSFUL'
If SysVar('SysEnv') <> "FORE" Then do
  queue 'READY                                  '
  queue '  TSS MODIFY(FACILITY('strip(FMXNAME,t)'=BYPLIST))'
  end
else ,
  queue ' '
queue 'TSS9550I FACILITY DISPLAY FOR' FMXNAME
/* TSS9570I BYPASS TABLE DISPLAY FOR FACILITY  xxxxxxxx */
queue 'TSS9570I BYPASS TABLE DISPLAY FOR FACILITY  'FMXNAME
listtbl = 'SYSID CEMT SPI DCT DSN FCT',
          'JCT LOCKTIME PCT PSB TCT TRANS',
          'TST PPT TRANID PPPPPPPP DB2 RRRRRRRR',
          'SSSSSSSS TTTTTTTT UUUUUUUU VVVVVVVV WWWWWWWW XXXXXXXX',
          'YYYYYYYY ZZZZZZZZ'
FMXCBYPL = C2d(Storage(D2x(x + 48),4))
FMXCPPTL = C2d(Storage(D2x(x + 56),4))
if C2d(Storage(D2x(FMXCBYPL),4)) < C2d(Storage(D2x(FMXCPPTL),4)) then ,
  cnta = C2d(Storage(D2x(FMXCBYPL),4))
else,
  cnta = C2d(Storage(D2x(FMXCPPTL),4))
do a1 = 1 to cnta
  a2 = a1 * 4
  lnth = 8
  if word(listtbl,a1) = 'TRANID' then lnth = 4
  line = 'TSS9571I RESOURCE='left(word(listtbl,a1),8),
         'BYPASS  NAMES:  '
  cntb = C2d(Storage(D2x(FMXCBYPL + a2),4))
  do until cntb = 0
    cntc = C2d(Storage(D2x(cntb + 5),1))
    do b1 = 1 to cntc
      if length(line) > 66 then do
        queue line
        line = 'TSS9572I        '
        end
      b1a = Storage(D2x(cntb + (b1 * 8) + 7),1)
      fld = Storage(D2x(cntb + (b1 * 8)),8)
      if b1a < '40'x then,
        field = Storage(D2x(cntb + (b1 * 8)),C2d(b1a) + 1)
      else
        field = Storage(D2x(cntb + (b1 * 8)),8)
      field = strip(field,t)
      if length(field) = 1 & field = '00'x then iterate
      if length(field) > 0 then field = left(field,lnth)
      else iterate
      if word(listtbl,a1) = 'TRANID' then field = left(fld,lnth)
      if substr(field,1,1) < '40'x & word(listtbl,a1) = 'TRANID' then,
        field = '....'
      line = line field
      end /* do b1 = 1 to cntc */
    cntb = C2d(Storage(D2x(cntb),4))
  end /* do until cntb = 0 */
  if (length(line) > 43 & word(line,1) = 'TSS9571I') |,
    (length(line) > 16 & word(line,1) = 'TSS9572I') then,
    queue line
  line = 'TSS9571I RESOURCE='left(word(listtbl,a1),8),
         'PROTECT NAMES:  '
  cntb = C2d(Storage(D2x(FMXCPPTL + a2),4))
  do until cntb = 0
    cntc = C2d(Storage(D2x(cntb + 5),1))
    do b1 = 1 to cntc
      if length(line) > 66 then do
        queue line
        line = 'TSS9572I        '
        end
      b1a = Storage(D2x(cntb + (b1 * 8) + 7),1)
      if b1a < '40'x then,
        field = Storage(D2x(cntb + (b1 * 8)),C2d(b1a) + 1)
      else
        field = Storage(D2x(cntb + (b1 * 8)),8)
      field = strip(field,t)
      if length(field) = 1 & field = '00'x then iterate
      if length(field) > 0 then field = left(field,lnth)
      else iterate
      if substr(field,1,1) < '40'x & word(listtbl,a1) = 'TRANID' then,
        field = '....'
      line = line field
      end /* do b1 = 1 to cntc */
    cntb = C2d(Storage(D2x(cntb),4))
  end /* do until cntb = 0 */
  if (length(line) > 43 & word(line,1) = 'TSS9571I') |,
    (length(line) > 16 & word(line,1) = 'TSS9572I') then,
    queue line
end /* do a1 = */
Return
 
Select_and_Sort:
CVT      = C2d(Storage(10,4))                /* point to CVT         */
CVTRAC   = C2d(Storage(D2x(CVT + 992),4))    /* point to RACF CVT    */
TSSFAC   = CVTRAC + 4088
i = 1
do x = TSSFAC by 64
  FMXJOBTP = Storage(D2x(x + 32),1)
  if FMXJOBTP = '00'x then leave
  if FMXJOBTP = 'FF'x then iterate
  FMXFLAGA = Storage(D2x(x + 26),1)
  FMXNAME  = strip(Storage(D2x(x),8))
/*say c2x(FMXFLAGA) "**" null "**" full "**" c2x(bitand(FMXFLAGA,'80'x)) "**"
  if full = null then say "Variable full is equal to nothing." */
  If full = null & ,
    bitand(FMXFLAGA,'80'x) = '00'x then iterate
  FMXMODE  = Storage(D2x(x + 36),1)
  If bitand(FMXMODE,'80'x) = '80'x then MODE     = 'DORMANT'
  If bitand(FMXMODE,'40'x) = '40'x then MODE     = 'WARN'
  If bitand(FMXMODE,'20'x) = '20'x then MODE     = 'FAIL'
  If bitand(FMXMODE,'30'x) = '30'x then MODE     = 'IMPL'
  FMXLOGID = Storage(D2x(x + 39),2)
  FMXNAME.i = Storage(D2x(x),8) x FMXLOGID MODE
  FMXNAME.0 = i
  i = i + 1
end
SORT_DONE = 0
SORT_RECS = FMXNAME.0
Do while SORT_DONE = 0
  SORT_DONE = 1
  Do I = 1 to SORT_RECS - 1
    J = I + 1
    If FMXNAME.I > FMXNAME.J then do
      SORT_DONE = 0
      TEMP_SORT = FMXNAME.J
      FMXNAME.J = FMXNAME.I
      FMXNAME.I = TEMP_SORT
    End /* if */
  End /* do i=1 to sort_recs */
  SORT_RECS = SORT_RECS - 1
End /* do while */
return