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