/*DCFMSGS -- Place DCF error messages after line in error. (REXX) */ /* F. David McRitchie, "The REXX Macros Toolbox", 1993/10/14 */ /* Concept modeled after SPELL macro by William Horton CBT-103 */ /* Will invoke @SCRIPT and read back in userid.S9999.LIST */ /* If @SCRIPT Q -- has already been invoked then .. */ /* ===> DCFMSGS @SCRIPT */ /* If @SCRIPT Q -- has already been invoked then .. */ /* ===> DCFMSGS @SCRIPT */ /**********************************************************************/ /* PARM OPTIONS are same as for @SCRIPT */ /* @SCRIPT bypass formatting, no other options are supplied */ /* FP(1) do not include as this will be included, for you */ /**********************************************************************/ /* NORMAL USAGE WITHOUT ANY PARAMETERS */ /* @SCRIPT will be invoked, all lines will be undisplayed, */ /* lines in error will be redisplay. Error messages merged. */ /*-------------------------------------------------------------------*/ ADDRESS 'ISREDIT';'MACRO (PARM)' /***********************************/ "ISREDIT (DCHG) = DATA_CHANGED" IF DCHG = "YES" then if document /= "DOC" then do SAY '*************************************************************' SAY '* YOUR FILE HAS NOT BEEN SAVED AFTER MAKING CHANGES *' SAY '* *' SAY '* CANNOT SCRIPT UNLESS YOU SAVE -- Hit enter to terminate *' SAY '************************* -- OR -- **************************' SAY ' REPLY or type in "CAN" to terminate request' SAY ' REPLY "SAVE" | "SAV" to save then @SCRIPT saved version' SAY ' REPLY "CANCEL" | "CAN" if you doo not want to @SCRIPT' , 'at this time' pull PARM1;parm1 = translate(parm1) if SUBSTR(PARM1,1,3) /= "SAV" then do ; "LINE_BEFORE .ZFIRST = NOTELINE ""Not SCRIPTing UNSAVED data""" ZEDLMSG = "Data Has not been SAVED -- NOT SCRIPTED" ADDRESS "ISPEXEC" "SETMSG MSG(ISRZ000)";Return 1 end "@SAVE" if rc > 1 then do "LINE_BEFORE .ZFIRST = NOTELINE ""SAVE before SCRIPT failed""" return end end /*********************************************************************/ mnote = "MSGLINE" /* until DSMDEB323i -- then NOTELINE*/ parm = translate(parm) if parm= "QUICK" | parm = "@SCRIPT" , then do;parm='';quick="QUICK";end; else quick='NO' dsm_swt = 0 "reset special" qcnt = 0 q.='' p.='';p.0 = 0 ZEDSMSG = ZEDLMSG = '** ERROR location in progress **' ADDRESS 'ISPEXEC' 'CONTROL DISPLAY LOCK' ADDRESS 'ISPEXEC' 'DISPLAY MSG(ISRZ000)' '(dataset) = DATASET' '(MEMBER) = MEMBER' SYSUID = SYSVAR('SYSUID') /*reject special sop usage where current member invoked by Annnn*/ sstring = "'"strip(member)"'" REJECT1 = 'DSMMOM397I' SSTRING 'WAS IMBEDDED AT' before = 2 after = 1 /* TSO dataset conventions for use w/o quotes */ if quick="QUICK" then signal quick /* Invoke SCRIPT/VS */ if parm = "" then do userid = SYSVAR('sysuid') if member = "" then dsname = dataset else dsname = dataset'('strip(member)')' address "TSO" "SCRIPT '"dsname"' ", " PRO('SCRIPT.r40.MACLIB(DSMPROFL)') LIB('SCRIPT.r40.MACLIB')", " FO('SYS1.prod.FONTLIB')INDEX SEG('SYS1.prod.PSEGLIB')", " DEV(1403W6) CO FP(1)SYS(X NO H NO D YES ) M(ID TRACE DELAY)", " FILE('"userid".S9999.LIST') B(0 0) SP" end; else do "(line) = linenum 1" i = pos('FP(1)',line) if i = 0 then "@SCRIPT Q FP(1)" parm else "@SCRIPT Q" parm end; /****************************************************/ quick: ZEDSMSG = ZEDLMSG = '** ERROR LOCATION IN PROGRESS ** -- FINAL PHASE' ADDRESS 'ISPEXEC' 'CONTROL DISPLAY LOCK' ADDRESS 'ISPEXEC' 'DISPLAY MSG(ISRZ000)' "reset";"x .zf .zl ' ' all" "(hiline) = linenum .zlast" EOF = 'NO' MISSPELLED = 0 Address "TSO" "ALLOC FI(infile)", "DSN('"SYSUID".S9999.LIST') OLD REUSE" q.='';p.='';p.0=0 ADDRESS 'TSO' 'EXECIO * DISKR infile (STEM Q. FINIS' if q.0 = 0 then do "line_before .zf = msgline ""'"SYSUID".S9999.lIST' is empty""" lbzf="line_before .zf = noteline" /*reduce continuation lines*/ lbzf """Try again by issuing... """ lbzf """ ===> @SCRIPT Q """ lbzf """ ===> pfk-3 to return to member""" lbzf """ ===> DCFMSGS @SCRIPT """ lbzf """ --------- or -----------------""" lbzf """ ===> DCFMSGS """ return 4 end /*------------------------------------------------------*/ /* Read SCRIPT error messages and create MSG records to */ /* show user which card images have misspelled words. */ /*------------------------------------------------------*/ /* aaaa aabb aaBB aacc aaCC aaff aagg aahh aaii aajj aakk*/ dcfrec='';p.='';p.0=0 EOF = 'NO' call getpack do while (p.0 \= 0) after = before - 1 address 'ISREDIT' 'LABEL' after '= .after' address 'ISREDIT' 'LABEL' before '= .before' 'reset .after .after' do i = 1 to p.0; record = p.i record=strip(substr(record,2)) 'LINE_BEFORE .before = 'mnote' (record)' end p.0=0 /* if EOF \= 'NO' then return 0 */ if EOF = 'NO' then call getpack END return 0 DCFINPUT: qcnt=qcnt+1; q.qcnt = dcfrec Return GETPACK: if EOF \= 'NO' then return p='';p.0 = 0 more: call getrec; msg = substr(dcfrec,2,10) msgtext = substr(dcfrec,2) if reject1 = substr(dcfrec,2,length(reject1)) then signal more if msg ='' then signal more; if EOF \= 'NO' then return p0 = p.0 + 1; p.p0 = dcfrec; p.0 = p0; if substr(msg,1,3) = 'DSM' then dsm_swt = 1; if substr(msg,1,4) = '*M* ' then dsm_swt = 1; if dsm_swt = 0 then do; p.0=0; signal more; end; select; when msg = 'DSMBEG323I' then do mnote = "NOTELINE" signal more end when msg = 'DSMMOM395I' then do igp = pos(sstring,dcfrec) if igp /= 0 then do parse var dcfrec left ' LINE ' after ':' right before = after + 1 end else "line_before" before " = noteline", "'---actual line in error (below) may be hidden in a macro'" if before > hiline then before = hiline if before < 2 then before = 2 call look_ahead; /* check for continuations */ return 0 end when msg = 'DSMMOM397I' then do igp = pos(sstring,dcfrec) if igp = 0 then signal more; parse var dcfrec left ' AT LINE ' after ' OF ' right before = after + 1 if before > hiline then before = hiline if before < 2 then before = 2 call look_ahead; /* check for continuations */ return 0 end when msg = '*M* MACRO' then do after = strip(substr(dcfrec,11,12)) before = after + 1 invoked = strip(substr(dcfrec,28,20)) parse var invoked '<' invoked '>' invoked = translate('*M* '||invoked' ') if before > hiline then before = hiline if before < 2 then before = 2 more2: call getrec; if substr(dcfrec,3,1) = ' ' then signal more2; if substr(dcfrec,2,10) /= invoked then do qcnt = qcnt - 1; return; end p0=p.0 + 1; p.p0=dcfrec; p.p0=p0 signal more2 end otherwise signal more; end; /* of select*/ GETREC: qcnt = qcnt + 1 if qcnt <= q.0 then do dcfrec = q.qcnt end; else do; dcfrec='>>EOF>>' EOF='YES' end; Return look_ahead: /* pick up continuation lines*/ lookmore: qcnt = qcnt + 1 if qcnt > q.0 then do qcnt = qcnt - 1; return; end x3 = substr(q.qcnt,2,3); x1 = substr(q.qcnt,28,1) if x3 = 'DSM' | x1 = '<' then do qcnt = qcnt - 1; trace off return; end; aft62 = substr(p.p0,62) if aft62 = '' then do; dcfrec=substr(dcfrec,1,61)||substr(q.qcnt,2) p.p0 = substr(p.p0,1,61)||substr(q.qcnt,2) end; else do; p0=p.0 +1; p.p0 = strip(q.qcnt); p.0 = p0 end; signal lookmore