/*Rexx routine to read a pds directory and show the ispf stats     */
/*     non load module only.                                       */
/* Author: Doug Nadel - 3/31/2001 */
Parse Upper Arg dsname .
If 0<>listdsi(dsname) Then
  Do
    Say 'Data set 'dsname' not allocated'
    Exit
  End
If 'PO'<>substr(sysdsorg,1,2) Then
  Do
    Say 'Data set 'dsname' is not a pds'
    Exit
  End
Address tso
'ALLOC F(AREAD) DS('dsname') SHR REUSE DSORG(PS) LRECL(256) RECFM(F B)'
'EXECIO * DISKR AREAD ( FINIS STEM DIRS.'
'FREE F(AREAD)'
Do blocknum = 1 to dirs.0
  block=dirs.blocknum
  Parse Var dirs.blocknum bl 3 block
  block=substr(block,1,c2d(bl)-2)
  Do While block<>''
    Parse Var block name 9 ttr 12 c 13 block
    c=c2d(bitand(c,'1f'x))
    If name='FFFFFFFFFFFFFFFF'x Then
      Leave blocknum
    stats=''
    If c=15 & sysrecfm \= 'U' Then
      stats=decodestats(substr(block,1,30))
    Say name stats
    block=delstr(block,1,c*2)
  End
End
Exit
decodestats:  Procedure  /* decode the directory */
direntry=Arg(1)
  Parse Var direntry,
    vv 2 mm 3 flags 4 ss 5 crecc 6 crdate 9 modcc 10 moddate 13 hh,
    14 tm 15 lines 17 init 19 mod 21 userid 28 .
  Parse Value c2x(crdate)  with cyy 3 cjjj 6 .
  Parse Value c2x(moddate) with myy 3 mjjj 6 .
  out=leftd(vv)'.'leftd(mm)                       /* Vv.Mm         */
  out=out 19+c2x(crecc)cyy'.'cjjj                 /* Create date   */
  out=out 19+c2x(modcc)myy'.'mjjj                 /* Mod date      */
  out=out leftx(hh)':'leftx(tm)':'leftx(ss)       /* mod time      */
  out=out right(c2d(lines),5)                     /* Lines         */
  out=out right(c2d(init),5)                      /* Initial lines */
  out=out right(c2d(mod),5)                       /* Mod lines     */
  out=out userid                                  /* User id       */
  If bitand(flags,'80'x) = '80'x Then
    out=out '(SCLM)'                              /* Saved by SCLM */
  Return out
leftd: return right(c2d(arg(1)),2,'0')
leftx: return right(c2x(arg(1)),2,'0')