©
ray e.kohring jr.@newsgroup
The program may be used to display any table.
/* REXX * DUMPTAB
You can use any method that will work to display the contents of an
arbitrary ISPF table (or even write a quicky dialog to do it, since
this table has a defined format). Option 7.4 can be used to display a
row at a time. Or, feel free to use the following EXEC I wrote (basic
form back in '85).
Ray Kohring FSW Application Tools
Loral Space Information Sys
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
arg tablname opts
address ISPEXEC
if tablname = ' ' ! tablname = '?'
then do
say " ISPF Table Dumping Utility"
say " "
say "%DUMPTAB tablename options - TBOPEN keywords Y"
say " tablename member - name of table in ISPTLIB, or of"
say " LIBRARY(ddname) if specified"
say " dataset.name(member) - with or w/o quotes"
say " options OPEN - table is already open"
say " NOFORMAT - lists without trying to maintain"
say " columns"
say " TBOPEN keywords - any valid keyword for TBOPEN"
say " "
exit
end
if opts = 'NOFORMAT'
then do
fmt = 0
opts = ''
end
else fmt = 1
i = index(tablname,'(')
if i > 0
then do
parse var tablname dsn'('tablname')'.
if substr(dsn,1,1) = "'"
then dsn = dsn"'"
"LIBDEF TABLDUMP DATASET ID("dsn")"
if rc > 0
then do
say "LIBDEF failed, RC="rc
exit
end
opts = opts "LIBRARY(TABLDUMP)"
end
else dsn = ""
if opts = 'OPEN'
then do
"CONTROL ERRORS RETURN"
"TBQUERY" tablname "KEYS(KEYS) NAMES(NAMES) POSITION(ROWNUM)"
open rc = rc
"CONTROL ERRORS CANCEL"
if open rc > 0
then do
say "Table not Open - RC="open rc
exit
end
"TBTOP" tablname
end
else do
"CONTROL ERRORS RETURN"
"TBOPEN" tablname "NOWRITE" opts
open rc = rc
/* "CONTROL ERRORS CANCEL" */
if open rc > 0
then do
say "Open failed - RC="open rc
exit
end
"TBQUERY" tablname "KEYS(KEYS) NAMES(NAMES)"
rownum = 0
end
if length(keys)>2
then keys = substr(keys,2,length(keys)-2)
if length(names)>2
then names = substr(names,2,length(names)-2)
vars = strip(keys names)
numvars = words(vars)
if fmt
then do
do i = 1 to numvars
len.i = wordlength(vars,i)
end
"TBSKIP" tablname
do while rc = 0
do i = 1 to numvars
l = length(value( subword(vars,i,1) ))
len.i = max( l, len.i )
end
"TBSKIP" tablname
end
num_lines = 1
trace ?a
line.1 = "say left("subword(vars,1,1)","len.1")"
head.1 = left(subword(vars,1,1),len.1)
tlen = len.1
do i = 2 to numvars
if tlen + len.i > 76
then do
num_lines = num_lines + 1
line.num_lines = "say ' ' left("subword(vars,i,1)","len.i")"
head.num_lines = " " left(subword(vars,i,1),len.i)
tlen = len.i + 5
end
else do
line.num_lines = line.num_lines "left("subword(vars,i,1)","len.i")"
head.num_lines = head.num_lines left(subword(vars,i,1),len.i)
tlen = tlen + len.i + 1
end
end
do i = 1 to num_lines
say head.i
end
say
end
else say vars
"TBTOP" tablname
"TBSKIP" tablname "SAVENAME(SVARS)"
do while rc = 0
if fmt
then do
do i = 1 to num_lines
interpret line.i
end
end
else do
tline = " "
do i = 1 to numvars
entry = value(subword(vars,i,1))
if length(tline) + length(entry) > 76
then do
if length(tline)>0 then say tline
tline = ' ' entry
end
else tline = tline entry
end
say tline
end
if length(svars)>2
then do
svars = substr(svars,2,length(svars)-2)
tline = " "
do i = 1 to words(svars)
entry = subword(svars,i,1)"='"value(subword(svars,i,1))"'"
if length(tline) + length(entry) > 60
then do
if length(tline)>0 then say ' ' tline
tline = entry
end
else tline = tline entry
end
say ' ' tline
end
"TBSKIP" tablname "SAVENAME(SVARS)"
end
if opts = 'OPEN'
then do
"TBTOP" tablname
if rownum > 0
then "TBSKIP" tablname "NUMBER("rownum")"
end
else "TBEND" tablname
if dsn <> ""
then "LIBDEF TABLDUMP"
back to REXX with ISPF