/* REXX -- @SCRIPT -- reworked an exec better than @SCRIPT clist*/ /* the old @SCRIPT clist is now in CSTSCRP and CSTSVW */ /* Temporary usage until @SCRIPT updated to fully support OUTDES */ /*********************************************************************/ /* @SCRIPT created by David McRitchie, 1987/04/10, "The REXX Macros Toolbox" */ /* rewritten in REXX 1992/04/10, by David McRitchie. */ /*********************************************************************/ /* The following prevent printing */ /* BROWSE | EDIT | NOPRINT | STOP -- prevent printing */ /* The following pertain to OUTDES (printing) options */ /* CLASS() DEST() GROUPID() FORMDEF() PAGEDEF() */ /* COPIES() as OUTDES not as a SCRIPT option */ /* PROFS(profid) is converted to DEST() */ /* SYSTECH equates to DEST(P100E) in SYSTECH */ /* To override the input dataset or member */ /* INPUT(dsn) */ /* MEMBER(member) */ /* BookMaster requested with "B", alternative to GML starter set */ /* B BookMaster formating requested */ /* The following are SCRIPT options */ /* CHARS(), CONT|CONTINUE|NOCO dsmprof(dsmprof4), */ /* DEV()|DEVICE(), NOSPELL NUMBER SYSVAR() TRACE UP */ /* --------- character options ---------- */ /* CHARS(X0....) used with default device(PG1A), and PG1A90 */ /* CHARS(X1....) used with device(38PPN) */ /* CHARS(X2....) used with device(38PPNS90) */ /* CHARS(X0GT12) GOTHIC */ /* CHARS(X0T0550C) SONORAN SANS SERIF (US SUBSET) T1DCDCFS */ /* CHARS(X0T0559I) SONORAN SANS SERIF (International) T1DCDCFS */ /* CHARS(X0H21001) HELVETICA LATIN1 (USA/Canada - CECP) T1V10037 */ /* CHARS(X0422001) HELVETICA LATIN1 (Latin1 Code Page) T1000361 */ /* SYSVAR(C US) force codepage T1GI0395 */ /* The following are special purpose affect SCRIPT options */ /* DOWN DROPCAP IDATA POINT() DUPLEX(Y|N) PSA STYLE(l3column) */ /* The following affect this REXX execute, not SCRIPT */ /* BATCH job will be submitted in BATCH, using OUTPUT statement */ /*********************************************************************/ /* ------------- options used for testing ------- generates----- */ /* @SCRIPT B */ /* @SCRIPT B Q */ /* @SCRIPT DEST(PU00L) ------- DEV(1403W8S), with FCB(8X85) */ /* @SCRIPT DEV(1403W8) FORMDEF(0101LA) -- w/o dest FORMDEF reqd */ /* @SCRIPT L ----------- DEV(PG1A90) PAGEDEF(c10110) */ /* @SCRIPT P ----------- DEV(PG1A) FORMDEF(A10111)---- */ /* @SCRIPT ----------- DEV(PG1A) FORMDEF(A10111)---- */ /* @SCRIPT DEV(PG1A90) -------- DEV(PG1A90) PAGEDEF(C10110) */ /* @SCRIPT SYSTECH ----------- DEV(1403W6) DEST(P100E) ----- */ /* @SCRIPT SYSTECH ----------- DEV(1403W6) DEST(P100E) ----- */ /* @SCRIPT BATCH */ /* @SCRIPT DOWN ----------- DEV(38PPNS90) chars(X2T0550C) */ /* @SCRIPT ACROSS ----------- DEV(38PPNS) chars(X1T0550C) */ /* uses FORMDEF(0101LA) default */ /* @SCRIPT ACROSS CLASS(1) ---- DEV(38PPN) chars(X1T0550C) */ /* FORDEF(0101PA) */ /********************************************************************/ /* */ /* HELP INFORMATION HH HH EEEEEEEE LL PPPPPPPP */ /* IS DISPLAYED ON HH HH EE LL PP PP */ /* THE LINES ABOVE. HHHHHHHHH EEEEE LL PPPPPPPP */ /* FOR ADDITIONAL HELP HH HH EE LL PP */ /* CONTACT THE AUTHOR HH HH EEEEEEEE LLLLLLLL PP */ /* F. David McRitchie */ /* "The REXX Macros Toolbox" command ===> TSO CLIST @SCRIPT HELP */ /********************************************************************/ Address "ISREDIT";"MACRO (TOKEN)" Address "ISPEXEC" "VGET (ZPREFIX) PROFILE" /* check for prefix usage*/ prefix = ZPREFIX if zprefix = "" then prefix = SYSVAR(SYSUID) /*normally use SYSUID */ origtoken=" "token;origtokenUP=" "translate(token) origtokenLC=" "translate(token,'ABCDEFGHIJKLMNOPQRSTUVWXYZ',, 'abcdefghijklmnopqrstuvwxyz') macro='' TOKEN = " "TRANSLATE(TOKEN)" " "(MEMBERX) = MEMBER";"(DSNX) = DATASET" IF substr(memberx,1,1) = "S" then /* allow AxxxxOLD etc. as valid*/ if datatype(substr(memberx,2,4),'W') then /*test for whole number*/ if dsnx = "TECH.LIBR2.TEXT" then memberx = 'A'||substr(memberx,2) parse var token left " MEMBER(" memberz ") " right token = left || ' ' || right if memberz \= '' then memberx=memberz /* override memberx*/ IF Memberx \= "" then dsnxx = DSNX"("MEMBERX")" ELSE dsnxx = DSNX IF token = '' then do ; token = " P "; "LINE_BEFORE .zfirst = NOTELINE ""Option P has been assumed as", "the default, will print in PORTRAIT"""; end ; "(CARD1ST) = LINE .ZFIRST" /* FP(1) DUPLEX(NO) can be defaulted */ i = index(token,' ? '); if i=0 then i=INDEX(token,' HELP '); if i\=0 then do ; /* Address "TSO" "pdsdd sysproc @SCRIPT";RETURN; end ; */ Address "TSO" "clist @SCRIPT help";RETURN; end ; /*********** determine release for SCRIPT.Rxx.MACLIB *****/ REL = "" i = index(token,' R40 '); if i \=0 then do; REL = "R40" parse var token left " R40 " right token = left || ' ' || right end if rel = "" then rel = "R40" /* use default */ /******* special testing ***********/ document = ''; IF DSNX = "IS03.LIBR.CLIST" then if SYSVAR(SYSUID) = "IS03" then if , substr(memberx,1,1) = 'Z' then token = token " DOC "; /*special*/ i = index(token,' DOC ');if i \=0 then document = "DOC" if document = "DOC" then do "FIND 1 last ' '" "LABEL .ZCSR = .OLD 0" "FIND 1 next '='p" "LABEL .ZCSR = .BOT 0" "LINE_BEFORE .BOT = DATALINE "" "DATE('N') TIME('N') , " ===>" SYSVAR(SYSICMD) origtokenUP"""" parse var token left " DOC " right token = left || ' ' || right end /***********************************/ "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 do 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 /*********************************************************************/ "LINE_BEFORE .ZFIRST = NOTELINE """, ||TIME('N') SYSVAR(SYSICMD) origtokenUP"""" /* set variables to nulls or initial values */ dsmprof = '*';pointv='';codepage='';ochars='';delay=''; spellchk='';continue='';nospell='';NOPRINT="";device="";trace=""; fontlib="";fontlibx="";nochars=''; writer=''; outdes = " ";edit=""; page='' profile = " PRO('SCRIPT.R40.MACLIB(DSMPROF4)')" /*unless option B*/ library = "SCRIPT.R40.MACLIB" /* unless option B (book)*/ CECP = '(Country Extended Code Page)' /*********/ i = index(token,' B '); if i=0 then Book = ' '; else do ; /* BookMaster */ Book = "BookMaster" profile = " PRO('SCRIPT.EDF.EDFMAC(EDFPRF40)')" library = "SCRIPT.EDF.EDFMAC" /* SCRIPT.EDF.EDFMAC VERSION LATER*/ parse var token left " B " right token = left || ' ' || right end parse var token left " BIND(" bind ") " right if bind = '' then parse var token left " B(" bind ") " right if bind \= '' then do ; bind = " B("bind")" token = left || ' ' || right end parse var token left " CHARS(" chars ") " right token = left || ' ' || right parse var token left " CLASS(" class ") " right token = left || ' ' || right parse var token left " /*" comment "*/ " right token = left || ' ' || right /* observe comment delimiters in quotes do not "LOSE DATA" */ parse var token left " COPIES(" copies ") " right token = left || ' ' || right if fontlib = "" then FONTLIB = "SYS1.PROD.FONTLIB" parse var token left " DCFINDEX(" DCFINDEX ") " right token = left || ' ' || right parse var token left " DEST(" dest ") " right token = left || ' ' || right parse var token left " DEVICE(" device ") " right token = left || ' ' || right if device ='' then do ; parse var token left " DEV(" device ") " right /*DEVICE contd*/ token = left || ' ' || right end ; parse var token left " DSMPROF(" DSMPROF ") " right token = left || ' ' || right parse var token left " DUPLEX(" duplex ") " right token = left || ' ' || right duplex = substr(duplex,1,1) i = index(card1st,'DUPLEX(NO)') if i \=0 then do; say "Found DUPLEX(NO) ", "on first card will include SYSVAR(D N)" if duplex = '' then duplex = "N" end /* save duplex for sysvar later on */ parse var token left " FCB(" fcb ") " right token = left || ' ' || right parse var token left " FORMDEF(" formdef ") " right token = left || ' ' || right parse var token left " FP(" fp ") " right token = left || ' ' || right if fp \='' then fp = ' FP('fp')'; if fp ='' then do i = index(card1st,'FP(1)') if i \=0 then do ; fp = ' FP(1) ';say "Found FP(1) ", "on first card will format one pass only" end end parse var token left " GROUPID(" groupid ") " right token = left || ' ' || right parse var token left " INPUT(" input ") " right token = left || ' ' || right if input \= '' then dsnxx = input if substr(dsnxx,1,1) = "'" then parse var dsnxx "'"dsnxx"'" /*'*/ parse var token left " LINECT(" LINECT ") " right token = left || ' ' || right;if linect = '' then linect=0 parse var token left " LL(" ll ") " right token = left || ' ' || right /* will be included with sysvar*/ parse var token left " PAGE(" page ") " right token = left || ' ' || right if page = '' then page='';else page=' PAGE('page') '; if page \= '' then do /* catch lowercase prefixes */ i = index(origtokenUP,' PAGE(') j = index(substr(origtokenUP,i),')'); LCpage = substr(origtokenLC,i,j) xxpage = substr(origtoken,i,j) if LCpage \= xxpage then page=' PAGE('||substr(origtoken,i+6,j-6) if substr(origtokenUP,i+6,j-6) \= substr(origtokenLC,i+6,j-6) , then say "Warning "page" is lettercase sensitive" end parse var token left " MACRO(" macro ") " right token = left || ' ' || right parse var token left " PAGEDEF(" pagedef ") " right token = left || ' ' || right parse var token left " POINT(" point ") " right token = left || ' ' || right parse var token left " WTR(" writer ") " right token = left || ' ' || right if writer = "" then do parse var token left " WRITER(" writer ") " right token = left || ' ' || right end if device = '' then do /* must be filled in before DEST default */ if writer = 'PODU' | writer = 'POSI' | writer = 'MSDS', then device = '1403N6' end parse var token left " PROFS(" profs ") " right if profs \= '' then do token = left || ' ' || right dest = '' bind = " B(0 0)" outdes = outdes "DEST(bbbbbbbb."profs") " if class = '' then class = 'S' if ll = '' then ll = '78' device = '1403W8' end ; parse var token left " PSEGLIB(" pseglib ") " right token = left || ' ' || right if pseglib = "" then do parse var token left " SEG(" pseglib ") " right token = left || ' ' || right if pseglib = '' then pseglib= 'SYS1.PROD.PSEGLIB'; end parse var token left " SYSVAR(" sysvar ") " right token = left || ' ' || right parse var token left " STYLE(" STYLE ") " right /* Style() must be checked after SYSVAR */ if style \= '' then do token = left || ' ' || right style=translate(style) SYSVAR = SYSVAR "1" style Book = "BookMaster" profile = " PRO('script.edf.edfmac(EDPRF40)')" library = "script.edf.edfmac" IF style = "L3COLUMN" | style = "L2OFFSET" , | style = "L2COLUMN" then if device='' then device='PG1A270' end ; i = index(token,' SCRPTLIB ');if i \= 0 then do ; parse var token left " SCRPTLIB " right; token = left right library = '' end ; i = index(token,' SCRPTLIB ');if i \= 0 then do ; parse var token left " SCRPTLIB " right; token = left right library = '' end ; /********* single word parameters d.o.n.e after keyword parens ****/ across = process('across') batch = process('BATCH') bold = process('bold') direct = process('direct') /*not for general use */ down = process('DOWN') dropcap = process('dropcap'); edit = process('EDIT');if edit = "" then edit= process('BROWSE') /* edit and relationship to spellchk below*/ gt12 = process('gt12') gt15 = process('gt15') helvetica = process('helvetica') italic = process('italic') nochars = process('nochars') nospell = process('nospell') noprint = process('noprint') nowait = process('nowait') nofcb = process('nofcb') number = processB('NUMBER') P = process('P');if P='' then P = process('L') sans = process('SANS'); sonoran = process('sonoran') spellchk = process('spellchk') if macro \= "" then do; macro="MACRO("macro")"; edit="EDIT"; end; if edit \= "" then if NOSPELL = '' then SPELLCHK = 'SPELLCHK' stop = process('stop') systech = process('systech') techpsf = process('techpsf') systechl = process('systechl') /* laser in landscape*/ systechp = process('systechp') /* laser in portrait */ timing = process('timing') /* useful with idata */ if trace = '' then trace = processB('trace') if delay = '' then delay = processB('delay') up = process('up') view = process('view') review = process('review') CONTINUE = process('NOCO'); if CONTINUE = '' then CONTINUE = process('CONTINUE') if CONTINUE = '' then CONTINUE =process('CONT') if CONTINUE = '' then CONTINUE =process('CO') if substr(CONTINUE,1,2) = "CO" then CONTINUE = "CO" if CONTINUE = 'NOCO' then CONTINUE = '' i = index(token,' IDATA '); if i=0 then idata=''; if i ^= 0 then do ; parse var token left" IDATA "right;token=left||' '||right; /* if dest='' then dest = 'PROG1A3A' -- olde defaulte*/ if dest='' then dest = 'P12W6'; /*new default*/ say '------ DEST('dest')---------- for your IDATA' class = 'S'; sysvar=sysvar "M IDATA"; if device = '' then device = 'PG1A'; end i = index(token,' PSA '); if i=0 then psa=''; else do ;psa='PSOUT(A)'; dcfindex='SCRIPT.'rel'.FONTPS'; /* script.r40.fontps */ FONTLIB = ' '; if device = '' then device = 'PSA'; pseglib = "" parse var token left" PSA "right;token=left||' '||right; end ; if substr(device,1,3) = 'PSA' then do dcfindex = "FO('SCRIPT."rel".FONTPS')" /* script.r40.fontps */ if FONT3820 = "FONT3820" then dcfindex="FO('SYS1.FONT3820')" if device = '' then device = psa; FONTLIB = ' '; pseglib = "" chars = 'PSFHV' /* helvetica */ end i = index(token,' Q '); if i \= 0 then do ; parse var token left" Q "right;token=left||' '||right bind = " B(0 0)" if Book = "" then if dsmprof = " " then dsmprof = "DSMPROFL" if device = "" then device = "1403W6" if edit = '' then edit = "EDIT" if NOSPELL = '' then SPELLCHK = 'SPELLCHK';CONTINUE = "CO" trace = ' TRACE' /* delay = ' DELAY' -- not included automatically */ noprint = 'NOPRINT' "line_before .zf = noteline ""===> DCFMSGS @SCRIPT may be", "used to merge error messages after @SCRIPT Q""" end /* CHECK that all variables in TOKEN were accepted ------ */ if token \='' then do Address "ISREDIT" ZEDLMSG = "remaining values unknown to @SCRIPT -- "token Address "ISREDIT" "LINE_AFTER .ZCSR = NOTELINE ", """"TIME('N') "remaining values unknown to @SCRIPT -- "token"""" ADDRESS "ISPEXEC" "SETMSG MSG(ISRZ000)" RETURN 12 end /* REPROCESS variables ---------------------------------- */ if dropcap = 'DROPCAP' then sysvar = sysvar "I YES" if systech = 'SYSTECH' then dest="P100E" /*SYSTECH - DEV(1403W6) DEST(P100E) FCB(Z666) */ /*SYSTECH DEV(1403W8) -- DEST(P100E) FCB(Z888) */ if systechl = 'SYSTECHL' then do /* LANDSCAPE on Laser */ device = '1403W8S';FCB='8X85' /* your only choice*/ SYSVAR = SYSVAR "M SYSTECHL" /* coding in ccc@SYM profile ext.*/ dest="PU00L" end if systechp = 'SYSTECHP' then do /* PORTRAIT on Laser */ if device ='' then device = '1403W8' /* will pick up FCB later either Z888 or Z666 */ dest="PU00L";sysvar = sysvar "M SYSTECHP" /*If portrait were used again -- 11 inches long */ /* -- DEV(1403W8) DEST(xxxxx) FCB(Z888) */ end if techpsf = "TECHPSF" then dest=TECHPSF if dest = "TECHPSF" then do if device ='' then device = "PG4A"; /* as a 4028 */ if fontlib = '' then fontlib = duvt end if view = "VIEW" then do profile = " PRO('SCRIPT.R40.MACLIB(DSMVIEW4)')" /* line length will be set to 78 in DSMVIEW4 */ CONTINUE = ' CO ' BIND = ' B(0 0)' if device = '' then device = '1403W6' end /* not really JCL but it will stand out if shown as JCL */ Address "TSO" "CLS" Address "TSO" "$time @SCRIPT --" address "TSO" "LISTDDJ SCRPTLIB TEXTLIB" address "TSO" "%MURPHY" Address "TSO" "$time @SCRIPT --" status = msg('off') /*********************************************************************/ /* Address "TSO" "FREE FILE(SCRPTLIB TEXTLIB)" */ /*********************************************************************/ Address "TSO" "FREE DA('"dsnxx"')" Address "TSO" "FREE DA(dsmutmsg.text)" LISTXDSN = "'"prefix".S9999.LIST'" /*also used by view*/ Address "TSO" "Free da("listxdsn")" Address "TSO" "DEL "listxdsn status = msg('on') a='1' /* set outdes not previously set*/ if dest = '' | dest = "AHCENTER" then do if pagedef='' & fcb='' then do if '1403W8S' = device then do;FCB='8X85';ochars='GT12';end; if '1403W6' = device then do;FCB='8X85';ochars='GT12';end; if '1403W8' = device then do;notell = "DEV(1403W8) is useable", " at AHCENTER only if line length remains < 95";say , left('-',60,'-');"LINE_BEFORE .zf = noteline """notell""""; pagedef='down8';say notell;say left('-',60,'-'); end end end else do if device = '' then device = '1403W6' if pagedef='' & fcb='' then if NOFCB='' then do if '1403W6' = device then fcb='Z666' if '1403W8' = device then fcb='Z888' end end if device = "" then do if DOWN = "DOWN" then device = "38PPNS90" if ACROSS = "ACROSS" then if CLASS = "1" then device = "38PPN" else device = "38PPNS" if P = "L" then device = "PG1A90" if P = "P" then device = "PG1A" if device /*is still*/ = '' then device = "PG1A" if edit = "EDIT" then device = '1403W8' end if formdef = '' then do if device = '38PPN' then formdef = '0101PA'; if device = '38PPNS' | device = '38PPNS90' then formdef = '0101LA'; if substr(device,1,4) = 'PG1A' then formdef = 'A10111'; if substr(device,1,4) = 'PG4A' then formdef = 'A10111'; /*PG1A PG1A90 PG1A180 PG1A270 */ if device = 'PG1A90' then formdef = 'C10110' /*F1c10110*/ end if nofcb = "NOFCB" then FCB="" if class = '' then class = 'A' if class \= '' then outdes = outdes "CLASS("class")" if ochars \= '' then outdes = outdes "CHARS("ochars")" if copies \= '' then outdes = outdes "COPIES("copies")" else copies = '1' if dest \= '' then outdes = outdes "DEST("dest")" if fcb \= '' then outdes = outdes "FCB("fcb")" if formdef \= '' then outdes = outdes "FORMDEF("formdef")" if LINECT \= '' then outdes = outdes "LINECT("linect")" if pagedef \= '' then outdes = outdes "PAGEDEF("pagedef")" if writer \= '' then outdes = outdes "WRITER("writer")" if groupid = '' then do /* basically as a comment on OUTDES */ if style \= '' then groupid = style else if memberx \= '' then do ; if 0 = verify(memberx,'@#$','M') , then groupid=memberx; end ; else if formdef \= '' then groupid = formdef else if dest \= '' then groupid = dest else if device \= '' then groupid = device else groupid = '@SCRIPT' end ; if groupid \= '' then outdes = outdes "GROUPID("groupid")" if direct = "DIRECT" | batch = "BATCH" , then FILE = " PRINT("copies","class")" else FILE = " FILE("listxdsn")" if LL \= '' then SYSVAR = SYSVAR' L 'LL /* place our default SYSVAR in font of any supplied*/ SYSVAR = 'X NO H NO 'SYSVAR if duplex = "Y" | duplex = "YES" | duplex = "" then duplex = "Y" sysvar = strip(sysvar) "D" duplex /*********************************************************************/ if Review = 'REVIEW' then do; Address "TSO" "CSTSVW" 'REVIEW'; return 1; end /* tie into ccc on-line in color viewing */ say "Abbreviations used on SCRIPT command, due to 250 byte maximum" say " B=BIND, CH=CHARS, CO=CONTINUE, DEV=DEVICE, FI=FILE" SAY " FO=FONTLIB, FP=FPASSES, PRO=PROFILE, SP=SPELLCHK" SAY "---- " STOP if spellchk = '' then spell = '' else do; spell = ' SP';if edit = 'EDIT' then delay = ' DELAY';end if device = "4250A" then FONTLIB = "sys1.fontlibb" /*not sure*/ if substr(device,1,4) = "PG4A" then do; FONTLIB = "DUVTT.V1R1M0.FONT300" FONTLIB = "SYS1.PROD.FONT300" if chars='' then chars="X0H21001"; /* 10 point HELVETICA */ if formdef='' then formdef="A10111" end fontlibx = fontlib; if fontlib \= '' then FONTLIB = " FO('"fontlib"')" if PSEGLIB \= '' then PSEGLIB = " SEG('"PSEGLIB"')" if dsmprof ^='' then do profile = " PRO('SCRIPT."rel".MACLIB("dsmprof")')" if BOOK \= " " then profile = " PRO('SCRIPT.EDF.EDFMAC("dsmprof")')" end /* CREATE CHAR(XXX) NAME BASED ON POINT() */ if chars ^= '' then do AA ="X0GT89 X0H4106C X0H5106C X0H2106C X0H3106C X0N4106C X0N5106C", "X0N2106C X0N3106C X044107C X045107C X042107C X043107C", "X0H4107C X0H5107C X0H2107C X0H3107C X0N4107C X0N5107C", "X0N2107C X0N3107C X0CB59 X0CR59 X0CD59 X0CW59 X0CI59", "X044108C X045108C X042108C X043108C X0GT59 X0GL59 X0H4108C", "X0H5108C X0H2108C X0H3108C X0ST59 X0N4108C X0N5108C X0N2108C", "X0N3108C X0CBE9 X0CIE9 X0CRE9 X0GBE9 X0GTE9 X0GIE9 X0GLE9" BB="X0GPE9 X0H4109C X0H5109C X0H2109C X0H3109C X0LBE9 X0LRE9", "X0PBE9 X0PRE9 X0PIE9 X0SBE9 X0STE9 X0SIE9 X0SOE9 X0N4109C", "X0N5109C X0N2109C X0N3109C X0BRR9 X0BIR9 X0DOR9 X0CB09", "X0CR09 X0CI09 X044100C X045100C X042100C X043100C X0EBR9", "X0ELR9 X0ESR9 X0EIR9 X0GB09 X0GT09 X0GL09 X0GR09 X0H4100C", "X0H5100C X0H2100C X0H3100C X0PR09 X0RT09 X0ST09 X0SI09", "X0A10500 X0T10500 X0N4100C X0N5100C X0N2100C X0N3100C" CC="X0H410AC X0H510AC X0H210AC X0H310AC X0N410AC X0N510AC", "X0N210AC X0N310AC X04410BC X04510BC X04210BC X04310BC", "X0H410BC X0H510BC X0H210BC X0H310BC X0N410BC X0N510BC", "X0N210BC X0N310BC X04410DC X04510DC X04210DC X04310DC", "X0H410DC X0H510DC X0H210DC X0H310DC X0N410DC X0N510DC", "X0N210DC X0N310DC X0H410FC X0H510FC X0H210FC X0H310FC", "X0N410FC X0N510FC X0N210FC X0N310FC X0H410HC X0H510HC" DD="X0H210HC X0H310HC X0N410HC X0N510HC X0N210HC X0N310HC", "X04410JC X04510JC X04210JC X04310JC X0H410JC X0H510JC", "X0H210JC X0H310JC X0N410JC X0N510JC X0N210JC X0N310JC", "X0H410NC X0H510NC X0H210NC X0H310NC X0N410NC X0N510NC", "X0N210NC X0N310NC X0H410TC X0H510TC X0H210TC X0H310TC", "X0N410TC X0N510TC X0N210TC X0N310TC X0H410ZC X0H510ZC", "X0H210ZC X0H310ZC X0N410ZC X0N510ZC X0N210ZC X0N310ZC" T1V10500 = AA BB CC DD EE ii = index(T1v10500,chars) if ii ^= 0 then if point = '' then do; sysvar = SYSVAR "C US" /* unfortunately only T1V10500 has all point sizes */ codepage = "T1V10500 International #5, will become", "T1V10037 USA/CAN - CECP with DSMPROF4/ccc@SYM profile" say ' ' codepage end end IF POINT \= '' THEN do ; POINTV = POINT IF POINTV ='10' THEN POINTV ='0' IF POINTV ='11' THEN POINTV ='A' IF POINTV ='12' THEN POINTV ='B' IF POINTV ='14' THEN POINTV ='D' IF POINTV ='16' THEN POINTV ='F' IF POINTV ='18' THEN POINTV ='H' IF POINTV ='20' THEN POINTV ='J' IF POINTV ='24' THEN POINTV ='N' IF POINTV ='30' THEN POINTV ='T' IF POINTV ='36' THEN POINTV ='Z' IF LENGTH(POINTV) > 1 THEN do ; SAY "POINT("POINT")", " INVALID MUST BE 4-9,10-12,14,16,18,20,24,30,36" RETURN 20 end ; end else pointv='' if pointv \= '' then do if chars = 'X0H21001' then chars = substr(chars,1,6)||pointv||substr(chars,8,1) end if chars = '' then if '' \= , pointv||helvetica||italic||down||across||GT15||GT12||SANS||bold , ||techpsf , then do chars = 'X0T0550C' if techpsf = "TECHPSF" then chars="X0H22001" if gt12 = "GT12" then chars='X0GT12' if gt15 = "GT15" then chars='X0GT15' if pointv \= '' then chars=substr(chars,1,6)||pointv||substr(chars,8,1) if ACROSS = "ACROSS" then chars='X1'||substr(chars,3) if DOWN = "DOWN" | device = '38PPN8S' , then chars='X2'||substr(chars,3) if device = '' then device = "PG1A" if sans = 'SANS' then chars=substr(chars,1,2)||'A'||substr(chars,4) if italic = 'ITALIC' then chars=substr(chars,1,3)||'1'||substr(chars,5) if bold = 'BOLD' then chars=substr(chars,1,4)||'7'||substr(chars,6) if HELVETICA = 'HELVETICA' then do chars=substr(chars,1,2)||'H21001' /*X0H22001 HELVETICA LATIN1*/ if pointv \= '' then chars=substr(chars,1,6)||pointv||substr(chars,8,1) else do ;point = 10;pointv='0'; end if BOLD||ITALIC='ITALIC' then chars=substr(chars,1,3)||'3'||substr(chars,5) if BOLD||ITALIC='BOLD' then chars=substr(chars,1,3)||'4'||substr(chars,5) if BOLD||ITALIC='BOLDITALIC' then chars=substr(chars,1,3)||'5'||substr(chars,5) font = 'HELVETICA LATIN1' end end IF CHARS \= '' THEN IF SUBSTR(CHARDS,5,1) = ' ' THEN DO PERINCH= SUBSTR(CHARS,3,2); IF '24' = PERINCH THEN POINT = 04 IF '20' = PERINCH THEN POINT = 05 IF '15' = PERINCH THEN POINT = 08 IF '12' = PERINCH THEN POINT = 09 IF '10' = PERINCH THEN POINT = 10 IF CHARS = "GC15" THEN POINT = 07 SAY "PRINTING WILL BE DONE IN POINT REL 2 ", "COMPATIBILITY USING CHARS("CHARS")" end ; IF SUBSTR(CHARS,8,1) \= ' ' THEN DO if substr(chars,3,1) \= 'H' then do IF SUBSTR(chars,7,1) = 'A' then , FONT = 'SONORAN SANS SERIF' IF SUBSTR(chars,7,1) = 'T' then , FONT = 'SONORAN SERIF' IF SUBSTR(chars,7,1) = 'J' then , FONT = 'SONORAN DISPLAY' if substr(font,1,3) = 'SON' then do IF SUBSTR(chars,7,1) = '1' then , ITALIC = ITALIC IF SUBSTR(chars,5,1) = '7' then Bold = "BOLD"; else BOLD = "" end end if substr(chars,3,1) = "H" then do pointx = substr(chars,7,1) font = "HELVETICA" if substr(chars,5,1) = "2" then font="HELVETICA LATIN1" if substr(chars,5,1) = "1" then font="HELVETICA" end /* 12 WIDTH ULTRA-CONDENSED, MEDIUM, ULTR-EXPANDED*/ POINTX = SUBSTR(CHARS,8,1) IF POINTX= "0" THEN POINT = 10 IF POINTX= "A" THEN POINT = 11 IF POINTX= "B" THEN POINT = 12 IF POINTX= "D" THEN POINT = 14 IF POINTX= "F" THEN POINT = 16 IF POINTX= "H" THEN POINT = 18 IF POINTX= "J" THEN POINT = 20 IF POINTX= "N" THEN POINT = 24 IF POINTX= "T" THEN POINT = 30 IF POINTX= "Z" THEN POINT = 36 if substr(chars,8,1) = '1' then codepage = 'T1000361 LATIN1 Code Page (full set)' if substr(chars,2,6) = 'H21071' then codepage = 'T1V10037 USA/Canada CECP' CECP if substr(chars,2,6) = 'H21001' then codepage = 'T1V10037 USA/Canada CECP' CECP if substr(chars,8,1) = 'E' then codepage = 'T1000395 LATIN1 Code Page (10 only)' if substr(chars,8,1) = 'C' then codepage = 'T1DCDCFS U.S. Text Subset (full set)' if substr(chars,8,1) = 'I' then codepage = 'T1GI0361 International Set 5 (full set)' if substr(chars,8,1) = '5' then codepage = , 'T1Gi0395 United States, Canada (English) --(10 only)' SAY "Printing will begin with TYPE ("POINT" '"FONT"' ", ITALIC BOLD ") codepage" substr(codepage,1,8) SAY ' ' codepage END if CHARS \= '' then do if fontlibx = "" then fontlibx = "SYS1.PROD.FONTLIB" x = SYSDSN("'"fontlibx"("chars")'") if x \= 'OK' then do say fontlibx"("chars") -- "||x if substr(device,1,4) = 'PG1A' then return end charsx = ' CHARS('chars') ' end else charsx='' if FORMDEF \= '' then do x = SYSDSN("'SYS1.PROD.FDEFLIB(F1"FORMDEF")'") if x \= 'OK' then do xa= SYSDSN("'SYS1.FDEFLIB(F1"FORMDEF")'") if xa \= 'OK' then xa= SYSDSN("'SYS1.FDEFLIB(F1"FORMDEF")'") if xa \= 'OK' then do say "SYS1......FDEFLIB(f1"formdef") -- "||x return 12 end end end if fp ='' then fp = ' FP(2)' if library \= '' then library = " LIB('"library"')" SAY /* S -s- */"SCRIPT '"DSNXX"'"||profile, number||library||fontlib||INDEX||PSEGLIB, "DEV("device")"charsx continue||PSA||UP||FP"SYS("sysvar")", "M(ID"trace||delay")"||PAGE FILE bind||spell If dest = 'PU00L' then do if device \= '1403W8S' then call sayboth('Incorrect device for SYSTECH, s/b 1403W8S') if linect \= 0 then call sayboth('Incorrect LINECT('||linect||') s/b 0') if fcb \= '' then if fcb \= '8X85' then call sayboth('Incorrect FCB('||fcb||') s/b blank or 8X85') end if dest = "" then sysvar = sysvar "Z Unknown" else sysvar = sysvar "Z" dest if nowait = "NOWAIT" then call sayboth(' ---- The use of NOWAIT is no longer '||, 'meaningful on your @SCRIPT command ---------------') if document = "DOC" then do "LINE_BEFORE .BOT = dataline "" -- "INDEX , "DEV("device")"charsx continue||PSA||UP||FP"SYS("sysvar")", "M(ID"trace||delay")"||page bind||spell"""" "LINE_BEFORE .BOT = dataline "" -- OUTDES NAME1" OUTDES"""" end IF STOP = "STOP" then do ; say "OUTDES NAME1" OUTDES "<-- ended by STOP" ZEDSMSG = "STOP" ZEDLMSG = 'STOP option indicates not to do SCRIPTing' return 1 /* STOP option is for checking SCRIPT statement*/ end if document = "DOC" then "@SAVE" if BATCH = 'BATCH' then do if copies ='' then copies='1' LISTXDSN = "'"prefix".S9999B.LIST'" if direct = "DIRECT" | batch = "BATCH" , then FILE = " PRINT("copies","class")" else FILE = " FILE("listxdsn")" SAY "------------- BATCH Script will be invoked now --------------" ADDRESS "TSO" QUEUE "//IS03XX JOB (0289,O179),'D.MCR TEST',CLASS=9,MSGCLASS=T" QUEUE "//TS0 EXEC PGM=IKJEFT01,DYNAMNBR=20,REGION=6M" QUEUE "//DEFAULT OUTPUT FORMDEF="FORMDEF",DEFAULT=YES,DEST="dest QUEUE "//"||"*SYSTSPRT ------------ SCRIPT COMMAND AND ERR MSGS" QUEUE "//SYSTSPRT DD SYSOUT=T,DEST=AHCENTER,HOLD=YES" QUEUE "//SYSPROC DD DSN=SYS1.TSOCLIST,DISP=SHR ?SCRPTLIB?" x = outtrap('var.') "listddj SCRPTLIB"; if var.0 > 0 then do i=1 to var.0; queue var.i; say var.i; end ; x = outtrap('var.') "listddj TEXTLIB" if var.0 > 0 then do i=1 to var.0; queue var.i; say var.i; end ; QUEUE "//SYSTSIN DD *" QUEUE "SCRIPT '"DSNXX"'" " +" QUEUE profile"+" QUEUE number||library||fontlib" +" QUEUE INDEX||PSEGLIB" +" QUEUE "DEV("device")"charsx continue||PSA||UP||FP"SYS("sysvar") + " QUEUE "M(ID"trace||delay")"||PAGE||FILE bind||spell QUEUE " SEND 'BATCH SCRIPT RC="RC"',U(IS03)" QUEUE "$$" "SUBMIT * END($$)" return 1 end SAY "------------- Script will be invoked now --------------" Address "TSO" "SCRIPT '"DSNXX"'"||profile, number||library||fontlib||INDEX||PSEGLIB, "DEV("device")"charsx continue||PSA||UP||FP"SYS("sysvar")", "M(ID"trace||delay")"||page||FILE bind||spell ScriptRC = rc ScriptRCc = ScriptRC SAY "Script/VS RC="ScriptRC", OUTDES=OUTDES NAME1 "outdes Address "TSO" "$time @SCRIPT --" IF EDIT = "BROWSE" & substr(device,1,2) = "PG" then do VSTSRVTI = listxdsn /* e.g. PG1A, PG1A90, PG4A, PG4A90 */ Address "ISPEXEC" "VPUT (VSTSRVTI) SHARED" DSNDESC = "Page count may be determined with F X'D3A8AF' ALL" ADDRESS "ISPEXEC" "VPUT (DSNDESC) SHARED" /* PANEL SYSBROB2 WILL TREAT CMDVAR AS INITIAL COMMAND*/ CMDVAR = "F X'D3A8AF' ALL" ADDRESS "ISPEXEC" "CONTROL NONDISPL ENTER" ADDRESS "ISPEXEC" "BROWSE DATASET("listxdsn") PANEL(SYSBROB2)" if ScriptRC = 0 then do /* give a chance to cancel */ say "Hit ENTER to print, type CANCEL to not print";say '***' Address "REXX" pull answer Address "TSO" answer = translate(answer) ZEDSMSG = "Not Printed, Script/VS RC="ScriptRC ZEDLMSG = "SCRIPT invoked by" SYSVAR(SYSICMD) , "RC=0, not printed by your request to CANCEL" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" if "CAN" = substr(answer,1,3) then return 1 end end else IF EDIT \= '' then do if edit = 'BROWSE' then say , "page count may be determined with F x'D3A8AF' all" address "TSO" "$"EDIT listxdsn macro return 1 end if VIEW = "VIEW" then do Address "TSO" "%CSTSVW VIEW" return 1 end if ScriptRC \= 0 then do ZEDSMSG = "Script/VS RC="ScriptRC ZEDLMSG = "SCRIPT invoked by" SYSVAR(SYSICMD) , ", please fix your text, Script/VS RC="ScriptRC Address "ISPEXEC" "SETMSG MSG(ISRZ000)" say '==========> Your SCRIPT text has errors. <=================' say '=====> Please make a note of errors shown above. <==========' say 'Then hit ENTER, to return to your text and to fix errors. ' say '*** TO FORCE PRINTING, reply with CONTINUE' Address "ISREDIT" "F ':docprof' 1 first" if rc = 0 then say '*** :docprof -- use option B for BookMaster' Address "ISREDIT" "F ':userdoc' 1 first" if rc = 0 then say '*** :userdoc -- use option B for BookMaster' Address "ISREDIT" "F ':prolog' 1 first" if rc = 0 then say '*** :prolog -- use option B for BookMaster' say '***' Address "REXX" arg answerx /* eliminate any garbage */ pull answer Address "ISREDIT" answer = translate(answer) /*testing -- if device = 'PG1A90' then answer = "CONTINUE"*/ if answer = "CONTINUE" then ScriptRCc = 0 end IF ScriptRCc = 0 THEN DO ZEDSMSG = "Script/VS RC="ScriptRC ZEDLMSG = "SCRIPT invoked by" SYSVAR(SYSICMD) "ran fine RC=0" if ScriptRCc \= ScriptRC then ZEDLMSG = "Script/VS invoked by" SYSVAR(SYSICMD) , "(forced to continue) RC="ScriptRC Address "ISPEXEC" "SETMSG MSG(ISRZ000)" if "NOPRINT" = noprint then do say "ended by NOPRINT option" return 1 end Address "TSO" status = msg('off') "FREE OUTDES(NAME1) FI(SYSUT1 SYSUT2 SYSPRINT)" status = msg('on') if groupid = '' then if formdef \= '' then outdes = outdes 'GROUPID('formdef')' SAY "OUTDES NAME1 " OUTDES "OUTDES NAME1" OUTDES if rc \=0 then do end "ALLOC FI(SYSPRINT) DUMMY " "ALLOC FI(SYSUT1) DA("listxdsn") SHR" "ALLOC FI(SYSUT2) SYSOUT("class") OUTDES(NAME1) " "ALLOC FI(SYSIN) DUMMY REUSE " "CALL 'SYS1.LINKLIB(IEBGENER)' " if rc = 0 then SAY "Document has been Printed to CLASS("class")" "FREE FI(SYSUT1 SYSUT2) OUTDES(NAME1) " "ALLOC FI(SYSIN) DA(*) REUSE " "ALLOC FI(SYSPRINT) DA(*) REUSE " if idata = "IDATA" then if timinig = "TIMING" then "%IDATA1" END Address "ISREDIT" , "LINE_BEFORE .ZCSR = NOTELINE """TIME('N') " ===> " SYSVAR(SYSICMD), "--completed Script/VS RC="ScriptRC Date('U') """" exit Sayboth: procedure expose document arg saying Say saying address "ISREDIT" "LINE_BEFORE .ZF = NOTELINE """Saying"""" if document = "DOC" then do address "ISREDIT" "LINE_BEFORE .ZL = DATALINE "" "Saying"""" end return Process: procedure expose token arg subtoken i = index(token,' '||subtoken||' ') if i=0 then return '' tokenx = substr(token,1,I) || substr(token,I+2+length(subtoken)) token = tokenx return subtoken ProcessB: procedure expose token arg subtoken x = process(subtoken) if x \='' then x = ' '||x return x