TITLE 'APSUX01 - INSTALLATION EXIT JOB HEADER ROUTINE' 00010000 **** START OF SPECIFICATIONS ***************************************** 00020000 * * 00030000 *01* MODULE NAME = APSUX01 * 00040000 * * 00050000 * $MOD(APSUX01 ) COMP(APS) PROD(PSF) : VERSION 3.2.0 * 00060000 * * 00070000 *01* DESCRIPTIVE NAME = DEFAULT INSTALLATION EXIT JOB HEADER ROUTINE * 00080000 * * 00090000 *01* STATUS = VERSION 3, RELEASE 2, LEVEL 0 * 00100000 * * 00110000 *01* FUNCTION = Defines a job header separator page with the * 00120000 * JOBNAME in block letters and followed by job * 00130000 * related information lines. * 00140000 * * 00150000 * This exit will also put out a continuation header * 00160000 * page, if printing of a data set is interrupted by a * 00170000 * JES command, and then resumes. The continuation * 00180000 * header page is identical to the start header page * 00190000 * except the continuation header page prints the word * 00200000 * 'CONT' instead of the word 'START'. * 00210000 * * 00220000 * This job header exit contains the code (commented@D2A* 00230000 * out) to not transmit this header page (branches @D2A* 00240000 * around the exit code) if connected to DPF @D2A* 00250000 * (Distributed Print Facility). Headers are @D2A* 00260000 * required to be active when connected to DPF @D2A* 00270000 * so that PSF can inform DPF of the job @D2A* 00280000 * boundaries (required when below JES2 4.1.0 or @D2A* 00290000 * JES3 4.2.0). @D2A* 00300000 * * 00310000 * HEADER SHEET * 00320000 * * 00330000 * There are 2 forms of this header sheet that can be printed. * 00340000 * If JES supports Enhanced Sysout Support (ESS) then the * 00350000 * ESS header sheet is printed. If JES does not support ESS * 00360000 * then the original header sheet is printed. * 00370000 * * 00380000 * The ESS header sheet provides 6 additional keywords. * 00390000 * They are: * 00400000 * TITLE: * 00410000 * NAME: * 00420000 * ROOM: * 00430000 * BUILDING: * 00440000 * DEPARTMENT: * 00450000 * ADDRESS: * 00460000 * * 00470000 * The 6 keywords are obtained from the Print Dataset's * 00480000 * OUTPUT JCL. * 00490000 * * 00500000 * A SEGMENT ID field may or may not be printed on * 00510000 * the same line as the JOBID on the ESS header sheet. * 00520000 * If the SYSOUT is not segmented, then the entire * 00530000 * SEGMENT ID field is omitted from the header sheet. * 00540000 * For segmented SYSOUT, the SEGMENT ID is formatted * 00550000 * and printed on the header sheet. If the segment ID is * 00560000 * negative or greater than 99999, then the SEGMENT ID field * 00570000 * is printed as ***** (indicates an invalid segment ID). * 00580000 * * 00590000 * The OUTPUT JCL (SWBTU) is the preferred source for NAME * 00600000 * and ROOM. The JCL values (6 new keywords) are * 00610000 * retrieved via the SWBTUREQ macro. If * 00620000 * NAME is not in the SWBTU, then the programmer name from the * 00630000 * JSPA is used. Likewise, if ROOM is not in the SWBTU, then * 00640000 * the room from the JSPA (Job Stmt) is used. * 00650000 * * 00660000 * The ADDRESS keyword allows the address to be from 1 to 4 * 00670000 * lines long. Any lines that are unused are printed as blank * 00680000 * lines, but the label ADDRESS appears on the first line even * 00690000 * if no address was specified on the OUTPUT JCL. * 00700000 * * 00710000 * If the SWBTUREQ macro returned an error, the ADDRESS line * 00720000 * is not printed. An error message is printed in the four * 00730000 * lines that would have contained the ADDRESS that contains * 00740000 * the SWBTUREQ Return Code and Reason Code. * 00750000 * * 00760000 * DESTINATION is a new field on the header sheet. Its value * 00770000 * is obtained from the JSPA. * 00780000 * * 00790000 * Enhanced Sysout Support (ESS) is supported by: * 00800000 * * 00810000 * MVS 4.1.0+ * 00820000 * JES2 4.10+ * 00830000 * JES3 4.20+ * 00840000 * * 00850000 * CONDITIONAL ASSEMBLY * 00860000 * * 00870000 * Conditional assembly is used * 00880000 * in this module to determine whether to * 00890000 * assemble the ESS header sheet code or not assemble it. * 00900000 * The System Variable Symbol SYSPARM is used to determine the * 00910000 * conditional assembly. * 00920000 * * 00930000 * If SYSPARM is not specified in a job control statement (null) * 00940000 * or SYSPARM is specified as null ("SYSPARM ()"), then the * 00950000 * ESS header sheet code is not assembled. * 00960000 * * 00970000 * If SYSPARM is specified in a job control statement as * 00980000 * non-null ("SYSPARM (xxx)" where xxx is any character * 00990000 * string up to 255 characters), then the ESS header sheet * 01000000 * code is assembled. * 01010000 * * 01020000 * Example: //STEP EXEC ASMFC,PARM=(SYSPARM(ESS)) * 01030000 * * 01040000 * If the ESS header sheet code is assembled, the ESS * 01050000 * header sheet is still not printed unless JES supports * 01060000 * ESS (ECEJESS = 1). * 01070000 * * 01080000 * * 01090000 *02* OPERATION = The following items are done by this exit: * 01100000 * 1. Create 12 block letter line records for * 01110000 * the job name. * 01120000 * 2. Pass the block letter lines to PSF. * 01130000 * 3. Build Job Information Lines. * 01140000 * 4. Pass the information line record to PSF. * 01150000 * * 01160000 *01* NOTES = * 01170000 *02* DEPENDENCIES = NONE * 01180000 *02* RESTRICTIONS = NONE * 01190000 *02* REGISTER-CONVENTIONS = R15 = ENTRY ADDRESS, RESET ON RETURN * 01200000 * R13 = SAVE AREA ADDRESS * 01210000 * R12 = BASE REGISTER * 01220000 * R4-R11 = SEE ASSEMBLER EQUATES BELOW * 01230000 *02* PATCH LABEL = PSPACE * 01240000 * * 01250000 *01* MODULE TYPE = PROCEDURE * 01260000 *02* PROCESSOR = ASSEMBLER * 01270000 *02* ATTRIBUTES = REENTRANT * 01280000 * AMODE 31 * 01290000 * RMODE ANY * 01300000 * * 01310000 *01* ENTRY POINT = APSUX01 * 01320000 *02* LINKAGE = STANDARD CALL * 01330000 * R1 = ADDRESS OF A 4 BYTE FIELD WHICH * 01340000 * CONTAINS THE ADDRESS OF APSGEXTP * 01350000 * * 01360000 *01* INPUT = * 01370000 * APSUCOM - PSF Exits Constants Table * 01380000 * APSGEXTP - PSF Installation Exit Parameter Area * 01390000 * APSUECA - PSF Exit Communications Area * 01400000 * IAZJSPA - JOB Separator Page Area * 01410000 * IEFJMR - MVS Job Management Record * 01420000 * CVT - Communication Vector Table * 01430000 * IEESMCA - System Management Facilities Control @DYA* 01440000 * Table @DYA* 01450000 * IEFJESCT - Job Entry Subsystem Communication Table * 01460000 * IEFSJTRP - Scheduler JCL Facility SWBTUREQ RETRIEVE * 01470000 * Parameter List * 01480000 * IEFDOTUM - Dynamic Output Text Unit Mappings * 01490000 * IEFDOKEY - Dynamic Output Key Mapping * 01500000 * IEFSJTRC - Scheduler JCL Facility (SJF) SWBTUREQ * 01510000 * Services Return and Reason Codes * 01520000 * * 01530000 *01* OUTPUT = * 01540000 * LINE DATA RECORDS * 01550000 * * 01560000 *01* EXIT NORMAL = RETURN TO CALLER * 01570000 * * 01580000 *01* EXIT ERROR = NONE * 01590000 * * 01600000 *01* EXTERNAL REFERENCES = * 01610000 *02* ROUTINES = * 01620000 * APSUBLK - BUILD BLOCK LETTER RECORDS * 01630000 * APSUPUT - PUT RECORD TO PSF * 01640000 *02* DATA AREAS = * 01650000 * APSUCOM - PSF Exits Constants Table * 01660000 * APSGEXTP - PSF Installation Exit Parameter Area * 01670000 * APSUECA - PSF Exit Communications Area * 01680000 * IAZJSPA - JES Separator Page Area * 01690000 * IEFJMR - MVS Job Management Record * 01700000 * CVT - Communication Vector Table * 01710000 * IEESMCA - System Management Facilities Control @DYA* 01720000 * Table @DYA* 01730000 * IEFJESCT - Job Entry Subsystem Communication Table * 01740000 * IEFSJTRP - Scheduler JCL Facility SWBTUREQ RETRIEVE * 01750000 * Parameter List * 01760000 * IEFDOTUM - Dynamic Output Text Unit Mappings * 01770000 * IEFDOKEY - Dynamic Output Key Mapping * 01780000 * IEFSJTRC - Scheduler JCL Facility (SJF) SWBTUREQ * 01790000 * Services Return and Reason Codes * 01800000 *02* INCLUDES = NONE * 01810000 * * 01820000 *01* MACROS = NONE * 01830000 * * 01840000 *01* MESSAGES = NONE * 01850000 * * 01860000 * 01* CHANGE ACTIVITY = * 01870000 * $H3=LAPS0003,HAF1220,032588,53KRSB: RELEASE 2.1 * 01880000 * $01=OY12136C,HAF1220,032588,53KRSB: CONTINUATION SEPARATOR NOT * 01890000 * PRINTING * 01900000 * $L1=LAPS0004, HAF1228, 880601, B53KELJ: RELEASE 3.0 * 01910000 * $H5=LAPS0005, HPRF102, 033189, B53KEMC: REL 2.1.0 NEW FUNCT @H5A* 01920000 * $H9=LAPS0005, HAF1237, 062990, B53KRLD: ESS NEW FUNCTION @H9A* 01930000 * $L2=LAPS0005, HPRF102, 910201, BJ13RLD: UPDATE PROLOG RELEASE @L2A* 01940000 * LEVEL (P1966) * 01950000 * $D2=LAPS0006, HPRF220, 930108, BJ13RLD: REL 2.2.0 - @D2A* 01960000 * ADD COMMENTED OUT CODE * 01970000 * TO BYPASS THE EXIT IF * 01980000 * CONNECTED TO DPF. PTR * 01990000 * BF00037. * 02000000 * $D2=LAPS0006, HPRF220, 930715, BJ13RLD: REL 2.2.0 - @D2A* 02010000 * ADD RETURN CODE CHECKING * 02020000 * UPON RETURN FROM APSUPUT. * 02030000 * PTR BF00097. * 02040000 * $02=OW08944, HPRF220, 950127, BJ13RLD: PRINT THE ENTIRE YEAR @02A* 02050000 * (1995) ON THE HEADER * 02060000 * SHEET * 02070000 * $DU=LAPS0007,HPRF310,980604,BDKURLB: Version 3.1.0 @DUA* 02080000 * $DY=LAPS0008,HPRF320,991115,BDKURLD: System ID on Banner @DYA* 02090000 * $DX=LAPS0008,HPRF320,991117,BUQ4RLB: Version 3.2.0 @DXA* 02100000 * * 02110000 **** END OF SPECIFICATIONS ******************************************* 02120000 * 02130000 APSUX01 START 0 02140000 TITLE 'DSECT - XTP' 02150000 APSGEXTP LIST=YES 02160000 TITLE 'DSECT - ECA' 02170000 APSUECA LIST=YES 02180000 TITLE 'DSECT - JSPA' 02190000 IAZJSPA LIST=YES 02200000 TITLE 'DSECT - JMR' 02210000 IEFJMR 02220000 TITLE 'SMCA MAPPING' @DYA 02230000 IEESMCA @DYA 02240000 TITLE 'CVT MAPPING' 02250000 CVT DSECT=YES Required for SWBTUREQ @H9A 02260000 TITLE 'JESCT MAPPING' 02270000 IEFJESCT Required for SWBTUREQ @H9A 02280000 TITLE 'APSUX01 - INSTALLATION EXIT JOB HEADER ROUTINE' 02290000 APSUX01 CSECT , 02300000 APSUX01 AMODE 31 @H5A 02310000 APSUX01 RMODE ANY @H5A 02320000 USING *,@15 02330000 B PROLOG 02340000 DC AL1(16) 02350000 DC CL8'APSUX01' @L1C 02360000 DC CL8'&SYSDATE' @L1C 02370000 DROP @15 02380000 * 02390000 ********************************************************************** 02400000 * PROLOG 02410000 ********************************************************************** 02420000 * 02430000 PROLOG DS 0H 02440000 STM @14,@12,12(@13) SAVE CALLERS REGISTERS 02450000 LR @12,@15 R12 IS BASE REG 02460000 USING APSUX01,@12 BASE APSUX01 ON R12 02470000 USING APSGEXTP,XTPPTR BASE APSGEXTP ON XTPPTR 02480000 USING APSUECA,ECAPTR BASE APSUECA ON ECAPTR 02490000 USING IAZJSPA,JSPAPTR BASE IAZJSPA ON JSPAPTR 02500000 USING JMR,JMRPTR BASE JMR ON JMRPTR 02510000 L @04,0(,@01) LOAD ADDRESS OF APSGEXTP 02520000 L @05,XTPECAP LOAD ADDRESS OF APSUECA 02530000 LA ECAWKPTR,ECAWKBUF LOAD ADDRESS OF ECA WORK 02540000 * BUFFER 02550000 USING BUFWRK,ECAWKPTR BASE WORK AREA ON ECA WORK 02560000 * BUFFER 02570000 LR @02,@13 LOAD ADDRESS OF CALLER SAVE 02580000 * AREA 02590000 LA @13,ECAUSAVE R13 POINTS TO APSUX01 02600000 * SAVE AREA 02610000 ST @02,4(,@13) SAVE CALLERS SAVE AREA ADDR 02620000 * 02630000 ********************************************************************** 02640000 * TO SUPPRESS THIS HEADER WHEN ATTACHED TO THE @D2A 02650000 * DISTRIBUTED PRINT FUNCTION OF PSF/2 THEN UNCOMMENT @D2A 02660000 * THE FOLLOWING CODE. @D2A 02670000 ********************************************************************** 02680000 * 02690000 * USING APSUECE,@02 Get addressablity @D2A 02700000 * L @02,ECAECEP to ECE @D2A 02710000 * @D2A 02720000 * TM ECEFLAG,ECEDPF DPF attached printer?@D2A 02730000 * BO OUT YES - exit immediate @D2A 02740000 * @D2A 02750000 * DROP @02 Drop addr. to ECE @D2A 02760000 * @D2A 02770000 SLR RTNCODE,RTNCODE RESET RETURN CODE 02780000 XC ECAFLAGS(2),ECAFLAGS RESET ECAFLAGS 02790000 L JSPAPTR,XTPJSPAP LOAD ADDRESS OF IAZJSPA 02800000 L JMRPTR,JSPAJMR LOAD ADDRESS OF IEFJMR 02810000 L PUTPTR,ECAPUTP LOAD ADDRESS OF APSUPUT 02820000 NI ECAFLAGS,B'10111111' RESET LEFT ADJUST FLAG 02830000 MVI ECADRF,X'00' RESET RECORD TYPE FLAG 02840000 OI ECADRF,B'01010000' SET LINE MODE AND MACHINE 02850000 * CODE FLAGS 02860000 MVC ECARECLN(4),ONE GET LENGTH OF RECORD 02870000 LA @14,BUFWRK GET ADDRESS OF 02880000 ST @14,ECARECAD RECORD 02890000 * 02900000 ********************************************************************** 02910000 * PRINT THE JOB NAME IN STRAIGHT BLOCK LETTERS 02920000 ********************************************************************** 02930000 * 02940000 MVC ECABLKIN(8),JSPAJBNM OBTAIN JOB NAME 02950000 NI ECAFLAGS,B'01111111' TURN OFF SLANT INDICATOR 02960000 L @15,BLKPTR CALL 02970000 BALR @14,@15 APSUBLK 02980000 MVC ECARECLN(4),LINELGTH SET LENGTH OF THE BLOCK 02990000 * LETTER 03000000 LA @14,BUFWRK SET ADDRESS OF 03010000 ST @14,ECARECAD RECORD 03020000 MVI PRINTCC(@14),X'09' SET CC IN PRINT RECORD 03030000 LA @14,1 LOOP 03040000 STH @14,INDEX INDEX 03050000 LOOP LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 03060000 BNZ OUT NOT ZERO, EXIT 03070000 LR @15,PUTPTR CALL 03080000 BALR @14,@15 APSUPUT 03090000 LA @14,132 GET NEXT 03100000 AL @14,ECARECAD RECORD 03110000 ST @14,ECARECAD TO PRINT 03120000 MVI PRINTCC(@14),X'09' SET CC 03130000 LA @14,1 CHECK IF 03140000 AH @14,INDEX PRINTED 03150000 STH @14,INDEX TWELVE 03160000 C @14,TWELVE LINES 03170000 BNH LOOP 03180000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED 03190000 BNZ OUT EXIT 03200000 * 03210000 ********************************************************************** 03220000 * PROVIDE 3 BLANK LINES BETWEEN BLOCK LETTER GROUPS 03230000 ********************************************************************** 03240000 * 03250000 LA @14,BUFWRK SET RECORD ADDRESS BACK TO 03260000 ST @14,ECARECAD BEGINNING OF WORK BUFFER 03270000 MVC ECARECLN(4),TWO GET LENGTH OF RECORD 03280000 MVI WRKCC,X'09' SET CC TO WRITE 03290000 MVC PRINTPOS(1),BLANK SET PRINTPOS TO BLANK 03300000 LA @14,1 LOOP 03310000 STH @14,INDEX INDEX 03320000 LOOP1 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 03330000 BNZ OUT NOT ZERO, EXIT 03340000 LR @15,PUTPTR CALL 03350000 BALR @14,@15 APSUPUT 03360000 LA @14,1 CHECK IF 03370000 AH @14,INDEX PRINTED 03380000 STH @14,INDEX THREE 03390000 C @14,THREE LINES 03400000 BNH LOOP1 03410000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED 03420000 BNZ OUT EXIT 03430000 * 03440000 ********************************************************************** 03450000 * PRINT THE JOB ID IN STRAIGHT BLOCK LETTERS 03460000 ********************************************************************** 03470000 * 03480000 MVC ECABLKIN(8),JSPAJBID OBTAIN JOB ID 03490000 NI ECAFLAGS,B'01111111' TURN OFF SLANT INDICATOR 03500000 L @15,BLKPTR CALL 03510000 BALR @14,@15 APSUBLK 03520000 MVC ECARECLN(4),LINELGTH SET LENGTH OF RECORD 03530000 LA @14,BUFWRK SET RECORD ADDRESS BACK TO 03540000 ST @14,ECARECAD BEGINNING OF PRINT RECORDS 03550000 MVI PRINTCC(@14),X'09' SET CC IN PRINT RECORD 03560000 LA @14,1 LOOP 03570000 STH @14,INDEX INDEX 03580000 LOOP2 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 03590000 BNZ OUT NOT ZERO, EXIT 03600000 LR @15,PUTPTR CALL 03610000 BALR @14,@15 APSUPUT 03620000 LA @14,132 GET NEXT 03630000 AL @14,ECARECAD RECORD 03640000 ST @14,ECARECAD TO PRINT 03650000 MVI PRINTCC(@14),X'09' SET CC 03660000 LA @14,1 CHECK IF 03670000 AH @14,INDEX PRINTED 03680000 STH @14,INDEX TWELVE 03690000 C @14,TWELVE RECORDS 03700000 BNH LOOP2 03710000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED 03720000 BNZ OUT EXIT 03730000 * 03740000 ********************************************************************** 03750000 * PROVIDE 3 BLANK LINES BETWEEN BLOCK LETTER GROUPS 03760000 ********************************************************************** 03770000 * 03780000 LA @14,BUFWRK SET RECORD ADDRESS BACK TO 03790000 ST @14,ECARECAD BEGINNING OF WORK BUFFER 03800000 MVC ECARECLN(4),TWO SET LENGTH OF RECORD 03810000 MVI WRKCC,X'09' SET CC TO WRITE 03820000 MVC PRINTPOS(1),BLANK SET PRINT POSITION TO BLANK 03830000 LA @14,1 LOOP 03840000 STH @14,INDEX INDEX 03850000 LOOP3 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 03860000 BNZ OUT NOT ZERO, EXIT 03870000 LR @15,PUTPTR CALL 03880000 BALR @14,@15 APSUPUT 03890000 LA @14,1 CHECK 03900000 AH @14,INDEX IF PRINTED 03910000 STH @14,INDEX THREE 03920000 C @14,THREE LINES 03930000 BNH LOOP3 03940000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED 03950000 BNZ OUT EXIT 03960000 * 03970000 ********************************************************************** 03980000 * 03990000 * Conditional assembly check for ESS 04000000 * 04010000 * The code between the AIF and the label .NOESS01 will be 04020000 * suppressed if SYSPARM is NULL. 04030000 * 04040000 ********************************************************************** 04050000 * 04060000 AIF ('&SYSPARM' EQ '').NOESS01 Branch - ESS not supp @H9A 04070000 * 04080000 ********************************************************************** 04090000 * Determine which separator format to print. * 04100000 * Room Number & Sysout Class are not printed in * 04110000 * straight block letters in ESS. * 04120000 ********************************************************************** 04130000 * 04140000 USING APSUECE,@02 Get addressability @H9A 04150000 L @02,ECAECEP to ECE @H9A 04160000 * 04170000 TM ECEFLAG,ECEJESS Does JES support ESS? @H9A 04180000 BNZ MAINPLIN YES -skip room & @H9A 04190000 * sysout 04200000 * NO -use room & sysout 04210000 * 04220000 DROP @02 Drop addr. to ECE @H9A 04230000 * 04240000 .NOESS01 ANOP @H9A 04250000 * 04260000 ********************************************************************** 04270000 * PRINT THE ROOM NUMBER & SYSOUT CLASS IN STRAIGHT BLOCK LETTERS 04280000 ********************************************************************** 04290000 * 04300000 MVI ECABLKIN,C' ' BLANK OUT 04310000 MVC ECABLKIN+1(7),ECABLKIN THE AREA 04320000 MVC ECABLKIN(4),JSPJRMNO OBTAIN ROOM NUMBER 04330000 MVC ECABLKIN+6(1),JSPJSOCL OBTAIN SYSOUT CLASS 04340000 NI ECAFLAGS,B'01111111' TURN OFF SLANT INDICATOR 04350000 L @15,BLKPTR CALL 04360000 BALR @14,@15 APSUBLK 04370000 MVC ECARECLN(4),LINELGTH GET LENGTH OF THE RECORD 04380000 LA @14,BUFWRK GET ADDRESS OF 04390000 ST @14,ECARECAD THE RECORD 04400000 MVI PRINTCC(@14),X'09' SET CC IN PRINT RECORD 04410000 LA @14,1 LOOP 04420000 STH @14,INDEX INDEX 04430000 LOOP4 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 04440000 BNZ OUT NOT ZERO, EXIT 04450000 LR @15,PUTPTR CALL 04460000 BALR @14,@15 APSUPUT 04470000 LA @14,132 GET NEXT 04480000 AL @14,ECARECAD RECORD 04490000 ST @14,ECARECAD TO PRINT 04500000 MVI PRINTCC(@14),X'09' SET CC 04510000 LA @14,1 CHECK IF 04520000 AH @14,INDEX PRINTED 04530000 STH @14,INDEX TWELVE 04540000 C @14,TWELVE LINES 04550000 BNH LOOP4 04560000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED 04570000 BNZ OUT EXIT 04580000 * 04590000 ********************************************************************** 04600000 * PROVIDE 2 BLANK LINES AFTER BLOCK LETTERS 04610000 ********************************************************************** 04620000 * 04630000 LA @14,BUFWRK SET ECARECAD TO WORK 04640000 ST @14,ECARECAD BUFFER ADDRESS 04650000 MVC ECARECLN(4),TWO SET LENGTH OF RECORD 04660000 MVI WRKCC,X'09' SET CC TO WRITE 04670000 MVC PRINTPOS(1),BLANK SET PRINT POSITION TO BLANK 04680000 LA @14,1 LOOP 04690000 STH @14,INDEX INDEX 04700000 LOOP5 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 04710000 BNZ OUT NOT ZERO, EXIT 04720000 LR @15,PUTPTR CALL 04730000 BALR @14,@15 APSUPUT 04740000 LA @14,1 CHECK IF 04750000 AH @14,INDEX PRINTED 04760000 STH @14,INDEX TWO 04770000 C @14,TWO LINES 04780000 BNH LOOP5 04790000 LTR RTNCODE,RTNCODE APSUPUT FAILED 04800000 BNZ OUT EXIT 04810000 * 04820000 ********************************************************************** 04830000 * BEGIN BUILDING THE MAIN PRINT LINE 04840000 ********************************************************************** 04850000 * 04860000 MAINPLIN MVI BUFPRT+1,C' ' SET 04870000 MVC BUFPRT+2(125),BUFPRT+1 PRINT LINE @02C 04880000 MVC BUFPRT(1),BLANK TO BLANKS 04890000 * 04900000 ********************************************************************** 04910000 * OBTAIN TIME AND DATE 04920000 * 04930000 * The time and date are calculated here for both the original 04940000 * header sheet and the ESS header sheet. 04950000 * 04960000 * The date is returned in register 1 as packed decimal @02A 04970000 * digits of the form: @02A 04980000 * @02A 04990000 * 0CYYDDDF where @02A 05000000 * @02A 05010000 * C is a digit representing centuries beyond the twentieth. @02A 05020000 * In the years 1900 through 1999, C = 0. In the years @02A 05030000 * 2000 through 2099, C = 1. @02A 05040000 * YY is the last 2 digits of the year. @02A 05050000 * DDD is the day of the year. @02A 05060000 * F is a 4-bit sign character that allows the data to be @02A 05070000 * unpacked and printed. @02A 05080000 * 05090000 ********************************************************************** 05100000 * 05110000 LA @01,2 SET R1 05120000 SLR @00,@00 RESET R0 05130000 SVC 11 ISSUE TIME SVC 05140000 ST @01,WRKDATE SAVE THE DATE (PACKED DEC) 05150000 * 05160000 ********************************************************************** 05170000 * ADJUST TIME FOR AM/PM 05180000 ********************************************************************** 05190000 * 05200000 LA WRKPTR,WRKTIME GET ADDRESS OF WORK AREA 05210000 LA AMPMPTR,WRKAMPM GET ADDRESS OF AM/PM WORK 05220000 * AREA 05230000 MVC WRKAMPM(2),AM SET AM/PM TO AM 05240000 CL @00,=X'12000000' TEST FOR ZERO HOURS 05250000 BL PMORNING BRANCH IF AM 05260000 MVI 0(@03),C'P' CHANGE FROM AM TO PM 05270000 SL @00,=X'12000000' SUBTRACT TWELVE HOURS 05280000 PMORNING ST @00,0(,@02) STORE ADJUSTED TIME 05290000 CLI 0(@02),X'00' TEST FOR ZERO HOURS 05300000 BNE PADJERR BR IF NOT TO TEST ADJ ERR 05310000 MVI 0(@02),X'12' CONVERT ZERO TO TWELVE 05320000 PADJERR TM 0(@02),X'08' TEST FOR ADJUSTMENT ERRORS 05330000 BZ PEDTIME BRANCH IF NO ERROR 05340000 NI 0(@02),X'09' CORRECT FOR BINARY 05350000 * SUBSTRACT ERROR 05360000 PEDTIME DS 0H 05370000 * 05380000 ********************************************************************** 05390000 * UNPACK HOURS MINUTES SECONDS 05400000 ********************************************************************** 05410000 * 05420000 MVI WRKTH,X'0C' RESET LOW ORDER 2 BYTES 05430000 * WITH SIGN FOR PACKED DEC 05440000 UNPK WRKUTIME(7),WRKTIME(4) UNPACK TIME 05450000 CLI WRKHR,X'F0' IF HOUR HAS LEADING ZERO 05460000 BNE NEXT 05470000 MVC WRKHR(1),BLANK CHANGE ZERO TO BLANK 05480000 * 05490000 ********************************************************************** 05500000 * OBTAIN MONTH, DAY AND YEAR 05510000 ********************************************************************** 05520000 * 05530000 NEXT LA @01,4 ADDRESSABILITY TO 05540000 AL @01,ECAUCOMP JULIAN TABLE 05550000 MVC WRKJTBL(48),DAYTBL(@01) COPY TABLE FOR LEAP YEAR 05560000 * ADJUSTMENT 05570000 MVC WRKWORK+4(4),WRKDATE OBTAIN DATE FROM SAVED AREA 05580000 TM WRKWORK+5,X'01' TEST 05590000 BO NOLEAPYR FOR 05600000 TM WRKWORK+5,X'12' LEAP 05610000 BM NOLEAPYR YEAR 05620000 MVI WRKJTBL+4,29 ADJUST FEB FOR LEAP YEAR 05630000 NOLEAPYR MVC WRKED(3),=X'F02120' PLACE PATTERN FOR EDIT@02C 05640000 ED WRKED(3),WRKWORK+5 EDIT THE YEAR @02C 05650000 MVC WRKYY(2),WRKED+1 STORE THE YEAR @02A 05660000 MVC WRKWORK(6),ZEROES RESET ALL BUT JULIAN DATE 05670000 SLR @00,@00 CLEAR FOR IC 05680000 CVB 1,WRKWORK CONVERT TO BINARY DAY 05690000 LA 2,WRKJTBL-4 ADDRESS OF DATE CONVERSION 05700000 * TABLE 05710000 SEARCH SLR @01,@00 CONVERT 05720000 LA @02,4(,@02) JULIAN DAY 05730000 IC @00,0(,@02) TO 05740000 CLR @00,@01 STANDARD DAY 05750000 BL SEARCH 05760000 CVD 1,WRKWORK CONVERT TO DECIMAL DAY 05770000 UNPK WRKDD(2),WRKWORK+6(2) UNPACK THE DAY 05780000 OI WRKDD+1,X'F0' ENSURE SIGN NIBBLE 05790000 MVC WRKMMM(3),1(@02) SET EBCDIC ALPHA MONTH 05800000 * 05810000 MVC WCEN(4),XZERO CLEAR CENTURY FIELD @02A 05820000 MVC WCEN+3(1),WRKDATE OBTAIN CENTURY FROM @02A 05830000 * SAVED AREA @02A 05840000 L @02,WCEN LOAD CENTURY @02A 05850000 A @02,NINETEEN BUMP CENTURY BY 19 @02A 05860000 CVD @02,WRKWORK CONVERT TO DECIMAL @02A 05870000 UNPK WRKCEN(2),WRKWORK+6(2) UNPACK THE CENTURY @02A 05880000 OI WRKCEN+1,X'F0' ENSURE SIGN NIBBLE @02A 05890000 * 05900000 ********************************************************************** 05910000 * 05920000 * Conditional assembly check for ESS 05930000 * 05940000 * The code between the AIF and the label .NOESS02 will be 05950000 * suppressed if SYSPARM is NULL. 05960000 * 05970000 ********************************************************************** 05980000 * 05990000 AIF ('&SYSPARM' EQ '').NOESS02 Branch - ESS not supp @H9A 06000000 * 06010000 ********************************************************************** 06020000 * Determine which separator format to print * 06030000 ********************************************************************** 06040000 * 06050000 USING APSUECE,@02 Get addressability @H9A 06060000 L @02,ECAECEP to ECE @H9A 06070000 * 06080000 TM ECEFLAG,ECEJESS Does JES support ESS? @H9A 06090000 BNZ BUILDBOX YES -build detail box @H9A 06100000 * NO -create old hdr @H9A 06110000 * 06120000 DROP @02 Drop addr. to ECE @H9A 06130000 * 06140000 .NOESS02 ANOP @H9A 06150000 * 06160000 ********************************************************************** 06170000 * CONVERT THE JOE (JOB OUTPUT ELEMENT) ID'S TO UNPACKED FORMAT 06180000 ********************************************************************** 06190000 * 06200000 LH @14,JSPJGRP1 SET JOE ID 1 TO A FOUR 06210000 ST @14,WRKJID1 BYTE FIELD 06220000 LH @00,JSPJGRP2 SET JOE ID 2 TO A FOUR 06230000 ST @00,WRKJID2 BYTE FIELD 06240000 CVD @14,WRKJIDEC CONVERT JOE ID1 TO PACKED 06250000 UNPK WRKJID1Z(8),WRKJIDEC(8) CONVERT JOE ID1 TO ZONED 06260000 OI WRKJID1Z+7,X'F0' FORCE SIGN FOR EBCDIC 06270000 CVD @00,WRKJIDEC CONVERT JOE ID2 TO PACKED 06280000 UNPK WRKJID2Z(8),WRKJIDEC(8) CONVERT JOE ID2 TO ZONED 06290000 OI WRKJID2Z+7,X'F0' FORCE SIGN FOR EBCDIC 06300000 * 06310000 ********************************************************************** 06320000 * COMPOSE THE MAIN PRINT LINE 06330000 ********************************************************************** 06340000 * 06350000 MVI PRTFRAME,X'5C' SET FRAME CHARACTER 06360000 TM JSPAFLG1,JSPA1CON IF THIS IS CONTINUE @01C 06370000 BNZ CONTSEP HEADER PAGE 06380000 MVC PRTFORM(5),START START HEADER PAGE 06390000 * deleted 1 line @02D 06400000 B NEXT2 06410000 CONTSEP MVC PRTFORM(5),CONT CONT HEADER PAGE 06420000 * deleted 1 line @02D 06430000 NEXT2 MVC PRTNUM(8),JSPAJBID SET JOB NUMBER 06440000 MVC PRTNAME(8),JSPAJBNM SET JOB NAME 06450000 MVC PRTJNAME(8),JSPJGRPN SET JOE NAME 06460000 MVC PRTJID1(3),WRKJID1Z+5 SET JOE ID 1 06470000 MVC PRTJID2(3),WRKJID2Z+5 SET JOE ID 2 06480000 MVI PRTJROUT+5,C' ' SET JOE 06490000 MVC PRTJROUT+6(2),PRTJROUT+5 ROUTE 06500000 MVC PRTJROUT(5),LOCALPR CODE 06510000 MVC PRTPNAME(20),JSPJPNAM SET PROGRAMMER NAME 06520000 MVC PRTRKEY(4),ROOM SET ROOM WORD 06530000 MVC PRTROOM(4),JSPJRMNO SET ROOM NUMBER 06540000 MVC PRTHR(2),WRKHR SET CURRENT HOUR 06550000 MVI PRTTS1,X'4B' SET TIME SEPARATOR 06560000 MVC PRTMIN(2),WRKMIN SET CURRENT MINUTE 06570000 MVI PRTTS2,X'4B' SET TIME SEPARATOR 06580000 MVC PRTSEC(2),WRKSEC SET CURRENT SECONDS 06590000 MVC PRTAMPM(2),WRKAMPM SET CURRENT AM/PM @H9A 06600000 MVC PRTDD(2),WRKDD SET CURRENT DAY 06610000 MVC PRTMMM(3),WRKMMM SET CURRENT MONTH 06620000 MVC PRTCEN(2),WRKCEN SET CURRENT CENTURY @02A 06630000 MVC PRTYY(2),WRKYY SET CURRENT YEAR 06640000 MVC PRTDNAME(8),JSPADEVN SET DEVICE NAME 06650000 MVC PRTSYS(4),JMRCPUID SET SYSTEM NAME 06660000 ********************************************************************** 06670000 * When running in an MAS environment and you want the system ID 06680000 * of the system on which the job was printed, uncomment the 06690000 * following 3 lines, compile, and linkedit the exit. @DYA 06700000 ********************************************************************** 06710000 * L @02,CVTPTR LOCATE @DYA 06720000 * L @02,CVTSMCA-CVT(,@02) SMCA @DYA 06730000 * MVC PRTSYS(4),SMCASID-SMCABASE(@02) USE SMF ID @DYA 06740000 MVC PRTCLASX(1),JSPJSOCL SET SYSOUT CLASS 06750000 * deleted 1 line @02D 06760000 * 06770000 ********************************************************************** 06780000 * FILL REST OF SEPARATOR PAGE WITH MAIN PRINT LINE 06790000 ********************************************************************** 06800000 * 06810000 MVI WRKCC,X'09' CC IS WRITE WITH SPACE 06820000 MVC ECARECLN(4),LINELGTH GET LENGTH OF RECORD 06830000 LA @14,BUFWRK GET RECORD 06840000 ST @14,ECARECAD ADDRESS 06850000 LA @14,1 LOOP 06860000 STH @14,INDEX INDEX 06870000 LOOP6 LTR RTNCODE,RTNCODE CHECK RC OF APSUPUT 06880000 BNZ OUT NOT ZERO, EXIT 06890000 LR @15,PUTPTR CALL 06900000 BALR @14,@15 APSUPUT 06910000 LA @14,1 CHECK IF 06920000 AH @14,INDEX PRINTED 06930000 STH @14,INDEX SIXTEEN 06940000 C @14,SIXTEEN LINES 06950000 BNH LOOP6 06960000 OUT DS 0H 06970000 * 06980000 ********************************************************************** 06990000 * EPILOGUE 07000000 ********************************************************************** 07010000 * 07020000 SLR RTNCODE,RTNCODE RESET RETURN CODE 07030000 L @13,4(,@13) RESTORE CALLERS SAVE AREA 07040000 * ADDRESS 07050000 L @14,12(,@13) RESTORE CALLERS RETURN 07060000 * ADDRESS 07070000 LM @00,@12,20(@13) RESTORE CALLERS REGISTERS 07080000 BR @14 RETURN TO CALLER 07090000 DS 0H 07100000 EJECT 07110000 * 07120000 ********************************************************************** 07130000 * 07140000 * Conditional assembly check for ESS 07150000 * 07160000 * The code between the AIF and the label .NOESS03 will be 07170000 * suppressed if SYSPARM is NULL. 07180000 * 07190000 ********************************************************************** 07200000 * 07210000 AIF ('&SYSPARM' EQ '').NOESS03 Branch - ESS not supp @H9A 07220000 * 07230000 *********************************************************************** 07240000 * * 07250000 * BUILDBOX - Build the detail box and print it on the * 07260000 * separator page. * 07270000 * * 07280000 * FUNCTION: * 07290000 * * 07300000 * This code builds and prints the detail box on the * 07310000 * separator page. * 07320000 * * 07330000 * Addressability to the ECA buffer work area is * 07340000 * established and the routine CLRLINE is called to clear * 07350000 * the separator page line buffer. * 07360000 * * 07370000 * CLRLINE is called for each subsequent line to clear that * 07380000 * line and reset the buffer work space pointer. The detail * 07390000 * box information is then filled into the line buffer and * 07400000 * APSUPUT is invoked to print the line. * 07410000 * * 07420000 * This routine will retrieve the new ESS JCL keywords: * 07430000 * * 07440000 * * ADDRESS * 07450000 * * BUILDING * 07460000 * * DEPARTMENT * 07470000 * * TITLE * 07480000 * * ROOM * 07490000 * * NAME * 07500000 * * 07510000 * and place them on the separator page. The keywords * 07520000 * are retrieved using the Scheduler JCL Facility * 07530000 * SWBTUREQ macro. * 07540000 * * 07550000 * The separator page is formated as a detail box * 07560000 * in place of the repeated 16 lines. * 07570000 * * 07580000 * The new format is only available on: * 07590000 * * 07600000 * * MVS 4.1.0+ * 07610000 * * JES2 4.1.0+ * 07620000 * * JES3 4.2.0+ * 07630000 * * 07640000 * Storage located at the end of ECAWKBUF: * 07650000 * * 07660000 * * SWBTUREQ Parameter List * 07670000 * * SWBTUREQ Work Area * 07680000 * * Keylist * 07690000 * * List of SWBTU pointers * 07700000 * * 07710000 * Storage located in the area pointed to by ECEWKPTR: * 07720000 * * 07730000 * * SWBTUREQ OUTPUT AREA * 07740000 * * 07750000 * OTHER CONSIDERATIONS: * 07760000 * * 07770000 * None * 07780000 * * 07790000 *********************************************************************** 07800000 BUILDBOX DS 0H 07810000 * 07820000 ********************************************************************** 07830000 * * 07840000 * Fill in the SWBTUREQ RETRIEVE parameter list, IEFSJTRP. * 07850000 * * 07860000 * * 07870000 ********************************************************************** 07880000 * 07890000 XC SJTRP(SJTRLGTH),SJTRP Clear parameter list @H9A 07900000 MVC SJTRID,=A(SJTRCID) Assign function @H9A 07910000 MVI SJTRVERS,SJTRCVER Assign version number @H9A 07920000 LA @01,SJTRLGTH Set parameter list @H9A 07930000 STH @01,SJTRLEN length @H9A 07940000 * 07950000 * The Work Area is a 1K work area in ECAWKBUF that is used as 07960000 * a work area by the SWBTUREQ macro. 07970000 * 07980000 LA @01,SWBTUWS Set work area @H9A 07990000 ST @01,SJTRSTOR address @H9A 08000000 LA @01,L'SWBTUWS Set work area @H9A 08010000 STH @01,SJTRSTSZ length @H9A 08020000 * 08030000 LA @01,1 Indicate only ONE @H9A 08040000 STH @01,SJTRSWBN SWBTU pointer @H9A 08050000 LA @01,SBTLAREA Set SWBTU addr. list @H9A 08060000 ST @01,SJTRSWBA address (SJTRSBTL) @H9A 08070000 * 08080000 LA @01,6 Indicate six keys in @H9A 08090000 STH @01,SJTRKIDN key list @H9A 08100000 LA @01,KEYLIST Set key list @H9A 08110000 ST @01,SJTRKIDL address @H9A 08120000 ST @01,WRKKYLST Save keylist address @H9A 08130000 * 08140000 USING APSUECE,@02 Get addressability @H9A 08150000 L @02,ECAECEP to ECE @H9A 08160000 * 08170000 * This is a 1K Text Unit Output Area where the parameters are 08180000 * returned by the SWBTUREQ macro. 08190000 * 08200000 L @01,ECEWKPTR Set output area @H9A 08210000 ST @01,SJTRAREA address @H9A 08220000 L @01,ECEWKLEN Set output area @H9A 08230000 STH @01,SJTRSIZE length @H9A 08240000 * 08250000 ********************************************************************** 08260000 * * 08270000 * Initialize the SWBTU pointer list * 08280000 * * 08290000 ********************************************************************** 08300000 * 08310000 USING SJTRSBTL,@07 Establish @H9A 08320000 LA @07,SBTLAREA addressability @H9A 08330000 * 08340000 XC SBTLAREA(L'SBTLAREA),SBTLAREA Clear SWBTU list @H9A 08350000 * 08360000 * Set the address of the area containing the SWBTU data from the JCL 08370000 * for the SWBTUREQ macro. 08380000 * 08390000 MVC SJTRSTUP,ECETUPTR Set input SWBTU ptr @H9A 08400000 DROP @07 08410000 DROP @02 @H9A 08420000 * 08430000 ********************************************************************** 08440000 * * 08450000 * Insert the keys for all of the ESS * 08460000 * parameters being used into the key list. * 08470000 * * 08480000 ********************************************************************** 08490000 * 08500000 $JTRKEYL DS 0H 08510000 USING SJTRKEYL,@07 Establish @H9A 08520000 L @07,WRKKYLST addressability 08530000 * 08540000 XC SJTRKEYL(6*SJTRKLEN),SJTRKEYL Clear key list @H9A 08550000 * 08560000 LA @01,DOTITLE Request @H9A 08570000 STH @01,SJTRKYID+KYLSTTL TITLE key @H9A 08580000 * 08590000 LA @01,DONAME Request @H9A 08600000 STH @01,SJTRKYID+KYLSTNM NAME key @H9A 08610000 * 08620000 LA @01,DOROOM Request @H9A 08630000 STH @01,SJTRKYID+KYLSTRM ROOM key @H9A 08640000 * 08650000 LA @01,DOBUILD Request @H9A 08660000 STH @01,SJTRKYID+KYLSTBL BUILDING key @H9A 08670000 * 08680000 LA @01,DODEPT Request @H9A 08690000 STH @01,SJTRKYID+KYLSTDP DEPARTMENT key @H9A 08700000 * 08710000 LA @01,DOADDRES Request @H9A 08720000 STH @01,SJTRKYID+KYLSTAD ADDRESS key @H9A 08730000 * 08740000 DROP @07 08750000 * 08760000 ********************************************************************** 08770000 * * 08780000 * INVOKE the SWBTUREQ REQUEST=RETRIEVE Macro * 08790000 * ------------------------------------------ * 08800000 * * 08810000 * Set up R1 to point to a word of storage that * 08820000 * contains the address of the parameter list, IEFSJTRP. * 08830000 * * 08840000 ********************************************************************** 08850000 * 08860000 MVI SWBERR,C'N' Initialize to no @H9A 08870000 * SWBTUREQ error 08880000 * 08890000 LA @01,SJTRP Address of @H9A 08900000 ST @01,WRKPLPTR the SWBTUREQ @H9A 08910000 LA @01,WRKPLPTR parameter list @H9A 08920000 * 08930000 * 08940000 SWBTUREQ REQUEST=RETRIEVE INVOKE the Macro @H9A 08950000 * 08960000 * 08970000 C @15,FOUR Check return code @H9A 08980000 BL TOPLINE GOOD retrieval @H9A 08990000 * 09000000 * No keys matched indicates that none of the JCL keywords 09010000 * were specified on the OUTPUT JCL. No error message is 09020000 * printed. Instead the keywords are just left blank on the 09030000 * header sheet. 09040000 * 09050000 CLC SJTRREAS,=A(SJTRNOKY) No keys matched? @H9A 09060000 BE TOPLINE YES---Go to TOPLINE @H9A 09070000 * 09080000 ********************************************************************** 09090000 * * 09100000 * If the SWBTUREQ returns an error, the detail box is * 09110000 * still printed. An error message is printed on the * 09120000 * ADDRESS line. * 09130000 * * 09140000 * NOTE: The PSF-supplied exits should not receive any * 09150000 * errors from the SWBTUREQ. This code is mainly * 09160000 * supplied for diagnostic purposes when changing * 09170000 * the exit. * 09180000 * * 09190000 ********************************************************************** 09200000 * 09210000 REQ_BAD DS 0H 09220000 CVD @15,DBLWORD Convert to pkd dec. @H9A 09230000 MVC FULLWORD,DBLWORD+4 Move packed ret. cde @H9A 09240000 UNPK DBLWORD,FULLWORD Unpack return code @H9A 09250000 MVZ DBLWORD+7(1),DBLWORD+6 Correct the sign @H9A 09260000 * 09270000 MVC SWBRC(4),DBLWORD+4 Save return code @H9A 09280000 * 09290000 LH @01,SJTRREAS Load reason code 09300000 CVD @01,DBLWORD Convert to pkd dec. @H9A 09310000 MVC FULLWORD,DBLWORD+4 Move packed reas. cde @H9A 09320000 UNPK DBLWORD,FULLWORD Unpack reason code 09330000 MVZ DBLWORD+7(1),DBLWORD+6 Correct the sign @H9A 09340000 * 09350000 MVC SWBRS(4),DBLWORD+4 Save reason code @H9A 09360000 * 09370000 MVI SWBERR,C'Y' Indicate a SWBTUREQ @H9A 09380000 * error occurred and 09390000 * a msg is required 09400000 * 09410000 * 09420000 ********************************************************************** 09430000 * Build and print top line * 09440000 ********************************************************************** 09450000 * 09460000 TOPLINE DS 0H 09470000 BAL @14,CLRLINE Clear printline @H9A 09480000 TM JSPAFLG1,JSPA1CON Continuation? @H9A 09490000 BNZ CONTTOP YES--Branch CONTTOP @H9A 09500000 STARTTOP DS 0H 09510000 MVC BOXLINE(10),STARTAG Move in START tag @H9A 09520000 B BOXBEG Branch BOXBEG @H9A 09530000 CONTTOP DS 0H 09540000 MVC BOXLINE(10),CONTAG Move in CONT tag @H9A 09550000 BOXBEG DS 0H 09560000 MVC BOXLINE+10(L'BOXLINE-10),BOXLINE Propogate chars @H9A 09570000 * 09580000 L @15,ECAPUTP CALL @H9A 09590000 BALR @14,@15 APSUPUT @H9A 09600000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 09610000 BNZ OUT EXIT @D2A 09620000 * 09630000 ********************************************************************** 09640000 * Build and print 2 blank lines * 09650000 * ( Frame characters in box cols 01 & 80 ) * 09660000 ********************************************************************** 09670000 * 09680000 LA @06,2 LOAD Reg6 with 2 @H9A 09690000 TOPBLNKS DS 0H 09700000 BAL @14,CLRLINE Clear printline @H9A 09710000 * 09720000 L @15,ECAPUTP CALL @H9A 09730000 BALR @14,@15 APSUPUT @H9A 09740000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 09750000 BNZ OUT EXIT @D2A 09760000 * 09770000 BCT @06,TOPBLNKS Build & print 2 lines @H9A 09780000 * 09790000 ********************************************************************** 09800000 * Build and print JOB ID line * 09810000 ********************************************************************** 09820000 * 09830000 BAL @14,CLRLINE Clear printline @H9A 09840000 * 09850000 MVC BOXDESC,LBJOBID Put JOB ID label @H9A 09860000 MVC BOXINFO(8),JSPAJBID Put JOBID into box @H9A 09870000 * 09880000 * 09890000 USING JSPEXT,@07 Base JSPA extension @H9A 09900000 TM JSPAFLG1,JSPA1EXT Does JSPA ext. exist? @H9A 09910000 BZ PRJOBID NO--Branch PRJOBID @H9A 09920000 * 09930000 LR @07,JSPAPTR Load JSPA address @H9A 09940000 AH @07,JSPALEN Add JSPA length @H9A 09950000 * 09960000 CLC JSPCESEG,XZERO Is SYSOUT segmented? @H9A 09970000 BE PRJOBID NO---Omit SEGMENT ID @H9A 09980000 * 09990000 MVC BOXSGLBL(13),LBSEGID Put SEGMENT ID label @H9A 10000000 L @14,JSPCESEG Load R14 SEGMENT# @H9A 10010000 * 10020000 CVD @14,DBLWORD Convert to pkd dec. @H9A 10030000 CP DBLWORD,PZERO Is SEGMENT# < 0? @H9A 10040000 BL INVSEG YES--put invalid SEG# @H9A 10050000 CP DBLWORD,MAXSEG# Is SEGMENT# > 99999? @H9A 10060000 BNH PRSEG# NO---put SEGMENT# @H9A 10070000 * 10080000 INVSEG MVC BOXSGINF(5),=C'*****' Set invalid SEGMENT# @H9A 10090000 B PRJOBID GO print this line @H9A 10100000 PRSEG# DS 0H 10110000 UNPK BOXSGINF,DBLWORD+5(3) Put SEGMENT# into box @H9A 10120000 OI BOXSGINF+4,X'F0' Insure positive sign @H9A 10130000 * 10140000 PRJOBID DS 0H 10150000 L @15,ECAPUTP CALL @H9A 10160000 BALR @14,@15 APSUPUT @H9A 10170000 DROP @07 @H9A 10180000 * 10190000 ********************************************************************** 10200000 * Build and print JOB NAME line * 10210000 ********************************************************************** 10220000 * 10230000 BAL @14,CLRLINE Clear printline @H9A 10240000 * 10250000 MVC BOXDESC,LBJOBNAM Put JOB NAME label @H9A 10260000 MVC BOXINFO(8),JSPAJBNM Put JOBNAME into box @H9A 10270000 * 10280000 L @15,ECAPUTP CALL @H9A 10290000 BALR @14,@15 APSUPUT @H9A 10300000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 10310000 BNZ OUT EXIT @D2A 10320000 * 10330000 ********************************************************************** 10340000 * Build and print USER ID line * 10350000 ********************************************************************** 10360000 * 10370000 BAL @14,CLRLINE Clear printline @H9A 10380000 * 10390000 MVC BOXDESC,LBUSERID Put USER NAME label @H9A 10400000 * 10410000 USING JSPEXT,@07 Base JSPA extension @H9A 10420000 TM JSPAFLG1,JSPA1EXT Does JSPA ext. exist? @H9A 10430000 BZ PRUSRID NO--Branch PRUSRID @H9A 10440000 * 10450000 LR @07,JSPAPTR Load JSPA address @H9A 10460000 AH @07,JSPALEN Add JSPA length @H9A 10470000 * 10480000 MVC BOXINFO(8),JSPCEUID Put USER NAME @H9A 10490000 * 10500000 PRUSRID L @15,ECAPUTP CALL @H9A 10510000 BALR @14,@15 APSUPUT @H9A 10520000 DROP @07 @H9A 10530000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 10540000 BNZ OUT EXIT @D2A 10550000 * 10560000 ********************************************************************** 10570000 * Build and print SYSOUT CLASS line * 10580000 ********************************************************************** 10590000 * 10600000 BAL @14,CLRLINE Clear printline @H9A 10610000 * 10620000 MVC BOXDESC,LBSYSCL Put SYSOUT CLASS lbl @H9A 10630000 MVC BOXINFO(1),JSPJSOCL Put SYSOUT CLASS @H9A 10640000 * 10650000 L @15,ECAPUTP CALL @H9A 10660000 BALR @14,@15 APSUPUT @H9A 10670000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 10680000 BNZ OUT EXIT @D2A 10690000 * 10700000 ********************************************************************** 10710000 * Build and print OUTPUT GROUP line * 10720000 ********************************************************************** 10730000 * 10740000 BAL @14,CLRLINE Clear printline @H9A 10750000 * 10760000 MVC BOXDESC,LBOUTGRP Put OUTPUT GROUP lbl @H9A 10770000 MVC BOXJNAME(8),JSPJGRPN Put OUTPUT GRP NODE1 @H9A 10780000 * 10790000 MVI BOXGSEP1,C'.' Insert separator char @H9A 10800000 * 10810000 LH @00,JSPJGRP1 Get JOE ID1 @H9A 10820000 CVD @00,WRKJIDEC Convert to pkd decimal@H9A 10830000 UNPK BOXJID1,WRKJIDEC+5(3) Unpack NODE2 @H9A 10840000 OI BOXJZON1,X'F0' Insure positive sign @H9A 10850000 MVI BOXGSEP2,C'.' Insert separator char @H9A 10860000 * 10870000 LH @00,JSPJGRP2 Get JOE ID2 @H9A 10880000 CVD @00,WRKJIDEC Convert to pkd decimal@H9A 10890000 UNPK BOXJID2,WRKJIDEC+5(3) Unpack GRP NODE3 @H9A 10900000 OI BOXJZON2,X'F0' Insure positive sign @H9A 10910000 * 10920000 L @15,ECAPUTP CALL @H9A 10930000 BALR @14,@15 APSUPUT @H9A 10940000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 10950000 BNZ OUT EXIT @D2A 10960000 * 10970000 * 10980000 ********************************************************************** 10990000 * Build and print TITLE line * 11000000 ********************************************************************** 11010000 * 11020000 BAL @14,CLRLINE Clear printline @H9A 11030000 * 11040000 MVC BOXDESC,LBTITLE Put TITLE label @H9A 11050000 * 11060000 USING SJTRKEYL,@02 Base KEYLIST @H9A 11070000 ICM @02,B'1111',WRKKYLST Load KEYLIST address @H9A 11080000 BZ PRTITLE Branch if NO KEYLIST @H9A 11090000 * 11100000 LA @02,KYLSTTL(,@02) Locate addr. of TITLE @H9A 11110000 * key in the KEYLIST @H9A 11120000 ICM @01,B'1111',SJTRTPAD Load TITLE TU address @H9A 11130000 BZ PRTITLE Branch if NO TITLE @H9A 11140000 * 11150000 LA @01,DOCNTENT-DOCNUNIT(,@01) Addr. of TEXT UNIT @H9A 11160000 BAL @08,MOVETU Get TITLE data @H9A 11170000 * from the TU 11180000 PRTITLE DS 0H 11190000 L @15,ECAPUTP CALL @H9A 11200000 BALR @14,@15 APSUPUT @H9A 11210000 * 11220000 DROP @02 Drop KEYLIST @H9A 11230000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 11240000 BNZ OUT EXIT @D2A 11250000 * 11260000 ********************************************************************** 11270000 * Build and print a blank line * 11280000 * ( Frame characters in box cols 01 & 80 ) * 11290000 ********************************************************************** 11300000 * 11310000 BAL @14,CLRLINE Clear printline @H9A 11320000 L @15,ECAPUTP CALL @H9A 11330000 BALR @14,@15 APSUPUT @H9A 11340000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 11350000 BNZ OUT EXIT @D2A 11360000 * 11370000 ********************************************************************** 11380000 * Build and print DESTINATION line * 11390000 ********************************************************************** 11400000 * 11410000 BAL @14,CLRLINE Clear printline @H9A 11420000 * 11430000 MVC BOXDESC,LBDEST Put DESTINATION label @H9A 11440000 MVC BOXINFO(8),JSPJGRPD Put DESTINATION @H9A 11450000 * 11460000 L @15,ECAPUTP CALL @H9A 11470000 BALR @14,@15 APSUPUT @H9A 11480000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 11490000 BNZ OUT EXIT @D2A 11500000 * 11510000 ********************************************************************** 11520000 * Build and print NAME line * 11530000 ********************************************************************** 11540000 * 11550000 BAL @14,CLRLINE Clear printline @H9A 11560000 * 11570000 MVC BOXDESC,LBNAME Put NAME label @H9A 11580000 * 11590000 USING SJTRKEYL,@02 Base KEYLIST @H9A 11600000 ICM @02,B'1111',WRKKYLST Load KEYLIST Address @H9A 11610000 BZ NONAME Branch if no KEYLIST @H9A 11620000 * 11630000 LA @02,KYLSTNM(,@02) Locate Addr. of NAME @H9A 11640000 * key in the KEYLIST 11650000 ICM @01,B'1111',SJTRTPAD Load NAME TU address @H9A 11660000 BZ NONAME Branch if NO NAME @H9A 11670000 * 11680000 LA @01,DOCNTENT-DOCNUNIT(,@01) Addr of text unit @H9A 11690000 BAL @08,MOVETU Put NAME data from TU @H9A 11700000 B PRT_NAME Branch to PRT_NAME @H9A 11710000 * 11720000 DROP @02 Drop KEYLIST @H9A 11730000 * 11740000 NONAME DS 0H If name not in the JCL 11750000 * then use the name in 11760000 * the JSPA 11770000 MVC BOXINFO(L'JSPJPNAM),JSPJPNAM Set from JOB stmt @H9A 11780000 * 11790000 PRT_NAME DS 0H 11800000 L @15,ECAPUTP CALL @H9A 11810000 BALR @14,@15 APSUPUT @H9A 11820000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 11830000 BNZ OUT EXIT @D2A 11840000 * 11850000 ********************************************************************** 11860000 * Build and print ROOM line * 11870000 ********************************************************************** 11880000 * 11890000 BAL @14,CLRLINE Clear printline @H9A 11900000 * 11910000 MVC BOXDESC,LBROOM Put ROOM label @H9A 11920000 * 11930000 USING SJTRKEYL,@02 Base KEYLIST @H9A 11940000 ICM @02,B'1111',WRKKYLST Load KEYLIST address @H9A 11950000 BZ NOROOM Branch if no KEYLIST @H9A 11960000 * 11970000 LA @02,KYLSTRM(,@02) Locate Addr of ROOM @H9A 11980000 * Key in the KEYLIST 11990000 ICM @01,B'1111',SJTRTPAD Load ROOM TU Address @H9A 12000000 BZ NOROOM Branch If no ROOM @H9A 12010000 * 12020000 LA @01,DOCNTENT-DOCNUNIT(,@01) Addr of TEXT UNIT @H9A 12030000 BAL @08,MOVETU Put ROOM data from TU @H9A 12040000 * 12050000 B PRT_ROOM Branch to PRTROOM @H9A 12060000 * 12070000 DROP @02 Drop KEYLIST @H9A 12080000 * 12090000 NOROOM DS 0H If room not in the JCL 12100000 * then use the room in 12110000 * the JSPA 12120000 MVC BOXINFO(L'JSPJRMNO),JSPJRMNO Set from JOB stmt @H9A 12130000 * 12140000 PRT_ROOM DS 0H 12150000 L @15,ECAPUTP CALL @H9A 12160000 BALR @14,@15 APSUPUT @H9A 12170000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 12180000 BNZ OUT EXIT @D2A 12190000 * 12200000 ********************************************************************** 12210000 * Build and print BUILDING line * 12220000 ********************************************************************** 12230000 * 12240000 BAL @14,CLRLINE Clear printline @H9A 12250000 * 12260000 MVC BOXDESC,LBBLDG Put BLDG label @H9A 12270000 * 12280000 USING SJTRKEYL,@02 Base KEYLIST @H9A 12290000 ICM @02,B'1111',WRKKYLST Load KEYLIST address @H9A 12300000 BZ PRTBLDG Branch if no KEYLIST @H9A 12310000 * 12320000 LA @02,KYLSTBL(,@02) Locate addr of BLDG @H9A 12330000 ICM @01,B'1111',SJTRTPAD Load BLDG TU Address @H9A 12340000 BZ PRTBLDG Branch if no BUILDING @H9A 12350000 * 12360000 LA @01,DOCNTENT-DOCNUNIT(,@01) Addr of TEXT UNIT @H9A 12370000 BAL @08,MOVETU Put BLDG data from TU @H9A 12380000 * 12390000 PRTBLDG DS 0H 12400000 L @15,ECAPUTP CALL @H9A 12410000 BALR @14,@15 APSUPUT @H9A 12420000 * 12430000 DROP @02 Drop KEYLIST @H9A 12440000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 12450000 BNZ OUT EXIT @D2A 12460000 * 12470000 ********************************************************************** 12480000 * Build and print DEPARTMENT line * 12490000 ********************************************************************** 12500000 * 12510000 BAL @14,CLRLINE Clear printline @H9A 12520000 * 12530000 MVC BOXDESC,LBDEPT Put DEPT label @H9A 12540000 * 12550000 USING SJTRKEYL,@02 Base KEYLIST @H9A 12560000 ICM @02,B'1111',WRKKYLST Load KEYLIST address @H9A 12570000 BZ PRTDEPT Branch if no KEYLIST @H9A 12580000 * 12590000 LA @02,KYLSTDP(,@02) Locate addr of DEPT @H9A 12600000 ICM @01,B'1111',SJTRTPAD Load DEPT TU address @H9A 12610000 BZ PRTDEPT Branch if no DEPT @H9A 12620000 * 12630000 LA @01,DOCNTENT-DOCNUNIT(,@01) Addr of TEXT UNIT @H9A 12640000 BAL @08,MOVETU Put DEPT data from TU @H9A 12650000 * 12660000 PRTDEPT DS 0H 12670000 L @15,ECAPUTP CALL @H9A 12680000 BALR @14,@15 APSUPUT @H9A 12690000 * 12700000 DROP @02 Drop KEYLIST @H9A 12710000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 12720000 BNZ OUT EXIT @D2A 12730000 * 12740000 ********************************************************************** 12750000 * * 12760000 * BUILD AND PRINT ADDRESS LINES * 12770000 * ----------------------------- * 12780000 * The address can be from 1 to 4 lines long. Any lines * 12790000 * that are unused must be printed as blank lines, but the * 12800000 * label "ADDRESS:" must appear on the first line even if * 12810000 * no address was specified on the OUTPUT JCL. * 12820000 * * 12830000 * A blank line is printed after the four ADDRESS lines. * 12840000 * * 12850000 * If the SWBTUREQ macro returned an error, the ADDRESS * 12860000 * line is not printed. An error message is printed * 12870000 * in the four lines that would have contained the ADDRESS. * 12880000 * * 12890000 ********************************************************************** 12900000 * 12910000 BAL @14,CLRLINE Clear printline @H9A 12920000 * 12930000 MVC WRKADNUM(2),XZERO Zero number of lines @H9A 12940000 * 12950000 CLI SWBERR,C'Y' SWBTUREQ error? @H9A 12960000 BNE ADDRLBL NO - GO print @H9A 12970000 * ADDR label 12980000 * 12990000 * 13000000 ********************************************************************** 13010000 * Print the SWBTUREQ error msg * 13020000 ********************************************************************** 13030000 * 13040000 MVC BOXMSG1(40),LBMSG Set error msg text @H9A 13050000 * 13060000 L @15,ECAPUTP CALL @H9A 13070000 BALR @14,@15 APSUPUT @H9A 13080000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 13090000 BNZ OUT EXIT @D2A 13100000 * 13110000 BAL @14,CLRLINE Clear printline @H9A 13120000 * 13130000 MVC BOXRCLB,LBRC Set RETURN CODE label @H9A 13140000 MVC BOXRC(4),SWBRC Set SWBTUREQ @H9A 13150000 * return code 13160000 * 13170000 L @15,ECAPUTP CALL @H9A 13180000 BALR @14,@15 APSUPUT @H9A 13190000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 13200000 BNZ OUT EXIT @D2A 13210000 * 13220000 BAL @14,CLRLINE Clear printline @H9A 13230000 * 13240000 MVC BOXRSLB,LBRS Set REASON CODE label @H9A 13250000 MVC BOXRS(4),SWBRS Set SWBTUREQ @H9A 13260000 * reason code 13270000 * 13280000 L @15,ECAPUTP CALL @H9A 13290000 BALR @14,@15 APSUPUT @H9A 13300000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 13310000 BNZ OUT EXIT @D2A 13320000 * 13330000 BAL @14,CLRLINE Clear printline @H9A 13340000 * 13350000 MVC WRKADNUM(2),THREE Set the number of @H9A 13360000 * ADDRESS lines used @H9A 13370000 * 13380000 B NOADDR GO to NOADDR to print @H9A 13390000 * the remaining lines 13400000 * as blank lines 13410000 ********************************************************************** 13420000 * Print the ADDRESS label * 13430000 ********************************************************************** 13440000 * 13450000 ADDRLBL MVC BOXDESC,LBADDR Put ADDRESS label @H9A 13460000 * 13470000 USING SJTRKEYL,@02 Base KEYLIST @H9A 13480000 ICM @02,B'1111',WRKKYLST Load KEYLIST address @H9A 13490000 BZ NOADDR Branch if no KEYLIST @H9A 13500000 * 13510000 LA @02,KYLSTAD(,@02) Locate addr of ADDR @H9A 13520000 * Key in the KEYLIST 13530000 ICM @01,B'1111',SJTRTPAD Load ADDR TU address @H9A 13540000 BZ NOADDR Branch if no ADDRESS @H9A 13550000 * 13560000 LH @07,DOCNTNUM-DOCNUNIT(,@01) Number of lines used @H9A 13570000 * for ADDRESS info 13580000 CL @07,FOUR Is number > 4 ? @H9A 13590000 BNH SAVENUML NO---Save number of @H9A 13600000 * lines 13610000 LA @07,4 YES---Set to MAX of 4 @H9A 13620000 * 13630000 SAVENUML DS 0H 13640000 STH @07,WRKADNUM Save number of lines @H9A 13650000 LTR @07,@07 Number > zero? @H9A 13660000 BZ NOADDR NO---print blank @H9A 13670000 * lines 13680000 * 13690000 DROP @02 Drop KEYLIST @H9A 13700000 * 13710000 ********************************************************************** 13720000 * LOOP to Build/Print Multiple Line ADDRESS * 13730000 ********************************************************************** 13740000 * 13750000 LA @01,DOCNTENT-DOCNUNIT(,@01) Addr of TEXT UNIT @H9A 13760000 USING DOCNTFLD,@01 @H9A 13770000 * 13780000 ADDRLOOP DS 0H 13790000 LR @06,@01 Save the TU address @H9A 13800000 BAL @08,MOVETU Put ADDR data from TU @H9A 13810000 * 13820000 L @15,ECAPUTP CALL @H9A 13830000 BALR @14,@15 APSUPUT @H9A 13840000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 13850000 BNZ OUT EXIT @D2A 13860000 * 13870000 LR @01,@06 Restore TU address @H9A 13880000 LH @15,DOCNTLEN Bump down to next @H9A 13890000 LA @01,L'DOCNTLEN(@15,@01) ADDRESS length/data @H9A 13900000 * pair 13910000 * 13920000 BAL @14,CLRLINE Clear printline @H9A 13930000 * 13940000 BCT @07,ADDRLOOP Loop again if more @H9A 13950000 * data 13960000 DROP @01 Drop addressability @H9A 13970000 * 13980000 ********************************************************************** 13990000 * LOOP to Build/Print Multiple Blank ADDRESS Lines * 14000000 ********************************************************************** 14010000 * 14020000 NOADDR DS 0H 14030000 LA @06,4 Load MAX # of lines @H9A 14040000 LH @07,WRKADNUM Restore # of address @H9A 14050000 * lines used 14060000 SR @06,@07 Find number unused @H9A 14070000 * lines 14080000 LA @06,1(,@06) Add 1 for extra blank @H9A 14090000 * line 14100000 * 14110000 BLKLINE DS 0H 14120000 L @15,ECAPUTP CALL @H9A 14130000 BALR @14,@15 APSUPUT @H9A 14140000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 14150000 BNZ OUT EXIT @D2A 14160000 * 14170000 BAL @14,CLRLINE Clear printline @H9A 14180000 BCT @06,BLKLINE LOOP if more to print @H9A 14190000 * 14200000 ********************************************************************** 14210000 * Build and print TIME line * 14220000 ********************************************************************** 14230000 * 14240000 BAL @14,CLRLINE Clear printline @H9A 14250000 * 14260000 MVC BOXDESC,LBPRTIME Put PRINT TIME label @H9A 14270000 * 14280000 CLC WRKHR(1),BLANK If hour has leading @H9A 14290000 * blank 14300000 BNE HROKAY NO - then branch @H9A 14310000 MVI WRKHR,X'F0' Change blank to zero @H9A 14320000 HROKAY MVC BOXHR(2),WRKHR Set current hour @H9A 14330000 MVI BOXTS1,X'7A' Set time separator @H9A 14340000 * 14350000 MVC BOXMIN(2),WRKMIN Set current minute @H9A 14360000 MVI BOXTS2,X'7A' Set time separator @H9A 14370000 * 14380000 MVC BOXSEC(2),WRKSEC Set current second @H9A 14390000 * 14400000 MVC BOXAMPM(2),WRKAMPM Set current AM/PM @H9A 14410000 * 14420000 L @15,ECAPUTP CALL @H9A 14430000 BALR @14,@15 APSUPUT @H9A 14440000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 14450000 BNZ OUT EXIT @D2A 14460000 * 14470000 ********************************************************************** 14480000 * Build and print DATE line * 14490000 ********************************************************************** 14500000 * 14510000 BAL @14,CLRLINE Clear printline @H9A 14520000 * 14530000 MVC BOXDESC,LBPRDATE Put PRINT DATE label @H9A 14540000 * 14550000 MVC BOXDDD(2),WRKDD Set print DAY @H9A 14560000 MVC BOXMMM(3),WRKMMM Set print MONTH @H9A 14570000 MVC BOXCEN(2),WRKCEN Set print century @02A 14580000 MVC BOXYYY(2),WRKYY Set print YEAR @H9A 14590000 * 14600000 L @15,ECAPUTP CALL @H9A 14610000 BALR @14,@15 APSUPUT @H9A 14620000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 14630000 BNZ OUT EXIT @D2A 14640000 * 14650000 ********************************************************************** 14660000 * Build and print PRINTER NAME line * 14670000 ********************************************************************** 14680000 * 14690000 BAL @14,CLRLINE Clear printline @H9A 14700000 * 14710000 MVC BOXDESC,LBPRNAME Put PRINTER NAME lbl @H9A 14720000 MVC BOXINFO(8),JSPADEVN Put device NAME @H9A 14730000 * 14740000 L @15,ECAPUTP CALL @H9A 14750000 BALR @14,@15 APSUPUT @H9A 14760000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 14770000 BNZ OUT EXIT @D2A 14780000 * 14790000 ********************************************************************** 14800000 * Build and print SYSTEM NAME line * 14810000 ********************************************************************** 14820000 * 14830000 USING JMR,@07 Base JMR @H9A 14840000 L @07,JSPAJMR Load address of JMR @H9A 14850000 * 14860000 BAL @14,CLRLINE Clear printline @H9A 14870000 * 14880000 MVC BOXDESC,LBSYSTEM Put SYSTEM label @H9A 14890000 MVC BOXINFO(4),JMRCPUID Put SYSTEM ID @H9A 14900000 ********************************************************************** 14910000 * When running in an MAS environment and you want the system ID 14920000 * of the system on which the job was printed, uncomment the 14930000 * following 3 lines, compile, and linkedit the exit. @DYA 14940000 ********************************************************************** 14950000 * L @02,CVTPTR LOCATE @DYA 14960000 * L @02,CVTSMCA-CVT(,@02) SMCA @DYA 14970000 * MVC BOXINFO(4),SMCASID-SMCABASE(@02) USE SMF ID @DYA 14980000 * 14990000 L @15,ECAPUTP CALL @H9A 15000000 BALR @14,@15 APSUPUT @H9A 15010000 * 15020000 DROP @07 Drop Adress. to JMR @H9A 15030000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 15040000 BNZ OUT EXIT @D2A 15050000 * 15060000 ********************************************************************** 15070000 * Build and print 2 blank lines * 15080000 * ( Frame characters in box cols 01 & 80 ) * 15090000 ********************************************************************** 15100000 * 15110000 LA @06,2 LOAD Reg6 with 2 @H9A 15120000 BOTBLNKS DS 0H 15130000 BAL @14,CLRLINE Clear printline @H9A 15140000 * 15150000 L @15,ECAPUTP CALL @H9A 15160000 BALR @14,@15 APSUPUT @H9A 15170000 LTR RTNCODE,RTNCODE IF APSUPUT FAILED @D2A 15180000 BNZ OUT EXIT @D2A 15190000 * 15200000 BCT @06,BOTBLNKS Build & print 2 lines @H9A 15210000 * 15220000 ********************************************************************** 15230000 * Build and print bottom line * 15240000 ********************************************************************** 15250000 * 15260000 BAL @14,CLRLINE Clear printline @H9A 15270000 * 15280000 TM JSPAFLG1,JSPA1CON Is this a @H9A 15290000 * continuation? 15300000 BNZ CONTBOT YES--branch CONTBOT @H9A 15310000 * 15320000 STARTBOT DS 0H 15330000 MVC BOXLINE(10),STARTAG Move in START tag @H9A 15340000 B BOXEND Branch BOXEND @H9A 15350000 * 15360000 CONTBOT DS 0H 15370000 MVC BOXLINE(10),CONTAG Move in CONT tag @H9A 15380000 * 15390000 BOXEND DS 0H 15400000 MVC BOXLINE+10(L'BOXLINE-10),BOXLINE Propogate chars @H9A 15410000 * 15420000 L @15,ECAPUTP CALL @H9A 15430000 BALR @14,@15 APSUPUT @H9A 15440000 * 15450000 B OUT Return to PSF @H9A 15460000 * 15470000 ********************************************************************** 15480000 * END OF BUILDBOX 15490000 ********************************************************************** 15500000 EJECT 15510000 * 15520000 * 15530000 * 15540000 *********************************************************************** 15550000 * * 15560000 * CLRLINE - Clears the separator page line and * 15570000 * inserts the box frame characters. * 15580000 * * 15590000 * FUNCTION: * 15600000 * * 15610000 * This subroutine is called to clear the separator * 15620000 * page line. This is necessary so as to avoid * 15630000 * printing detail box information left over from * 15640000 * previous processing with the current line. * 15650000 * * 15660000 * LINKAGE: * 15670000 * * 15680000 * Accessed via BAL using the label as the entry address * 15690000 * and register 14 as the return address. * 15700000 * * 15710000 * INPUT: * 15720000 * The separator page line/box buffer ( WRKBUF). * 15730000 * * 15740000 * OUTPUT: * 15750000 * The separator page line is cleared and the frame * 15760000 * characters inserted in columns 1 and 80 of the * 15770000 * detail box. * 15780000 * * 15790000 * ECARECAD - Address of the separator page line * 15800000 * ECARECLN - Length of the separator page line * 15810000 * * 15820000 * REGISTER USAGE: * 15830000 * * 15840000 * REG VALUE ON ENTRY VALUE ON EXIT * 15850000 * * 15860000 * R1-R7 N/A Unchanged * 15870000 * R8 N/A Destroyed * 15880000 * R9-R13 N/A Unchanged * 15890000 * R14 Return address Unchanged * 15900000 * R15 N/A Unchanged * 15910000 * * 15920000 * RETURN CODES: * 15930000 * * 15940000 * None * 15950000 * * 15960000 * OTHER CONSIDERATIONS: * 15970000 * * 15980000 * None * 15990000 * * 16000000 *********************************************************************** 16010000 * 16020000 CLRLINE DS 0H 16030000 MVI WRKCC,X'09' Set CC to write @H9A 16040000 * 1 line 16050000 * 16060000 MVI PAGELINE,C' ' Clear 1st printline @H9A 16070000 * char 16080000 MVC PAGELINE+1(L'PAGELINE-1),PAGELINE Propogate @H9A 16090000 * spaces 16100000 * 16110000 MVI BOXCOL1,C'*' Insert box @H9A 16120000 MVI BOXCOL80,C'*' frame character @H9A 16130000 LA @08,BUFWRK Get record @H9A 16140000 ST @08,ECARECAD address @H9A 16150000 MVC ECARECLN(4),ESSLLEN Get length of record @H9A 16160000 BR @14 Return to caller @H9A 16170000 * 16180000 EJECT 16190000 *********************************************************************** 16200000 * * 16210000 * MOVETU - Move the TU text from the TU output area to the * 16220000 * detail line DSECT. * 16230000 * * 16240000 * FUNCTION: * 16250000 * * 16260000 * This subroutine is called to move the TU text from the * 16270000 * TU output area to the detail line DSECT area. Since * 16280000 * TUs are variable length (up to sixty characters long), * 16290000 * the detail line is padded with blanks on the right after * 16300000 * the move is performed. * 16310000 * * 16320000 * LINKAGE: * 16330000 * * 16340000 * Accessed via BAL using the label as the entry address * 16350000 * and register 8 as the return address. * 16360000 * * 16370000 * INPUT: * 16380000 * R1 - Address of TU length/parameter pair * 16390000 * * 16400000 * OUTPUT: * 16410000 * The text from the TU parameter is copied into the * 16420000 * detail line DSECT area ( BOXINFO ). * 16430000 * * 16440000 * REGISTER USAGE: * 16450000 * * 16460000 * REG VALUE ON ENTRY VALUE ON EXIT * 16470000 * * 16480000 * R0 N/A Destroyed * 16490000 * R1 Length/Parameter Pair Destroyed * 16500000 * R2-R7 N/A Unchanged * 16510000 * R8 Return Address Unchanged * 16520000 * R9-R13 N/A Unchanged * 16530000 * R14-R15 N/A Destroyed * 16540000 * * 16550000 * RETURN CODES: * 16560000 * * 16570000 * None * 16580000 * * 16590000 * OTHER CONSIDERATIONS: * 16600000 * * 16610000 * None * 16620000 * * 16630000 *********************************************************************** 16640000 * 16650000 USING DOCNTFLD,@01 @H9A 16660000 MOVETU LA @14,DOCNTPRM Load TU text address @H9A 16670000 LH @15,DOCNTLEN Length of TU text @H9A 16680000 ICM @15,B'1000',BLANKS Set pad char to blank @H9A 16690000 * 16700000 LA @00,BOXINFO Set up the @H9A 16710000 LA @01,L'BOXINFO receiving field @H9A 16720000 * 16730000 MVCL @00,@14 Move the text @H9A 16740000 * 16750000 BR @08 Return to caller @H9A 16760000 DROP @01 @H9A 16770000 * 16780000 .NOESS03 ANOP @H9A 16790000 * 16800000 PSIZE EQU ((*-APSUX01+99)/100)*5 PATCH AREA SIZE 16810000 DC C'PATCH AREA - APSUX01 88.XXX' 16820000 PSPACE DC 25S(*) PATCH AREA 16830000 ORG PSPACE 16840000 DC ((PSIZE+1)/2)S(*) 16850000 ORG , 16860000 * 16870000 ********************************************************************** 16880000 * MISC CONSTANTS 16890000 ********************************************************************** 16900000 * 16910000 XZERO DC F'0' @H9A 16920000 ONE DC F'1' 16930000 TWO DC F'2' 16940000 THREE DC F'3' 16950000 FOUR DC F'4' @H9A 16960000 TWELVE DC F'12' 16970000 SIXTEEN DC F'16' 16980000 NINETEEN DC F'19' @02A 16990000 LINELGTH DC F'127' 17000000 ESSLLEN DC F'133' @H9A 17010000 ZEROES DC X'000000000000' 17020000 BLANK DC X'40' 17030000 BLANKS DC CL8' ' @H9A 17040000 START DC CL5'START' 17050000 CONT DC CL5'CONT ' 17060000 LOCALPR DC CL5'LOCAL' 17070000 ROOM DC CL4'ROOM' 17080000 AM DC CL2'AM' 17090000 STARTAG DC CL10'**START***' @H9A 17100000 CONTAG DC CL10'**CONT****' @H9A 17110000 MAXSEG# DC PL8'99999' @H9A 17120000 PZERO DC PL8'00000' @H9A 17130000 * 17140000 *********************************************************************** 17150000 * All labels that will appear in the detail box are listed * 17160000 * below. * 17170000 *********************************************************************** 17180000 * 17190000 LBJOBID DC CL(L'BOXDESC)'JOBID:' @H9A 17200000 LBSEGID DC CL(L'BOXDESC)'SEGMENT ID:' @H9A 17210000 LBJOBNAM DC CL(L'BOXDESC)'JOB NAME:' @H9A 17220000 LBUSERID DC CL(L'BOXDESC)'USERID:' @H9A 17230000 LBSYSCL DC CL(L'BOXDESC)'SYSOUT CLASS:' @H9A 17240000 LBOUTGRP DC CL(L'BOXDESC)'OUTPUT GROUP:' @H9A 17250000 LBTITLE DC CL(L'BOXDESC)'TITLE:' @H9A 17260000 LBDEST DC CL(L'BOXDESC)'DESTINATION:' @H9A 17270000 LBNAME DC CL(L'BOXDESC)'NAME:' @H9A 17280000 LBROOM DC CL(L'BOXDESC)'ROOM:' @H9A 17290000 LBBLDG DC CL(L'BOXDESC)'BUILDING:' @H9A 17300000 LBDEPT DC CL(L'BOXDESC)'DEPARTMENT:' @H9A 17310000 LBADDR DC CL(L'BOXDESC)'ADDRESS:' @H9A 17320000 LBPRTIME DC CL(L'BOXDESC)'PRINT TIME:' @H9A 17330000 LBPRDATE DC CL(L'BOXDESC)'PRINT DATE:' @H9A 17340000 LBPRNAME DC CL(L'BOXDESC)'PRINTER:' @H9A 17350000 LBSYSTEM DC CL(L'BOXDESC)'SYSTEM ID:' @H9A 17360000 * 17370000 LBMSG DC CL(L'BOXMSG)'EXIT ERROR -- SWBTUREQ MACRO FAILED' 17380000 * @H9A 17390000 LBRC DC CL(L'BOXRCLB)'RETURN CODE:' @H9A 17400000 LBRS DC CL(L'BOXRSLB)'REASON CODE:' @H9A 17410000 * 17420000 ********************************************************************** 17430000 * 17440000 * Conditional assembly check for ESS 17450000 * 17460000 * The code between the AIF and the label .NOESS04 will be 17470000 * suppressed if SYSPARM is NULL. 17480000 * 17490000 ********************************************************************** 17500000 * 17510000 AIF ('&SYSPARM' EQ '').NOESS04 Branch - ESS not supp @H9A 17520000 * 17530000 ********************************************************************** 17540000 * Key list equates * 17550000 ********************************************************************** 17560000 * 17570000 KYLSTTL EQU 0*SJTRKLEN Title key @H9A 17580000 KYLSTNM EQU 1*SJTRKLEN Name key @H9A 17590000 KYLSTRM EQU 2*SJTRKLEN Room key @H9A 17600000 KYLSTBL EQU 3*SJTRKLEN Building key @H9A 17610000 KYLSTDP EQU 4*SJTRKLEN Dept key @H9A 17620000 KYLSTAD EQU 5*SJTRKLEN Address key @H9A 17630000 * 17640000 ********************************************************************** 17650000 * 17660000 .NOESS04 ANOP @H9A 17670000 * 17680000 ********************************************************************** 17690000 * EQUATES FOR REGISTERS 0-15 17700000 ********************************************************************** 17710000 * 17720000 @00 EQU 00 17730000 @01 EQU 01 17740000 @02 EQU 02 17750000 @03 EQU 03 17760000 @04 EQU 04 17770000 @05 EQU 05 17780000 @06 EQU 06 17790000 @07 EQU 07 17800000 @08 EQU 08 17810000 @09 EQU 09 17820000 @10 EQU 10 17830000 @11 EQU 11 17840000 @12 EQU 12 17850000 @13 EQU 13 17860000 @14 EQU 14 17870000 @15 EQU 15 17880000 * 17890000 ********************************************************************** 17900000 * POINTER REGISTERS AND ROUTINES 17910000 ********************************************************************** 17920000 * 17930000 PUTPTR EQU @10 APSUPUT POINTER 17940000 WRKPTR EQU @02 WORK AREA POINTER 17950000 AMPMPTR EQU @03 POINTER TO AM/PM PRINT AREA 17960000 XTPPTR EQU @04 APSGEXTP POINTER 17970000 ECAPTR EQU @05 APSUECA POINTER 17980000 JMRPTR EQU @07 JMR POINTER 17990000 ECAWKPTR EQU @09 ECA WORK BUFFER POINTER 18000000 JSPAPTR EQU @11 JSPA POINTER 18010000 RTNCODE EQU @15 RETURN CODE 18020000 BLKPTR EQU ECABLKP APSUBLK POINTER 18030000 APSUPUT EQU 0 18040000 APSUBLK EQU 0 18050000 BUFPRI EQU 0 18060000 PRINTCC EQU BUFPRI 18070000 DAYTBL EQU 0 18080000 * 18090000 ********************************************************************** 18100000 * APSUECA WORK BUFFER 18110000 ********************************************************************** 18120000 * 18130000 BUFWRK DSECT 18140000 WRKCC DS CL1 CARRIAGE CONTROL 18150000 WRKDATA DS CL132 DATA LINE 18160000 WRKARORG DS 0CL1 Work area ORG @H9A 18170000 * 18180000 ********************************************************************** 18190000 * INFORMATION PRINT LINE (ORIGINAL HEADER SHEET) 18200000 ********************************************************************** 18210000 * 18220000 BUFPRT EQU WRKDATA 18230000 ORG WRKDATA 18240000 PRTFRAME DS CL1 FRAME '*' 18250000 PRTFORM DS CL5 HEADER TYPE 18260000 DS CL1 SPACE 18270000 PRTNUM DS CL8 JOB NUMBER 18280000 DS CL1 SPACE 18290000 PRTNAME DS CL8 JOB NAME 18300000 DS CL1 SPACE 18310000 PRTJNAME DS CL8 JOE NAME 18320000 DS CL1 SPACE 18330000 PRTJID1 DS CL3 JOE ID1 18340000 DS CL1 SPACE 18350000 PRTJID2 DS CL3 JOE ID2 18360000 DS CL1 SPACE 18370000 PRTJROUT DS CL8 JOE ROUTE CODE 18380000 DS CL1 SPACE 18390000 PRTPNAME DS CL20 PROGRAMMER NAME 18400000 DS CL1 SPACE 18410000 PRTRKEY DS CL4 'ROOM' 18420000 DS CL1 SPACE 18430000 PRTROOM DS CL4 ROOM NUMBER 18440000 DS CL1 SPACE 18450000 PRTTIME DS CL8 PRINT TIME 18460000 ORG PRTTIME 18470000 PRTHR DS CL2 HOUR 18480000 PRTTS1 DS CL1 SEPARATOR 18490000 PRTMIN DS CL2 MINUTE 18500000 PRTTS2 DS CL1 SEPARATOR 18510000 PRTSEC DS CL2 SECOND 18520000 DS CL1 SPACE 18530000 PRTAMPM DS CL2 AM/PM 18540000 DS CL1 SPACE 18550000 PRTDATE DS CL11 PRINT DATE @02C 18560000 ORG PRTDATE 18570000 PRTDD DS CL2 DAY 18580000 DS CL1 SPACE 18590000 PRTMMM DS CL3 MONTH 18600000 DS CL1 SPACE 18610000 PRTCEN DS CL2 CENTURY @02A 18620000 PRTYY DS CL2 YEAR 18630000 DS CL1 SPACE 18640000 PRTDNAME DS CL8 DEVICE NAME 18650000 DS CL1 SPACE 18660000 PRTSYS DS CL4 SYSTEM NAME 18670000 DS CL1 SPACE 18680000 * delete 2 lines @02D 18690000 PRTCLASX DS CL1 CLASS 18700000 DS CL5 SPACES @02C 18710000 * DELETE 1 LINE 18720000 * 18730000 ********************************************************************** 18740000 * WORK AREA 18750000 ********************************************************************** 18760000 * 18770000 BUFBLK EQU WRKDATA 18780000 SHORTLIN EQU WRKDATA 18790000 PRINTPOS EQU SHORTLIN 18800000 INDEX EQU ECAGWRK 18810000 * 18820000 ********************************************************************** 18830000 * Begin separator page line & detail box mapping (ESS) * 18840000 ********************************************************************** 18850000 * 18860000 ORG WRKDATA Separator page line & @H9A 18870000 * detail box 18880000 PAGELINE DS 0CL132 @H9A 18890000 DS CL26 Left margin @H9A 18900000 * 18910000 BOXLINE DS 0CL80 @H9A 18920000 * COL DESCRIPTION 18930000 * (relative) 18940000 BOXCOL1 DS CL1 1 Frame Character @H9A 18950000 DS CL1 2 Blank @H9A 18960000 BOXDESC DS CL13 3-15 Line Description @H9A 18970000 DS CL2 16-17 Blanks @H9A 18980000 BOXINFO DS CL60 18-77 Line Information @H9A 18990000 DS CL2 78-79 Blanks @H9A 19000000 BOXCOL80 DS CL1 80 Frame Character @H9A 19010000 DS CL26 Right margin @H9A 19020000 * 19030000 ORG BOXLINE+39 Segment area @H9A 19040000 BOXSGLBL DS C'SEGMENT ID: ' 40-52 Segment ID label @H9A 19050000 BOXSGINF DS CL5 53-57 Segment ID Numb. @H9A 19060000 * 19070000 ORG BOXINFO Output Group area @H9A 19080000 BOXJNAME DS CL8 18-25 JOE name @H9A 19090000 BOXGSEP1 DS CL1 26 Group separator @H9A 19100000 BOXJID1 DS 0CL5 27-31 JOE ID 1 @H9A 19110000 DS CL4 27-30 @H9A 19120000 BOXJZON1 DS CL1 31 Byte field for MVZ 19130000 * @H9A 19140000 BOXGSEP2 DS CL1 32 Group separator @H9A 19150000 BOXJID2 DS 0CL5 33-37 JOE ID 2 @H9A 19160000 DS CL4 33-36 @H9A 19170000 BOXJZON2 DS CL1 37 Byte field for MVZ 19180000 * @H9A 19190000 * 19200000 ORG BOXINFO Print Time Area @H9A 19210000 BOXTIME DS 0CL11 18-28 @H9A 19220000 BOXHR DS CL2 18-19 Print Hour @H9A 19230000 BOXTS1 DS CL1 20 Separator @H9A 19240000 BOXMIN DS CL2 21-22 Print Minute @H9A 19250000 BOXTS2 DS CL1 23 Separator @H9A 19260000 BOXSEC DS CL2 24-25 Print Second @H9A 19270000 DS CL1 26 @H9A 19280000 BOXAMPM DS CL2 27-28 AM / PM @H9A 19290000 * 19300000 ORG BOXINFO Print Date Area @H9A 19310000 BOXDATE DS 0CL11 18-28 Printing Date @02C 19320000 BOXDDD DS CL2 18-19 Printing Day @H9A 19330000 DS CL1 20 @H9A 19340000 BOXMMM DS CL3 21-23 Printing Month @H9A 19350000 DS CL1 24 @H9A 19360000 BOXCEN DS CL2 25-26 Printing Century @02A 19370000 BOXYYY DS CL2 27-28 Printing Year @02C 19380000 * 19390000 ORG BOXINFO SWBTUREQ Error Msg Area @H9A 19400000 BOXMSG DS 0CL40 18-57 @H9A 19410000 BOXMSG1 DS CL40 18-57 Static msg text @H9A 19420000 ORG BOXINFO @H9A 19430000 BOXRCLB DS CL12 18-29 RETURN CDE label @H9A 19440000 DS CL1 30 19450000 BOXRC DS CL4 31-34 SWBTUREQ @H9A 19460000 * return code 19470000 ORG BOXINFO @H9A 19480000 BOXRSLB DS CL12 18-29 REASON CDE label @H9A 19490000 DS CL1 30 @H9A 19500000 BOXRS DS CL4 31-34 SWBTUREQ @H9A 19510000 * reason code 19520000 * 19530000 ********************************************************************** 19540000 * End separator page line & detail box mapping 19550000 ********************************************************************** 19560000 * 19570000 * 19580000 ********************************************************************** 19590000 * Work Areas (Used for both Original & ESS Header sheets) 19600000 ********************************************************************** 19610000 * 19620000 WRKAREAS EQU WRKARORG @H9A 19630000 ORG WRKARORG @H9A 19640000 DS 0F @H9A 19650000 WRKDATE DS CL4 CURRENT DATE - PACKED 19660000 WRKTIME DS CL4 CURRENT TIME - PACKED 19670000 ORG WRKTIME 19680000 DS CL3 HOURS MINUTES SECONDS 19690000 WRKTH DS CL1 TENTHS AND HUNDREDTHS 19700000 WRKUDATE DS CL10 CURRENT DATE-UNPACKED @02C 19710000 ORG WRKUDATE 19720000 WRKMMM DS CL3 MONTH 19730000 WRKDD DS CL2 DAY 19740000 WRKCEN DS CL2 CENTURY @02A 19750000 WRKYY DS CL2 YEAR 19760000 DS CL1 RESERVED 19770000 WRKAMPM DS CL2 CURRENT AM/PM @H9A 19780000 WRKUTIME DS CL7 CURRENT TIME - UNPACKED 19790000 ORG WRKUTIME 19800000 WRKHR DS CL2 HOUR 19810000 WRKMIN DS CL2 MINUTE 19820000 WRKSEC DS CL2 SECOND 19830000 DS CL1 SIGN BYTE 19840000 DS CL1 RESERVED 19850000 WRKED DS CL3 EDIT PATTERN @02A 19860000 DS CL1 RESERVED @02A 19870000 WRKJID1 DS F WORK AREA FOR JOE ID 1 19880000 WRKJID2 DS F WORK AREA FOR JOE ID 2 19890000 WCEN DS F WORK AREA FOR CENTURY @02A 19900000 DS 0D ALIGNMENT @H9A 19910000 WRKJIDEC DS CL8 WORK AREA JOE ID TO DECIMAL 19920000 WRKJID1Z DS CL8 WORK AREA JOE ID 1 TO ZONED 19930000 WRKJID2Z DS CL8 WORK AREA JOE ID 2 TO ZONED 19940000 WRKWORK DS CL8 WORK AREA FOR CONVERSION 19950000 WRKJTBL DS CL48 JULIAN CONVERSION TABLE 19960000 * 19970000 ********************************************************************** 19980000 * SWBTUREQ DECLARES 19990000 ********************************************************************** 20000000 * 20010000 DS 0F 20020000 WRKJSPE@ DS F Pointer to JSPA Extension 20030000 WRKADNUM DS H Number of ADDRESS @H9A 20040000 * lines 20050000 WRKPLPTR DS F Address of SWBTUREQ @H9A 20060000 * parm list 20070000 WRKKYLST DS F Keylist address @H9A 20080000 * (SJTRKEYL) 20090000 * 20100000 FULLWORD DS F Full word work area @H9A 20110000 DBLWORD DS D Double word work area @H9A 20120000 * 20130000 SWBRC DS F SWBTUREQ return code @H9A 20140000 SWBRS DS F SWBTUREQ reason code @H9A 20150000 SWBERR DS CL1 SWBTUREQ error = "Y" @H9A 20160000 * 20170000 DS 0F 20180000 KEYLIST DS CL64 SJTRKEYL Area @H9A 20190000 SBTLAREA DS CL16 SJTRSBTL Area @H9A 20200000 SWBTUWS DS CL1024 SWBTUREQ Work Area @H9A 20210000 * 20220000 ********************************************************************** 20230000 * 20240000 * Conditional assembly check for ESS 20250000 * 20260000 * The code between the AIF and the label .NOESS05 will be 20270000 * suppressed if SYSPARM is NULL. 20280000 * 20290000 ********************************************************************** 20300000 * 20310000 AIF ('&SYSPARM' EQ '').NOESS05 Branch - ESS not supp @H9A 20320000 * 20330000 ********************************************************************** 20340000 * 20350000 ********************************************************************** 20360000 * 20370000 * Even though the SWBTUREQ parameter list is invoked 20380000 * with DSECT=NO, there are still DSECTs in the macro. 20390000 * Therefore do NOT attempt to add DCs or DSs after this 20400000 * macro that are not part of a DSECT. 20410000 * 20420000 ********************************************************************** 20430000 * 20440000 IEFSJTRP DSECT=NO SWBTUREQ parm. list @H9A 20450000 * 20460000 ********************************************************************** 20470000 * * 20480000 * End of APSUECA work buffer * 20490000 * * 20500000 ********************************************************************** 20510000 * 20520000 * 20530000 IEFDOTUM Text unit mapping @H9A 20540000 IEFDOKEY OUTPUT key mapping @H9A 20550000 IEFSJTRC SWBTUREQ return codes @H9A 20560000 * 20570000 .NOESS05 ANOP @H9A 20580000 * 20590000 END APSUX01 20600000