/*                                                         REXX
 List all active ispf in-storage command tables.
*/

 parse value copies('0 ',30) with $edit $all lst.0 .
 parse value '' with tables

 address ispexec
 "control errors return"
 "vget zscrmaxw"
 width=zscrmaxw
 awidth=(width-19)%2
 tliblist=ListTlibs()

 "qtabopen list(qtol.)"

 do qtoln=1 to qtol.0
   tblname=strip(qtol.qtoln)
   if right(tblname,4)<>'CMDS' then iterate
   tables=tables tblname
   Call AddList '-->' tblname LocDsn(tliblist,tblname)
   Call AddList ''

   'tbquery' tblname 'rownum(rows)'
   if rc<>0 then do
     Call AddList '*Table is probably libdef''d in another screen'
     Call AddList ''
     iterate
   end
   tblid = left(tblname,length(tblname)-4)
   zerrlm=''
   'tbtop' tblname
   do rows
     'tbskip' tblname
     Call AddList  left(zctverb,8) left(tblid,4),
       left(zcttrunc,3) left(zctact,awidth) left(zctdesc,awidth)
   end
   Call AddList ''
 end
 call Xispmsg 'Tables listed:' space(tables)

 address tso
 Signal on syntax name AltDisplay
 call StemEdit 'VIEW','lst.',,lst.0,cmd,,width+14
 exit 0

AltDisplay: /* used if pgm STEMEDIT is not installed */
 cc=bpxwdyn('alloc new delete rtddn(lstdd) unit(vio) dsorg(ps)',
    'lrecl('width+14') recfm(v,b) blksize(0) tracks space(1,4)')
 if cc<>0 then exit xmsg("alloc failed" cc)+12

 "execio" lst.0 "diskw" lstdd "(stem lst. finis"
 address ispexec  "lminit dataid(did1) ddname("lstdd")"
 address ispexec  "view dataid("did1")"
 exit Bpxwdyn("free dd("lstdd")")*0

AddList: Procedure expose lst.
 parse value 1+lst.0 1+lst.0 arg(1) with n lst.0 lst.n
 return 0

XMsg: if arg(1)<>'' then say arg(1);return word(arg(2) 0,1)
XISPMSG:
 parse arg zedlmsg
 address ispexec"setmsg msg(isrz000)"
 return 0

LocDsn: Procedure
 trace off
 arg list ,mbr .
 do n=1 to words(list)
   dsn=word(list,n)
   if sysdsn("'"dsn"("mbr")'")='OK' then return 'in' dsn
 end
 return 'library not located'

ListTlibs: Procedure /* locate mbrname in library */
 trace off
 parse value '' with qpl qbl qll ltype
 address ispexec
 "qbaselib ISPPROF id(qpl)"
 "qbaselib ISPTLIB id(qbl)"
 "qlibdef  ISPTLIB id(qll) type(ltype)"
 if ltype='LIBRARY' then "qbaselib" qll "id(qll)"
 rtn=space(translate(qpl qll qbl," ","',"))
 do n=words(rtn) to 1 by -1
   w=word(rtn,n)
   if left(w,3)='SYS' & substr(w,9,2)='.T' then rtn=delword(rtn,n,1)
 end
 return rtn