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