/*  RXLSTCAT:  Produce reduced VSAM LSTCAT listing.               */
/*             A single PARM value is accepted that is the        */
/*             dataset name of the catalog to produce the         */
/*             listing for.                                       */
/* Revision 0: Rich Smrcina 07/25/97                              */
/* Revision 1: Rich Smrcina 12/08/97                              */
/*             Added System Timestamp and a data compression      */
/*             indicator.                                         */
arg catname
signal on error name error_out
call outtrap lst.
call rexxipt sysipt.
sysipt.0=1
sysipt.1=' LISTCAT CATALOG('CATNAME') ALL'
address link 'IDCAMS'
eof=0
first=1
i=0
v=0
pc=0
call print_heading
do until eof=1
  call get_next_line
  if eof=1 then
    iterate
  select
    when word1='CLUSTER' | word1='AIX' then
      call process_cluster
    when word1='DATA' | word1='INDEX' then
      call process_component word1
    when word1='VOLUME' & left(word2,1)='-' then do
      call process_volume
      end
    otherwise
      nop
    end
  end
vs.0=v
call write_volume_summary
exit
 
process_cluster: procedure expose lst. i eof pc lc catname first
parse var lst.i . . cluster_name
do 2                           /* Skip 2 lines  */
  call get_next_line
  end
parse var lst.i . creation
tcreation=translate(creation,' ','-')
parse var tcreation . creation_date
creation_date=strip(creation_date)
if first=1 then
  first=0
else do
  line.1=' '
  call write_line
  end
line.1=' 'left(cluster_name,44)||'    '||'Created: 'creation_date
call write_line
return
 
process_component: procedure expose lst. i eof pc lc catname
arg comp_type
parse var lst.i . . comp_name   /* Get component name       */
call get_stats
cpr=' '
if comp_type='DATA' then do
  tsinfo=' Timestamp: '||tsday' 'tstime
  if compress=1 then
    cpr='C'
  end
else do
  tsinfo=''
  end
line.1='  'left(comp_name,44)||tsinfo
call write_line
cicasp=dcisplits||'/'||dcasplits
freesp=dfspci||'/'||dfspca
alloc=dsppri||'/'||dspsec||left(dsptype,1)
if dhurba=0 then
  pctused=0
else
  pctused=(1/(dharba/dhurba))*100
pctused=format(pctused,3,0)
line.1=' '||drecsret||' '||drecsdel||' '||drecins||' '||drecsupd||' ' ,
       ||dtotrecs||' '||dkeylen||' '||drkp||' '||davgrecl||' '|| ,
       dmaxrecl||' '||cicasp||' '||freesp||' '||dcisize||' '||     ,
       dvolser||' 'cpr||alloc||' '||pctused||' '||dext||' '||dil
call write_line
return
 
process_volume: procedure expose lst. i eof pc lc catname vs. v
parse var lst.i . . volid
v=v+1
vs.v.volume=volid
do until word1='CHARACTERISTICS'
  call get_next_line
  end
call get_next_line
parse var lst.i bytespertrk devtyp .
call get_next_line
parse var lst.i trkspercyl .
call get_next_line
parse var lst.i cylspervol .
tbytespertrk=translate(bytespertrk,' ','-')
parse var tbytespertrk . dbytespertrk
dbytespertrk=right(strip(dbytespertrk),5)
tdevtyp=translate(devtyp,' ','-')
parse var tdevtyp . ddevtyp
ddevtyp=strip(ddevtyp)
ttrkspercyl=translate(trkspercyl,' ','-')
parse var ttrkspercyl . dtrkspercyl
dtrkspercyl=right(strip(dtrkspercyl),2)
tcylspervol=translate(cylspervol,' ','-')
parse var tcylspervol . dcylspervol
dcylspervol=right(strip(dcylspervol),5)
vs.v.bpt=dbytespertrk
vs.v.dtyp=ddevtyp
vs.v.tpc=dtrkspercyl
vs.v.cpv=dcylspervol
ds=0
do until word1='DATASPACE'
  call get_next_line
  end
do until word1='CLUSTER' | word1='AIX' | word1='VOLUME'
  call get_next_line
  if word1='EXTENT-DESCRIPTOR:' then do
    ds=ds+1
    call get_next_line
    parse var lst.i trackstotal begcylhd .
    ttrackstotal=translate(trackstotal,' ','-')
    parse var ttrackstotal . . dtrackstotal
    dtrackstotal=right(strip(dtrackstotal),6)
    tbegcylhd=translate(begcylhd,' ','-')
    parse var tbegcylhd . "X'" cylhd "'" .
    cyl=left(cylhd,4)
    head=right(cylhd,4)
    do until left(word1,6)='TRACKS'
      call get_next_line
      end
    parse var lst.i tracksused .
    ttracksused=translate(tracksused,' ','-')
    parse var ttracksused . . dtracksused
    dtracksused=right(strip(dtracksused),6)
    vs.v.ds.trktot=dtrackstotal
    vs.v.ds.begcyl=cyl
    vs.v.ds.beghd=head
    vs.v.ds.trkusd=dtracksused
    end
  end
/* If we hit a CLUSTER, AIX or VOLUME back up 1 line so that the      */
/* component can be processed correctly.                              */
vs.v.0=ds
i=i-1
return
 
get_stats: procedure expose i lst. dkeylen davgrecl dbufspace dcisize ,
                            drkp dmaxrecl dexcpexit dciperca dtotrecs ,
                            dcisplits drecsdel dcasplits dext drecins ,
                            dfspci drecsupd dfspca drecsret dvolser   ,
                            ddevtyp dsptype dharba dhurba word1 dsppri ,
                            dspsec dil tsday tstime comp_type compress
do until word1='ATTRIBUTES'
  call get_next_line
  end
call get_next_line
parse var lst.i keylen  avgrecl bufspace cisize .
call get_next_line
parse var lst.i rkp     maxrecl excpexit ciperca .
tkeylen=translate(keylen,' ','-')
parse var tkeylen . dkeylen
dkeylen=right(strip(dkeylen),4)
tavgrecl=translate(avgrecl,' ','-')
parse var tavgrecl . davgrecl
davgrecl=right(strip(davgrecl),5)
tbufspace=translate(bufspace,' ','-')
parse var tbufspace . dbufspace
dbufspace=right(strip(dbufspace),6)
tcisize=translate(cisize,' ','-')
parse var tcisize . dcisize
dcisize=right(strip(dcisize),5)
trkp=translate(rkp,' ','-')
parse var trkp . drkp
drkp=right(strip(drkp),4)
tmaxrecl=translate(maxrecl,' ','-')
parse var tmaxrecl . dmaxrecl
dmaxrecl=right(strip(dmaxrecl),5)
texcpexit=translate(excpexit,' ','-')
parse var texcpexit . dexcpexit
dexcpexit=right(strip(dexcpexit),8)
tciperca=translate(ciperca,' ','-')
parse var tciperca . dciperca
dciperca=right(strip(dciperca),4)
do until word1='STATISTICS'
  call get_next_line
  if word1='STATISTICS' then
    leave
  else
    if wordpos('COMPRESSED',lst.i)>0 then do
      compress=1
      end
  end
call get_next_line
parse var lst.i totrecs cisplits .
call get_next_line
parse var lst.i recsdel casplits ext il .
call get_next_line
parse var lst.i recsins fspci .
call get_next_line
parse var lst.i recsupd fspca tsday tstime .
call get_next_line
parse var lst.i recsret .
ttotrecs=translate(totrecs,' ','-')
parse var ttotrecs . . dtotrecs
dtotrecs=right(strip(dtotrecs),8)
tcisplits=translate(cisplits,' ','-')
parse var tcisplits . . dcisplits
dcisplits=right(strip(dcisplits),5)
trecsdel=translate(recsdel,' ','-')
parse var trecsdel . . drecsdel
drecsdel=right(strip(drecsdel),8)
tcasplits=translate(casplits,' ','-')
parse var tcasplits . . dcasplits
dcasplits=right(strip(dcasplits),4)
text=translate(ext,' ','-')
parse var text . dext
dext=right(strip(dext),3)
til=translate(il,' ','-')
parse var til . dil
dil=right(strip(dil),1)
trecins=translate(recsins,' ','-')
parse var trecins . . drecins
drecins=right(strip(drecins),8)
tfspci=translate(fspci,' ','-')
parse var tfspci . . dfspci
dfspci=right(strip(dfspci),3)
trecsupd=translate(recsupd,' ','-')
parse var trecsupd . . drecsupd
drecsupd=right(strip(drecsupd),8)
tfspca=translate(fspca,' ','-')
parse var tfspca . . dfspca
dfspca=right(strip(dfspca),3)
trecsret=translate(recsret,' ','-')
parse var trecsret . . drecsret
drecsret=right(strip(drecsret),8)
do until word1='ALLOCATION'
  call get_next_line
  end
call get_next_line
parse var lst.i sptype  .
call get_next_line
parse var lst.i sppri   . harba
call get_next_line
parse var lst.i spsec   . hurba
tsptype=translate(sptype,' ','-')
parse var tsptype . . dsptype
dsptype=strip(dsptype)
tharba=translate(harba,' ','-')
parse var tharba . . . dharba
dharba=strip(dharba)
thurba=translate(hurba,' ','-')
parse var thurba . . . dhurba
dhurba=strip(dhurba)
tsppri=translate(sppri,' ','-')
parse var tsppri . . dsppri
dsppri=right(strip(dsppri),4)
tspsec=translate(spsec,' ','-')
parse var tspsec . . dspsec
dspsec=right(strip(dspsec),4)
do until word1='VOLUME'
  call get_next_line
  end
call get_next_line
parse var lst.i volser  .
call get_next_line
parse var lst.i devtyp  .
tvolser=translate(volser,' ','-')
parse var tvolser . dvolser
dvolser=strip(dvolser)
tdevtyp=translate(devtyp,' ','-')
parse var tdevtyp . ddevtyp
ddevtyp=strip(ddevtyp)
return
 
write_volume_summary: procedure expose pc lc vs. v catname
pc=pc+1
head.1='1'||center('REXX LSTCAT',112)||'Page 'pc
head.2=center(catname,114)
head.3=center('Volume Summary',114)
head.4=' '
head.5=' Volumes                                           Dataspaces'
head.6=' Volid   Dev Type  Bytes/Trk  Trks/Cyl  Cyls/Vol   Trks/Total' ,
'  Trks/Used  Pct  Beg Cyl/Hd  Beg Trk'
'execio 6 diskw syslst (cc stem head.'
lc=6
do w=1 to vs.0
  line.1=' '||vs.w.volume||'      '||vs.w.dtyp||'      '||vs.w.bpt|| ,
         '        '||vs.w.tpc||'     '||vs.w.cpv
  call write_line
  do e=1 to vs.w.0
    if vs.w.e.trkusd=0 then
      pctusd=0
    else
      pctusd=(1/(vs.w.e.trktot/vs.w.e.trkusd))*100
    pctusd=format(pctusd,3,0)
    dcyl=format(x2d(vs.w.e.begcyl),5,0)
    dhd=format(x2d(vs.w.e.beghd),2,0)
    strk=format(((dcyl*15)+dhd),6,0)
    line.1='                                                       '|| ,
           vs.w.e.trktot||'      '||vs.w.e.trkusd||'  '||pctusd||      ,
           '    '||dcyl||'/'||dhd||'   '||strk
    call write_line
    end
  end
return
 
get_next_line: procedure expose lst. i eof word1 word2
i=i+1
/* say lst.i  */
parse var lst.i word1 word2 .
if word1='IDCAMS' | word1='LISTING' | word1='' then do
  do until word1<>'IDCAMS' & word1<>'LISTING' & word1<>''
    i=i+1
    parse var lst.i word1 word2 .
    end
  end
if word1='THE' & word2='NUMBER' then do  /* Check for end of LSTCAT */
  eof=1
  end
return
 
print_heading: procedure expose catname pc lc
pc=pc+1
head.1='1'||center('REXX LSTCAT',112)||'Page 'pc
head.2=center(catname,114)
head.3=' '
head.4='     Recs     Recs     Recs     Recs    Number ..Key..',
'   ..Recl...   .Splits.  Freesp   CI          ..Alloc..  Pct     I'
head.5='     Retr      Del      Ins      Upd     Recs  Len Pos    Avg',
'  Max    CI / CA   CI/CA  Size  Volid   Pri/Sec   Usd Ext L'
head.6=' '
'execio 6 diskw syslst (cc stem head.'
lc=6
return
 
write_line: procedure expose pc lc line. catname
'execio 1 diskw syslst (cc stem line.'
lc=lc+1
if lc>60 then
  call print_heading
return
 
error_out:
exit