/* REXX SYSEMON (v.2) Edit the SYSUMON KSDS. Begin by scanning the SYSUMON KSDS to discover all the keys. Table the keys and display the table to allow key selection. When a key is selected, read(RXVSAM) the KSD, parse its values, and display for update. If any changes, reconstruct the record and rewrite. RUNDATA provides some parm information. Use '(routine name) ?' for HELP-text. |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| | | | WARNING: EMBEDDED COMPONENTS. | | See text following TOOLKIT_INIT | | | |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| Written by Frank Clarke rexxhead@yahoo.com 20211108 Impact Analysis . SYSEXEC RUNDATA . SYSEXEC STRSORT . SYSEXEC TRAPOUT Modification History 20230202 fxc blank-fill counters instead of zero-fill; 20230608 fxc use &ZUP/&ZCONT 20230723 fxc modernize logging; 20230726 fxc adjust HELP; 20230729 fxc clip long lines; 20230806 fxc chg SYSPROC to SYSEXEC in Impact Analysis; 20230810 fxc set msglim based on screen width; 20230908 fxc set log lrecl to 255; 20240305 fxc align panel names; 20240309 fxc change dollar-sign to @ everywhere; 20240415 fxc DUMP_QUEUE quiet; 20240509 fxc RUNDATA supplies VSPREF; */ 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 */ if WordPos( "?",info ) > 0 then call HELP /* */ call A_INIT /* -*/ call I_ISPF_SVCS /* -*/ call ZB_SAVELOG /* */ if \sw.nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ SYSEMON */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO parse value "?" with, v. keylist userlist toollist , . /* */ parse value "0 0 0 0 0 0 0 0 0 0 0" with, ct. , . call AA_SETUP_LOG /* -*/ call AC_CONSTANTS /* for RXVSAM -*/ call AK_KEYWDS /* -*/ call AR_READ_KEYS /* -*/ return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ AA_SETUP_LOG: /*@ */ if branch then call BRANCH address TSO msglim = SYSVAR( "SYSWTERM" ) - 12 parse value "0 0 0 0 0" with, log# log. . parse value Date("S") Time("S") Time("N") with, yyyymmdd sssss hhmmss . hhmmss = Space( Translate( hhmmss,' ',':' ) ,0 ) parse var yyyymmdd 4 yrdigit 5 mm 7 dd /* 9 12 14 maybe */ if Pos(yrdigit,"13579") > 0 then mm = mm + 12 /* mm=24 */ logtag = Substr("ABCDEFGHIJKLMNOPQRSTUVWX",mm,1) /* logtag=X */ subid = logtag""dd""Left( hhmmss,4 ) /* X141743 ? */ vb4k.0 = "NEW CATALOG UNIT(SYSDA) SPACE(1 5) TRACKS", "RECFM( V B ) LRECL( 255 ) BLKSIZE( 0 )" logdsn = "@LOG."exec_name"."subid".LIST" logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref, exec_name "started by" Userid() yyyymmdd hhmmss ) call ZL_LOGMSG( logpref "Arg:" argline ) return /*@ AA_SETUP_LOG */ /* RXVSAM literals . ----------------------------------------------------------------- */ AC_CONSTANTS: /*@ */ if branch then call BRANCH address TSO /* RXVSAM action verbs. These all end with a blank. */ v.CLOSE = "CLOSE " v.DELETE = "DELETE " v.OPENINPUT = "OPENINPUT " v.OPENIO = "OPENIO " v.OPENOUTPUT = "OPENOUTPUT " v.READ = "READ " v.READGENERIC = "READGENERIC " v.READLAST = "READLAST " v.READNEXT = "READNEXT " v.READPREV = "READPREV " v.REWRITE = "REWRITE " v.STARTBWD = "STARTBWD " v.STARTFWD = "STARTFWD " v.WRITE = "WRITE " return /*@ AC_CONSTANTS */ /* . ----------------------------------------------------------------- */ AK_KEYWDS: /*@ */ if branch then call BRANCH address TSO tgtuser = KEYWD( "USER" ) tgttool = KEYWD( "TOOL" ) return /*@ AK_KEYWDS */ /* . ----------------------------------------------------------------- */ AR_READ_KEYS: /*@ */ if branch then call BRANCH address TSO "ALLOC FI( @VS ) DA( "vsksds" ) SHR REU" rxv_rc = RXVSAM( v.OPENINPUT , "@VS" , "KSDS" ) if rxv_rc > 0 then do logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref "OPENINPUT" rxvsam_returnmsg ) end do forever /* every record */ rxv_rc = RXVSAM( v.READNEXT , "@VS" ,, "RECORD" ) if rxv_rc > 0 then leave /* end-of-file */ parse var record user . 9 tool . 17 keylist = keylist ';' user tool ct.0keys = ct.0keys + 1 if WordPos( user,userlist ) = 0 then, userlist = userlist user if WordPos( tool,toollist ) = 0 then, toollist = toollist tool end /* forever */ rxv_rc = RXVSAM( v.CLOSE , "@VS" ) if rxv_rc > 0 then do logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref "CLOSE " rxvsam_returnmsg ) end "FREE FI(@VS)" keylist = Strip( keylist ) /* zap blanks */ keylist = Strip( keylist,,';' ) /* zap semicolons */ keylist = Space( keylist,1 ) userlist = STRSORT( userlist ) toollist = STRSORT( toollist ) logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "Keys:" ct.0keys " Users:" Words( userlist ), " Tools:" Words( toollist ) ) return /*@ AR_READ_KEYS */ /* . ----------------------------------------------------------------- */ I_ISPF_SVCS: /*@ */ if branch then call BRANCH address ISPEXEC call IA_PROLOG /* Setup -*/ call ID_DISPLAY_TBL /* -*/ call IZ_EPILOG /* Teardown -*/ return /*@ I_ISPF_SVCS */ /* Extract ISPF assets. Load table TOOLS with all known keys. . ----------------------------------------------------------------- */ IA_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 @tn@ = "TOOLS" "TBCREATE" @tn@ "KEYS( TDUSER TDTOOL ) NOWRITE REPLACE " /* TBCREATE leaves the table in an OPEN state */ spare_keys = keylist /* make a copy */ do while( spare_keys <> "" ) /* use all of it */ parse var spare_keys tduser tdtool ";" spare_keys "TBADD" @tn@ end /* spare_keys */ return /*@ IA_PROLOG */ /* Show the list of keys, allow caller to select one or more to edit. . ----------------------------------------------------------------- */ ID_DISPLAY_TBL: /*@ */ if branch then call BRANCH address TSO "ALLOC FI(@VS) DA( "vsksds" ) SHR REU" rc = RXVSAM( v.OPENIO , '@VS' , 'KSDS' ) if rxv_rc > 0 then do logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref "OPENIO " rxvsam_returnmsg ) end address ISPEXEC sel = "" "TBTOP" @tn@ do forever "TBDISPL" @tn@ "PANEL( KEYS )" if rc > 4 then leave do ztdsels "CONTROL DISPLAY SAVE" select when( sel = 'D' ) then call IDD_DEL_KEY /* -*/ otherwise call IDE_EDIT_RECORD /* -*/ end "CONTROL DISPLAY RESTORE" if ztdsels > 1 then "TBDISPL" @tn@ end /* ztdsels */ sel = "" end /* forever */ address TSO rc = RXVSAM( v.CLOSE , '@VS' ) if rxv_rc > 0 then do logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref "CLOSE " rxvsam_returnmsg ) end "FREE FI(@VS)" return /*@ ID_DISPLAY_TBL */ /* Whatever row was selected yielded TDUSER and TDTOOL. . ----------------------------------------------------------------- */ IDD_DEL_KEY: /*@ */ if branch then call BRANCH address ISPEXEC logpref = "("Branch( "ID" )")" vskey = Left( tduser,8 )Left( tdtool,8 ) rc = RXVSAM( v.READ , '@VS' , vskey , 'VSREC' ) if rxv_rc > 0 then do call ZL_LOGMSG( logpref "READ " rxvsam_returnmsg ) end ; else, call ZL_LOGMSG( logpref " Read:" vsrec ) rxv_rc = RXVSAM( v.DELETE , "@VS" , vskey ) if rxv_rc > 0 then do call ZL_LOGMSG( logpref "DELETE " rxvsam_returnmsg ) end ; else, "TBDELETE" @tn@ return /*@ IDD_DEL_KEY */ /* Whatever row was selected yielded TDUSER and TDTOOL. . ----------------------------------------------------------------- */ IDE_EDIT_RECORD: /*@ */ if branch then call BRANCH address TSO logpref = "("Branch( "ID" )")" vskey = Left( tduser,8 )Left( tdtool,8 ) rc = RXVSAM( v.READ , '@VS' , vskey , 'VSREC' ) if rxv_rc > 0 then do call ZL_LOGMSG( logpref "READ " rxvsam_returnmsg ) end ; else, call ZL_LOGMSG( logpref " Read:" vsrec ) parse var vsrec 17, ct01 ct02 ct03 ct04 ct05 ct06, ct07 ct08 ct09 ct10 ct11 ct12, keyorig vsname origdata = Space( ct01 ct02 ct03 ct04 ct05 ct06 ct07 ct08 ct09 ct10, ct11 ct12 keyorig vsname , 1 ) vsname = SHIFT( vsname ) /* dual case */ address ISPEXEC do forever "DISPLAY PANEL( DATA )" if rc > 0 then leave /* PF3 ? */ end /* forever */ newdata = Space( ct01 ct02 ct03 ct04 ct05 ct06 ct07 ct08 ct09 ct10, ct11 ct12 keyorig vsname , 1 ) if newdata <> origdata then do keyorig = Left( keyorig"." , 1 ) vsrec = Left( tduser,8 )Left( tdtool,8 ), Right(ct01,5,' '), Right(ct02,5,' '), Right(ct03,5,' '), Right(ct04,5,' '), Right(ct05,5,' '), Right(ct06,5,' '), Right(ct07,5,' '), Right(ct08,5,' '), Right(ct09,5,' '), Right(ct10,5,' '), Right(ct11,5,' '), Right(ct12,5,' '), keyorig " "vsname call ZL_LOGMSG( logpref "Write:" vsrec ) key = Left( tduser,8 )Left( tdtool,8 ) rxv_rc = RXVSAM( v.REWRITE , "@VS" , key , "VSREC" ) if rxv_rc > 0 then do call ZL_LOGMSG( logpref "REWRITE " rxvsam_returnmsg ) end end /* mismatch */ return /*@ IDE_EDIT_RECORD */ /* . ----------------------------------------------------------------- */ IZ_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 /*@ IZ_EPILOG */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO "NEWSTACK" "RUNDATA READ TBLKEY SYSUMON " /* VSPREF */ do queued() /* return from RUNDATA */ pull tag tagval tagval = Space( tagval,1 ) @z = Value( tag,tagval ) /* tag <-- tagval */ end /* queued */ "DELSTACK" if Words( vspref ) < 1 then do helpmsg = "Some required information was not provided by RUNDATA. ", "Please ensure that RUNDATA key SYSUMON includes", "VSPREF." call HELP /* ...and exit -*/ end parse value KEYWD("VSAMIN") "'"vspref".SYSUMON.KSD'" with, vsksds . return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* . ----------------------------------------------------------------- */ SHIFT: Procedure /*@ */ address TSO shifted = "" arg wordlist do Words( wordlist ) parse var wordlist word wordlist low = Translate(word,, "abcdefghijklmnopqrstuvwxyz",, "ABCDEFGHIJKLMNOPQRSTUVWXYZ") word = Left(word,1)Substr(low,2) shifted = shifted word end /* wordlist */ return( shifted ) /*@ SHIFT */ /* 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 REU UNIT(SYSDA) SPACE(1 5) TRACKS DIR(40)", "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 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 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 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 */ /* . ----------------------------------------------------------------- */ ZB_SAVELOG: /*@ */ if branch then call BRANCH address TSO if Symbol("LOG#") = "LIT" then return /* not yet set */ "ALLOC FI(@LOG) DA("logdsn") REU" vb4k.0 "EXECIO" log# "DISKW @LOG (STEM LOG. FINIS" "FREE FI(@LOG)" return /*@ ZB_SAVELOG */ /* . ----------------------------------------------------------------- */ ZL_LOGMSG: Procedure expose, /*@ */ (tk_globalvars) log. log# msglim rc = Trace("O") address TSO parse arg msgtext /* for making the msgline always reasonably short: */ do while Length(msgtext) > msglim pt = LastPos(" ",msgtext,msglim) slug = Left(msgtext,pt) if monitor then say, slug parse value log#+1 slug with, zz log.zz 1 log# . msgtext = " "Substr(msgtext,pt) end /* while msglim */ parse value log#+1 msgtext with, zz log.zz 1 log# . if monitor then say, msgtext return /*@ ZL_LOGMSG */ /* Find where code was run from. It assumes cataloged data sets. Original by Doug Nadel With SWA code lifted from Gilbert Saint-flour's SWAREQ exec . ----------------------------------------------------------------- */ FIND_ORIGIN: Procedure /*@ */ answer="* UNKNOWN *" /* assume disaster */ Parse Source . . name dd ds . /* get known info */ Call listdsi(dd "FILE") /* get 1st ddname from file */ Numeric digits 10 /* allow up to 7FFFFFFF */ If name = "?" Then /* if sequential exec */ answer="'"ds"'" /* use info from parse source */ Else /* now test for members */ If sysdsn("'"sysdsname"("name")'")="OK" Then /* if in 1st ds */ answer="'"sysdsname"("name")'" /* go no further */ Else /* hooboy! Lets have some fun!*/ Do /* scan tiot for the ddname */ tiotptr=24+ptr(12+ptr(ptr(ptr(16)))) /* get ddname array */ tioelngh=c2d(stg(tiotptr,1)) /* nength of 1st entry */ Do Until tioelngh=0 | tioeddnm = dd /* scan until dd found */ tioeddnm=strip(stg(tiotptr+4,8)) /* get ddname from tiot */ If tioeddnm <> dd Then /* if not a match */ tiotptr=tiotptr+tioelngh /* advance to next entry */ tioelngh=c2d(stg(tiotptr,1)) /* length of next entry */ End If dd=tioeddnm Then, /* if we found it, loop through the data sets doing an swareq for each one to get the dsname */ Do Until tioelngh=0 | stg(4+tiotptr,1)<> " " tioejfcb=stg(tiotptr+12,3) jfcb=swareq(tioejfcb) /* convert SVA to 31-bit addr */ dsn=strip(stg(jfcb,44)) /* dsname JFCBDSNM */ vol=storage(d2x(jfcb+118),6) /* volser JFCBVOLS (not used) */ If sysdsn("'"dsn"("name")'")='OK' Then, /* found it? */ Leave /* we is some happy campers! */ tiotptr=tiotptr+tioelngh /* get next entry */ tioelngh=c2d(stg(tiotptr,1)) /* get entry length */ End answer="'"dsn"("name")'" /* assume we found it */ End Return answer /*@ FIND_ORIGIN */ /* . ----------------------------------------------------------------- */ ptr: Return c2d(storage(d2x(Arg(1)),4)) /*@ */ /* . ----------------------------------------------------------------- */ stg: Return storage(d2x(Arg(1)),Arg(2)) /*@ */ /* . ----------------------------------------------------------------- */ SWAREQ: Procedure /*@ */ If right(c2x(Arg(1)),1) \= 'F' Then /* SWA=BELOW ? */ Return c2d(Arg(1))+16 /* yes, return sva+16 */ sva = c2d(Arg(1)) /* convert to decimal */ tcb = c2d(storage(21c,4)) /* TCB PSATOLD */ tcb = ptr(540) /* TCB PSATOLD */ jscb = ptr(tcb+180) /* JSCB TCBJSCB */ qmpl = ptr(jscb+244) /* QMPL JSCBQMPI */ qmat = ptr(qmpl+24) /* QMAT QMADD */ Do While sva>65536 qmat = ptr(qmat+12) /* next QMAT QMAT+12 */ sva=sva-65536 /* 010006F -> 000006F */ End return ptr(qmat+sva+1)+16 /*@ SWAREQ */ /* . ----------------------------------------------------------------- */ GETNAME: /*@ */ ASCBASXB = d2x(c2d(Storage(224,4))+108) ASXBSENV = d2x(c2d(Storage(ASCBASXB,4))+200) ACEEUNAM = d2x(c2d(Storage(ASXBSENV,4))+100) Adr = c2x(Storage(ACEEUNAM,4)) Name = Storage(d2x(c2d(Storage(ACEEUNAM,4))+1),c2d(Storage(Adr,1))-1) Name = Strip(Name,"B"," ") return(Name) /*@ GETNAME */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg ex_nam = Left(exec_name,8) /* predictable size */ say " " say " "ex_nam" allows the caller to edit the contents of the SYSUMON " say " KSDS. " say " " say " Syntax: "ex_nam" no parms " say " (( VSAMIN ksds " say " " say " ksds names the SYSUMON KSDS to be used in place of the " say " default:"vsksds" " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " MONITOR displays key information throughout processing. " 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 the " say " execution in REXX TRACE Mode. " say " " say " " say " Debugging tools can be accessed in the following manner: " say " " say " TSO "ex_nam" parameters (( debug-options " say " " say " For example " say " " say " TSO "ex_nam" (( MONITOR TRACE ?R " if sw.inispf 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 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(") ",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 delimiter*/ 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 */ /* . ----------------------------------------------------------------- */ 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" "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") "N" 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 */ /* ISPF assets follow immediately ))) PLIB KEYS .. )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) %|-| Available Keys +|-| %Command ===>_ZCMD %Scroll ===>_ZAMT+ /-- D - Delete * - Display / +V --User-- --Tool-- )MODEL _z!tduser +!tdtool + )INIT .ZVARS = '(SEL)' .HELP = KEYSH )REINIT )PROC IF (.PFKEY = 'PF05') &PFKEY = 'F5' .RESP = END )END ))) PLIB KEYSH .. )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) @ TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) %TUTORIAL |-| Available Keys |-| TUTORIAL + Select one or more keysets to be edited. Use any key except%D.+ The records for the keys selected will be presented, formatted, for update one-by-one. + If a row is selected with a%D,+the key is deleted from the VSAM file. + )PROC &ZUP = KEYSH &ZCONT = KEYSH )END ))) PLIB DATA .. )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) @ TYPE( TEXT ) INTENS( HIGH ) COLOR( YELLOW ) _ TYPE( INPUT ) INTENS( LOW ) CAPS( ON ) ! TYPE( INPUT ) INTENS( HIGH ) CAPS( OFF ) } TYPE( INPUT ) INTENS( HIGH ) JUST( RIGHT ) { TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) @|-|% Edit key {vskey @|-| %COMMAND ===>_ZCMD %SCROLL ===>_ZAMT+ + + January }ct01 + February }ct02 + March }ct03 + April }ct04 + May }ct05 + June }ct06 + July }ct07 + August }ct08 + September }ct09 + October }ct10 + November }ct11 + December }ct12 + + Key origin !z+ Name !vsname + )INIT .ZVARS = '( KEYORIG )' .HELP = DATAH )PROC VER( &KEYORIG,NB ) )END ))) PLIB DATAH .. )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 |-| Edit key !vskey %|-| TUTORIAL %Next Selection ===>_ZCMD + Any field shown on the panel may be altered. + No editing is done, so changing a numeric field to a non-numeric may have unpleasant consequences later. )PROC &ZUP = DATAH &ZCONT = DATAH )END */