TITLE 'IKJEFF13 - USERID PROMPT JOB ROUTINE' 00010000 * GEN (TITLE 'IKJEFF13 --- USERID PROMPT JOB ROUTINE '); 00020000 TITLE 'IKJEFF13 --- USERID PROMPT JOB ROUTINE ' 00030000 * /******************************************************************* 00040000 * /* * 00050000 * /* MODULE NAME = IKJEFF13 * 00060000 * /* * 00070000 * /* DESCRIPTIVE NAME = PROMPT JOB CHARACTER ROUTINE * 00080000 * /* * 00090000 * /******************************************************************* 00100000 * /* STATUS * 00110000 * /* VS2 RELEASE 02.0 * 00120000 * /* * 00130000 * /* COPYRIGHT = NONE * 00140000 * /* * 00150000 * /* PATCH NAME = PATCH (INITIALIZED WITH 'ZAP'S) * 00160000 * /* * 00170000 * /* CHANGE ACTIVITY = Y02656 (NO APARS) * 00180000 * /* * 00190000 * /* FUNCTION * 00200000 * /* . PROMPTJOB COMPARES THE JOB NAME * 00210000 * /* AGAINST THE USERID AND PROMPTS THE * 00220000 * /* USER, BY WAY OF THE MESSAGE ROUTINE, * 00230000 * /* FOR AN ALPHANUMERIC IF THE NAME * 00240000 * /* CONSISTS OF THE USERID ONLY. THE * 00250000 * /* ALPHANUMERIC WILL BE APPENDED TO THE * 00260000 * /* USERID TO COMPLETE THE JOBNAME. IN * 00270000 * /* SUCH A CASE, THE CONTROL ROUTINE * 00280000 * /* IKJEFF06 IS CALLED TO HAVE THE CHANGED * 00290000 * /* JOB CARD PROCESSED. * 00300000 * /* * 00310000 * /* . IF THERE IS NO ROOM TO ADD A * 00320000 * /* CHARACTER, THE GENJOB ROUTINE IKJEFF08 * 00330000 * /* IS CALLED TO GENERATE A DEFAULT JOB * 00340000 * /* STATEMENT. THE ORIGINAL IS TURNED * 00350000 * /* INTO A COMMENT. * 00360000 * /* * 00370000 * /* ENTRY POINT * 00380000 * /* IKJEFF13 * 00390000 * /* * 00400000 * /* INPUT * 00410000 * /* . REGISTER 1 POINTS TO A LIST OF * 00420000 * /* POINTERS TO THE FOLLOWING PARAMETERS * 00430000 * /* * 00440000 * /* MESSAGE ROUTINE LIST POINTER * 00450000 * /* CURRENT STATEMENT POINTER * 00460000 * /* USERID * 00470000 * /* CONTROL TABLE POINTER * 00480000 * /* CURRENT JOBNAME * 00490000 * /* HISTORY TABLE * 00500000 * /* * 00510000 * /* * 00520000 * /* * 00530000 * /* * 00540000 * /* EXTERNAL REFERENCES * 00550000 * /* IKJEFF02 (VIA ADDRESS) * 00560000 * /* IKJEFF06 * 00570000 * /* IKJEFF08 * 00580000 * /* * 00590000 * /* EXITS, NORMAL * 00600000 * /* RETURN TO CALLER * 00610000 * /* * 00620000 * /* EXITS,ERROR * 00630000 * /* RETURN TO CALLER * 00640000 * /* * 00650000 * /* TABLE/WORK AREAS * 00660000 * /* HISTORY TABLE * 00670000 * /* MESSAGE INTERFACE * 00680000 * /* * 00690000 * /* ATTRIBUTES * 00700000 * /* REENTRANT AND REFRESHABLE * 00710000 * /* * 00720000 * /* NOTES * 00730000 * /* CHARACTER CODE DEPENDENCY - EBCDIC CHARACTER SET * 00740000 * /* USED IN ASSEMBLING, MODULE MUST BE REASSEMBLED IF * 00750000 * /* A DIFFERENT CHARACTER SET IS TO BE USED DURING * 00760000 * /* EXECUTION. * 00770000 * /* * 00780000 * /* MESSAGES (SEE MESSAGE MODULE IKJEFF03 FOR DETAILS) * 00790000 * /* 13A 'ENTER JOBNAME CHARACTER+ -' (PUTGET) * 00800000 * /* 13B 'MISSING JOBNAME CHARACTER AND UNABLE TO * 00810000 * /* PROMPT' * 00820000 * /* 13C 'INVALID CHARACTER -' * 00830000 * /* 13D 'REENTER+ -' (PUTGET) * 00840000 * /* * 00850000 * /* CHANGE ACTIVITY * 00860000 * /* ***RELEASE 2 SUPPORT CODES*** * 00870000 * /* Y02993 MODULE OWNERSHIP * 00880000 * /* Y02656 SCHEDULER PROTECTION * 00890000 * /* * 00900000 * /* ***APAR HISTORY*** * 00910000 * /* NONE * 00920000 * /* * 00930000 * /* ***PTM HISTORY*** * 00940000 * /* OS/VS2 RELEASE 2 - * 00950000 * /* YM7267 - MESSAGE 13B SHOULD BE PUTLINE, NOT PUTGET * 00960000 * /* * 00970000 * /******************************************************************* 00980000 * GEN; 00990000 LCLA &T,&SPN 01000000 IKJEFF13 CSECT 01010000 B 18(0,15) 01020000 DC AL1(8) 01030000 DC CL8'IKJEFF13' 01040000 DC CL5'02/74' @Y02993 01050000 AGO .@001 01060000 * 01070000 * IKJEFF13: 01080000 * PROC (MSGPTR, STMTPT, USERID, CONTABPT, JOBNAME, HISTFLD) 01090000 * OPTIONS (REENTRANT); 01100000 LCLA &T,&SPN 0003 01110000 .@001 ANOP 0003 01120000 IKJEFF13 CSECT , 0003 01130000 STM @E,@C,12(@D) 0003 01140000 BALR @B,0 0003 01150000 @PSTART DS 0H 0003 01160000 USING @PSTART+00000,@B 0003 01170000 L @0,@SIZ001 0003 01180000 GETMAIN R,LV=(0) 0003 01190000 LR @C,@1 0003 01200000 USING @DATD+00000,@C 0003 01210000 LM @0,@1,20(@D) 0003 01220000 XC @TEMPS(@L),@TEMPS 0003 01230000 ST @D,@SAV001+4 0003 01240000 LA @F,@SAV001 0003 01250000 ST @F,8(0,@D) 0003 01260000 LR @D,@F 0003 01270000 * /******************************************************************** 01280000 * /* *** IKJEFFHT *** LEVEL=08/21/73 SYSTEMS=OS/VS2 RELEASE 2.0 * 01290000 * /* SUPPORT CODE=Y02064 * 01300000 * /* SUPPORT CODE=Y02993 * 01310000 * /* PLS MAPPING MACRO FOR SUBMIT'S INTERNAL HISTORY TABLE * 01320000 * /* USAGE - %HTNEW='1' - - - - - - - IF DON'T WANT BASED * 01330000 * /* %INCLUDE SYSLIB(IKJEFFHT) * 01340000 * /******************************************************************** 01350000 * DCL 1 HISTORY 01360000 * BASED(ADDR(HISTFLD)) 01370000 * , /* *** HISTORY TABLE *** * 01380000 * 2 SUBTAB CHAR (12), /* SUBMIT TABLE * 01390000 * 2 WHATMOD CHAR (4), /* WHAT MODULE * 01400000 * (3 INCONTRL, /* CONTROL = IKJEFF06 * 01410000 * 3 INPROMPT, /* PROMPTJOB=IKJEFF13 * 01420000 * 3 INGEN) PTR (8), /* GENJOB = IKJEFF08 * 01430000 * (3 INREAD, /* READER = IKJEFF05 * 01440000 * 3 INIDENT, /* IDENTIFY= IKJEFF07 * 01450000 * 3 INEXIT, /* EXITINT = IKJEFF09 * 01460000 * 3 INWRMGR, /* WRMGR = IKJEFF12 * 01470000 * 3 INDAIRIN, /* (UNUSED IN REL.2) * 01480000 * 3 INMSG, /* (UNUSED IN REL.2) * 01490000 * 3 INCOMPIN, /* (UNUSED IN REL.2) * 01500000 * 3 INOINIT) BIT (1), /* OUTPUTINIT = IKJEFF1 01510000 * - Y02064* 01520000 * 2 JCLSWITS CHAR(8), /* JCL SWITCHES Y02993* 01530000 * 3 PRIORJCL CHAR (4), /* PRIOR CARD * 01540000 * 4 PVERB CHAR(2), /* VERB TYPE * 01550000 * (5 PDELIM, /* DELIMITER * 01560000 * 5 PDATA, /* DATA * 01570000 * 5 PNULL, /* NULL * 01580000 * 5 PJOB, /* JOB * 01590000 * 5 PEXEC, /* EXEC * 01600000 * 5 PDD, /* DD * 01610000 * 5 PCOMMAND, /* COMMAND * 01620000 * 5 PCOMMENT, /* COMMENT * 01630000 * 5 PJES, /* SLASH-ASTERISK 01640000 * NONBLANK * 01650000 * 5 *) BIT(1), 01660000 * 5 * BIT(6), 01670000 * 4 PDTYPE CHAR (1), /* DATA TYPE * 01680000 * (5 PDDAST, /* ASTERISK * 01690000 * 5 PDDDATA) BIT (1), /* DATE * 01700000 * 4 PMISC CHAR (1), /* MISC SWITS * 01710000 * (5 PCONEX, /* CON EXPECTED * 01720000 * 5 POPCONEX, /* OPERAND CONEXP* 01730000 * 5 PCONERR, /* CON EXPECT ERR* 01740000 * 5 PNAME, /* HAS NAME * 01750000 * 5 PVERBCOP, /* VERB COPIED * 01760000 * 5 PCOMCON, /* MAKE NEXT STMT 01770000 * A COMMENT * 01780000 * 5 PNOTHING, /* UNKNOWN * 01790000 * 5 PDLMFND) BIT(1), /* DLM= FOUND 01800000 * - (BUT MAY HAVE BAD VALUE) 01810000 * - Y02993* 01820000 * 3 CURRJCL CHAR (4), /* CURRENT JCL * 01830000 * 4 CVERB CHAR (2), /* SAME AS FOR PVERB * 01840000 * (5 CDELIM, /* SAME AS FOR PVERB * 01850000 * 5 CDATA, /* SAME AS FOR PVERB * 01860000 * 5 CNULL, /* SAME AS FOR PVERB * 01870000 * 5 CJOB, /* SAME AS FOR PVERB * 01880000 * 5 CEXEC, /* SAME AS FOR PVERB * 01890000 * 5 CDD, /* SAME AS FOR PVERB * 01900000 * 5 CCOMMAND, /* SAME AS FOR PVERB * 01910000 * 5 CCOMMENT, /* SAME AS FOR PVERB * 01920000 * 5 CJES, /* SAME AS FOR PVERB * 01930000 * 5 *) BIT(1), 01940000 * 5 * BIT(6), 01950000 * 4 CDTYPE CHAR (1), /* CURRENT DATA TYPE * 01960000 * (5 CDDAST, /* SAME AS FOR PDTYPE* 01970000 * 5 CDDDATA) BIT (1), /* SAME AS FOR PDTYPE* 01980000 * 4 CMISC CHAR (1), /* SAME AS FOR PMISC * 01990000 * (5 CCONEX, /* SAME AS FOR PMISC * 02000000 * 5 COPCONEX, /* SAME AS FOR PMISC * 02010000 * 5 CCONERR, /* SAME AS FOR PMISC * 02020000 * 5 CNAME, /* SAME AS FOR PMISC * 02030000 * 5 CVERBCOP, /* SAME AS FOR PMISC * 02040000 * 5 CCOMCON, /* SAME AS FOR PMISC * 02050000 * 5 CNOTHING, /* SAME AS FOR PMISC * 02060000 * 5 CDLMFND) BIT(1), /* SAME AS FOR PMISC * 02070000 * 2 STATICSW CHAR(4), /* STATIC SWITCHES * 02080000 * 3 GENL CHAR (1), /* GENERAL * 02090000 * (4 QUIT, /* QUIT * 02100000 * 4 FLUSH, /* FLUSH * 02110000 * 4 FIRST, /* FIRST SWITCH * 02120000 * 4 NONOTIFY) BIT (1), /* DON'T PUT NOTIF 02130000 * KEYWORD ON 02140000 * GENERATED JOB 02150000 * CARD */ 02160000 * 3 TAKEXITS CHAR (1), /* TAKE EXITS ON * 02170000 * (4 JOBX, /* JOB * 02180000 * 4 EXECX, /* EXEC * 02190000 * 4 DDX, /* DD * 02200000 * 4 CMDX, /* COMMAND * 02210000 * 4 NULLX, /* NULL * 02220000 * 4 JESX, /* JES2 CTL CARD * 02230000 * 4 COMNTX, /* COMMENT (JES3)* 02240000 * 4 *) BIT(1), 02250000 * 3 OPOFF PTR (8), /* OPERAND OFFSET * 02260000 * 3 CODEFLD PTR(8), /* FUNCTION CODES Y02993* 02270000 * 4 HTCODE PTR(8), /* SEE DCLS FOR CONSTANTS Y02064* 02280000 * 2 * PTR(31), /* **RESERVED** * 02290000 * 2 DLMONJCL CHAR(2), /* FOR DLM KWD ON DD * OR DD DATA* 02300000 * 3 HTDLM CHAR(2), /* DLM = 2 CHARACTER VALUE Y02993* 02310000 * 2 HTSWITCH CHAR(1), /* SWITCH BYTE FOR SUBMIT * 02320000 * 3 HTDLMSW BIT(1), /* ON IF DLM= FOUND ON DD Y02993* 02330000 * 3 * BIT(7), /* **RESERVED** * 02340000 * 2 * CHAR(1), /* **RESERVED** * 02350000 * 2 * BDY(BYTE) PTR(31), /* **RESERVED** * 02360000 * 2 HTACCNTP PTR(31), /* PTR TO USER'S JOB ACCOUNTING 02370000 * INFORMATION Y02993* 02380000 * 2 HTACCNTL BDY(BYTE) FIXED(15), /* LENGTH OF ACCOUNT 02390000 * INFORMATION (MAX OF 142 + QUOTE 02400000 * +/OR PARENTHESES) Y02993* 02410000 * 2 HTACNTC1 BDY(BYTE) FIXED(15), /* END COLUMN OF ACCOUNT 02420000 * INFO TO INSERT IN FIRST CARD OF 02430000 * GENERATED JOB STMT (0 IF ACCOUN 02440000 * INFO FITS ON ONE CARD) Y02993* 02450000 * 2 HTACNTC2 BDY(BYTE) FIXED(15), /* END COLUMN OF ACCOUNT 02460000 * INFO TO INSERT IN SECOND CARD O 02470000 * GENERATED JOB STMT (0 IF ACCOUN 02480000 * INFO FITS ON TWO CARDS) Y02993* 02490000 * 2 * BDY(BYTE) FIXED(15); /* **RESERVED** * 02500000 * 02510000 * DCL HTACCNTI 02520000 * BASED(HTACCNTP) 02530000 * CHAR(190); /* USER'S ACCOUNTING INFORMATION A 02540000 * LOGON (RECONSTRUCTED) Y02993* 02550000 * /***************************************************************** 02560000 * /* END OF THE IKJEFFHT MAPPING MACRO * 02570000 * /***************************************************************** 02580000 * DCL 02590000 * USERID CHAR (8); 02600000 * DCL 02610000 * JOBNAME CHAR (8); /* FIELD FOR THE NAME OF THE 02620000 * CURRENT JOB */ 02630000 * DCL 02640000 * STMTPT PTR; /* POINTER TO THE CURRENT (JOB) 02650000 * STATEMENT */ 02660000 * DCL 02670000 * CARD CHAR (80) BASED (STMTPT); 02680000 * DCL 02690000 * CARD2 CHAR (80); /* THIS IS A WORK FIELD TO BE 02700000 * USED IF THE INPUT JOB CARD HAS 02710000 * TO BE CHANGED */ 02720000 * DCL 02730000 * SAVEJCL CHAR(4); /* SAVE CURRJCL WHILE PROCESSING 02740000 * NULL CARD TO DELIMIT JOBS 02750000 * @Y02993* 02760000 * DCL 02770000 * MSGPTR PTR; 02780000 **/******************************************************************** 02790000 **/* * 02800000 **/* *** IKJEFFMT *** LEVEL= 2/12/74 OS/VS2 RELEASE 02.0 * 02810000 **/* * 02820000 **/* DESCRIPTION - BILINGUAL MAPPING MACRO FOR PARAMETER LIST TO * 02830000 **/* IKJEFF02 (TSO MESSAGE ISSUER SERVICE ROUTINE) * 02840000 **/* * 02850000 **/* FUNCTION - THE PARAMETER LIST IDENTIFIES A MESSAGE (WHICH * 02860000 **/* MAY HAVE A SECOND LEVEL MESSAGE), DESCRIBES * 02870000 **/* INSERT(S) FOR THE MESSAGE, AND INDICATES WHETHER * 02880000 **/* TO ISSUE THE MESSAGE AS A PUTLINE, PUTGET, WTO, * 02890000 **/* OR A WRITE TO PROGRAMMER. * 02900000 **/* * 02910000 **/* THE PARAMETER LIST ALSO POINTS TO A MESSAGE * 02920000 **/* CSECT CONTAINING THE MESSAGE'S TEXT. THE * 02930000 **/* IKJTSMSG MACRO IS USED TO GENERATE THE * 02940000 **/* NECESSARY DC'S FOR THE TEXT AND THE OFFSETS * 02950000 **/* TO INSERTS IN THE MESSAGE. THE LAST ENTRY IN * 02960000 **/* THE CSECT MUST BE AN IKJTSMSG MACRO WITH NO * 02970000 **/* OPERANDS. SEE THE MICROFICHE LISTING OF MODULE * 02980000 **/* IKJEFF55 FOR EXAMPLES OF MESSAGE TEXTS GENERATED * 02990000 **/* BY THE IKJTSMSG MACRO. * 03000000 **/* * 03010000 **/* REGISTER 1 -> MTPARML = MSGTABLE PARMLIST * 03020000 **/* REGISTER 15 WILL CONTAIN IKJEFF02'S RETURN CODE * 03030000 **/* TO THE CALLER (0 IF SUCCESSFUL, * 03040000 **/* 76 IF PARAMETER LIST ERROR (MESSAGE * 03050000 **/* ALSO ISSUED), OR ERROR RETURN CODE * 03060000 **/* FROM PUTLINE OR PUTGET) * 03070000 **/* * 03080000 **/* METHOD OF ACCESS * 03090000 **/* PL/S - %MTNEW='1' - - - - - - IF DON'T WANT BASED * 03100000 **/* %MTBASE='ANY BASE' - - IF MTNEW ISN'T SPECIFIED, * 03110000 **/* DEFAULTS TO BASED(MSGPTR) * 03120000 **/* %MTINSRTN='N' - - - - TO GET INSERT ARRAY WITH N * 03130000 **/* ELEMENTS - DEFAULTS TO * 03140000 **/* 4 INSERTS, NO ARRAY * 03150000 **/* %INCLUDE SYSLIB(IKJEFFMT) * 03160000 **/* * 03170000 **/* BAL - <> * 03190000 **/* MTDSECT=YES IF DON'T WANT TO GET CORE, * 03200000 **/* THEN CODE LA REG,MYMTCORE *CALLER AREA* * 03210000 **/* USING MTDSECTD,REG * 03220000 **/* MTDSECT=NO IS THE DEFAULT. * 03230000 **/* * 03240000 **/* MTNINST=NUMBER SPECIFIES NUMBER OF INSERT ENTRIES * 03250000 **/* IN THE PARAMETER LIST. MTNINST=4 IS THE DEFAULT. * 03260000 **/* * 03270000 **/* F.E.'S - MICROFICHE LISTING = IKJEFFMT * 03280000 **/* * 03290000 **/******************************************************************** 03300000 ** DCL 1 MSGTABLE 03310000 ** BASED(MSGPTR) 03320000 ** , /* <> UNUSED 03330000 ** FIELDS MUST BE ZEROED */ 03340000 ** 2 LISTPTR PTR(31), /* POINTER TO MESSAGE DESCRIPTION SECTION OF 03350000 ** PARAMETER LIST */ 03360000 ** 2 TMCTPTR PTR (31),/* POINTER TO TMP'S TMCT CONTROL BLOCK 03370000 ** (REQUIRED FOR PUTLINE OR PUTGET) */ 03380000 ** 3 MTCPPL PTR(31), /* (ALSO CALLED CPPL) */ 03390000 ** 2 ECBPTR PTR(31), /* OPTIONAL PUTLINE/PUTGET ECB POINTER */ 03400000 ** 2 * PTR(31), /* ** RESERVED FOR FUTURE USE ** */ 03410000 ** 3 MTHIGH BIT(1), /* CAN TURN ON FOR STANDARD LINKAGE */ 03420000 ** 2 MSGCSECT PTR(31), /* < 03430000 ** POINTER TO CSECT WITH CALLER'S MESSAGE 03440000 ** TEXTS, BUILT WITH IKJTSMSG MACRO */ 03450000 ** 2 SW PTR(8), /* FIRST BYTE OF SWITCHES */ 03460000 ** 3 MTNOIDSW BIT(1), /* ON IF PRINTING DATA (SEE IKJEFF02'S 03470000 ** PROLOGUE FOR DETAILS) */ 03480000 ** 3 MTPUTLSW BIT(1), /* ON IF ISSUE PUTLINE, NOT DEFAULT OF PUTGET 03490000 ** FOR PUTLINE, MESSAGE INSERTS FOR A SECOND 03500000 ** LEVEL MESSAGE MUST BE LISTED BEFORE INSERT 03510000 ** FOR A FIRST LEVEL. PUTGET MESSAGES MUST 03520000 ** HAVE A SECOND LEVEL. */ 03530000 ** 3 MTWTOSW BIT(1), /* ON IF ISSUE MESSAGE AS A WTO WITH 03540000 ** ROUTCDE=(2), DESC=(6). MESSAGE IS 03550000 ** TRUNCATED IF IT EXCEEDS 124 CHARACTERS. */ 03560000 ** 3 MTHEXSW BIT(1), /* ON IF TRANSLATE NUMERIC INSERTS TO 03570000 ** PRINTABLE HEX (X'VALUE'), NOT DECIMAL */ 03580000 ** 3 MTKEY1SW BIT(1), /* ON IF DO MODESET TO KEY 0 BEFORE ISSUE 03590000 ** A PUTLINE OR PUTGET, THEN RETURN TO KEY 1 03600000 ** (IF KEY 0 OR 8, DON'T NEED MODESET) */ 03610000 ** 3 MTJOBISW BIT(1), /* ON IF COMPRESS BLANKS OUT OF XX(YY) 03620000 ** TYPE INSERT */ 03630000 ** 3 MTWTPSW BIT(1), /* ON IF ISSUE MESSAGE AS A WRITE TO 03640000 ** PROGRAMMER (WITH DESC=(7). IF MESSAGE IS 03650000 ** LONGER THAN 124 CHARACTERS, SEVERAL WTP'S 03660000 ** ARE ISSUED. */ 03670000 ** 3 MTNHEXSW BIT(1), /* ON IF TRANSLATE ALL NUMERIC INSERTS 03680000 ** TO PRINTABLE DECIMAL (DEFAULT IS 03690000 ** DECIMAL IF VALUE LESS THAN X'FFFF', 03700000 ** OTHERWISE TRANSLATE TO PRINTABLE HEX) */ 03710000 ** 2 RETMSG PTR(24), /* POINTER TO REPLY FROM PUTGET */ 03720000 ** 2 SW2 PTR(8), /* SECOND BYTE OF SWITCHES */ 03730000 ** 3 MT2OLDSW BIT(1), /* ON IF MTOLDPTR POINTS TO SECOND LEVEL 03740000 ** MESSAGE ALREADY IN PUTLINE/PUTGET O.L.D. 03750000 ** FORMAT. IKJEFF02 WILL COPY IKJ MSG ID FRO 03760000 ** FIRST LEVEL INTO FIRST SEGMENT OF SECOND 03770000 ** LEVEL MESSAGE. (FOR TSO STATUS COMMAND.)* 03780000 ** 3 MTDOMSW BIT(1), /* ON IF DELETE WRITE TO PROGRAMMER OR WTO 03790000 ** MESSAGES FROM DISPLAY CONSOLE */ 03800000 ** 3 MTNOXQSW BIT(1), /* ON IF OVERRIDE DEFAULT OF X' ' AROUND 03810000 ** INSERTS CONVERTED TO PRINTABLE HEX */ 03820000 ** 3 MTNPLMSW BIT(1), /* ON IF OVERRIDE DEFAULT OF WRITE TO 03830000 ** PROGRAMMER ERROR MESSAGE IF PUTLINE FAILS* 03840000 ** 3 MTPGMSW BIT(1), /* ON IF WANT AN ERROR MSG IF PUTGET FAILS */ 03850000 ** 3 * BIT(3), /* ** RESERVED ** */ 03860000 ** 2 * PTR(24), /* ** RESERVED ** */ 03870000 ** 2 MTOLDPTR PTR(31), /* POINTS TO O.L.D. IF MT2OLDSW IS ON */ 03880000 ** 2 * PTR(31), /* ** RESERVED ** */ 03890000 ** 2 * PTR(31), /* ** RESERVED ** */ 03900000 ** 2 MSGID CHAR (4), /* MESSAGE ID USED TO SEARCH FOR MESSAGE 03910000 ** TEXT IN THE MESSAGE CSECT */ 03920000 ** 2 MTINSRTS, /* USE THIS NAME TO ZERO INSERT AREA. HAVE 03930000 ** MAXIMUM OF 255 PARTS TO A FIRST OR LATER 03940000 ** LEVEL MESSAGE, BUT IF A MESSAGE LEVEL 03950000 ** EXCEEDS 256 CHARACTERS, IT IS TRUNCATED. 03960000 ** TRAILING BLANKS ARE DELETED FROM INSERTS. 03970000 ** EXTRA INSERT FIELDS NEED NOT BE ZEROED. 03980000 ** IF AN INSERT LENGTH (OR ADDRESS) FIELD IS 03990000 ** ZERO, NO INSERT IS DONE FOR THE ENTRY, BUT 04000000 ** FOLLOWING INSERTS ARE DONE. * 04010000 ** 3 L1 PTR (8), /* LENGTH OF INSERT 1. MAXIMUM 04020000 ** LENGTH IS 127. */ 04030000 ** 4 HIGHL1 BIT (1), /* ON IF TRANSLATE FIRST 04040000 ** 4 BYTES OF INSERT 04050000 ** FROM HEX TO CHARACTER 04060000 ** (IGNORE REST). SEE MTHEXSW. */ 04070000 ** 3 VAR1 PTR (24), /* ADDRESS OF INSERT1 04080000 ** -NOTE- INSERTS FOR 04090000 ** SECOND LEVEL MSG MUST 04100000 ** BE FIRST IF PUTLINE OR WTP */ 04110000 ** 3 L2 PTR (8),/* LEN OF INSERT2 */ 04120000 ** 4 HIGHL2 BIT (1), /* BIT FOR INSERT2 */ 04130000 ** 3 VAR2 PTR (24),/* ADDR OF INSERT2 */ 04140000 ** 3 L3 PTR (8), /* LEN OF INSERT3 */ 04150000 ** 4 HIGHL3 BIT (1), /* BIT FOR INSERT3 */ 04160000 ** 3 VAR3 PTR (24), /* ADDR OF INSERT3 */ 04170000 ** 3 L4 PTR (8), /* LEN OF INSERT4 */ 04180000 ** 4 HIGHL4 BIT (1), /* BIT FOR INSERT4 */ 04190000 ** 3 VAR4 PTR (24), /* ADDR OF INSERT4 */ 04200000 ** 2 MSGRTN PTR (31);/* MESSAGE ROUTINE ADDRESS - NOT USED 04210000 ** BY IKJEFF02 */ 04220000 ** 04230000 **/******************************************************************** 04240000 **/* IKJEFFMT - FORMAT OF REPLY FROM TSO USER * 04250000 **/******************************************************************** 04260000 ** DCL 1 RET BDY(WORD) BASED(RETMSG), /* MESSAGE REPLY BUFFER. 04270000 ** IKJEFF02 OBTAINS THE BUFFER IN SUBPOOL 0 04280000 ** AND THE CALLER MAY FREE THIS BUFFER. */ 04290000 ** 2 RETSIZE FIXED(15), /* BUFFER SIZE, INCLUDING THESE TWO 04300000 ** BYTES */ 04310000 ** 2 RETCHAR CHAR(999); /* REPLY TEXT FROM PUTGET. IKJEFF02 04320000 ** CONVERTS REPLY TO UPPER CASE. */ 04330000 ** 04340000 **/******************************************************************** 04350000 **/* IKJEFFMT - CPPL AND ECB POINTED TO BY MESSAGE TABLE * 04360000 **/******************************************************************** 04370000 ** DCL MSGTMCT BASED (TMCTPTR); /* TMP'S CPPL CONTROL BLOCK */ 04380000 ** DCL MSGECB BASED (ECBPTR); /* ECB FOR PUTLINE/PUTGET */ 04390000 **/******************************************************************** 04400000 **/* END OF IKJEFFMT MAPPING MACRO * 04410000 **/******************************************************************** 04420000 * DCL 04430000 * MSGSW CHAR (1) BASED (ADDR(SW)); 04440000 * /* CHAR DESCRIP OF 'SW' */ 04450000 * DCL 04460000 * MSGADDR PTR; 04470000 * DCL 04480000 * JEFF02 ENTRY BASED (MSGADDR); 04490000 * /* MESSAGE PROCESSING ROUTINE */ 04500000 * DCL 04510000 * CT; /* LOOP CONTROL USED IN 04520000 * CONVERSING WITH THE USER */ 04530000 * DCL 04540000 * HOLD; /* USED TO HOLD THE POINTER TO 04550000 * THE CURRENT STATEMENT IF IT 04560000 * BECOMES NECESSARY TO GENERATE 04570000 * A NEW ONE */ 04580000 * DCL 04590000 * I; /* USED TO INDEX THROUGH THE 04600000 * USER'S REPLY BUFFER */ 04610000 * DCL 04620000 * K; /* CARD INDEX */ 04630000 * DCL 04640000 * R1 PTR REG (1); 04650000 * DCL 04660000 * R15 REG (15); 04670000 * DCL 04680000 * R0 REG (0); 04690000 * DCL 04700000 * ADDCHAR CHAR (1); /* THIS IS THE ADDED CHARACTER 04710000 * THAT IS TO BE APPENDED TO THE 04720000 * USERID JOBNAME -- TAKEN FROM 04730000 * THE FIRST NON-BLANK IN THE 04740000 * USER'S RESPONSE TO PROMPTING 04750000 * */ 04760000 * DCL 1 PATCH STATIC LOCAL, /* F.E. PATCH AREA @Y02993* 04770000 * 2 PTCHINIT(17) CHAR(3) INIT((17)'ZAP'); 04780000 * INPROMPT = INPROMPT+1; 04790000 LA @F,1 0029 04800000 L @8,20(0,@1) ADDRESS OF HISTFLD 0029 04810000 SR @0,@0 0029 04820000 IC @0,13(0,@8) 0029 04830000 AR @F,@0 0029 04840000 STC @F,13(0,@8) 0029 04850000 * IF FIRST='0'B & 04860000 * PNULL='0'B THEN /* IF NOT FIRST JOB CARD AND IF 04870000 * HAD NO PRIOR NULL CARD @Y02993* 04880000 TM 24(@8),B'00100000' 0030 04890000 BC 05,@9FF 0030 04900000 TM 16(@8),B'00100000' 0030 04910000 BC 05,@9FE 0030 04920000 * DO; 04930000 * CARD2='//'; /* FIRST PROCESS A NULL CARD TO 04940000 * CUT OFF THE PRECEDING JOB 04950000 * PRIOR TO LOOKING AT THE 04960000 * CURRENT ONE -- OTHERWISE THE 04970000 * USER WILL SEE THE PROMPT MSG 04980000 * BEFORE HE SEES THE 04990000 * CONFIRMATION JOB SUBMITTED 05000000 * MSG FOR THE LAST JOB @Y02993*/ 05010000 MVC CARD2(2),@C2 0032 05020000 MVI CARD2+2,C' ' 0032 05030000 MVC CARD2+3(77),CARD2+2 0032 05040000 * SAVEJCL=CURRJCL; /* WON'T GO THROUGH JCL ID RTN 05050000 * AGAIN FOR JOB CARD @Y02993*/ 05060000 MVC SAVEJCL(4),20(@8) 0033 05070000 * CURRJCL=PRIORJCL; /*BUT GO TO JCL ID FOR NULLY02993* 05080000 MVC 20(4,@8),16(@8) 0034 05090000 * HOLD=STMTPT; /* SAVE PTR TO JOB CARD @Y02993* 05100000 L @9,4(0,@1) ADDRESS OF STMTPT 0035 05110000 MVC HOLD(4),0(@9) 0035 05120000 * STMTPT=ADDR(CARD2); /* STORE ADDR OF // CARD @Y02993* 05130000 LA @F,CARD2 0036 05140000 ST @F,0(0,@9) 0036 05150000 * CALL IKJEFF06 (CONTABPT); /* PROCESS NULL CARD @Y02993* 05160000 L @6,12(0,@1) ADDRESS OF CONTABPT 0037 05170000 ST @6,@PL001 0037 05180000 L @F,@V1 ADDRESS OF IKJEFF06 0037 05190000 LA @1,@PL001 0037 05200000 BALR @E,@F 0037 05210000 L @1,4(0,@D) 0037 05220000 L @1,24(0,@1) 0037 05230000 * STMTPT=HOLD; /* RESTORE JOB CARD @Y02993* 05240000 L @8,4(0,@1) ADDRESS OF STMTPT 0038 05250000 MVC 0(4,@8),HOLD 0038 05260000 * PRIORJCL=CURRJCL; /* SHOULD BE NULL CARD @Y02993* 05270000 L @9,20(0,@1) ADDRESS OF HISTFLD 0039 05280000 MVC 16(4,@9),20(@9) 0039 05290000 * CURRJCL=SAVEJCL; /* RESTORE IDENTITY OF JOB CARD 05300000 * @Y02993* 05310000 MVC 20(4,@9),SAVEJCL 0040 05320000 * END; /* END OF CHANGED LOGIC @Y02993* 05330000 * IF USERID ^= JOBNAME THEN 05340000 @9FE EQU * 0042 05350000 @9FF L @8,16(0,@1) ADDRESS OF JOBNAME 0042 05360000 L @9,8(0,@1) ADDRESS OF USERID 0042 05370000 CLC 0(8,@9),0(@8) 0042 05380000 BC 08,@9FB 0042 05390000 * DO; /* RETURN IF JOBNAME IS NOT 05400000 * EXACTLY SAME AS USERID -- BUT 05410000 * IF IT IS THE SAME, THEN A 05420000 * CHARACTER MUST BE ADDED TO 05430000 * MAKE IT UNIQUE -- NOTE - THE 05440000 * USER AT HIS TERMINAL IS 05450000 * ALREADY KNOWN TO THE SYSTEM AS 05460000 * 'USERID' */ 05470000 * 05480000 * OUT: 05490000 * INPROMPT = INPROMPT-1; 05500000 OUT LH @F,@D1 0044 05510000 L @8,20(0,@1) ADDRESS OF HISTFLD 0044 05520000 SR @0,@0 0044 05530000 IC @0,13(0,@8) 0044 05540000 AR @F,@0 0044 05550000 STC @F,13(0,@8) 0044 05560000 * RETURN; 05570000 BC 15,@EL01 0045 05580000 * END; /* AN EXTRA CHARACTER IS TO BE 05590000 * ADDED TO NAME BUT FIRST CHECK 05600000 * TO SEE IF HAVE ROOM FOR IT */ 05610000 * K=3; 05620000 @9FB LA @F,3 0047 05630000 ST @F,K 0047 05640000 * 05650000 * LOOP: 05660000 * K=K+1; 05670000 LOOP LA @F,1 0048 05680000 A @F,K 0048 05690000 ST @F,K 0048 05700000 * IF CARD(K) ^=' ' THEN 05710000 LR @8,@F 0049 05720000 L @9,4(0,@1) ADDRESS OF STMTPT 0049 05730000 L @6,0(0,@9) STMTPT 0049 05740000 LA @A,0(@8,@6) 0049 05750000 BCTR @A,0 0049 05760000 CLI 0(@A),C' ' 0049 05770000 * GO TO LOOP; /* LOOP ACROSS THE NAME FIELD TO 05780000 * FIND THE BLANK -- IF CARD(K) 05790000 * IS NOT BLANK THEN KEEP LOOPING 05800000 * */ 05810000 BC 07,LOOP 0050 05820000 * IF CARD(K+1)=' ' THEN 05830000 LA @7,1 0051 05840000 A @7,K 0051 05850000 LA @A,0(@7,@6) 0051 05860000 BCTR @A,0 0051 05870000 CLI 0(@A),C' ' 0051 05880000 * GO TO PROMPT; /* OK TO PROMPT IF TWO BLANKS 05890000 * FOUND -- OTHERWISE K+1 PTS TO 05900000 * J OF JOB */ 05910000 BC 08,PROMPT 0052 05920000 * IF CARD(K+5)=' ' THEN 05930000 LA @4,5 0053 05940000 A @4,K 0053 05950000 LA @A,0(@4,@6) 0053 05960000 BCTR @A,0 0053 05970000 CLI 0(@A),C' ' 0053 05980000 * GO TO MOVEJOB; /* ALSO OK IF HAVE ROOM AFTER 05990000 * 'JOB' -- IN WHICH CASE MOVE 06000000 * 'JOB' OVER AND THEN PROCEED TO 06010000 * PROMPT FOR A CHAR TO BE ADDED 06020000 * */ 06030000 BC 08,MOVEJOB 0054 06040000 * IF CARD(70:71)=' ' THEN 06050000 CLC 69(2,@6),@C4 0055 06060000 BC 07,@9FA 0055 06070000 * DO; /* STILL OK IF COLS 70-71 ARE 06080000 * BLANK */ 06090000 * CARD2(1:65-K) = CARD(K+5:69); 06100000 LA @5,5 0057 06110000 A @5,K 0057 06120000 LA @E,0(@5,@6) 0057 06130000 BCTR @E,0 0057 06140000 LR @2,@F 0057 06150000 LCR @2,@2 0057 06160000 AH @2,@D2 0057 06170000 BCTR @2,0 0057 06180000 LA @A,CARD2 0057 06190000 EX @2,@MVC 0057 06200000 * /* COPY OPERANDS AND COMMENTS TO 06210000 * CARD2 AND BACK AGAIN ONE BYTE 06220000 * TO THE RIGHT */ 06230000 * CARD(K+6:70) = CARD2(1:65-K); 06240000 LA @E,CARD2 0058 06250000 LA @2,70 0058 06260000 LA @3,6 0058 06270000 A @3,K 0058 06280000 SR @2,@3 0058 06290000 LA @A,0(@3,@6) 0058 06300000 BCTR @A,0 0058 06310000 EX @2,@MVC 0058 06320000 * GO TO MOVEJOB; /* AFTER THIS SHUFFLE, NOW GO TO 06330000 * MOVE 'JOB' AND PROMPT */ 06340000 BC 15,MOVEJOB 0059 06350000 * END; 06360000 * HOLD = STMTPT; /* FAILING THESE MOVES IT WILL BE 06370000 * NECESSARY TO CALL GENJOB FOR A 06380000 * DEFAULT JOB CARD AND THEN TURN 06390000 * THE CURRENT ONE INTO A COMMENT 06400000 * */ 06410000 @9FA L @8,4(0,@1) ADDRESS OF STMTPT 0061 06420000 MVC HOLD(4),0(@8) 0061 06430000 * STMTPT= ADDR(CARD2); 06440000 LA @F,CARD2 0062 06450000 ST @F,0(0,@8) 0062 06460000 * CARD2='//* ORIGINAL JOB CARD FOLLOWS'; 06470000 MVC CARD2(29),@C5 0063 06480000 MVI CARD2+29,C' ' 0063 06490000 MVC CARD2+30(50),CARD2+29 0063 06500000 * CALL IKJEFF08 (HISTFLD, STMTPT, USERID, CONTABPT,MSGPTR); 06510000 L @9,20(0,@1) ADDRESS OF HISTFLD 0064 06520000 ST @9,@PL001 0064 06530000 ST @8,@PL001+4 0064 06540000 L @6,8(0,@1) ADDRESS OF USERID 0064 06550000 ST @6,@PL001+8 0064 06560000 L @7,12(0,@1) ADDRESS OF CONTABPT 0064 06570000 ST @7,@PL001+12 0064 06580000 L @4,0(0,@1) ADDRESS OF MSGPTR 0064 06590000 ST @4,@PL001+16 0064 06600000 L @F,@V2 ADDRESS OF IKJEFF08 0064 06610000 LA @1,@PL001 0064 06620000 BALR @E,@F 0064 06630000 L @1,4(0,@D) 0064 06640000 L @1,24(0,@1) 0064 06650000 * /* CALL GENJOB ROUTINE TO 06660000 * GENERATE A NEW JOB CARD -- 06670000 * NOTE THAT GENJOB WILL ALSO 06680000 * HAVE THE COMMENT CARD BUILT 06690000 * HERE (CARD2) TO BE PROCESSED 06700000 * @Y02993* 06710000 * CCOMCON='1'B; /* TURN COMMENT CONTINUATION 06720000 * SWITCH ON, MEANING THAT THIS 06730000 * CARD AND ALL CONS OF IT ARE TO 06740000 * BE TURNED INTO COMMENTS (BY 06750000 * IDENT IKJEFF07) -- RESTORE THE 06760000 * POINTER TO THE ORIGINAL INPUT 06770000 * JOB CARD */ 06780000 L @8,20(0,@1) ADDRESS OF HISTFLD 0065 06790000 OI 23(@8),B'00000100' 0065 06800000 * STMTPT=HOLD; 06810000 L @9,4(0,@1) ADDRESS OF STMTPT 0066 06820000 MVC 0(4,@9),HOLD 0066 06830000 * 06840000 * CALLCON: 06850000 * CALL IKJEFF06 (CONTABPT); /* CALL THE CONTROL ROUTINE TO 06860000 * PROCESS THE CARD AND THEN QUIT 06870000 * */ 06880000 CALLCON L @8,12(0,@1) ADDRESS OF CONTABPT 0067 06890000 ST @8,@PL001 0067 06900000 L @F,@V1 ADDRESS OF IKJEFF06 0067 06910000 LA @1,@PL001 0067 06920000 BALR @E,@F 0067 06930000 L @1,4(0,@D) 0067 06940000 L @1,24(0,@1) 0067 06950000 * GO TO OUT; 06960000 BC 15,OUT 0068 06970000 * 06980000 * MOVEJOB: 06990000 * CARD(K+1:K+5)=' JOB '; /* MOVE JOB OVER */ 07000000 MOVEJOB LA @E,@C7 0069 07010000 LA @8,5 0069 07020000 A @8,K 0069 07030000 LA @9,1 0069 07040000 A @9,K 0069 07050000 SR @8,@9 0069 07060000 L @6,4(0,@1) ADDRESS OF STMTPT 0069 07070000 L @7,0(0,@6) STMTPT 0069 07080000 LA @A,0(@9,@7) 0069 07090000 BCTR @A,0 0069 07100000 EX @8,@MVC 0069 07110000 * 07120000 * PROMPT: 07130000 * /* ASK USER FOR A CHARACTER -- K 07140000 * POINTS TO WHERE IT GOES */ 07150000 * CT=0; 07160000 PROMPT SR @F,@F 0070 07170000 ST @F,CT 0070 07180000 * MSGID='13A '; /*ENTER JOBNAME CHAR MSG*/ 07190000 L @8,0(0,@1) ADDRESS OF MSGPTR 0071 07200000 L @9,0(0,@8) MSGPTR 0071 07210000 MVC 40(4,@9),@C8 0071 07220000 * 07230000 * CALLMSG: 07240000 * MTPUTLSW = '0'B; /* CALL THE MESSAGE PROCESSING 07250000 * ROUTINE TO PUT OUT A PROMPT MSG 07260000 * @Y02656* 07270000 CALLMSG L @8,0(0,@1) ADDRESS OF MSGPTR 0072 07280000 L @9,0(0,@8) MSGPTR 0072 07290000 NI 20(@9),B'10111111' 0072 07300000 * CALLMSG2: 07310000 * MSGADDR = MSGRTN; 07320000 CALLMSG2 L @8,0(0,@1) ADDRESS OF MSGPTR 0073 07330000 L @9,0(0,@8) MSGPTR 0073 07340000 MVC MSGADDR(4),60(@9) 0073 07350000 * HOLD=R1; /* NEED TO SAVE R1 */ 07360000 ST @1,HOLD 0074 07370000 * R1 = MSGPTR; /* SET UP REG ONE WITH CORRECT 07380000 * PARAMETER LIST */ 07390000 L @1,0(0,@8) 0075 07400000 * CALL JEFF02; /* CALL MESSAGE PROCESSOR */ 07410000 L @6,MSGADDR 0076 07420000 LR @F,@6 0076 07430000 BALR @E,@F 0076 07440000 * R1 = HOLD; /* RESTORE REGISTER ONE */ 07450000 L @1,HOLD 0077 07460000 * IF QUIT='1'B THEN 07470000 L @8,20(0,@1) ADDRESS OF HISTFLD 0078 07480000 TM 24(@8),B'10000000' 0078 07490000 * GO TO OUT; /* QUIT INDICATES THAT AN ERROR WA 07500000 * ENCOUNTERED SOMEWHERE IN THE 07510000 * SUBMIT PROCESSING */ 07520000 BC 01,OUT 0079 07530000 * IF MSGID='13C ' THEN DO; /* INVALID CHARACTER MESSAGE */ 07540000 L @9,0(0,@1) ADDRESS OF MSGPTR 0080 07550000 L @6,0(0,@9) MSGPTR 0080 07560000 CLC 40(4,@6),@C9 0080 07570000 BC 07,@9F5 0080 07580000 * MSGID='13D '; /* SET MSG ID FOR REENTER MESSAGE* 07590000 MVC 40(4,@6),@C10 0082 07600000 * GOTO CALLMSG; 07610000 BC 15,CALLMSG 0083 07620000 * END; 07630000 * MTPUTLSW = '1'B; /* INDICATE PUTLINE NOW, NOT 07640000 * PUTGET @Y02656* 07650000 @9F5 L @8,0(0,@1) ADDRESS OF MSGPTR 0085 07660000 L @9,0(0,@8) MSGPTR 0085 07670000 OI 20(@9),B'01000000' 0085 07680000 * IF R15 ^=0 THEN 07690000 LTR @F,@F 0086 07700000 BC 08,@9F4 0086 07710000 * DO; 07720000 * 07730000 * BAD: 07740000 * /* IF THE RETURN CODE IS NOT 07750000 * ZERO, ISSUE A MESSAGE TO SAY 07760000 * 'MISSING JOB CHAR' AND THEN 07770000 * QUIT */ 07780000 * QUIT='1'B; 07790000 BAD L @8,20(0,@1) ADDRESS OF HISTFLD 0088 07800000 OI 24(@8),B'10000000' 0088 07810000 * MSGID='13B '; 07820000 L @9,0(0,@1) ADDRESS OF MSGPTR 0089 07830000 L @6,0(0,@9) MSGPTR 0089 07840000 MVC 40(4,@6),@C11 0089 07850000 * GO TO CALLMSG2; /* ISSUE MESSAGE AS PUTLINE, NOT 07860000 * PUTGET @Y02993* 07870000 BC 15,CALLMSG2 0090 07880000 * END; 07890000 * CT=CT+1; 07900000 @9F4 LA @F,1 0092 07910000 A @F,CT 0092 07920000 ST @F,CT 0092 07930000 * DO I =1 TO RETSIZE-2; /* LOOP THROUGH THE USER'S 07940000 * RESPONSE LOOKING FOR THE FIRST 07950000 * NON-BLANK */ 07960000 LA @F,1 0093 07970000 ST @F,I 0093 07980000 @DO9F3 LH @F,@D3 0093 07990000 L @8,0(0,@1) ADDRESS OF MSGPTR 0093 08000000 L @9,0(0,@8) MSGPTR 0093 08010000 L @9,20(0,@9) MSGTABLE 0093 08020000 AH @F,0(0,@9) 0093 08030000 C @F,I 0093 08040000 BC 04,@DO9F0 0093 08050000 BC 15,@DO9F1 0093 08060000 @DO9F2 LA @F,1 0093 08070000 A @F,I 0093 08080000 ST @F,I 0093 08090000 BC 15,@DO9F3 0093 08100000 * IF RETCHAR(I) ^=' ' THEN 08110000 @DO9F1 L @8,I 0094 08120000 L @9,0(0,@1) ADDRESS OF MSGPTR 0094 08130000 L @6,0(0,@9) MSGPTR 0094 08140000 L @6,20(0,@6) MSGTABLE 0094 08150000 LA @A,1(@8,@6) 0094 08160000 CLI 0(@A),C' ' 0094 08170000 * GO TO VALIDCHK; 08180000 BC 07,VALIDCHK 0095 08190000 BC 15,@DO9F2 0096 08200000 * END; 08210000 * ADDCHAR=' '; /* INITIALIZE ADDCHAR TO A BLANK 08220000 * BECAUSE THIS WILL ONLY BE EXE- 08230000 * CUTED IF THERE IS A FALL THROUG 08240000 * FROM THE ABOVE DO LOOP, HENCE 08250000 * INDICATING THAT A BLANK LINE WA 08260000 * ENTERED. */ 08270000 @DO9F0 MVI ADDCHAR,C' ' 0097 08280000 * AGAIN: 08290000 * R0=RETSIZE; /* SET UP REG ZERO TO CONTAIN SIZE 08300000 * OF THE AREA TO BE FREED */ 08310000 AGAIN L @8,0(0,@1) ADDRESS OF MSGPTR 0098 08320000 L @9,0(0,@8) MSGPTR 0098 08330000 L @9,20(0,@9) MSGTABLE 0098 08340000 LH @0,0(0,@9) 0098 08350000 * HOLD=R1; /* SAVE ORIGINAL REGISTER ONE */ 08360000 ST @1,HOLD 0099 08370000 * R1=ADDR(RET); /* FREE THE RESPONSE BUFFER */ 08380000 LR @1,@9 0100 08390000 * GEN (FREEMAIN R,LV=(0),A=(1)); 08400000 FREEMAIN R,LV=(0),A=(1) 08410000 DS 0H 08420000 * R1=HOLD; /* RESTORE THE ORIGINAL CONTENTS O 08430000 * REGISTER ONE */ 08440000 L @1,HOLD 0102 08450000 * IF CT=0 THEN 08460000 SR @F,@F 0103 08470000 C @F,CT 0103 08480000 * GO TO CALLCON; /* IF CT=0 THEN ALL DONE */ 08490000 BC 08,CALLCON 0104 08500000 * MSGID='13C '; /* MSG ID INDICATES INVALID 08510000 * CHARACTER MESSAGE */ 08520000 L @6,0(0,@8) MSGPTR 0105 08530000 MVC 40(4,@6),@C9 0105 08540000 * VAR1=ADDR(ADDCHAR); /* VARIABLE TO BE INSERTED WITHIN 08550000 * THE MSG IS THE RESPONSE GIVEN B 08560000 * THE USER */ 08570000 LA @F,ADDCHAR 0106 08580000 ST @F,@TEMP4 0106 08590000 MVC 45(3,@6),@TEMP4+1 0106 08600000 * L1=1; /* LENGTH OF VARIABLE IS ONE */ 08610000 MVI 44(@6),1 0107 08620000 * GO TO CALLMSG2; 08630000 BC 15,CALLMSG2 0108 08640000 * 08650000 * VALIDCHK: 08660000 * /* CHECK THE RESPONSE CHAR TO SEE 08670000 * IF IT IS A VALID ALPHANUMERIC 08680000 * */ 08690000 * ADDCHAR=RETCHAR(I); 08700000 VALIDCHK L @8,I 0109 08710000 L @9,0(0,@1) ADDRESS OF MSGPTR 0109 08720000 L @6,0(0,@9) MSGPTR 0109 08730000 L @6,20(0,@6) MSGTABLE 0109 08740000 LA @E,1(@8,@6) 0109 08750000 MVC ADDCHAR(1),0(@E) 0109 08760000 * IF ADDCHAR='#' THEN 08770000 CLI ADDCHAR,C'#' 0110 08780000 * GO TO APPEND; 08790000 BC 08,APPEND 0111 08800000 * IF ADDCHAR='$' THEN 08810000 CLI ADDCHAR,C'$' 0112 08820000 * GO TO APPEND; 08830000 BC 08,APPEND 0113 08840000 * IF ADDCHAR='@' THEN 08850000 CLI ADDCHAR,C'@' 0114 08860000 * GO TO APPEND; 08870000 BC 08,APPEND 0115 08880000 * IF ADDCHAR>= '0' THEN 08890000 CLI ADDCHAR,C'0' 0116 08900000 BC 04,@9EF 0116 08910000 * IF ADDCHAR <= '9' THEN 08920000 CLI ADDCHAR,C'9' 0117 08930000 * GO TO APPEND; 08940000 BC 12,APPEND 0118 08950000 * IF ADDCHAR>='A' THEN 08960000 @9EF CLI ADDCHAR,C'A' 0119 08970000 BC 04,@9EE 0119 08980000 * IF ADDCHAR <='Z' THEN 08990000 CLI ADDCHAR,C'Z' 0120 09000000 * GO TO APPEND; 09010000 * GO TO AGAIN; 09020000 BC 03,AGAIN 0122 09030000 * 09040000 * APPEND: 09050000 * CARD(K)=ADDCHAR; /* COPY THE CHARACTER TO WHERE K 09060000 * POINTS */ 09070000 APPEND L @8,K 0123 09080000 L @9,4(0,@1) ADDRESS OF STMTPT 0123 09090000 L @6,0(0,@9) STMTPT 0123 09100000 LA @A,0(@8,@6) 0123 09110000 BCTR @A,0 0123 09120000 MVC 0(1,@A),ADDCHAR 0123 09130000 * CURRJCL=PRIORJCL; 09140000 L @7,20(0,@1) ADDRESS OF HISTFLD 0124 09150000 MVC 20(4,@7),16(@7) 0124 09160000 * CT=0; 09170000 SR @F,@F 0125 09180000 ST @F,CT 0125 09190000 * GO TO AGAIN; /* NEED TO FREE RETURN MSG AND 09200000 * FROM THERE CALL CONTROL TO 09210000 * REPROCESS THE CARD */ 09220000 BC 15,AGAIN 0126 09230000 **/*IKJEFF13: CHART */ 09240000 **/*HEADER 09250000 **/*IKJEFF13 --- PROMPTJOB RTN */ 09260000 **/*E ENTER */ 09270000 **/*P INCREMENT THE INPROMPT JOB RTN CTR, PROCESS A NULL CARD */ 09280000 **/*S IKJEFF06: CALL IKJEFF06 */ 09290000 **/*D (NO,,YES,LOOP) IS USERID=JOB NAME? */ 09300000 **/*OUT: P DECREMENT THE 'INPROMPT-JOB' CTR */ 09310000 **/*R RETURN TO CALLER */ 09320000 **/*LOOP: D (NO,,YES,%D3) ROOM FOR AN EXTRA CHARACTER? */ 09330000 **/*N TWO BLANKS AFTER USERID OR 2 BEFORE VERB JOB */ 09340000 **/*P SAVE ORIGINAL JOB CARD;INIT COMMENT CARD FOR JEFF08 */ 09350000 **/*N COMMENT SAYS 'ORIGINAL JOB CARD FOLLOWS' */ 09360000 **/*S IKJEFF08: CALL IKJEFF08 */ 09370000 **/*P TURN ON 'JOB COMMENT SW' */ 09380000 **/*CALLCON: S (,OUT) IKJEFF06: CALL IKJEFF06 */ 09390000 **/*%D3: D (NO,,YES,PROMPT) IS THE BLANK BEFORE THE VERB JOB */ 09400000 **/*MOVEJOB: P MOVE THE VERB JOB OVER */ 09410000 **/*PROMPT: P INITIALIZE A CHARACTER PROMPT MSG */ 09420000 **/*CALLMSG: S IKJEFF02: CALL IKJEFF02 */ 09430000 **/*D (YES,OUT,NO,%J3) IS THE QUIT SW ON? */ 09440000 **/*%J3: D (NZERO,,ZERO,%LLB2) TEST RETURN CODE FROM MSG RTN */ 09450000 **/*BAD: P SET THE QUIT SW TO 1 */ 09460000 **/*P (,CALLMSG) SET MSGID TO SAY THERE WAS A MISSING JOBCHAR */ 09470000 **/*%LLB2: P INCREMENT THE COUNT */ 09480000 **/*N WHEN VALID CHAR IS FOUND CT ACTS LIKE A SWITCH */ 09490000 **/*D (NONB,,BLANK,AGAIN) TEST FOR USER'S RESPONSE */ 09500000 **/*VALIDCHK: D (YES,,NO,AGAIN) IS THE CHARACTER VALID */ 09510000 **/*APPEND: P COPY THE CHARACTER THAT THE USER GAVE */ 09520000 **/*P (,AGAIN) SET THE CT TO ZERO */ 09530000 **/*AGAIN: P FREE THE RESPONSE BUFFER */ 09540000 **/*D (NO,,YES,CALLCON) IS THE CT ZERO? */ 09550000 **/*P (,CALLMSG) MSGID = '13C' -- INVALID CHAR MSG */ 09560000 **/*IKJEFF13: END */ 09570000 * END 09580000 * /* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. 09590000 * /*%INCLUDE SYSLIB (IKJEFFHT) 09600000 * /*%INCLUDE SYSLIB (IKJEFFMT) 09610000 * ; 09620000 @EL01 L @D,4(0,@D) 0127 09630000 LR @1,@C 0127 09640000 L @0,@SIZ001 0127 09650000 FREEMAIN R,LV=(0),A=(1) 0127 09660000 LM @E,@C,12(@D) 0127 09670000 BCR 15,@E 0127 09680000 @DATA1 EQU * 09690000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 09700000 @1 EQU 01 09710000 @2 EQU 02 09720000 @3 EQU 03 09730000 @4 EQU 04 09740000 @5 EQU 05 09750000 @6 EQU 06 09760000 @7 EQU 07 09770000 @8 EQU 08 09780000 @9 EQU 09 09790000 @A EQU 10 09800000 @B EQU 11 09810000 @C EQU 12 09820000 @D EQU 13 09830000 @E EQU 14 09840000 @F EQU 15 09850000 @D1 DC H'-1' 09860000 @D2 DC H'65' 09870000 @D3 DC H'-2' 09880000 @MVC MVC 0(1,@A),0(@E) 09890000 @V1 DC V(IKJEFF06) 09900000 @V2 DC V(IKJEFF08) 09910000 DS 0F 09920000 @SIZ001 DC AL1(&SPN) 09930000 DC AL3(@DATEND-@DATD) 09940000 DS 0F 09950000 @C8 DC C'13A ' 09960000 @C9 DC C'13C ' 09970000 @C10 DC C'13D ' 09980000 @C11 DC C'13B ' 09990000 @C2 DC C'//' 10000000 @C4 DC C' ' 10010000 @C5 DC C'//* ORIGINAL JOB CARD FOLLOWS' 10020000 @C7 DC C' JOB ' 10030000 DS 0D 10040000 @DATA EQU * 10050000 CONTABPT EQU 00000000 FULLWORD INTEGER 10060000 HISTFLD EQU 00000000 FULLWORD INTEGER 10070000 HISTORY EQU HISTFLD+00000000 52 BYTE(S) ON WORD 10080000 SUBTAB EQU HISTORY+00000000 12 BYTE(S) 10090000 WHATMOD EQU HISTORY+00000012 4 BYTE(S) 10100000 INCONTRL EQU HISTORY+00000012 1 BYTE POINTER 10110000 INPROMPT EQU HISTORY+00000013 1 BYTE POINTER 10120000 INGEN EQU HISTORY+00000014 1 BYTE POINTER 10130000 INREAD EQU HISTORY+00000015 1 BIT(S) 10140000 INIDENT EQU HISTORY+00000015 1 BIT(S) 10150000 INEXIT EQU HISTORY+00000015 1 BIT(S) 10160000 INWRMGR EQU HISTORY+00000015 1 BIT(S) 10170000 INDAIRIN EQU HISTORY+00000015 1 BIT(S) 10180000 INMSG EQU HISTORY+00000015 1 BIT(S) 10190000 INCOMPIN EQU HISTORY+00000015 1 BIT(S) 10200000 INOINIT EQU HISTORY+00000015 1 BIT(S) 10210000 JCLSWITS EQU HISTORY+00000016 8 BYTE(S) 10220000 PRIORJCL EQU HISTORY+00000016 4 BYTE(S) 10230000 PVERB EQU HISTORY+00000016 2 BYTE(S) 10240000 PDELIM EQU HISTORY+00000016 1 BIT(S) 10250000 PDATA EQU HISTORY+00000016 1 BIT(S) 10260000 PNULL EQU HISTORY+00000016 1 BIT(S) 10270000 PJOB EQU HISTORY+00000016 1 BIT(S) 10280000 PEXEC EQU HISTORY+00000016 1 BIT(S) 10290000 PDD EQU HISTORY+00000016 1 BIT(S) 10300000 PCOMMAND EQU HISTORY+00000016 1 BIT(S) 10310000 PCOMMENT EQU HISTORY+00000016 1 BIT(S) 10320000 PJES EQU HISTORY+00000017 1 BIT(S) 10330000 A00000 EQU HISTORY+00000017 1 BIT(S) 10340000 A00001 EQU HISTORY+00000017 6 BIT(S) 10350000 PDTYPE EQU HISTORY+00000018 1 BYTE(S) 10360000 PDDAST EQU HISTORY+00000018 1 BIT(S) 10370000 PDDDATA EQU HISTORY+00000018 1 BIT(S) 10380000 PMISC EQU HISTORY+00000019 1 BYTE(S) 10390000 PCONEX EQU HISTORY+00000019 1 BIT(S) 10400000 POPCONEX EQU HISTORY+00000019 1 BIT(S) 10410000 PCONERR EQU HISTORY+00000019 1 BIT(S) 10420000 PNAME EQU HISTORY+00000019 1 BIT(S) 10430000 PVERBCOP EQU HISTORY+00000019 1 BIT(S) 10440000 PCOMCON EQU HISTORY+00000019 1 BIT(S) 10450000 PNOTHING EQU HISTORY+00000019 1 BIT(S) 10460000 PDLMFND EQU HISTORY+00000019 1 BIT(S) 10470000 CURRJCL EQU HISTORY+00000020 4 BYTE(S) 10480000 CVERB EQU HISTORY+00000020 2 BYTE(S) 10490000 CDELIM EQU HISTORY+00000020 1 BIT(S) 10500000 CDATA EQU HISTORY+00000020 1 BIT(S) 10510000 CNULL EQU HISTORY+00000020 1 BIT(S) 10520000 CJOB EQU HISTORY+00000020 1 BIT(S) 10530000 CEXEC EQU HISTORY+00000020 1 BIT(S) 10540000 CDD EQU HISTORY+00000020 1 BIT(S) 10550000 CCOMMAND EQU HISTORY+00000020 1 BIT(S) 10560000 CCOMMENT EQU HISTORY+00000020 1 BIT(S) 10570000 CJES EQU HISTORY+00000021 1 BIT(S) 10580000 A00002 EQU HISTORY+00000021 1 BIT(S) 10590000 A00003 EQU HISTORY+00000021 6 BIT(S) 10600000 CDTYPE EQU HISTORY+00000022 1 BYTE(S) 10610000 CDDAST EQU HISTORY+00000022 1 BIT(S) 10620000 CDDDATA EQU HISTORY+00000022 1 BIT(S) 10630000 CMISC EQU HISTORY+00000023 1 BYTE(S) 10640000 CCONEX EQU HISTORY+00000023 1 BIT(S) 10650000 COPCONEX EQU HISTORY+00000023 1 BIT(S) 10660000 CCONERR EQU HISTORY+00000023 1 BIT(S) 10670000 CNAME EQU HISTORY+00000023 1 BIT(S) 10680000 CVERBCOP EQU HISTORY+00000023 1 BIT(S) 10690000 CCOMCON EQU HISTORY+00000023 1 BIT(S) 10700000 CNOTHING EQU HISTORY+00000023 1 BIT(S) 10710000 CDLMFND EQU HISTORY+00000023 1 BIT(S) 10720000 STATICSW EQU HISTORY+00000024 4 BYTE(S) 10730000 GENL EQU HISTORY+00000024 1 BYTE(S) 10740000 QUIT EQU HISTORY+00000024 1 BIT(S) 10750000 FLUSH EQU HISTORY+00000024 1 BIT(S) 10760000 FIRST EQU HISTORY+00000024 1 BIT(S) 10770000 NONOTIFY EQU HISTORY+00000024 1 BIT(S) 10780000 TAKEXITS EQU HISTORY+00000025 1 BYTE(S) 10790000 JOBX EQU HISTORY+00000025 1 BIT(S) 10800000 EXECX EQU HISTORY+00000025 1 BIT(S) 10810000 DDX EQU HISTORY+00000025 1 BIT(S) 10820000 CMDX EQU HISTORY+00000025 1 BIT(S) 10830000 NULLX EQU HISTORY+00000025 1 BIT(S) 10840000 JESX EQU HISTORY+00000025 1 BIT(S) 10850000 COMNTX EQU HISTORY+00000025 1 BIT(S) 10860000 A00004 EQU HISTORY+00000025 1 BIT(S) 10870000 OPOFF EQU HISTORY+00000026 1 BYTE POINTER 10880000 CODEFLD EQU HISTORY+00000027 1 BYTE POINTER 10890000 HTCODE EQU HISTORY+00000027 1 BYTE POINTER 10900000 A00005 EQU HISTORY+00000028 FULLWORD POINTER 10910000 DLMONJCL EQU HISTORY+00000032 2 BYTE(S) 10920000 HTDLM EQU HISTORY+00000032 2 BYTE(S) 10930000 HTSWITCH EQU HISTORY+00000034 1 BYTE(S) 10940000 HTDLMSW EQU HISTORY+00000034 1 BIT(S) 10950000 A00006 EQU HISTORY+00000034 7 BIT(S) 10960000 A00007 EQU HISTORY+00000035 1 BYTE(S) 10970000 A00008 EQU HISTORY+00000036 4 BYTE POINTER 10980000 HTACCNTP EQU HISTORY+00000040 FULLWORD POINTER 10990000 HTACCNTL EQU HISTORY+00000044 2 BYTE INTEGER 11000000 HTACNTC1 EQU HISTORY+00000046 2 BYTE INTEGER 11010000 HTACNTC2 EQU HISTORY+00000048 2 BYTE INTEGER 11020000 A00009 EQU HISTORY+00000050 2 BYTE INTEGER 11030000 HTACCNTI EQU 00000000 190 BYTE(S) 11040000 USERID EQU 00000000 8 BYTE(S) 11050000 JOBNAME EQU 00000000 8 BYTE(S) 11060000 STMTPT EQU 00000000 FULLWORD POINTER 11070000 CARD EQU 00000000 80 BYTE(S) 11080000 MSGPTR EQU 00000000 FULLWORD POINTER 11090000 MSGTABLE EQU 00000000 64 BYTE(S) ON WORD 11100000 LISTPTR EQU MSGTABLE+00000000 FULLWORD POINTER 11110000 TMCTPTR EQU MSGTABLE+00000004 FULLWORD POINTER 11120000 MTCPPL EQU MSGTABLE+00000004 FULLWORD POINTER 11130000 ECBPTR EQU MSGTABLE+00000008 FULLWORD POINTER 11140000 A00010 EQU MSGTABLE+00000012 FULLWORD POINTER 11150000 MTHIGH EQU MSGTABLE+00000012 1 BIT(S) 11160000 MSGCSECT EQU MSGTABLE+00000016 FULLWORD POINTER 11170000 SW EQU MSGTABLE+00000020 1 BYTE POINTER 11180000 MTNOIDSW EQU MSGTABLE+00000020 1 BIT(S) 11190000 MTPUTLSW EQU MSGTABLE+00000020 1 BIT(S) 11200000 MTWTOSW EQU MSGTABLE+00000020 1 BIT(S) 11210000 MTHEXSW EQU MSGTABLE+00000020 1 BIT(S) 11220000 MTKEY1SW EQU MSGTABLE+00000020 1 BIT(S) 11230000 MTJOBISW EQU MSGTABLE+00000020 1 BIT(S) 11240000 MTWTPSW EQU MSGTABLE+00000020 1 BIT(S) 11250000 MTNHEXSW EQU MSGTABLE+00000020 1 BIT(S) 11260000 RETMSG EQU MSGTABLE+00000021 3 BYTE POINTER ON WORD+1 11270000 SW2 EQU MSGTABLE+00000024 1 BYTE POINTER 11280000 MT2OLDSW EQU MSGTABLE+00000024 1 BIT(S) 11290000 MTDOMSW EQU MSGTABLE+00000024 1 BIT(S) 11300000 MTNOXQSW EQU MSGTABLE+00000024 1 BIT(S) 11310000 MTNPLMSW EQU MSGTABLE+00000024 1 BIT(S) 11320000 MTPGMSW EQU MSGTABLE+00000024 1 BIT(S) 11330000 A00011 EQU MSGTABLE+00000024 3 BIT(S) 11340000 A00012 EQU MSGTABLE+00000025 3 BYTE POINTER ON WORD+1 11350000 MTOLDPTR EQU MSGTABLE+00000028 FULLWORD POINTER 11360000 A00013 EQU MSGTABLE+00000032 FULLWORD POINTER 11370000 A00014 EQU MSGTABLE+00000036 FULLWORD POINTER 11380000 MSGID EQU MSGTABLE+00000040 4 BYTE(S) 11390000 MTINSRTS EQU MSGTABLE+00000044 16 BYTE(S) ON WORD 11400000 L1 EQU MSGTABLE+00000044 1 BYTE POINTER 11410000 HIGHL1 EQU MSGTABLE+00000044 1 BIT(S) 11420000 VAR1 EQU MSGTABLE+00000045 3 BYTE POINTER ON WORD+1 11430000 L2 EQU MSGTABLE+00000048 1 BYTE POINTER 11440000 HIGHL2 EQU MSGTABLE+00000048 1 BIT(S) 11450000 VAR2 EQU MSGTABLE+00000049 3 BYTE POINTER ON WORD+1 11460000 L3 EQU MSGTABLE+00000052 1 BYTE POINTER 11470000 HIGHL3 EQU MSGTABLE+00000052 1 BIT(S) 11480000 VAR3 EQU MSGTABLE+00000053 3 BYTE POINTER ON WORD+1 11490000 L4 EQU MSGTABLE+00000056 1 BYTE POINTER 11500000 HIGHL4 EQU MSGTABLE+00000056 1 BIT(S) 11510000 VAR4 EQU MSGTABLE+00000057 3 BYTE POINTER ON WORD+1 11520000 MSGRTN EQU MSGTABLE+00000060 FULLWORD POINTER 11530000 RET EQU 00000000 1001 BYTE(S) ON WORD 11540000 RETSIZE EQU RET+00000000 HALFWORD INTEGER 11550000 RETCHAR EQU RET+00000002 999 BYTE(S) 11560000 MSGTMCT EQU 00000000 FULLWORD INTEGER 11570000 MSGECB EQU 00000000 FULLWORD INTEGER 11580000 MSGSW EQU 00000020 1 BYTE(S) 11590000 R1 EQU 00000001 FULLWORD POINTER REGISTER 11600000 R15 EQU 00000015 FULLWORD INTEGER REGISTER 11610000 R0 EQU 00000000 FULLWORD INTEGER REGISTER 11620000 PATCH EQU @DATA+00000000 51 BYTE(S) ON WORD 11630000 PTCHINIT EQU * 17*3 BYTE(S) 11640000 DC 00017C'ZAP' 11650000 ORG @DATA 11660000 DS 00000051C 11670000 @L EQU 1 11680000 @DATD DSECT 11690000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 11700000 CARD2 EQU @DATD+00000072 80 BYTE(S) 11710000 SAVEJCL EQU @DATD+00000152 4 BYTE(S) 11720000 MSGADDR EQU @DATD+00000156 FULLWORD POINTER 11730000 CT EQU @DATD+00000160 FULLWORD INTEGER 11740000 HOLD EQU @DATD+00000164 FULLWORD INTEGER 11750000 I EQU @DATD+00000168 FULLWORD INTEGER 11760000 K EQU @DATD+00000172 FULLWORD INTEGER 11770000 ADDCHAR EQU @DATD+00000176 1 BYTE(S) 11780000 DS 00000177C 11790000 @TEMPS DS 0F 11800000 @TEMP4 DC F'0' 11810000 @PL001 DS 05F 11820000 @DATEND EQU * 11830000 IKJEFF13 CSECT , 11840000 @9EE EQU AGAIN 11850000 END 11860000