rexx comment /* REXX FLTTBL Cloned from DUMPTBL 960619 to produce a flat rexx comment version (up to 32K characters wide) of any ISPF rexx comment table. rexx blank rexx comment Written by Frank Clarke, Oldsmar, FL rexx blank rexx comment Impact Analysis rexx comment . SYSPROC LA rexx comment . SYSPROC TRAPOUT rexx blank rexx comment Modification History rexx comment 19960918 fxc added some error-checking rexx comment 19970115 fxc upgrade REXXSKEL from v.960606 to v.970113; add rexx comment RESTARTability; rexx comment 19991231 fxc upgrade REXXSKEL from v.970113 to v.19991109; rexx comment RXSKLY2K; DECOMM; LRECL reduced from 32K to "min rexx comment needed"; rexx blank rexx code */ arg argline rexx code address TSO /* REXXSKEL ver.19991109 */ rexx code arg parms "((" opts rexx blank rexx code signal on syntax rexx code signal on novalue rexx blank rexx code call TOOLKIT_INIT /* conventional start-up -*/ rexx code rc = Trace(tv) rexx code info = parms /* to enable parsing */ rexx blank rexx code if \sw.inispf then do rexx code arg line rexx code line = line "(( RESTARTED" /* tell the next invocation */ rexx code "ISPSTART CMD("exec_name line")" /* Invoke ISPF if nec. */ rexx code exit /* ...and restart it */ rexx code end rexx blank rexx code call A_INIT /* -*/ rexx blank rexx code "NEWSTACK" rexx code if \sw.0error_found then, rexx code call C_TABLE_OPS /* -*/ rexx code if \sw.0error_found then, rexx code call D_PUMP_TBL /* -*/ rexx blank rexx code "DELSTACK" rexx blank rexx code if sw.restarted then do rexx code rc = OutTrap("ll.") rexx code exit 4 rexx code end rexx blank rexx code exit /*@ FLTTBL */ rexx comment /* rexx comment . ----------------------------------------------------------------- */ rexx code A_INIT: /*@ */ rexx code if branch then call BRANCH rexx code address TSO rexx blank rexx code call AA_KEYWDS /* -*/ rexx code parse var info $tn$ . /* table-name required */ rexx code if $tn$ = "" then do rexx code helpmsg = "Tablename is required." rexx code call HELP rexx code end rexx blank rexx code parse value outdsn "FLATTBLS."$tn$ with, rexx code outdsn . rexx blank rexx code xefef = "efef"x rexx code if tblds = "" then do rexx code call AB_FIND_LIBRARY /* -*/ rexx code if tblds = "" then do rexx code helpmsg = "Table" $tn$ "was not found in ISPTLIB. Please", rexx code "restart specifying a library name as shown below." rexx code call HELP /* ...and don't come back */ rexx code end rexx code end rexx code else, rexx code if Left(tblds,1) = "'" then tblds = Strip(tblds,,"'") rexx code else tblds = Userid()"."tblds rexx blank rexx code return /*@ A_INIT */ rexx comment /* rexx comment . ----------------------------------------------------------------- */ rexx code AA_KEYWDS: /*@ */ rexx code if branch then call BRANCH rexx code address TSO rexx blank rexx code tblds = KEYWD("IN") rexx code outdsn = KEYWD("OUTPUT") rexx code sortseq = KEYWD("SORT") rexx code sw.0purge = SWITCH("DELETEBEHIND") rexx blank rexx code parse value KEYWD("ADD") "0" with bytes_to_add . rexx blank rexx code return /*@ AA_KEYWDS */ rexx comment /* rexx comment was not specified. Locate the table in ISPTLIB. rexx comment . ----------------------------------------------------------------- */ rexx code AB_FIND_LIBRARY: /*@ */ rexx code if branch then call BRANCH rexx code address TSO rexx blank rexx code "NEWSTACK" rexx code "LA ISPTLIB ((STACK LINE" rexx code pull tliblist rexx code "DELSTACK" rexx blank rexx code do Words(tliblist) /* each library */ rexx code parse var tliblist tblds tliblist rexx code if Sysdsn("'"tblds"("$tn$")'") = "OK" then return rexx code end /* tliblist */ rexx code tblds = "" rexx blank rexx code return /*@ AB_FIND_LIBRARY */ rexx comment /* rexx comment . ----------------------------------------------------------------- */ rexx code C_TABLE_OPS: /*@ */ rexx code if branch then call BRANCH rexx code address ISPEXEC rexx blank rexx code call CA_OPEN_TBL /* -*/ rexx code call CS_SPIN_TBL /* -*/ rexx code call CZ_DROP_TBL /* -*/ rexx blank rexx code return /*@ C_TABLE_OPS */ rexx comment /* rexx comment . ----------------------------------------------------------------- */ rexx code CA_OPEN_TBL: /*@ */ rexx code if branch then call BRANCH rexx code address ISPEXEC rexx blank rexx code "LIBDEF ISPTLIB DATASET ID('"tblds"') STACK" rexx code "TBSTATS" $tn$ "STATUS1(s1) STATUS2(s2) ROWCURR(rowct)" rexx code if s1 > 1 then do rexx code say "Table" $tn$ "not available." rexx code sw.0error_found = "1"; return rexx code end; else, rexx code if s2 = 1 then, /* not open */ rexx code "TBOPEN " $tn$ "NOWRITE" rexx code else "TBTOP" $tn$ rexx code "LIBDEF ISPTLIB" rexx code if sw.0error_found then return rexx code "TBQUERY" $tn$ "KEYS(keylist)", rexx code "NAMES(nmlist)" rexx code parse var keylist "(" keylist ")" rexx code parse var nmlist "(" nmlist ")" rexx code namelist = keylist nmlist rexx blank rexx code if sortseq <> "" then "TBSORT" $tn$ "FIELDS("sortseq")" rexx blank rexx code return /*@ CA_OPEN_TBL */ rexx comment /* rexx comment . Given: contains all the defined names for this table. rexx comment The table has been TOPped. rexx comment . ----------------------------------------------------------------- */ rexx code CS_SPIN_TBL: Procedure expose, /*@ hide everything */ rexx code expose (tk_globalvars), /* except these */ rexx code $tn$ namelist xefef tblds rows keylist nmlist maxlen rexx code cs_tv = Trace() rexx code if branch then call BRANCH rexx code address ISPEXEC rexx blank rexx code maxlen = 0 /* maximum line length */ rexx code do forever rexx code "TBSKIP" $tn$ "SAVENAME(xvars)" rexx code if rc > 0 then leave /* we're done... */ rexx code line = "" /* set empty */ rexx comment /* add blocks of "var .. varvalue .." */ rexx code do cx = 1 to Words(namelist) rexx code thiswd = Word(namelist,cx) rexx code line = line thiswd xefef Value(thiswd) xefef rexx code end /* cx */ rexx code rc = Trace("O"); rc = Trace(cs_tv) rexx code parse var xvars "(" xvars ")" rexx comment /* add a block of "XVARS .. xvarlist .." */ rexx code line = line "XVARS" xefef xvars xefef rexx comment /* add blocks of "xvar .. xvarvalue .." */ rexx code do cx = 1 to Words(xvars) rexx code thiswd = Word(xvars,cx) rexx code line = line thiswd xefef Value(thiswd) xefef rexx code end /* cx */ rexx code rc = Trace("O"); rc = Trace(cs_tv) rexx code maxlen = Max(maxlen,Length(line)) rexx code queue line rexx code end /* forever */ rexx blank rexx code lines_in_stack = queued() rexx code line = "Contents of" $tn$ "in" tblds, rexx code "("lines_in_stack" rows) KEYS("keylist") NAMES("nmlist")." rexx code push line /* make it the first line */ rexx code maxlen = Max(maxlen,Length(line)) rexx code if monitor then say "Maximum line length is" maxlen rexx blank rexx code return /*@ CS_SPIN_TBL */ rexx comment /* rexx comment . ----------------------------------------------------------------- */ rexx code CZ_DROP_TBL: /*@ */ rexx code if branch then call BRANCH rexx code address ISPEXEC rexx blank rexx code if s2 = 1 then, /* table was not open at start*/ rexx code "TBEND" $tn$ rexx blank rexx code return /*@ CZ_DROP_TBL */ rexx comment /* rexx comment . ----------------------------------------------------------------- */ rexx code D_PUMP_TBL: /*@ */ rexx code if branch then call BRANCH rexx code address TSO rexx blank rexx code if monitor then say, rexx code "Writing text." rexx blank rexx code maxlen = maxlen + 4 + bytes_to_add /* set LRECL */ rexx code vbmax.0 = "NEW CATALOG UNIT(SYSDA) SPACE(1 5) TRACKS", rexx code "RECFM(V B) LRECL("maxlen") BLKSIZE(0)" rexx code vbmax.1 = "SHR" /* if it already exists... */ rexx blank rexx code tempstat = Sysdsn(outdsn) = "OK" /* 1=exists, 0=missing */ rexx code "ALLOC FI($TMP) DA("outdsn") REU" vbmax.tempstat rexx code rcx = rc rexx code "EXECIO" queued() "DISKW $TMP (FINIS" rexx code rcx = max(rcx,rc) rexx code "FREE FI($TMP)" rexx blank rexx code if rcx = 0 & sw.0purge then do rexx code address ISPEXEC rexx code "LIBDEF ISPTLIB DATASET ID('"tblds"') STACK" rexx code "TBERASE" $tn$ rexx code if rc = 0 then say $tn$ "was deleted" rexx code "LIBDEF ISPTLIB" rexx code end rexx blank rexx code return /*@ D_PUMP_TBL */ rexx comment /* rexx comment . ----------------------------------------------------------------- */ rexx code LOCAL_PREINIT: /*@ customize opts */ rexx code if branch then call BRANCH rexx code address TSO rexx blank rexx blank rexx code return /*@ LOCAL_PREINIT */ rexx comment /* rexx comment . ----------------------------------------------------------------- */ rexx code HELP: /*@ */ rexx code address TSO;"CLEAR" rexx code if helpmsg <> "" then do ; say helpmsg; say ""; end rexx code ex_nam = Left(exec_name,8) /* predictable size */ rexx code say " "ex_nam" produces a flattened version of any ISPF table " rexx code say " into a VB-form dataset of minimum necessary LRECL." rexx code say " " rexx code say " The field contents are written in KEYPHRS format " rexx code say " (var .. varval ..) " rexx code say " key-fields first, followed by name-fields, followed by the " rexx code say " names of any extension variables key-phrased by 'XVARS', " rexx code say " followed by the extension variables themselves in KEYPHRS " rexx code say " format. " rexx code say " " rexx code say " The first record on the file identifies the table name, the " rexx code say " source library, the number of rows processed, and the key- and " rexx code say " name-fields. " rexx code say " " rexx code say " more.... " rexx code pull rexx code "CLEAR" rexx code say " Syntax: "ex_nam" (Required)" rexx code say " " rexx code say " (Defaults)" rexx code say " " rexx code say " (Defaults)" rexx code say " " rexx code say " identifies the table to be dumped. " rexx code say " " rexx code say " identifies the ISPF Table library which holds ." rexx code say " If is not specified, ISPTLIB will be " rexx code say " searched to find the correct dataset. " rexx code say " " rexx code say " (default: FLATTBLS.) names the output file. " rexx code say " will be created if it does not exist. " rexx code say " " rexx code say " causes the table to be sorted as indicated before " rexx code say " being dumped. " rexx code say " " rexx code say " (default=0) causes the LRECL of the output dataset " rexx code say " to be extended to enable updating. " rexx code pull rexx code "CLEAR" rexx code say " Debugging tools provided include: " rexx code say " " rexx code say " MONITOR: displays key information throughout processing. " rexx code say " Displays most paragraph names upon entry. " rexx code say " " rexx code say " NOUPDT: by-pass all update logic. " rexx code say " " rexx code say " BRANCH: show all paragraph entries. " rexx code say " " rexx code say " TRACE tv: will use value following TRACE to place the " rexx code say " execution in REXX TRACE Mode. " rexx code say " " rexx code say " " rexx code say " Debugging tools can be accessed in the following manner: " rexx code say " " rexx code say " TSO "ex_nam" parameters (( debug-options " rexx code say " " rexx code say " For example: " rexx code say " " rexx code say " TSO "ex_nam" vt2231 add 17 (( MONITOR TRACE ?R " rexx code address ISPEXEC "CONTROL DISPLAY REFRESH" rexx code exit /*@ HELP */ rexx comment /* REXXSKEL back-end removed for space */