/* REXX TBLMSTR Master Table Maintenance: This table maintenance routine handles changes to the AAMSTR table. |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| | | | WARNING: EMBEDDED COMPONENTS. | | See text following TOOLKIT_INIT | | | |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| Written by Frank Clarke, Richmond, 19990716 rexxhead@yahoo.com Impact Analysis . SYSPROC DFLTTLIB . SYSPROC FCCMDUPD . SYSPROC SYSUMON . SYSPROC TRAPOUT . SYSPROC LA . ISPPLIB AASEL (Imbed) . ISPPLIB AADAT (Imbed) . ISPTLIB AAMSTR Modification History 19991129 fxc upgrade from v.19980225 to v.19991109; new DEIMBED; 20011002 fxc fixed scroll-amt field; 20020423 fxc allow multiple selections; auto-install; 20020904 fxc dont start command name with # 20040721 fxc compress fields; 20040723 fxc widescreen version; 20050413 fxc repair TBADD logic; 20210403 fxc add NEWROW; REXXSKEL v.20210402 */ arg argline address TSO /* REXXSKEL ver.20210402 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = Trace("O"); rc = trace(tv) info = parms /* to enable parsing */ call A_INIT /* -*/ call B_TABLE_OPS /* -*/ if \sw.nested then call DUMP_QUEUE /* -*/ exit /*@ TBLMSTR */ /* Initialize all variables . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO "SYSUMON USER" Userid() "TOOL" exec_name call AA_KEYWDS /* -*/ parse value " " with, pnl. pnl.select = "AASEL" /* Selection panel */ pnl.datent = "AADAT" /* Data Entry panel */ openmode.0 = "WRITE" /* based on NOUPDT */ openmode.1 = "NOWRITE" return /*@ A_INIT */ /* Extract parameters /* */ . ----------------------------------------------------------------- */ AA_KEYWDS: /*@ */ if branch then call BRANCH address TSO return /*@ AA_KEYWDS */ /* Acquire data via panels. . ----------------------------------------------------------------- */ B_TABLE_OPS: /*@ */ if branch then call BRANCH address ISPEXEC "CONTROL ERRORS RETURN" /* I'll handle my own */ call BA_OPEN /* -*/ if \sw.0error_found then, call BD_DISPLAY /* -*/ call BZ_CLOSE /* -*/ return /*@ B_TABLE_OPS */ /* Open the table; initialize as necessary. . ----------------------------------------------------------------- */ BA_OPEN: /*@ */ if branch then call BRANCH address ISPEXEC "LIBDEF ISPTLIB DATASET ID("isptlib") STACK" "TBSTATS" $tn$ "STATUS1(s1) STATUS2(s2)" if s1 > 1 then do /* table not found */ call BAA_INIT_MSTR /* Build a new AAMSTR table -*/ end; else, if s2 = 1 then do "TBOPEN " $tn$ openmode.noupdt end else "TBTOP" $tn$ if sw.0LoadNew then, call BAQ_LOAD_ROW /* -*/ "LIBDEF ISPTLIB" return /*@ BA_OPEN */ /* TBCREATE the AAMSTR table and TBADD the first entry. . ----------------------------------------------------------------- */ BAA_INIT_MSTR: /*@ */ if branch then call BRANCH address ISPEXEC "TBCREATE" $tn$ "KEYS(AATBLID)", "NAMES(AATBLNM AAKEYS AANAMES AASORT AADESC AALIBR)", openmode.noupdt aatblid = "AA" /* ID for AAMSTR */ aatblnm = "AAMSTR" /* its name */ aakeys = "AATBLID" /* the only key field */ aanames = "AATBLNM AAKEYS AANAMES AASORT AADESC AALIBR" aasort = "AATBLID,C,A" /* how it's sorted */ aadesc = "Master Table" /* how it's described */ "TBADD" $tn$ /* load these values */ sw.0table_changed = "1" /* mark it 'changed' */ return /*@ BAA_INIT_MSTR */ /* The queue has been loaded by an external caller with values to be inserted onto a new AAMSTR row. Read the queue, load values, and TBADD. . ----------------------------------------------------------------- */ BAQ_LOAD_ROW: /*@ */ if branch then call BRANCH address ISPEXEC checklist = " AATBLID AATBLNM AAKEYS AANAMES AASORT AADESC AALIBR" do queued() /* every line */ parse pull tag tagval tagval = Strip(tagval) /* compress */ if tag <> "AADESC" then upper tagval zz = Value(tag,tagval) pt = WordPos(tag,checklist) if pt > 0 then , checklist = DelWord(checklist,pt,1) end /* queued */ "TBADD" $tn$ /* load these values */ sw.0table_changed = "1" /* mark it 'changed' */ if checklist = "" then return /* we're done */ zerrsm = "Row not fully set" zerrlm = "The following tags were not populated:", Space(checklist,1)". The row may not be usable." address ISPEXEC "SETMSG MSG(ISRZ002)" return /*@ BAQ_LOAD_ROW */ /* Main table processing: display table, handle updates. . ----------------------------------------------------------------- */ BD_DISPLAY: /*@ */ if branch then call BRANCH address ISPEXEC call BDA_PROLOG /* extract/setup panels -*/ do forever "TBDISPL" $tn$ "PANEL("pnl.select")" /* show selection panel */ if rc > 4 then leave /* PF3 ? */ do ztdsels "CONTROL DISPLAY SAVE" select when Wordpos(action,"B") > 0 then do call BDB_BROWSE /* -*/ end when Wordpos(action,"E U") > 0 then do call BDC_CHANGE /* -*/ end when Wordpos(action,"D") > 0 then do call BDD_DELETE /* -*/ end when Wordpos(action,"I") > 0 then do call BDI_INSERT /* -*/ end otherwise nop end /* Select */ "CONTROL DISPLAY RESTORE" if ztdsels = 1 then, /* never do the last one */ ztdsels = 0 else "TBDISPL" $tn$ /* next row */ end /* ztdsels */ action = '' /* clear for re-display */ end /* forever */ call BDZ_EPILOG /* drop LIBDEFs */ return /*@ BD_DISPLAY */ /* . ----------------------------------------------------------------- */ BDA_PROLOG: /*@ */ if branch then call BRANCH address ISPEXEC call DEIMBED /* -*/ dd = "" do Words(ddnlist) /* each LIBDEF DD */ parse value ddnlist dd with dd ddnlist $ddn = $ddn.dd /* PLIB322 <- PLIB */ "LIBDEF ISP"dd "LIBRARY ID("$ddn") STACK" end ddnlist = ddnlist dd return /*@ BDA_PROLOG */ /* Display the row data. Do not store changes. . ----------------------------------------------------------------- */ BDB_BROWSE: /*@ */ if branch then call BRANCH address ISPEXEC io = "OUTPUT" /* attribute for AATBLID */ zerrsm = "Changes disallowed" zerrlm = "You selected BROWSE. To make changes, go back and", "select EDIT or UPDATE." "SETMSG MSG(ISRZ002)" do forever /* */ "DISPLAY PANEL("pnl.datent")" if rc > 0 then leave end /* forever */ return /*@ BDB_BROWSE */ /* Display the data for this row; accept updates. . ----------------------------------------------------------------- */ BDC_CHANGE: /*@ */ if branch then call BRANCH address ISPEXEC io = "OUTPUT" /* attribute for AATBLID */ do forever /* */ "DISPLAY PANEL("pnl.datent")" if rc > 0 then leave end /* forever */ call BDX_COMPRESS /* -*/ if Left( aalibr,1 ) = "'" then, /* quoted */ aalibr = Strip( aalibr,,"'" ) /* unquoted */ if rc = 8 then "TBMOD" $tn$ /* insert changes */ else do /* DISPLAY failed ? */ zerrlm = exec_name "("BRANCH("ID")")", zerrlm "SETMSG MSG(ISRZ002)" drop zerrlm /* make it a LIT again */ sw.0error_found = "1"; return end /* check the results of the TBMOD */ if rc > 0 then do zerrsm = "Update failed for AATBLID" aatblid"." if Symbol("zerrlm") = "LIT" then, zerrlm = "No additional diagnostics produced." zerrlm = exec_name "("BRANCH("ID")")", zerrlm "SETMSG MSG(ISRZ002)" drop zerrlm /* make it a LIT again */ sw.0error_found = "1"; return end sw.0table_changed = "1" /* mark it 'changed' */ return /*@ BDC_CHANGE */ /* Delete this row. . ----------------------------------------------------------------- */ BDD_DELETE: /*@ */ if branch then call BRANCH address ISPEXEC "TBDELETE" $tn$ if rc > 0 then do zerrsm = "Delete failed for AATBLID" aatblid"." if Symbol("zerrlm") = "LIT" then, zerrlm = "No additional diagnostics produced." zerrlm = exec_name "("BRANCH("ID")")", zerrlm "SETMSG MSG(ISRZ002)" drop zerrlm /* make it a LIT again */ sw.0error_found = "1"; return end sw.0table_changed = "1" /* mark it 'changed' */ return /*@ BDD_DELETE */ /* Display a blank panel for adding a new entry. . ----------------------------------------------------------------- */ BDI_INSERT: /*@ */ if branch then call BRANCH address ISPEXEC io = "INPUT" /* attribute for AATBLID */ "TBVCLEAR" $tn$ /* zap all variables */ do forever /* until PF3 */ "DISPLAY PANEL("pnl.datent")" disp_rc = rc if disp_rc > 0 then, if aakeys <> "" &, aanames <> "" &, aatblid <> "" &, aasort <> "" &, aalibr <> "" &, aatblnm <> "" &, aadesc <> "" then leave /* all fields filled */ end /* forever */ call BDX_COMPRESS /* remove extra blanks -*/ if Left( aalibr,1 ) = "'" then, /* quoted */ aalibr = Strip( aalibr,,"'" ) /* unquoted */ if aakeys <> "" &, aanames <> "" &, aatblid <> "" &, aasort <> "" &, aalibr <> "" &, aatblnm <> "" &, aadesc <> "" then do /* all fields filled */ "TBADD" $tn$ /* insert changes */ if rc > 0 then do zerrsm = "Insert failed for AATBLID" aatblid"." if Symbol("zerrlm") = "LIT" then, zerrlm = "No additional diagnostics produced." zerrlm = exec_name "("BRANCH("ID")")", zerrlm "SETMSG MSG(ISRZ002)" drop zerrlm /* make it a LIT again */ sw.0error_found = "1"; return end sw.0table_changed = "1" /* mark it 'changed' */ "TBSORT " $tn$ "FIELDS(AATBLID,C,A)" end /* all fields filled */ return /*@ BDI_INSERT */ /* Remove any extraneous nulls and spaces . ----------------------------------------------------------------- */ BDX_COMPRESS: /*@ */ if branch then call BRANCH address TSO aakeys = Translate(aakeys , '40'x , '00'x ) aakeys = Space(aakeys ,1) aanames = Translate(aanames , '40'x , '00'x ) aanames = Space(aanames,1) return /*@ BDX_COMPRESS */ /* . ----------------------------------------------------------------- */ BDZ_EPILOG: /*@ */ if branch then call BRANCH address ISPEXEC dd = "" do Words(ddnlist) /* each LIBDEF DD */ parse value ddnlist dd with dd ddnlist "LIBDEF ISP"dd end return /*@ BDZ_EPILOG */ /* Close table. If the data has changed, TBCLOSE; otherwise TBEND. The table may have been opened NOWRITE if NOUPDT was specified. In that case, both TBEND and TBCLOSE purge any changes. . ----------------------------------------------------------------- */ BZ_CLOSE: /*@ */ if branch then call BRANCH address ISPEXEC "LIBDEF ISPTABL DATASET ID("isptabl") STACK" if sw.0table_changed then "TBCLOSE" $tn$ /* write to ISPTABL */ else, "TBEND " $tn$ /* purge */ "LIBDEF ISPTABL" return /*@ BZ_CLOSE */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO rc = Trace("O") rc = trace(tv) if SWITCH("INSTALL") then do queue "AA" /* zctverb */ queue "0" /* zcttrunc */ queue "SELECT CMD(%TBLMSTR &ZPARM)" /* zctact */ queue "AA table Update" /* zctdesc */ "FCCMDUPD" /* load the table */ exit end /* INSTALL */ source = DFLTTLIB() /* the REAL table lives here */ parse value KEYWD("ISPTLIB") source with, isptlib . parse value KEYWD("ISPTABL") isptlib with, isptabl . parse value KEYWD("USETBL") "AAMSTR" with , $tn$ . sw.0LoadNew = SWITCH("NEWROW") return /*@ LOCAL_PREINIT */ /* Parse out the embedded components at the back of the source code. . ----------------------------------------------------------------- */ DEIMBED: Procedure expose, /*@ */ (tk_globalvars) ddnlist $ddn. daid. address TSO fb80po.0 = "NEW UNIT(VIO) SPACE(5 5) TRACKS DIR(40)", "RECFM(F B) LRECL(80) BLKSIZE(0)" parse value "" with ddnlist $ddn. daid. lastln = sourceline() currln = lastln /* */ if Left(sourceline(currln),2) <> "*/" then return currln = currln - 1 /* previous line */ "NEWSTACK" address ISPEXEC do while sourceline(currln) <> "/*" text = sourceline(currln) /* save with a short name ! */ if Left(text,3) = ")))" then do /* package the queue */ parse var text ")))" ddn mbr . /* PLIB PANL001 maybe */ if Pos(ddn,ddnlist) = 0 then do /* doesn't exist */ ddnlist = ddnlist ddn /* keep track */ $ddn = ddn || Random(999) $ddn.ddn = $ddn address TSO "ALLOC FI("$ddn")" fb80po.0 "LMINIT DATAID(DAID) DDNAME("$ddn")" daid.ddn = daid end daid = daid.ddn "LMOPEN DATAID("daid") OPTION(OUTPUT)" do queued() parse pull line "LMPUT DATAID("daid") MODE(INVAR) DATALOC(LINE) DATALEN(80)" end "LMMADD DATAID("daid") MEMBER("mbr")" "LMCLOSE DATAID("daid")" end /* package the queue */ else push text /* onto the top of the stack */ currln = currln - 1 /* previous line */ end /* while */ address TSO "DELSTACK" return /*@ DEIMBED */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then do ; say helpmsg; end say " " ex_nam = Left(exec_name,8) /* predictable size */ rowlist = "AATBLID AATBLNM AADESC AAKEYS AANAMES AASORT AALIBR" say " "ex_nam" displays/updates AAMSTR, the Master Table Control table " say " used primarily by TBLGEN. " say " " say " Syntax: "ex_nam" " say " (( ISPTLIB (Defaults) " say " ISPTABL (Defaults) " say " USETBL (Defaults) " say " INSTALL " say " NEWROW " say " " say " a TSO-format dataset name to be used as " say " ISPTLIB. If not specified, DFLTTLIB will be called" say " to supply a value. " say " " say " a TSO-format dataset name to be used as " say " ISPTABL. If not specified, the current value of " say " is used. " say " " say " the table name to be used for all table " say " operations. If not specified, it defaults to " say " 'AAMSTR'. " say " " say " more... " "NEWSTACK" ; pull ; "CLEAR" ; "DELSTACK" say " " say " adds a shortcut (AA) for this routine to the user's " say " command table. If INSTALL is specified, no other " say " processing takes place. " say " " say " signals that the queue has been loaded by a calling " say " routine asking that "ex_nam" create a new row from " say " the data presented. The queue must contain exactly " say " seven (7) rows each with one tag from the set " say " "rowlist say " and followed by the literal data to be composed " say " as a new AA table entry. " say " " say " NEWROW --cannot-- be used except by another REXX " say " routine. It cannot be entered manually. " say " " say " more... " "NEWSTACK" ; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " NOUPDT: by-pass all update logic. " say " " say " BRANCH: show all paragraph entries. " say " " say " TRACE tv: will use value following TRACE to place " say " the execution in REXX TRACE Mode. " say " " say " " say " Debugging tools can be accessed in the following manner: " say " " say " TSO" exec_name" parameters (( debug-options " say " " say " For example: " say " " say " TSO" exec_name " (( MONITOR TRACE ?R " if sysvar("SYSISPF") = "ACTIVE" then, address ISPEXEC "CONTROL DISPLAY REFRESH" exit /*@ HELP */ /* . ----------------------------------------------------------------- */ BRANCH: Procedure expose, /*@ */ sigl exec_name rc = trace("O") /* we do not want to see this */ arg brparm . origin = sigl /* where was I called from ? */ do currln = origin to 1 by -1 /* inch backward to label */ if Right(Word(Sourceline(currln),1),1) = ":" then do parse value sourceline(currln) with pgfname ":" . /* Label */ leave ; end /* name */ end /* currln */ select when brparm = "NAME" then return(pgfname) /* Return full name */ when brparm = "ID" then do /* wants the prefix */ parse var pgfname pgfpref "_" . /* get the prefix */ return(pgfpref) end /* brparm = "ID" */ otherwise say left(sigl,6) left(pgfname,40) exec_name "Time:" time("L") end /* select */ return /*@ BRANCH */ /* . ----------------------------------------------------------------- */ DUMP_QUEUE: /*@ Take whatever is in stack */ rc = trace("O") /* and write to the screen */ address TSO "QSTACK" /* how many stacks? */ stk2dump = rc - tk_init_stacks /* remaining stacks */ if stk2dump = 0 & queued() = 0 then return say "Total Stacks" rc , /* rc = #of stacks */ " Begin Stacks" tk_init_stacks , /* Stacks present at start */ " Excess Stacks to dump" stk2dump do dd = rc to tk_init_stacks by -1 /* empty each one. */ say "Processing Stack #" dd " Total Lines:" queued() do queued();pull line;say line;end /* pump to the screen */ "DELSTACK" /* remove stack */ end /* dd = 1 to rc */ return /*@ DUMP_QUEUE */ /* Handle CLIST-form keywords added 20020513 . ----------------------------------------------------------------- */ CLKWD: Procedure expose info /*@ hide all except info */ arg kw kw = kw"(" /* form is 'KEY(DATA)' */ kw_pos = Pos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ rtpt = Pos(") ",info" ",kw_pos) /* locate end-paren */ slug = Substr(info,kw_pos,rtpt-kw_pos+1) /* isolate */ info = Delstr(info,kw_pos,rtpt-kw_pos+1) /* excise */ parse var slug (kw) slug /* drop kw */ slug = Reverse(Substr(Reverse(Strip(slug)),2)) return slug /*@CLKWD */ /* Handle multi-word keys 20020513 . ----------------------------------------------------------------- */ KEYWD: Procedure expose info /*@ hide all vars, except info*/ arg kw kw_pos = wordpos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ kw_val = word(info,kw_pos+Words(kw))/* get the next word */ info = Delword(info,kw_pos,2) /* remove both */ return kw_val /*@ KEYWD */ /* . ----------------------------------------------------------------- */ KEYPHRS: Procedure expose, /*@ */ info helpmsg exec_name /* except these three */ arg kp wp = wordpos(kp,info) /* where is it? */ if wp = 0 then return "" /* not found */ front = subword(info,1,wp-1) /* everything before kp */ back = subword(info,wp+1) /* everything after kp */ parse var back dlm back /* 1st token must be 2 bytes */ if length(dlm) <> 2 then /* Must be two bytes */ helpmsg = helpmsg "Invalid length for delimiter("dlm") with KEYPHRS("kp")" if wordpos(dlm,back) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg "No matching second delimiter("dlm") with KEYPHRS("kp")" if helpmsg <> "" then call HELP /* Something is wrong */ parse var back kpval (dlm) back /* get everything b/w delim */ info = front back /* restore remainder */ return Strip(kpval) /*@ KEYPHRS */ /* . ----------------------------------------------------------------- */ NOVALUE: /*@ */ say exec_name "raised NOVALUE at line" sigl say " " say "The referenced variable is" condition("D") say " " zsigl = sigl signal SHOW_SOURCE /*@ NOVALUE */ /* . ----------------------------------------------------------------- */ SHOW_SOURCE: /*@ */ call DUMP_QUEUE /* Spill contents of stacks -*/ if sourceline() <> "0" then /* to screen */ say sourceline(zsigl) rc = trace("?R") nop exit /*@ SHOW_SOURCE */ /* . ----------------------------------------------------------------- */ SS: Procedure /*@ Show Source */ arg ssbeg ssend . if ssend = "" then ssend = 10 if \datatype(ssbeg,"W") | \datatype(ssend,"W") then return ssend = ssbeg + ssend do ssii = ssbeg to ssend ; say Strip(sourceline(ssii),'T') ; end return /*@ SS */ /* . ----------------------------------------------------------------- */ SWITCH: Procedure expose info /*@ */ arg kw sw_val = Wordpos(kw,info) > 0 /* exists = 1; not found = 0 */ if sw_val then /* exists */ info = Delword(info,Wordpos(kw,info),1) /* remove it */ return sw_val /*@ SWITCH */ /* . ----------------------------------------------------------------- */ SYNTAX: /*@ */ errormsg = exec_name "encountered REXX error" rc "in line" sigl":", errortext(rc) say errormsg zsigl = sigl signal SHOW_SOURCE /*@ SYNTAX */ /* Can call TRAPOUT. . ----------------------------------------------------------------- */ TOOLKIT_INIT: /*@ */ address TSO info = Strip(opts,"T",")") /* clip trailing paren */ parse source sys_id how_invokt exec_name DD_nm DS_nm, as_invokt cmd_env addr_spc usr_tokn parse value "" with tv helpmsg . parse value 0 "ISR00000 YES" "Error-Press PF1" with, sw. zerrhm zerralrm zerrsm if SWITCH("TRAPOUT") then do "TRAPOUT" exec_name parms "(( TRACE R" info exit end /* trapout */ sw.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = sysvar("SYSISPF") = "ACTIVE" if Word(parms,1) = "?" then call HELP /* I won't be back */ "QSTACK" ; tk_init_stacks = rc /* How many stacks? */ parse value SWITCH("BRANCH") SWITCH("MONITOR") SWITCH("NOUPDT") with, branch monitor noupdt . parse value mvsvar("SYSNAME") sysvar("SYSNODE") with, #tk_cpu node . parse value KEYWD("TRACE") "O" with tv . tk_globalvars = "exec_name tv helpmsg sw. zerrhm zerralrm ", "zerrsm zerrlm tk_init_stacks branch monitor ", "noupdt" call LOCAL_PREINIT /* for more opts -*/ return /*@ TOOLKIT_INIT */ /* Embedded components follow )))PLIB AASEL )ATTR % TYPE(TEXT) INTENS(HIGH) SKIP(ON) + TYPE(TEXT) INTENS(LOW) SKIP(ON) _ TYPE(INPUT) INTENS(HIGH) CAPS(ON) ! TYPE(OUTPUT) INTENS(HIGH) SKIP(ON) @ TYPE(OUTPUT) INTENS(LOW) SKIP(ON) )BODY EXPAND(||) WIDTH(&ZSCREENW) %|-| AAMSTR Table Selection +|-| %COMMAND ===>_ZCMD %SCROLL ===>_ZAMT+ % /- B = Browse, E,U = Change, I = Insert (new) % / %V +ID +Tbl Name+ Location Description )MODEL _Z+!Z !AATBLNM !AALIBR + !AADESC )INIT .ZVARS = '(ACTION AATBLID) ' .HELP = AASELH )REINIT )PROC )END ))) PLIB AASELH )ATTR % TYPE(TEXT) INTENS(HIGH) SKIP(ON) + TYPE(TEXT) INTENS(LOW) SKIP(ON) _ TYPE(INPUT) INTENS(HIGH) ! TYPE(OUTPUT) INTENS(HIGH) SKIP(ON) @ TYPE(OUTPUT) INTENS(LOW) SKIP(ON) )BODY EXPAND(||) WIDTH(&ZSCREENW) %TUTORIAL |-| AAMSTR Table Selection |-| TUTORIAL %Next Selection ===>_ZCMD + Select any row or rows with%B, E, U,+or%I+ to operate on the specified row. % D+is not shown as an option, but%is+available and will%TBDELETE+the selected row or rows )PROC )END )))PLIB AADAT )ATTR % TYPE(TEXT) INTENS(HIGH) SKIP(ON) @ TYPE(TEXT) INTENS(HIGH) COLOR(YELLOW) SKIP(ON) + TYPE(TEXT) INTENS(LOW) SKIP(ON) SKIP(ON) _ TYPE(INPUT) INTENS(HIGH) CAPS(ON) ! TYPE(INPUT) INTENS(HIGH) CAPS(OFF) $ TYPE(&IO) INTENS(HIGH) CAPS(ON) )BODY EXPAND(||) WIDTH(&ZSCREENW) @|-|% AAMSTR Table Update @|-| %COMMAND ===>_ZCMD %SCROLL ===>_ZAMT+ + + Table ID ===>$Z @ (xx) + Table Name ===>_AATBLNM @ (xxxxxxxx) + Description ===>!AADESC + Location ===>_AALIBR + DSN or '*' + + Key Fields ===>_AAKEYS + + Name Fields ===>_AANAMES + +Sort Sequence ===>_AASORT )INIT .ZVARS = '(AATBLID)' .HELP = AADATH )PROC )END )))PLIB AADATH )ATTR % TYPE(TEXT) INTENS(HIGH) SKIP(ON) + TYPE(TEXT) INTENS(LOW) SKIP(ON) _ TYPE(INPUT) INTENS(HIGH) ! TYPE(OUTPUT) INTENS(HIGH) SKIP(ON) @ TYPE(OUTPUT) INTENS(LOW) SKIP(ON) )BODY EXPAND(||) WIDTH(&ZSCREENW) %TUTORIAL |-| AAMSTR Table Update |-| TUTORIAL %Next Selection ===>_ZCMD + Enter a 2-character%Table ID+or change the existing ID. If you change an existing Table ID a new row may be created. Enter/update a 1-8 character%Table Name,+a free-form%Description,+the fully-qualified-unquoted library name where the 'official' table is stored, the names of the%Key Fields+and%Name Fields,+and the desired%Sort Sequence+for this table. %Hint:+field names should start with the 2-character%Table ID+to distinguish them from similarly-named fields from other tables. %All+fields are%required. + + In place of a library name, you may use a single token in parentheses ( ex.: '(user)' or '(temp)' ) to indicate that the location of the table is specific to the calling user. )PROC )END )))PLIB POP40BY4 )ATTR % TYPE(TEXT) INTENS(HIGH) SKIP(ON) )BODY WINDOW(40,4) +&pop1 +&pop2 +&pop3 +&pop4 )INIT )PROC )END */