CONTROL ASIS ISREDIT MACRO (TOK1,TOK2,TOK3,TOK4,TOK5,TOK6,TOK7,TOK8,TOK9,TOK10,+ TOK11,TOK12,TOK13,TOK14,TOK15,TOK16,TOK17,TOK18,TOK19,+ TOK20,TOK21,TOK22,TOK23,TOK24,TOK25,TOK26,TOK27,TOK28,+ TOK29,TOK30,TOK31,TOK32,TOK33,TOK34,TOK35,TOK36,TOK37) /* TO PRINT IN PORTRAIT FASHION /* ===TESTING ON SCRIPT PAPER /* ===> @PRINT CLASS(X) FORMDEF(0101PA) PAGEDEF(08080) -- THIS WORKS. /* ===TESTING ON REGULAR PAPER /* ===> @PRINT CLASS(X) FORMDEF(0101LA) PAGEDEF(08081) -- I THINK SO. /* PURPOSE: TSO PRINTOFF FOR MEMBER CURRENTLY DISPLAYED IN EDIT /* CONTRIBUTED: F. DAVID MCRITCHIE 1986/02/04 /* USER CONTACT: F. DAVID MCRITCHIE /* CODE MAINT.: SYSTECH GROUP /************************************************************** /* DOCUMENTED IS03.SHARE.TEXT(@PRINT) /* EXAMPLES: ... /* ==> @PRINT GOES TO BWATER 3800 /* ==> @PRINT DOWN | DOWN8 GOES TO BWATER 3800-5 CLASS=2 /* ==> @PRINT DOWN10 GOES TO BWATER 3800-5 CLASS=2 /* ==> @PRINT DEST(P100E) GOES TO SYSTECH PRINTER /* ==> @PRINT SYSTECH GOES TO SYSTECH PRINTER /* ==> @PRINT PROFS(MCRITCHI) /* USES IEBGENER TO SYSUT2 ALLOCATED DEST(BXXXXXXX.MCRITCHI) /* ==> @PRINT PROFS(MCRITCHI) BATCH /* SAME AS ==> @PRINT DEST(BXXXXXXX.MCRITCHI) BATCH /* ==> @PRINT DEST(CGDL2) DALLAS --- XEROX PRINTER /* ==> @PRINT OPTCD=J | OPTCD | OPTCD(J) /* ==> @PRINT TEST TELL OPTIONS DO NOTHING /* /* THE FOLLOWING ARE OPTIONAL TO THE NON-BATCH COMMAND PRINTOFF /* LIST/NOLIST PRINT/NOPRINT FOLD/NOFOLD /* THE FOLLOWING ARE OPTIONAL BOTH TO PRINTOFF AND TO BATCH JOB /* CLASS(X) DEST(XXXXXX) COPIES(X) VOLUME(XXXXXX) VOL(XXXXXX) /* HOLD/NOHOLD /* THE FOLLOWING WITH NOTHING ELSE WILL ALLOW IEBGENER TO BE USED /* IN PREFERENCE TO GENERATING A BATCH JOB /* PROFS(XXXXX) /* THE FOLLOWING OPTIONS WILL CAUSE A BATCH JOB TO BE USED /* CHARS(XXXX) GENERATES CHARS=XXXX, /* DOWN GENERATES PAGEDEF=08081,CLASS=2,CHARS=GT15, 08081 /* MA GENERATES PAGEDEF=M13280,CLASS=2,CHARS=GT20, /* MD GENERATES PAGEDEF=M132C1,CLASS=2,CHARS=GT20, /* FCB(XXXX) GENERATES FCB=XXXX, /* GTXX GENERATES FCB=XXXX, /* OPTCD... GENERATES DCB=OPTCD=J, /* PAGEDEF(XX) GENERATES PAGEDEF=XX, /* PAGEDEF(XXXX) GENERATES PAGEDEF=XXXX, ON OUTPUT STATMENT /* SCRIPT WHICH IMPLIES FCB=8X11,CHARS=GT12, /**************************************************************** SET PROFS = &STR(//)&STR(*) SET NPROFS = &STR() ISREDIT LINE_BEFORE .ZFIRST = - NOTELINE "&SYSTIME. @PRINT &TOK1 &TOK2 &TOK3 &TOK4 &TOK5 &TOK6 + &TOK7 &TOK8 &TOK9 &TOK10 &TOK11 &TOK12 &TOK13 " SET BLANKS = &STR( ) ISREDIT (DSNX) = DATASET ISREDIT (MEMBERX) = MEMBER IF &STR(&MEMBERX) = &STR() THEN SET DSNXX = &DSNX ELSE SET DSNXX = &DSNX(&MEMBERX) ISREDIT (DCHG) = DATA_CHANGED /* OUTPUT FOR CLASS = A UNLESS SCRIPT, */ /* IN WHICH CASE IT OUTPUTS TO CLASS Y */ ISREDIT (VAR016) = DATA_WIDTH SET COPIES = 1 SET MSGCLASS = 9 SET RP = &STR() IF &DCHG = YES THEN DO WRITE ****************************************************** WRITE * YOUR FILE HAS NOT BEEN SAVED AFTER MAKING CHANGES * WRITE * * WRITE * THE FILE PRINTED WILL NOT REFLECT CHANGES MADE IN * WRITE * THE CURRENT EDIT SESSION * WRITE ****************************************************** WRITE REPLY TO PRINT OLD VERSION WRITE REPLY "SAVE" | "SAV" TO SAVE THEN PRINT SAVED VERSION WRITE REPLY "CANCEL" | "CAN" IF YOU DO NOT WANT TO PRINT THE OLD READ PARM1 IF &SUBSTR(1:3,&STR(&SYSCAPS(&PARM1.) )) = CAN THEN DO WRITE TERMINATED BY YOUR COMMAND ... "CAN". SET &ZEDSMSG = &STR(TERMINATED) SET &XEDLMSG = &STR(CHANGES DONE SINCE LAST SAVE -- + YOU HAVE REPLIED TO CANCEL @PRINT) SET &ZEDLMSG = &STR(&XEDLMSG.) ISPEXEC SETMSG MSG(ISRZ000) EXIT CODE(8) END IF &SUBSTR(1:3,&STR(&SYSCAPS(&PARM1.) )) = SAV THEN DO ISREDIT SAVE SET RC = &LASTCC. /* 0 - NORMAL SAVE, 4 - NEW MEMBER SAVED, 12 DATA NOT SAVED IF &RC. > 4 THEN DO WRITE ****************************************************** WRITE * UNABLE TO SAVE YOUR FILE RC = &RC. * WRITE ****************************************************** SET &ZEDSMSG = &STR(TERMINATED) SET &XEDLMSG = &STR(UNABLE TO SAVE CHANGES -- + PERHAPS A COMPRESS IS NEEDED) SET &ZEDLMSG = &STR(&XEDLMSG.) ISPEXEC SETMSG MSG(ISRZ000) EXIT CODE(8) END GOTO SAVED END SET &ZEDSMSG = &STR(PRINTED/OLD CONTENT) SET &XEDLMSG = &STR(CHANGES DONE SINCE LAST SAVE -- + CONTENT PRINTED NOT SAME AS DISPLAYED...) SET &ZEDLMSG = &STR(&XEDLMSG.) ISPEXEC SETMSG MSG(ISRZ000) END SAVED: - IF &STR(&DSNX) = &STR() THEN - EXIT CODE(12) SET BLANKS = &STR(&BLANKS&BLANKS) SET BLANKS = &STR(&BLANKS&BLANKS) SET BLANKS = &STR(&BLANKS&BLANKS) SET LP = &STR(( SET RP = &STR()) SET N0 = 20 SET N = 0 SET I = 0 SET L = 0 /********* SET I = 1 DO WHILE &I <= 100 SET TOKEN = &&TOK&I SET TOKEN = &STR(&SYSCAPS(&TOKEN)) IF DEBUG = &DEBUG THEN WRITE &I TOK&&I=&&TOK&I TOKEN=&TOKEN IF &STR(&TOKEN) = &STR() THEN GOTO END_TOK IF ALL = &STR(&TOKEN) | NEXT = &STR(&TOKEN) | FIRST = + &STR(&TOKEN) | LAST = &STR(&TOKEN) | PREV = &STR(&TOKEN) + THEN DO SET &ZEDSMSG = &STR(&TOKEN INVALID) SET &ZEDLMSG = &STR("&TOKEN" NOT PROVIDED FOR NOR ARE NEXT + ALL FIRST LAST PREV) ISPEXEC SETMSG MSG(ISRZ000) EXIT CODE(12) END IF TEST = &STR(&TOKEN) THEN DO SET TEST = TEST GOTO NXT_TOK END IF OUTDES = &STR(&TOKEN) THEN DO SET OUTDES = OUTDES GOTO NXT_TOK END IF 3900 = &STR(&TOKEN) THEN DO SET WRITER = &STR(,WRITER=T3900) SET BATCH = BATCH SET MSGCLASS = T SET CLASS = X GOTO NXT_TOK END IF &STR(&TOKEN) = SYSTECH | &STR(&TOKEN) = P100E | + &STR(&TOKEN) = TECH - | &STR(&TOKEN) = SYSTECH THEN DO SET TOK&I = DEST(P100E&RP. SET DESTG = &STR(AHCENTER.P100E) SET DESTJ = &STR(DEST=AHCENTER.P100E,) SET BATCH = BATCH GOTO NXT_TOK END IF &STR(&TOKEN) = SYSTECHL | &STR(&TOKEN) = PU00L | + &STR(&TOKEN) = TECHL - | &STR(&TOKEN) = SYSTECHL THEN DO SET TOK&I = DEST(PU00L&RP. SET DESTG = &STR(AHCENTER.PU00L) SET DESTJ = &STR(DEST=AHCENTER.PU00L,) SET BATCH = BATCH GOTO NXT_TOK END IF SCRIPT = &STR(&TOKEN) THEN DO IF &STR(&CHARS) = THEN SET CHARS = &STR(CHARS=GT12,) IF &STR(&FCB) = THEN SET FCB = &STR(FCB=8X11,) IF &STR(&CLASS) = THEN SET CLASS = Y SET BATCH = BATCH GOTO NXT_TOK END IF DOWN8 = &STR(&TOKEN) THEN - IF &STR(&CHARS.) = &STR() THEN DO IF &VAR016 > 83 THEN DO ISREDIT SEEK FIRST 84 &VAR016. P'^' IF &LASTCC = 0 THEN SET CHARS = &STR(CHARS=GT15,) ELSE SET CHARS = &STR(CHARS=GT12,) END ELSE SET CHARS = &STR(CHARS=GT12,) END ELSE DO IF &STR(&CHARS.) = GT20 THEN DO IF &STR(&LINECT) = THEN SET LINECT = 0 END END IF DOWN = &STR(&TOKEN) THEN DO IF &STR(&CHARS.) = &STR() THEN DO IF &VAR016 > 90 THEN DO ISREDIT SEEK FIRST 91 &VAR016. P'^' IF &LASTCC = 0 THEN SET CHARS = &STR(CHARS=GT15,) ELSE SET CHARS = &STR(CHARS=GT12,) END ELSE SET CHARS = &STR(CHARS=GT12,) END IF &STR(&CHARS) = THEN SET CHARS = &STR(CHARS=GT15,) IF &STR(&PAGEDEF) = THEN SET PAGEDEF = &STR(PAGEDEF=08081,) IF &STR(&LINECT) = THEN SET LINECT = 77 IF &STR(&CLASS) = THEN SET CLASS = 2 SET BATCH = BATCH GOTO NXT_TOK END IF IDATA = &STR(&TOKEN) THEN DO IF &STR(&CHARS) = THEN SET CHARS = &STR(CHARS=GT15,) IF &STR(&PAGEDEF) = THEN SET PAGEDEF = &STR(PAGEDEF=A08682,) /* A08682 IS 86LINE/PAGE, A06462 IS 64 LINES /PAGE*/ IF &STR(&FORMDEF) = THEN SET FORMDEF = &STR(FORMDEF=A10110,) IF &STR(&LINECT) = THEN SET LINECT = 86 IF &STR(&CLASS) = THEN SET CLASS = S SET BATCH = BATCH GOTO NXT_TOK END IF DOWN8 = &STR(&TOKEN) + | DOWN10 = &STR(&TOKEN) THEN DO IF &STR(&CHARS) = THEN SET CHARS = &STR(CHARS=GT15,) IF &STR(&PAGEDEF) = THEN SET PAGEDEF = &STR(PAGEDEF=&TOKEN.,) IF &STR(&LINECT) = THEN SET LINECT = 77 IF &STR(&CLASS) = THEN SET CLASS = A SET BATCH = BATCH GOTO NXT_TOK END IF MA = &STR(&TOKEN) THEN DO /* MULIPLE-ACROSS */ IF &STR(&CHARS) = THEN SET CHARS = &STR(CHARS=GT20,) IF &STR(&PAGEDEF) = THEN SET PAGEDEF = &STR(PAGEDEF=M13280,) IF &STR(&CLASS) = THEN SET CLASS = A SET BATCH = BATCH GOTO NXT_TOK END IF MD = &STR(&TOKEN) THEN DO /* MULIPLE-DOWN */ IF &STR(&CHARS) = THEN SET CHARS = &STR(CHARS=GT20,) IF &STR(&PAGEDEF) = THEN SET PAGEDEF = &STR(PAGEDEF=M132C1,) IF &STR(&CLASS) = THEN SET CLASS = A SET BATCH = BATCH GOTO NXT_TOK END IF &STR(GT) = &SUBSTR(1:2,&STR(&TOKEN) ) THEN DO /* E.G. GT10 GT12 GT15 GT20 GT24 */ SET CHARS = &STR(CHARS=&TOKEN.,) SET BATCH = BATCH GOTO NXT_TOK END IF HELP = &STR(&TOKEN) | BATCH = &STR(&TOKEN) - THEN DO SET &&TOKEN. = &STR(&TOKEN) IF DEBUG = &DEBUG THEN WRITE &I TOK&I=&TOK&&I + TOKEN=&TOKEN GOTO NXT_TOK END IF HOLD = &STR(&TOKEN) THEN DO SET HOLD = &STR(HOLD=YES,) GOTO NXT_TOK END IF NOHOLD = &STR(&TOKEN) THEN DO SET HOLD = &STR(HOLD=NO,) GOTO NXT_TOK END IF &SUBSTR(1:9,&STR(&TOKEN) ) = + &STR(MSGCLASS&STR(&LP)) THEN DO SET MSGCLASS = &SUBSTR(10:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) SET BATCH = BATCH GOTO NXT_TOK END IF &SUBSTR(1:8,&STR(&TOKEN) ) = &STR(PAGEDEF&STR(&LP)) + THEN DO SET PAGEDEF = &SUBSTR(9:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) IF &LENGTH(&PAGEDEF.) > 6 THEN DO SET &ZEDSMSG = &STR(PAGEDEF= INVALID) SET &ZEDLMSG = &STR(&PAGEDEF. EXECEEDS 6 CHAR. LIMIT, + EXAMPLES: 8X85 08080 8X11 08081 ISPEXEC SETMSG MSG(ISRZ000) EXIT CODE(12) END SET PAGEDEF = &STR(PAGEDEF=&PAGEDEF.,) SET BATCH = BATCH GOTO NXT_TOK END IF &SUBSTR(1:8,&STR(&TOKEN) ) = &STR(FORMDEF&STR(&LP)) + THEN DO SET FORMDEF = &SUBSTR(9:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) IF &LENGTH(&FORMDEF.) > 6 THEN DO SET &ZEDSMSG = &STR(FORMDEF= INVALID) SET &ZEDLMSG = &STR(&FORMDEF. EXECEEDS 6 CHAR. LIMIT, + EXAMPLES: 0101LA 0101PA 0101PD 0101LA 0101LD) ISPEXEC SETMSG MSG(ISRZ000) EXIT CODE(12) END SET FORMDEF = &STR(FORMDEF=&FORMDEF.,) SET BATCH = BATCH GOTO NXT_TOK END IF &SUBSTR(1:7,&STR(&TOKEN) ) = &STR(LINECT&STR(&LP)) + THEN DO SET LINECT = &SUBSTR(8:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) SET BATCH = BATCH GOTO NXT_TOK END IF &SUBSTR(1:7,&STR(&TOKEN) ) = &STR(WRITER&STR(&LP)) + THEN DO SET WRITER = &SUBSTR(8:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) WRITE PLEASE USE WTR(&WRITER.) INSTEAD OF WRITER(&WRITER.) SET WRITER = &STR(WRITER=&WRITER,) SET BATCH = BATCH GOTO NXT_TOK END IF &SUBSTR(1:4,&STR(&TOKEN) ) = &STR(WTR&STR(&LP)) + THEN DO SET WRITER = &SUBSTR(5:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) SET WRITER = &STR(WRITER=&WRITER,) SET BATCH = BATCH GOTO NXT_TOK END IF &SUBSTR(1:7,&STR(&TOKEN) ) = &STR(COPIES&STR(&LP)) + THEN DO SET COPIES = &SUBSTR(8:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) GOTO NXT_TOK END IF &SUBSTR(1:5,&STR(&TOKEN) ) = &STR(OPTCD) + THEN DO SET OPTCD = &STR(,DCB=OPTCD=J,CHARS=&LP.GT15,GB15&RP.) SET BATCH = BATCH ISREDIT SEEK FIRST 2 '1' IF &LASTCC ^= 0 THEN DO ISREDIT LINE_BEFORE .ZF = NOTELINE + "THERE IS NO '1' IN COLUMN 2 OF ANY LINE" ISREDIT LINE_BEFORE .ZF = NOTELINE + " USE OF '0' AND '1' ARE EXPECTED AS VALUES" WRITE WARNING -- THERE IS NO "1" IN COLUMN 2 OF ANY LINE WRITE WARNING -- USE OF "0" AND "1" ARE EXPECTED + AS VALUES SET &ZEDSMSG = &STR(OPTCD? QUESTIONABLE) SET &ZEDLMSG = &STR(NO "1" IN COLUMN 2 OF ANY LINE) ISREDIT LINE_BEFORE &REFBEG. = + NOTELINE "*ERROR** &XEDLMSG." ISPEXEC SETMSG MSG(ISRZ000) END GOTO NXT_TOK END IF &SUBSTR(1:6,&STR(&TOKEN) ) = &STR(BEGIN&STR(&LP)) + THEN DO SET BEGIN = &SUBSTR(7:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) GOTO NXT_TOK END IF &SUBSTR(1:6,&STR(&TOKEN) ) = &STR(CHARS&STR(&LP)) + THEN DO SET CHARS = &SUBSTR(7:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) SET CHARS = &STR(CHARS=&CHARS.,) SET BATCH = BATCH GOTO NXT_TOK END IF &SUBSTR(1:5,&STR(&TOKEN) ) = &STR(CHARS&STR(&LP)) + THEN DO SET CHARS = &SUBSTR(6:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) WRITE **PLEASE USE CHARS(&CHARS.) -- CHAR IS INVALID. EXIT CODE(12) SET CHARS = &STR(CHARS=&CHARS.,) SET BATCH = BATCH WRITE PLEASE USE &CHARS GOTO NXT_TOK END IF &SUBSTR(1:6,&STR(&TOKEN) ) = &STR(CLASS&STR(&LP)) + THEN DO SET CLASS = &SUBSTR(7:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) SET BATCH = BATCH GOTO NXT_TOK END IF &SUBSTR(1:6,&STR(&TOKEN) ) = &STR(PROFS&STR(&LP)) + THEN DO SET PROFS = &STR() SET NPROFS = &STR(/)&STR(/)&STR(*) SET MSGCLASS = T SET DEST = &SUBSTR(7:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) SET IX = &SYSINDEX(.,&STR(&DEST.)) IF &EVAL(&IX.) = &EVAL(0) THEN DO SET DEST = &STR(BXXXXXXX.&DEST.) WRITE 'MSMAILNE ADDRESSES ARE NOT AVAILABLE IN THIS MANNER' /* FOR MSMAIL USING THE APPLICATION TOOLS PACKAGE...*/ /* WOULD NEED VALID, FROM ADDRESSEE AND A SUBJECT */ END IF &STR(&CLASS.) = &STR() THEN SET CLASS = Z SET GENER = GENER SET DESTG = &STR(&DEST.) SET DESTJ = &STR(DEST=&DEST.,) GOTO NXT_TOK END IF &SUBSTR(1:5,&STR(&TOKEN) ) = &STR(DEST&STR(&LP)) + THEN DO SET DEST = &SUBSTR(6:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) IF DALLAS = &STR(&DEST.) | CCC = &STR(&DEST.) | + XEROX = &STR(&DEST.) THEN DO WRITE CHANGED FROM DEST(&DEST.) TO DEST(CGDL2) SET DEST = CGDL2 END SET IX = &SYSINDEX(.,&STR(&DEST.)) IF &IX > 0 THEN SET BATCH = BATCH SET DESTG = &STR(&DEST.) SET DESTJ = &STR(DEST=&DEST.,) GOTO NXT_TOK END IF &SUBSTR(1:4,&STR(&TOKEN) ) = &STR(FCB&STR(&LP)) + THEN DO SET FCB = &SUBSTR(5:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) SET FCB = &STR(FCB=&FCB.,) SET BATCH = BATCH GOTO NXT_TOK END IF &SUBSTR(1:4,&STR(&TOKEN) ) = &STR(VOL&STR(&LP)) + THEN DO SET VOL = &SUBSTR(5:&EVAL(&LENGTH(&STR(&TOKEN))-1),+ &STR(&TOKEN) ) SET VOL = &STR(UNIT=3380,VOL=SER=&VOL,) GOTO NXT_TOK END SET REMAIN = &STR(&REMAIN &STR(&TOKEN)) WRITE REMAIN = &STR(&REMAIN &STR(&TOKEN)) NXT_TOK: - SET I = &I + 1 END END_TOK: SET I = &I /**************************************************************** /**************************************************************** IF &STR(&OUTDES.) NE &STR() THEN DO WRITE &CHARS. &PAGEDEF. EXIT CODE(1) END IF &STR(&PAGEDEF.) NE &STR() THEN DO SET BATCH = BATCH SET FCB = IF &STR(&CHARS.&PAGEDEF.) = &STR(CHARS=GT10,PAGEDEF=08081,) + THEN DO WRITE *************************************************** WRITE WARNING GT10 MAY RESULT IN LINE LOSS AT TOP OF PAGE WRITE *************************************************** ISREDIT LINE_BEFORE .ZF = NOTELINE + "WARNING GT10 MAY RESULT IN LOSS OF LINES AT TOP OF PAGE" SET WARN = &STR(--WARNING GT10 MAY RESULT PAGE TOP LINE LOSSES) END END IF BATCH = &BATCH THEN DO ISREDIT LINE_BEFORE .ZF = NOTELINE "-- IF YOU ARE + ALLOCATED EXCLUSIVELY TO THIS DATASET YOU MAY HAVE " ISREDIT LINE_BEFORE .ZF = NOTELINE + "&RBL. TO EXIT OUT OF THE DATASET -- FOR THE BATCH JOB TO RUN" IF &MEMBERX. = &STR() THEN - ISREDIT LINE_BEFORE .ZF = NOTELINE + "&RBL. SEQUENTIAL DATASETS ARE MORE LIKELY TO BE ENQUEUED ON" ISREDIT LOC 0 GOTO SCRIPT END IF GENER = &GENER THEN GOTO GENERX /* *************************************************************** IF &STR(&MEMBERX) = &STR() THEN DO PRINTOFF '&DSNX' - &TOK1 &TOK2 &TOK3 &TOK4 &TOK5 &TOK6 &TOK7 &TOK8 &TOK9 + &TOK10 &TOK11 &TOK12 &TOK13 EXIT CODE(0) END IF DEBUG = &DEBUG THEN CONTROL LIST CONLIST SYMLIST PRINTOFF '&DSNX(&MEMBERX)' - &TOK1 &TOK2 &TOK3 &TOK4 &TOK5 &TOK6 &TOK7 &TOK8 &TOK9 + &TOK10 &TOK11 &TOK12 &TOK13 EXIT CODE(0) /******************************************************************** /* ALLOCATE DOES NOT WORK FOR A PRINTER ONLY A USER */ /* THIS WOULD WORK FOR BXXXXXXX.MCRITCHI /* BUT WILL NOT WORK FOR AHCENTER.P100E A PRINTER /* AND WILL NOT WORK FOR AHCENTER.IS03 A TSO USERID GENERX: - IF &STR(&CLASS.) = &STR() THEN SET CLASS = A ALLOC FILE(SYSUT2) DEST(&DESTG.) SYSOUT(&CLASS.) REUSE IF &STR(&MEMBERX) = &STR() THEN - ALLOC FILE(SYSUT1) DA('&DSNX.') SHR REUSE ELSE - ALLOC FILE(SYSUT1) DA('&DSNX(&MEMBERX)') SHR REUSE ALLOC FILE(SYSPRINT) DSNAME(*) REUSE ALLOC FILE(SYSIN) DUMMY BLKSIZE(80) REUSE OLDGENER SET RC = &LASTCC. WRITE RETURN CODE=&RC. FREE FI(SYSPRINT SYSIN SYSUT1 SYSUT2) ALLOC FI(SYSPRINT) DS(*) ALLOC FI(SYSIN) DS(*) EXIT CODE(1) /******************************************************************** /* BATCH JOB WILL BE SUBMITTED -- MAY OR MAY NOT BE SCRIPT PAPER */ SCRIPT: - ISPEXEC VGET (TACCT) PROFILE IF &STR(&TACCT) = &STR() THEN DO WRITE PLEASE YOUR SUPPLY 4-DIGIT COST CENTER ACCOUNT NUMBER -- + FOR JOBCARD GENERATION READ TACCT ISPEXEC VPUT (TACCT) PROFILE END ISPEXEC VGET (TACCT) PROFILE IF &STR(&TACCT) = &STR() THEN DO WRITE PLEASE YOUR SUPPLY 4-DIGIT COST CENTER ACCOUNT NUMBER -- + FOR JOBCARD GENERATION READ TACCT ISPEXEC VPUT (TACCT) PROFILE END SET BLANKS = &STR( ) + &STR( ) SET PRTX = &SUBSTR(1:54,&DSNXX.&BLANKS) SET JOBNAME = &SUBSTR(1:8,&SYSUID.$P&MSGCLASS.&CLASS. ) IF &STR(&CLASS) = THEN SET CLASS = A ISREDIT LINE_BEFORE .ZF = MSGLINE '&TOK1. &TOK2. &TOK3. + &TOK4. &TOK5. -- LINECT=&LINECT.,CLASS=&CLASS.,+ &CHARS&FCB&HOLD.COPIES=&COPIES.&OPTCD -- &SYSTIME.' IF TEST = &TEST THEN EXIT CODE(4) SUBMIT * END($$) //&JOBNAME. JOB (&TACCT.), // NOTIFY=&SYSUID.,MSGCLASS=&MSGCLASS.,MSGLEVEL=(1,1),CLASS=X /*JOBPARM LINECT=0 //OUTPUT01 OUTPUT &DESTJ.&CHARS.LINECT=0&LINECT., // &PAGEDEF.&FORMDEF.&WRITER.CLASS=&CLASS. //S1 EXEC PGM=IEBGENER //SYSPRINT DD SYSOUT=*,DCB=BLKSIZE=605 NORMALLY WON'T PRINT &NPROFS.//SYSIN DD DUMMY //SYSUT1 DD * &RBL. &STR(&PRTX.)&SYSDATE. &SYSTIME. &RBL. @PRINT &TOK1. &TOK2. &TOK3. &TOK4. &TOK5. + &WARN. &FCB. &RBL. &PAGEDEF. &FORMDEF. &FCB. &RBL. ===============================================================+ ======= &RBL. &RBL. &PROFS. GENERATE MAXFLDS=2,MAXLITS=2 &PROFS. RECORD FIELD=(80,1,,1),FIELD=(1,'º',,81) //SYSUT2 DD DSN=&&TEMP,DISP=(,PASS),UNIT=VIO, // DCB=&DSNX //S2 EXEC PGM=IEBGENER //SYSPRINT DD SYSOUT=*,DCB=BLKSIZE=605 NORMALLY WON'T PRINT &NPROFS.//SYSIN DD DUMMY //SYSUT1 DD DSN=&&TEMP,DISP=(OLD,DELETE) 1992/08/23 FROM PASS // DD DSN=&DSNXX, // &VOL.DISP=SHR //SYSUT2 DD SYSOUT=(,),&CHARS&FCB&HOLD.COPIES=&COPIES.&OPTCD, // OUTPUT=*.OUTPUT01 &PROFS. GENERATE MAXFLDS=2,MAXLITS=2 &PROFS. RECORD FIELD=(80,1,,1),FIELD=(1,'º',,81) $$ IF IS03 = &SUBSTR(1:4,&SYSUID.XXXX) THEN + WRITE &RBL. @PRINT &TOK1. &TOK2. &TOK3. &TOK4. &TOK5. + &WARN. &PAGEDEF. &FORMDEF. &FCB. /**********/