© 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