/* REXX TBLMSTR Master Table Maintenance: This table maintenance routine handles changes to the AAMSTR table. Use '(routine name) ?' for HELP-text. |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| | | | WARNING: EMBEDDED COMPONENTS. | | See text following TOOLKIT_INIT | | | |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| Written by Frank Clarke, Richmond, 19990716 rexxhead@yahoo.com Impact Analysis . SYSEXEC DFLTTLIB . SYSEXEC FCCMDUPD . SYSEXEC TRAPOUT . SYSEXEC LA 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 don't start command name with # 20040721 fxc compress fields; 20040723 fxc widescreen version; 20050413 fxc repair TBADD logic; 20210403 fxc add NEWROW; REXXSKEL v.20210402 20230401 fxc SYSUMON only if not testing 20230406 fxc adjust HELP 20230425 fxc adjust HELP panels 20230518 fxc TBSORT immediate 20230608 fxc use &ZUP/&ZCONT 20230613 fxc add DEL to DEIMBED ALLOC 20230806 fxc chg SYSPROC to SYSEXEC in Impact Analysis; 20230829 fxc DFLTTLIB returns FQ-U dsname; 20240213 fxc disable SYSUMON; 20240305 fxc align panel names; 20240308 fxc chg dollar-sign to @ everywhere; 20240415 fxc DUMP_QUEUE quiet; 20240512 fxc ISPTLIB DSN is presented TSO-format; 20241227 fxc use active tablename for DFLTTLIB; 20250218 fxc add ZTDMARK at bottom of scroll; 20250515 fxc fix DEIMBED; 20250717 fxc REXXSKEL v.20210402 to v.20250630; better comments; rearrange HELP; 20250810 fxc adjust HELP; 20250925 fxc SPACEOUT; new DEIMBED; */ arg argline address TSO /* REXXSKEL ver.20250630 */ 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 /* Initialization -*/ call B_TABLE_OPS /* ISPF actions -*/ if \sw.0nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ TBLMSTR */ /* Initialize all variables . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO parse value " " with, pnl. ZTDMARK = "====== Bottom of data ======" pnl.select = "AASEL" /* Selection panel */ pnl.datent = "AADAT" /* Data Entry panel */ openmode.0 = "WRITE" /* based on NOUPDT */ openmode.1 = "NOWRITE" return /*@ A_INIT */ /* 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" "TBSORT " @tn@ "FIELDS( AATBLID,C,A )" 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 ) /* 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 /* Display row, block chgs -*/ end when Wordpos( action,"E U" ) > 0 then do call BDC_CHANGE /* Display row, alloc chgs -*/ end when Wordpos( action,"D" ) > 0 then do call BDD_DELETE /* Delete row -*/ end when Wordpos( action,"I" ) > 0 then do call BDI_INSERT /* Display empty panel -*/ 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 */ /* Extract ISPF assets and LIBDEF into place. . ----------------------------------------------------------------- */ 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 /* squeeze blanks out -*/ 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 */ /* Drop LIBDEFs . ----------------------------------------------------------------- */ BDZ_EPILOG: /*@ */ if branch then call BRANCH address ISPEXEC dd = "" do Words( ddnlist ) /* each LIBDEF DD */ parse value ddnlist dd with dd ddnlist @ddn = @ddn.dd /* PLIB322 <- PLIB */ "LIBDEF ISP"dd address TSO "FREE FI( "@ddn" )" end ddnlist = ddnlist dd 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 */ parse value KEYWD( "USETBL" ) "AAMSTR" with , @tn@ . source = DFLTTLIB( @tn@ ) parse value KEYWD( "ISPTLIB" ) "'"source"'" with, isptlib . parse value KEYWD( "ISPTABL" ) isptlib with, isptabl . 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 dlm = '5d5d5d'x /* three close-parens */ fb80po.0 = "NEW DELETE REU UNIT( SYSDA ) SPACE( 1 5 ) DIR( 40 )", "TRACKS RECFM( F B ) LRECL( 80 ) BLKSIZE( 0 )" fb80po.1 = "SHR REU" 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 Left( sourceline( currln ),2 ) <> "/*" text = sourceline( currln ) /* save with a short name ! */ if Left( text,3 ) = dlm then do /* package the queue */ parse var text . ddn mbr . /* PLIB PANL001 maybe */ if length( ddn ) > 4 then do /* data, not ISPF */ call DESPOOL /* -*/ currln = currln - 1 /* previous line */ iterate end if Pos( ddn,ddnlist ) = 0 then do /* doesn't exist */ ddnlist = ddnlist ddn /* keep track */ @ddn = ddn || Random( 999 ) /* PLIB322 maybe */ @ddn.ddn = @ddn /* @ddn.PLIB = PLIB322 */ 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 /* Subroutine of DEIMBED for non-ISPF data. Given : the stack, ddn, and mbr . ----------------------------------------------------------------- */ DESPOOL: /*@ */ if branch then call BRANCH address TSO if WordPos( ddn,ddnlist ) = 0 then, ddnlist = Space( ddnlist ddn,1 ) if Sysdsn( ddn".DATA" ) <> "OK" then, "ALLOC FI( "ddn" ) DA( "ddn".DATA )" fb80po.0 "ALLOC FI( "ddn" ) DA( "ddn".DATA("mbr") ) SHR REU" "EXECIO" queued() "DISKW" ddn "(FINIS" "DELSTACK" "NEWSTACK" /* re-establish */ return /*@ DESPOOL */ return /*@ DEIMBED */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg ex_nam = Left(exec_name,8) /* predictable size */ rowlist = "AATBLID AATBLNM AADESC AAKEYS AANAMES AASORT AALIBR" say " " say " "ex_nam" displays/updates AAMSTR, the Master Table Control table " say " used primarily by TBLGEN. " say " " say " Syntax: "ex_nam" no parms " say " (( USETBL tblnm (Defaults)" say " ISPTLIB indsn (Defaults)" say " ISPTABL outdsn (Defaults)" say " INSTALL " say " NEWROW " say " " say " tblnm the table name to be used for all table operations. " say " If not specified, it defaults to 'AAMSTR'. " say " " say " indsn a TSO-format dataset name to be used as ISPTLIB. If" say " not specified, DFLTTLIB will be called to supply a " say " value. " say " " say " outdsn a TSO-format dataset name to be used as ISPTABL. If" say " not specified, the current value of 'indsn' is used." say " " say " more... " "NEWSTACK" ; pull ; "CLEAR" ; "DELSTACK" say " " say " INSTALL 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 " NEWROW 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 as a" say " 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 " (( trace ?r branch " 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 ) /* 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 arg mode . "QSTACK" /* how many stacks? */ stk2dump = rc - tk_init_stacks /* remaining stacks */ if stk2dump = 0 & queued() = 0 then return if mode <> "QUIET" then, 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. */ if mode <> "QUIET" then, say "Processing Stack #" dd " Total Lines:" queued() do queued();parse 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( '5d40'x,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" )", info if wordpos( dlm,back ) = 0 then /* search for ending */ helpmsg = helpmsg, "No matching second delimiter( "dlm" ) with KEYPHRS( "kp" )", info 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 */ /* Invoke as: call ss 110 7 shows line 110 + 6 more . ----------------------------------------------------------------- */ 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','5d'x ) /* 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.0nested = sysvar( "SYSNEST" ) = "YES" sw.0batch = sysvar( "SYSENV" ) = "BACK" sw.0inispf = sysvar( "SYSISPF" ) = "ACTIVE" parse value KEYWD( "TRACE" ) "N" with tv . 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 . 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 Main selection panel )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 Main selection panel HELP )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 &ZUP = AASELH &ZCONT = AASELH )END ))) PLIB AADAT Table Update panel )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) @ TYPE( TEXT ) INTENS( HIGH ) COLOR( YELLOW ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) 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 Table Update panel HELP )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,+(may be an asterisk%(*),+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 an asterisk%(*)+to indicate that the location of the table is specific to the calling user. )PROC &ZUP = AADATH &ZCONT = AADATH )END */