TITLE 'APSUX01 - PERFORMANCE JOB HEADER ROUTINE' 00010000 **** START OF SPECIFICATIONS ***************************************** 00020000 * * 00030000 *01* MODULE NAME = APSUX01P * 00040000 * * 00050000 * $MOD(APSUX01 ) COMP(APS) PROD(PSF) : VERSION 3.2.0 * 00060000 * * 00070000 *01* DESCRIPTIVE NAME = JOB HEADER INSTALLATION EXIT * 00080000 * PERFORMANCE HEADER EXAMPLE * 00090000 * * 00100000 *01* STATUS = VERSION 3, RELEASE 2, LEVEL 0 * 00110000 * * 00120000 *01* FUNCTION = * 00130000 * Print a job header separator page which prints faster than * 00140000 * the JES-Format separator page. * 00150000 * The page contains the job name in block letters followed by * 00160000 * job related information lines. The job name and information * 00170000 * lines are surrounded by boxes. * 00180000 * Also a continuation header page will be generated when a * 00190000 * data set printing is interrupted by a JES command and then * 00200000 * resumes. The continuation header page is identical to the * 00210000 * start header page with the word 'START" replaced by 'CONT'. * 00220000 * * 00230000 * This job header exit contains the code (commented @D2A* 00240000 * out) to not transmit this header page (branches @D2A* 00250000 * around the exit code) if connected to DPF @D2A* 00260000 * (Distributed Print Facility). Headers are @D2A* 00270000 * required to be active when connected to DPF @D2A* 00280000 * so that PSF can inform DPF of the job @D2A* 00290000 * boundaries (required when below JES2 4.1.0 or JES3 4.2.0).@D2A* 00300000 * * 00310000 * CONDITIONAL ASSEMBLY * 00320000 * * 00330000 * Conditional assembly is used * 00340000 * in this module to determine whether to * 00350000 * assemble the ESS header sheet code or not assemble it. * 00360000 * The System Variable Symbol SYSPARM is used to determine the * 00370000 * conditional assembly. * 00380000 * * 00390000 * If SYSPARM is not specified in a job control statement (null) * 00400000 * or SYSPARM is specified as null ("SYSPARM ()"), then the * 00410000 * ESS header sheet code is not assembled. * 00420000 * * 00430000 * If SYSPARM is specified in a job control statement as * 00440000 * non-null ("SYSPARM (xxx)" where xxx is any character * 00450000 * string up to 255 characters), then the ESS header sheet * 00460000 * code is assembled. * 00470000 * * 00480000 * Example: //STEP EXEC ASMFC,PARM=(SYSPARM(ESS)) * 00490000 * * 00500000 * If the ESS header sheet code is assembled, the ESS * 00510000 * header sheet is still not printed unless JES supports * 00520000 * ESS (ECEJESS = 1). * 00530000 * * 00540000 * HEADER SHEET * 00550000 * * 00560000 * There are 2 forms of this header sheet that can be printed. * 00570000 * If JES supports Enhanced Sysout Support (ESS) then the * 00580000 * ESS header sheet is printed. If JES does not support ESS * 00590000 * then the original header sheet is printed. * 00600000 * * 00610000 * The ESS header sheet provides 6 additional keywords. * 00620000 * They are: * 00630000 * TITLE: * 00640000 * NAME: * 00650000 * ROOM: * 00660000 * BUILDING: * 00670000 * DEPARTMENT: * 00680000 * ADDRESS: * 00690000 * * 00700000 * The 6 keywords are obtained from the Print Dataset's * 00710000 * OUTPUT JCL. * 00720000 * * 00730000 * A SEGMENT ID field may or may not be printed on * 00740000 * the same line as the JOBID on the ESS header sheet. * 00750000 * If the SYSOUT is not segmented, then the entire * 00760000 * SEGMENT ID field is omitted from the header sheet. * 00770000 * For segmented SYSOUT, the SEGMENT ID is formatted * 00780000 * and printed on the header sheet. If the segment ID is * 00790000 * negative or greater than 99999, then the SEGMENT ID field * 00800000 * is printed as ***** (indicates an invalid segment ID). * 00810000 * * 00820000 * The OUTPUT JCL (SWBTU) is the preferred source for NAME * 00830000 * and ROOM. The JCL values (6 new keywords) are * 00840000 * retrieved via the SWBTUREQ macro. If * 00850000 * NAME is not in the SWBTU, then the programmer name from the * 00860000 * JSPA is used. Likewise, if ROOM is not in the SWBTU, then * 00870000 * the room from the JSPA (Job Stmt) is used. * 00880000 * * 00890000 * The ADDRESS keyword allows the address to be from 1 to 4 * 00900000 * lines long. Any lines that are unused are printed as blank * 00910000 * lines, but the label ADDRESS appears on the first line even * 00920000 * if no address was specified on the OUTPUT JCL. * 00930000 * * 00940000 * If the SWBTUREQ macro returned an error, the ADDRESS line * 00950000 * is not printed. An error message is printed in the four * 00960000 * lines that would have contained the ADDRESS that contains * 00970000 * the SWBTUREQ Return Code and Reason Code. * 00980000 * * 00990000 * DESTINATION is a new field on the header sheet. Its value * 01000000 * is obtained from the JSPA. * 01010000 * * 01020000 * Enhanced Sysout Support (ESS) is supported by: * 01030000 * * 01040000 * MVS 4.1.0+ * 01050000 * JES2 4.10+ * 01060000 * JES3 4.20+ * 01070000 * * 01080000 * * 01090000 * * 01100000 *02* OPERATION = * 01110000 * 1. Create 12 lines for the job name in block letters * 01120000 * 2. Pass the block letter record to PSF * 01130000 * 3. Pass record to PSF to draw the boxes * 01140000 * 4. Build job information lines * 01150000 * 5. Pass the information line record to PSF * 01160000 * * 01170000 *01* NOTES = * 01180000 *02* DEPENDENCIES = NONE * 01190000 *02* RESTRICTIONS = * 01200000 * THE SEPARATOR PAGE REQUIRES A FONT NO LARGER THAN 12 * 01210000 * PITCH IN ORDER FOR THE TEXT IN THE ESS DETAIL BOX TO * 01220000 * FIT IN THE BOX. * 01230000 *02* REGISTER CONVENTIONS = * 01240000 * SEE REGISTER EQUATES * 01250000 *02* PATCH LABEL = PSPACE * 01260000 * * 01270000 *01* MODULE TYPE = PROCEDURE * 01280000 *02* PROCESSOR = ASSEMBLER * 01290000 *02* ATTRIBUTES = REENTRANT * 01300000 * AMODE 31 * 01310000 * RMODE ANY * 01320000 * * 01330000 *01* ENTRY POINT = APSUX01 * 01340000 *02* LINKAGE = * 01350000 * R15 = ENTRY POINT ADDRESS * 01360000 * R13 = SAVE AREA ADDRESS * 01370000 * R1 = ADDRESS OF A 4 BYTE FIELD WHICH CONTAINS THE * 01380000 * ADDRESS OF APSGEXTP * 01390000 * * 01400000 *01* INPUT = * 01410000 * APSGEXTP - PSF Installation Exit Parameter Area * 01420000 * APSUECA - PSF Exit Communications Area * 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 * DATA STREAM RECORDS * 01560000 * * 01570000 *01* EXIT NORMAL = * 01580000 * RETURN TO CALLER, REGISTER 15 SET TO ZERO * 01590000 * * 01600000 *01* EXIT ERROR = NONE * 01610000 * * 01620000 *01* EXTERNAL REFERENCES = * 01630000 *02* ROUTINES = * 01640000 * APSUBLK - BUILD BLOCK LETTER RECORDS * 01650000 * APSUPUT - PUT RECORD TO PSF * 01660000 *02* DATA AREAS = * 01670000 * APSGEXTP - PSF Installation Exit Parameter Area * 01680000 * APSUECA - PSF Exit Communications Area * 01690000 * APSUCOM - PSF Exit Julian Day Table * 01700000 * IAZJSPA - Job Separator Page Area * 01710000 * IEFJMR - MVS Job Management Record * 01720000 * CVT - Communication Vector Table * 01730000 * IEESMCA - System Management Facilities Control @DYA* 01740000 * Table @DYA* 01750000 * IEFJESCT - Job Entry Subsystem Communication Table * 01760000 * IEFSJTRP - Scheduler JCL Facility SWBTUREQ RETRIEVE * 01770000 * Parameter List * 01780000 * IEFDOTUM - Dynamic Output Text Unit Mappings * 01790000 * IEFDOKEY - Dynamic Output Key Mapping * 01800000 * IEFSJTRC - Scheduler JCL Facility (SJF) SWBTUREQ * 01810000 * Services Return and Reason Codes * 01820000 *02* INCLUDES = NONE * 01830000 * * 01840000 *01* MACROS = NONE * 01850000 * * 01860000 *01* MESSAGES = NONE * 01870000 * * 01880000 * 01* CHANGE ACTIVITY = * 01890000 * $H3=LAPS0003, HAF1220, 870928, BJ13WLC: RELEASE 2.1 * 01900000 * $L1=LAPS0004, HAF1228, 880601, B53KELJ: RELEASE 3.0 * 01910000 * $H5=LAPS0005, HPRF102, 033189, B53KEMC: REL 2.1.0 NEW FUNCT @H5A* 01920000 * $H9=LAPS0005, HAF1237, 062990, B53KRLD: ESS NEW FUNCTION @H9A* 01930000 * $L2=LAPS0005, HPRF102, 910201, BJ13RLD: UPDATE PROLOG RELEASE @L2A* 01940000 * LEVEL (P1966) * 01950000 * $D2=LAPS0006, HPRF220, 930108, BJ13RLD: REL 2.2.0 - @D2A* 01960000 * ADD COMMENTED OUT CODE * 01970000 * TO BYPASS THE EXIT IF * 01980000 * CONNECTED TO DPF. PTR * 01990000 * BF00037. * 02000000 * $01=OW08944, HPRF220, 950213, BJ13RLD: PRINT THE ENTIRE YEAR @01A* 02010000 * (1995) ON THE HEADER * 02020000 * SHEET * 02030000 * $DU=LAPS0007,HPRF310,980604,BDKURLB: Version 3.1.0 @DUA* 02040000 * $DY=LAPS0008,HPRF320,991115,BDKURLD: System ID on Banner @DYA* 02050000 * $DX=LAPS0008,HPRF320,991117,BUQ4RLB: Version 3.2.0 @DXA* 02060000 * * 02070000 **** END OF SPECIFICATIONS ******************************************* 02080000 APSUX01 START 0 02090000 TITLE 'DSECT - XTP' 02100000 APSGEXTP LIST=YES 02110000 TITLE 'DSECT - ECA' 02120000 APSUECA LIST=YES 02130000 TITLE 'DSECT - JSPA' 02140000 IAZJSPA LIST=YES 02150000 TITLE 'DSECT - JMR' 02160000 IEFJMR 02170000 TITLE 'SMCA MAPPING' @DYA 02180000 IEESMCA @DYA 02190000 TITLE 'CVT MAPPING' 02200000 CVT DSECT=YES Required for SWBTUREQ @H9A 02210000 TITLE 'JESCT MAPPING' 02220000 IEFJESCT Required for SWBTUREQ @H9A 02230000 TITLE 'APSUX01 - PERFORMANCE JOB HEADER ROUTINE' 02240000 APSUX01 CSECT , 02250000 APSUX01 AMODE 31 @H5A 02260000 APSUX01 RMODE ANY @H5A 02270000 USING *,@15 02280000 B PROLOG 02290000 DC AL1(16) 02300000 DC CL8'APSUX01' 02310000 DC CL8'&SYSDATE' 02320000 DROP @15 02330000 * 02340000 ********************************************************************** 02350000 * PROLOG 02360000 ********************************************************************** 02370000 * 02380000 PROLOG DS 0H 02390000 STM @14,@12,12(@13) SAVE CALLERS REGISTERS 02400000 LR @12,@15 R12 IS BASE REG 02410000 USING APSUX01,@12,@03 BASE APSUX01 ON R12/R3@H9A 02420000 LA @03,4095(@12) R3 is Base Register @H9A 02430000 LA @03,1(@03) Set Base Register @H9A 02440000 USING APSGEXTP,XTPPTR BASE APSGEXTP ON XTPPTR 02450000 USING APSUECA,ECAPTR BASE APSUECA ON ECAPTR 02460000 USING IAZJSPA,JSPAPTR BASE IAZJSPA ON JSPAPTR 02470000 USING JMR,JMRPTR BASE IEFJMR ON JMRPTR 02480000 L @04,0(,@01) LOAD ADDRESS OF APSGEXTP 02490000 L @05,XTPECAP LOAD ADDRESS OF APSUECA 02500000 LR @02,@13 LOAD ADDRESS OF CALLER SAVE 02510000 * AREA 02520000 LA @13,ECAUSAVE R13 POINTS TO APSUX01 SAVE 02530000 * AREA 02540000 ST @02,4(,@13) SAVE CALLERS SAVE AREA 02550000 * ADDRESS 02560000 * 02570000 ********************************************************************** 02580000 * TO SUPPRESS THIS HEADER WHEN ATTACHED TO THE @D2A 02590000 * DISTRIBUTED PRINT FUNCTION OF PSF/2 THEN UNCOMMENT @D2A 02600000 * THE FOLLOWING CODE. @D2A 02610000 ********************************************************************** 02620000 * 02630000 * USING APSUECE,@02 Get addressablity @D2A 02640000 * L @02,ECAECEP to ECE @D2A 02650000 * @D2A 02660000 * TM ECEFLAG,ECEDPF DPF attached printer?@D2A 02670000 * BO OUT YES - exit immediate @D2A 02680000 * @D2A 02690000 * DROP @02 Drop addr. to ECE @D2A 02700000 * @D2A 02710000 SLR RTNCODE,RTNCODE RESET RETURN CODE 02720000 XC ECAFLAGS(2),ECAFLAGS RESET ECAFLAGS 02730000 L JSPAPTR,XTPJSPAP LOAD ADDRESS OF IAZJSPA 02740000 L JMRPTR,JSPAJMR LOAD ADDRESS OF IEFJMR 02750000 L PUTPTR,ECAPUTP LOAD ADDRESS OF APSUPUT 02760000 LA ECAWKPTR,ECAWKBUF GET ADDRESS OF ECA WORK BUF 02770000 * 02780000 ********************************************************************** 02790000 * CREATE JOB NAME IN BLOCK LETTERS 02800000 ********************************************************************** 02810000 * 02820000 NI ECAFLAGS,B'10111111' TURN ON CENTER BLOCK LETTER 02830000 * FLAG 02840000 MVI ECADRF,X'00' RESET RECORD TYPE FLAGS 02850000 MVC ECABLKIN(8),JSPAJBNM GET JOB NAME 02860000 OI ECAFLAGS,ECAPBLK TURN ON PERFORMANCE BLOCK 02870000 * LETTER INDICATOR 02880000 NI ECAFLAGS,B'01111111' TURN OFF SLANT LETTER FLAG 02890000 L @15,BLKPTR CALL 02900000 BALR @14,@15 APSUBLK 02910000 USING BLKWRK,ECAWKPTR BASE BLOCK LETTER COMPOSED- 02920000 * TEXT DATA AREA ON ECAWKPTR 02930000 TM ECAFLAGS,ECASLANT TEST IF SLANT LETTER 02940000 BNO NOSLANT NOT SLANT LETTER 02950000 TM ECAFLAGS,ECALJUST TEST IF LEFT ADJUSTED 02960000 BNO NOLEFT NOT LEFT ADJUSTED 02970000 MVC XPOS(2),SLL SET INLINE POSITION FOR 02980000 * SLANT & LEFT ADJUSTED 02990000 * BLOCK LETTERS 03000000 B CONT1 03010000 NOLEFT MVC XPOS(2),SLC SET INLINE POSITION FOR 03020000 * SLANT & CENTERED BLOCK 03030000 * LETTERS 03040000 B CONT1 03050000 NOSLANT TM ECAFLAGS,ECALJUST TEST IF LEFT ADJUSTED 03060000 BNO STCNTR 03070000 MVC XPOS(2),STL SET INLINE POSITION FOR 03080000 * STRAIGHT & LEFT-ADJUSTED 03090000 * BLOCK LETTERS 03100000 B CONT1 03110000 STCNTR MVC XPOS(2),STC SET INLINE POSITION FOR 03120000 * STRAIGHT & CENTERED 03130000 * BLOCK LETTERS 03140000 CONT1 DS 0H 03150000 MVC FROM(2),BEG SET POINTER TO THE 03160000 * BEGINNING OF THE LAST 03170000 * LINE OF BLOCK LETTERS 03180000 * IN THE BUFFER 03190000 MVC TO(2),END SET POINTER TO THE 03200000 * END OF THE LAST 03210000 * LINE OF BLOCK LETTERS 03220000 * IN THE BUFFER 03230000 LA @14,12 GET THE # OF LINES OF 03240000 * BLOCK LETTERS 03250000 STH @14,INDEX STORE THE # IN INDEX 03260000 LA @08,TEMPBUF GET ADDRESS OF TEMPORARY 03270000 * BUFFER 03280000 * 03290000 ********************************************************************** 03300000 * PRINT JOB NAME BLOCK LETTERS 03310000 ********************************************************************** 03320000 * 03330000 LOOP DS 0H 03340000 LH @01,FROM PICK UP 03350000 LR @06,ECAPTR A LINE OF BLOCK 03360000 ALR ECAPTR,@01 LETTERS FORMATTED 03370000 MVC 0(84,@08),BLKCHAR-1 BY APSUBLK 03380000 LR ECAPTR,@06 RESTORE ECAPTR 03390000 LH @14,INDEX MOVE THE LINE 03400000 MH @14,NINEFOUR INTO THE 03410000 LR @06,ECAWKPTR COMPOSED- 03420000 ALR ECAWKPTR,@14 TEXT DATA 03430000 MVC BLKTEXT-94(84),0(@08) AREA 03440000 MVC BLKPOS-94(8),YPOS1 ADD MOVE INLINE CONTROL 03450000 LR @14,ECAWKPTR SAVE ECAWKPTR 03460000 LR ECAWKPTR,@06 SET ECAWKPTR TO @ OF BLKWRK 03470000 MVC 0(2,@08),XPOS ADD MOVE BASELINE CONTROL 03480000 LR @06,ECAWKPTR SAVE POINTER TO BLKWRK 03490000 LR ECAWKPTR,@14 RESTORE ECAWKPTR 03500000 MVC BLKX-94(2),0(@08) ADD TRANSPARENT DATA 03510000 MVC BLKTRN-94(2),TRN1 TEXT CONTROL (TRN) 03520000 LR ECAWKPTR,@06 SET ECAWKPTR TO @ OF BLKWRK 03530000 LH @14,FROM UPDATE THE 03540000 LR @00,@14 BEGINNING AND 03550000 BCTR @00,0 END POINTER 03560000 STH @00,TO TO PICK UP 03570000 SL @14,LINELGTH THE NEXT LINE 03580000 STH @14,FROM OF BLOCK LETTERS 03590000 * NOTE: THE SEQUENCE OF 03600000 * MOVING BLOCK LETTER LINES 03610000 * FROM BUFFER TO CTX AREA IS 03620000 * BACKWARDS, THAT IS MOVE 03630000 * THE 12TH LINE FIRST. 03640000 SLR @14,@14 CHECK IF ALL 12 03650000 BCTR @14,0 LINES OF BLOCK 03660000 AH @14,INDEX LETTERS ARE MOVED 03670000 STH @14,INDEX INTO THE COMPOSED-TEXT 03680000 LTR @14,@14 DATA AREA, IF NOT 03690000 BP LOOP GO TO LOOP 03700000 MVC BLKY(4),YPOS2 SET ABSOLUTE BASELINE 03710000 * POSITION FOR THE 1ST 03720000 * LINE OF BLOCK LETTERS 03730000 MVC BLKTRN+1034(2),TRN2 SET UNCHAINED TRN FOR 03740000 * THE LAST LINE OF 03750000 * BLOCK LETTERS 03760000 MVC ECARECLN(4),BLKLGTH GET LENGTH OF THE COMPOSED 03770000 * TEXT DATA AREA FOR THE 03780000 * BLOCK LETTERS 03790000 LA @14,BLKCTX GET ADDRESS OF THE 03800000 ST @14,ECARECAD COMPOSED TEXT DATA AREA 03810000 MVI ECADRF,X'00' RESET RECORD DESC FALGS 03820000 OI ECADRF,ECADSR INDICATE DATA STREAM REC 03830000 MVC BLKSFI(10),SFI02 SET STRUCTURE FIELD 03840000 * INTRODUCER FOR THE 03850000 * COMPOSED TEXT AREA 03860000 LR @15,PUTPTR CALL 03870000 BALR @14,@15 APSUPUT 03880000 XC ECAFLAGS(2),ECAFLAGS RESET ECAFLAGS 03890000 LTR RTNCODE,RTNCODE IF RETURN CODE NOT ZERO, 03900000 BNZ OUT EXIT 03910000 * 03920000 ********************************************************************** 03930000 * 03940000 * Conditional assembly check for ESS 03950000 * 03960000 * The code between the AIF and the label .NOESS01 will be 03970000 * suppressed if SYSPARM is NULL. 03980000 * 03990000 ********************************************************************** 04000000 * 04010000 AIF ('&SYSPARM' EQ '').NOESS01 Branch - ESS not supp @H9A 04020000 * 04030000 ********************************************************************** 04040000 * Determine which separator format to print * 04050000 ********************************************************************** 04060000 * 04070000 USING APSUECE,@02 Get addressability @H9A 04080000 L @02,ECAECEP to ECE @H9A 04090000 * 04100000 TM ECEFLAG,ECEJESS Does JES support ESS? @H9A 04110000 BNZ BUILDBOX YES -build detail box @H9A 04120000 * NO -create old hdr @H9A 04130000 * 04140000 DROP @02 Drop addr. to ECE @H9A 04150000 * 04160000 .NOESS01 ANOP @H9A 04170000 * 04180000 ********************************************************************** 04190000 * DRAW BOXES 04200000 * 04210000 * NOTE: The following code was moved from the top of the 04220000 * routine since it is not common for the 2 forms of 04230000 * the header sheet. 04240000 ********************************************************************** 04250000 * 04260000 USING BOXCTX,ECAWKPTR Base Box Composed-Text@H9A 04270000 * Data Area (CTX) on ECAWKPTR 04280000 XC BOXCTX(184),BOXCTX RESET COMPOSED-TEXT 04290000 * DATA AREA (CTX) 04300000 MVC BOXSFI(10),SFI01 SET STRUCTURED FIELD 04310000 * INTRODUCER (SFI) 04320000 MVC BOXB1(8),AMB1 SET TEXT 04330000 MVC BOXB2(14),DRB2 CONTROLS 04340000 MVC BOXB3(8),AMB3 TO 04350000 MVC BOXB4(14),DRB4 DRAW 04360000 MVC BOXB5(8),AMB5 THE 04370000 MVC BOXB6(14),DRB6 BOLD 04380000 MVC BOXB7(4),AMB7 OUTER 04390000 MVC BOXB8(7),DRB8 BOX 04400000 MVC BOXT1(8),AMT1 SET 04410000 MVC BOXT2(14),DRT2 TEXT 04420000 MVC BOXT3(8),AMT3 CONTROLS 04430000 MVC BOXT4(14),DRT4 TO 04440000 MVC BOXT5(4),AMT5 DRAW 04450000 MVC BOXT6(7),DRT6 THE 04460000 MVC BOXT7(8),AMT7 THIN 04470000 MVC BOXT8(14),DRT8 INNER 04480000 MVC BOXT9(4),AMT9 BOXES 04490000 MVC BOXT0(14),DRT0 04500000 MVC BOXNOP(2),NOP NOP TEXT CONTROL 04510000 LA @14,BOXCTX LOAD ADDRESS OF CTX 04520000 ST @14,ECARECAD STORE THE ADDR IN ECARECAD 04530000 MVC ECARECLN(4),CTXLGTH GET LENGTH OF CTX 04540000 MVI ECADRF,X'00' RESET RECORD DESCRIPTION 04550000 OI ECADRF,ECADSR SET DATA STREAM FLAG 04560000 LR @15,PUTPTR CALL 04570000 BALR @14,@15 APSUPUT 04580000 LTR RTNCODE,RTNCODE CHECK APSUPUT RETURN CODE 04590000 BNZ OUT IF NOT ZERO, EXIT 04600000 * 04610000 ********************************************************************** 04620000 * OBTAIN TIME AND DATE 04630000 * 04640000 * The date is returned in register 1 as packed decimal @01A 04650000 * digits of the form: @01A 04660000 * @01A 04670000 * 0CYYDDDF where @01A 04680000 * @01A 04690000 * C is a digit representing centuries beyond the twentieth. @01A 04700000 * In the years 1900 through 1999, C = 0. In the years @01A 04710000 * 2000 through 2099, C = 1. @01A 04720000 * YY is the last 2 digits of the year. @01A 04730000 * DDD is the day of the year. @01A 04740000 * F is a 4-bit sign character that allows the data to be @01A 04750000 * unpacked and printed. @01A 04760000 * 04770000 ********************************************************************** 04780000 * 04790000 USING PRTWRK,ECAWKPTR BASE INFO PRINT LINE CTX 04800000 * ON ECAWKPTR 04810000 LA @01,2 04820000 SLR @00,@00 RESET R0 04830000 SVC 11 ISSUE TIME SVC 04840000 STCM @01,15,WRKDATE SAVE THE DATE (PACKED DEC) 04850000 * 04860000 ********************************************************************** 04870000 * ADJUST TIME FOR AM/PM 04880000 ********************************************************************** 04890000 * 04900000 MVI PRTTIME,C' ' RESET PRINT TIME IN 04910000 MVC PRTTIME+1(10),PRTTIME THE OUTPUT 04920000 LA WRKPTR,WRKTIME SET R2 TO ADDRESS OF 04930000 * TIME WORK AREA 04940000 LA AMPMPTR,WRKAMPM SET R8 TO ADD OF AM/PM@H9A 04950000 * WORK AREA 04960000 MVC WRKAMPM(2),AM INIT TO AM @H9A 04970000 CL @00,=X'12000000' TEST FOR ZERO HOURS 04980000 BL PMORNING BRANCH IF AM 04990000 MVI 0(@08),C'P' CHANGE FROM AM TO PM 05000000 SL @00,=X'12000000' SUBTRACT TWELVE HOURS 05010000 PMORNING ST @00,0(,@02) STORE ADJUSTED TIME 05020000 CLI 0(@02),X'00' TEST FOR ZERO HOURS 05030000 BNE PADJERR BR IF NOT TO TEST ADJ 05040000 * ERROR 05050000 MVI 0(@02),X'12' CONVERT ZERO TO TWELVE 05060000 PADJERR TM 0(@02),X'08' TEST FOR ADJUSTMENT ERRORS 05070000 BZ PEDTIME BRANCH IF NO ERROR 05080000 NI 0(@02),X'09' CORRECT FOR BIN. SUBTRACT 05090000 * ERROR 05100000 PEDTIME DS 0H 05110000 MVI WRKTH,X'0C' RESET LOW ORDER 2 BYTES 05120000 * WITH SIGH FOR PACK DEC 05130000 UNPK WRKUTIME(7),WRKTIME(4) UNPACK TIME 05140000 * 05150000 ********************************************************************** 05160000 * OBTAIN MONTH, DAY AND YEAR 05170000 ********************************************************************** 05180000 * 05190000 LA @01,4 ADDRESSABILITY TO 05200000 AL @01,ECAUCOMP JULIAN TABLE 05210000 MVC WRKJTBL(48),DAYTBL(@01) COPY TABLE FOR LEAP 05220000 * YEAR ADJUSTMENT 05230000 MVC WRKWORK+4(4),WRKDATE OBTAIN DATE FROM SAVED AREA 05240000 TM WRKWORK+5,X'01' TEST 05250000 BO NOLEAPYR FOR 05260000 TM WRKWORK+5,X'12' LEAP 05270000 BM NOLEAPYR YEAR 05280000 MVI WRKJTBL+4,29 ADJUST FEB FOR LEAP YEAR 05290000 NOLEAPYR MVC WRKED(3),=X'F02120' PLACE PATTERN FOR EDIT@01C 05300000 ED WRKED(3),WRKWORK+5 EDIT THE YEAR @01C 05310000 MVC WRKYY(2),WRKED+1 STORE THE YEAR @01A 05320000 MVC WRKWORK(6),ZEROES RESET ALL BUT JULIAN DATE 05330000 SLR @00,@00 CLEAR FOR IC 05340000 CVB 1,WRKWORK CONVERT TO BINARY DAY 05350000 LA 2,WRKJTBL-4 ADDRESS OF DATE CONVERSION 05360000 * TABLE 05370000 SEARCH SLR @01,@00 CONVERT 05380000 LA @02,4(,@02) JULIAN DAY 05390000 IC @00,0(,@02) TO 05400000 CLR @00,@01 STANDARD DAY 05410000 BL SEARCH 05420000 CVD 1,WRKWORK CONVERT TO DECIMAL DAY 05430000 UNPK WRKDD(2),WRKWORK+6(2) UNPACK THE DAY 05440000 OI WRKDD+1,X'F0' INSURE SIGN NIBBLE 05450000 MVC WRKMMM(3),1(@02) SET EBCDIC ALPHA MONTH 05460000 * 05470000 MVC WCEN(4),XZERO CLEAR CENTURY FIELD @01A 05480000 MVC WCEN+3(1),WRKDATE OBTAIN CENTURY FROM @01A 05490000 * SAVED AREA @01A 05500000 L @02,WCEN LOAD CENTURY @01A 05510000 A @02,NINETEEN BUMP CENTURY BY 19 @01A 05520000 CVD @02,WRKWORK CONVERT TO DECIMAL @01A 05530000 UNPK WRKCEN(2),WRKWORK+6(2) UNPACK THE CENTURY @01A 05540000 OI WRKCEN+1,X'F0' ENSURE SIGN NIBBLE @01A 05550000 * 05560000 ********************************************************************** 05570000 * CONVERT THE JOE (JOB OUTPUT ELEMENT) ID'S TO UNPACKED FORMAT 05580000 ********************************************************************** 05590000 * 05600000 LH @14,JSPJGRP1 SET JOE ID 1 TO A FOUR 05610000 ST @14,WRKJID1 BYTE FIELD 05620000 LH @00,JSPJGRP2 SET JOE ID 2 TO A FOUR 05630000 ST @00,WRKJID2 BYTE FIELD 05640000 CVD @14,WRKJIDEC CONVERT JOE ID 1 TO PACKED 05650000 UNPK WRKJID1Z(8),WRKJIDEC(8) UNPACK JOE ID 1 05660000 OI WRKJID1Z+7,X'F0' FORCE SIGN FOR EBCDIC 05670000 CVD @00,WRKJIDEC CONVERT JOE ID 2 TO PACKED 05680000 UNPK WRKJID2Z(8),WRKJIDEC(8) UNPACK JOE ID 2 05690000 OI WRKJID2Z+7,X'F0' FORCE SIGN FOR EBCDIC 05700000 * 05710000 ********************************************************************** 05720000 * COMPOSE THE INFORMATION PRINT LINES 05730000 ********************************************************************** 05740000 * 05750000 MVC PRTSFI(10),SFI03 SET SFI FOR INFO 05760000 * PRINT LINES 05770000 MVC PRTPOS0(8),AMP0 SET PRINT POSITION FOR 05780000 * JOB # LINE 05790000 MVC PRTTRN0(2),TRNP0 SET TRN FOR JOB # LINE 05800000 MVC PRTJNH(14),HEADP0 SET JOB # HEADING 05810000 MVC PRTJN(8),JSPAJBID SET JOB # 05820000 MVC PRTPOS1(8),AMP1 SET PRINT POSITION FOR 05830000 * SYSOUT LINE 05840000 MVC PRTTRN1(2),TRNP1 SET TRN FOR SYSOUT LINE 05850000 MVC PRTSCLH(14),HEADP1 SET SYSOUT HEADING 05860000 MVC PRTSCL(1),JSPJSOCL SET SYSOUT CLASS 05870000 MVC PRTPOS2(8),AMP2 SET PRINT POSITION FOR 05880000 * PRINTER NAME 05890000 MVC PRTTRN2(2),TRNP0 SET TRN FOR PRINTER NAME 05900000 MVC PRTNMH(14),HEADP2 SET PRINTER NAME HEADING 05910000 MVC PRTNM(8),JSPADEVN SET PRINTER NAME 05920000 MVC PRTPOS3(8),AMP3 SET PRINT POSITION FOR 05930000 * SYSTEM ID 05940000 MVC PRTTRN3(2),TRNP3 SET TRN FOR SYSTEM ID 05950000 MVC PRTSIDH(14),HEADP3 SET SYSTEM ID HEADING 05960000 MVC PRTSID(4),JMRCPUID SET SYSTEM ID 05970000 ********************************************************************** 05980000 * When running in an MAS environment and you want the system ID 05990000 * of the system on which the job was printed, uncomment the 06000000 * following 3 lines, compile, and linkedit the exit. @DYA 06010000 ********************************************************************** 06020000 * L @02,CVTPTR LOCATE @DYA 06030000 * L @02,CVTSMCA-CVT(,@02) SMCA @DYA 06040000 * MVC PRTSID(4),SMCASID-SMCABASE(@02) USE SMF ID @DYA 06050000 MVC PRTPOS4(8),AMP4 SET PRINT POSITION FOR 06060000 * PRINT DATE 06070000 MVC PRTTRN4(2),TRNP4 SET TRN FOR PRINT DATE 06080000 MVI PRTDATE,C' ' RESET PRINT DATE 06090000 MVC PRTDATE+1(8),PRTDATE FIELD TO BLANKS 06100000 MVC PRTDATEH(14),HEADP4 SET PRINT DATE HEADING 06110000 MVC PRTDAY(2),WRKDD SET CURRENT DAY 06120000 MVC PRTMTH(3),WRKMMM SET CURRENT MONTH 06130000 MVC PRTCEN(2),WRKCEN SET CURRENT CENTURY @01A 06140000 MVC PRTYR(2),WRKYY SET CURRENT YEAR 06150000 MVC PRTPOS5(8),AMP5 SET PRINT POSITION FOR 06160000 * PRINT TIME 06170000 MVC PRTTRN5(2),TRNP5 SET TRN FOR PRINT TIME 06180000 MVC PRTTIMEH(14),HEADP5 SET PRINT TIME HEADING 06190000 MVC PRTHR(2),WRKHR SET CURRENT HOUR 06200000 MVI PRTCL1,C':' SET COLON BETWEEN HOUR 06210000 * AND MINUTE 06220000 MVC PRTMIN(2),WRKMIN SET CURRENT MINUTE 06230000 MVI PRTCL2,C':' SET COLON BETWEEN MINUTE 06240000 * AND SECOND 06250000 MVC PRTSEC(2),WRKSEC SET CURRENT SECOND 06260000 MVC PRTAMPM(2),WRKAMPM SET AM/PM @H9A 06270000 MVC PRTPOS6(8),AMP6 SET PRINT POSITION FOR USER 06280000 * NAME 06290000 MVC PRTTRN6(2),TRNP6 SET TRN FOR USER NAME 06300000 MVC PRTUSRH(14),HEADP6 SET USER NAME HEADING 06310000 MVC PRTUSR(20),JSPJPNAM SET USER NAME 06320000 MVC PRTPOS7(8),AMP7 SET PRINT POSITION FOR JOB 06330000 * NAME 06340000 MVC PRTTRN7(2),TRNP0 SET TRN FOR JOBNAME 06350000 MVC PRTJNMH(14),HEADP7 SET JOB NAME HEADING 06360000 MVC PRTJNM(8),JSPAJBNM SET JOB NAME 06370000 MVC PRTPOS8(8),AMP8 SET PRINT POSITION FOR 06380000 * OUTPUT GROUP 06390000 MVC PRTTRN8(2),TRNP8 SET TRN FOR OUTPUT GROUP 06400000 MVI PRTOG,C' ' RESET OUTPUT GROUP FIELD 06410000 MVC PRTOG+1(15),PRTOG TO BLANKS 06420000 MVC PRTOGH(14),HEADP8 SET OUTPUT GROUP HEADING 06430000 MVC PRTOG1(8),JSPJGRPN SET JOE NAME 06440000 MVC PRTOG2(3),WRKJID1Z+5 SET JOE ID 1 06450000 MVC PRTOG3(3),WRKJID2Z+5 SET JOE ID 2 06460000 MVC PRTPOS9(8),AMP9 SET PRINT POSITION FOR 06470000 * ROOM # 06480000 MVC PRTTRN9(2),TRNP3 SET TRN FOR ROOM # 06490000 MVC PRTROOMH(14),HEADP9 SET ROOM # HEADING 06500000 MVC PRTROOM(4),JSPJRMNO SET ROOM # 06510000 MVC PRTPOS10(8),AMP10 SET PRINT POSITION FOR 06520000 * HEADER PAGE TYPE 06530000 MVC PRTTRN10(2),TRNP10 SET TRN FOR HEADER PAGE 06540000 * TYPE 06550000 TM JSPAFLG1,JSPA1CON IF JSPA CONTINUATION BIT 06560000 BNZ CONTSEP ON, SET UP CONT PAGE 06570000 MVC PRTSEPTY(5),START ELSE TYPE IS START 06580000 B CONT2 06590000 CONTSEP MVC PRTSEPTY(5),CONT TYPE IS CONT 06600000 CONT2 MVC ECARECLN(4),PRTLGTH GET LENGTH OF INFO PRINT 06610000 * LINE 06620000 OI ECADRF,ECADSR INDICATE DATA STREAM REC 06630000 LA @14,PRTCTX GET ADDRESS OF INFO 06640000 ST @14,ECARECAD PRINT LINE 06650000 LR @15,PUTPTR CALL 06660000 BALR @14,@15 APSUPUT 06670000 * 06680000 ********************************************************************** 06690000 * EPILOGUE 06700000 ********************************************************************** 06710000 * 06720000 OUT SLR RTNCODE,RTNCODE RESET RETURN CODE 06730000 L @13,4(,@13) RESTORE CALLERS SAVE AREA 06740000 * ADDRESS 06750000 L @14,12(,@13) RESTORE CALLERS RETURN 06760000 * ADDRESS 06770000 LM @00,@12,20(@13) RESTORE CALLERS REGISTERS 06780000 BR @14 RETURN TO CALLER 06790000 DS 0H 06800000 * 06810000 ********************************************************************** 06820000 * 06830000 * Conditional assembly check for ESS 06840000 * 06850000 * The code between the AIF and the label .NOESS02 will be 06860000 * suppressed if SYSPARM is NULL. 06870000 * 06880000 ********************************************************************** 06890000 * 06900000 AIF ('&SYSPARM' EQ '').NOESS02 Branch - ESS not supp @H9A 06910000 * 06920000 *********************************************************************** 06930000 * * 06940000 * BUILDBOX - Build the detail box and print it on the * 06950000 * separator page. * 06960000 * * 06970000 * FUNCTION: * 06980000 * * 06990000 * This code builds and prints the detail box on the * 07000000 * separator page. * 07010000 * * 07020000 * Addressability to the ECA buffer work area is * 07030000 * established. * 07040000 * * 07050000 * This routine will retrieve the new ESS JCL keywords: * 07060000 * * 07070000 * * ADDRESS * 07080000 * * BUILDING * 07090000 * * DEPARTMENT * 07100000 * * TITLE * 07110000 * * ROOM * 07120000 * * NAME * 07130000 * * 07140000 * and place them on the separator page. The keywords * 07150000 * are retrieved using the Scheduler JCL Facility * 07160000 * SWBTUREQ macro. * 07170000 * * 07180000 * The separator page is formated as a detail box * 07190000 * in place of the repeated 16 lines. * 07200000 * * 07210000 * The new format is only available on: * 07220000 * * 07230000 * * MVS 4.1.0+ * 07240000 * * JES2 4.1.0+ * 07250000 * * JES3 4.2.0+ * 07260000 * * 07270000 * Storage located at the end of ECAWKBUF: * 07280000 * * 07290000 * * SWBTUREQ Parameter List * 07300000 * * SWBTUREQ Work Area * 07310000 * * Keylist * 07320000 * * List of SWBTU pointers * 07330000 * * 07340000 * Storage located in the area pointed to by ECEWKPTR: * 07350000 * * 07360000 * * SWBTUREQ OUTPUT AREA * 07370000 * * 07380000 * OTHER CONSIDERATIONS: * 07390000 * * 07400000 * None * 07410000 * * 07420000 *********************************************************************** 07430000 BUILDBOX DS 0H 07440000 * 07450000 ********************************************************************** 07460000 * Draw boxes 07470000 ********************************************************************** 07480000 * 07490000 BOXES DS 0H @H9A 07500000 USING BOXWRK,ECAWKPTR Base Box Composed-Text@H9A 07510000 * Data Area on ECAWKPTR 07520000 MVC BOXCTXN,ESSBOX Set draw commands CTX @H9A 07530000 LA @14,BOXCTXN Get Boxes CTX Address @H9A 07540000 ST @14,ECARECAD Store Boxes CTX Addr @H9A 07550000 * 07560000 L @14,=A(ESSLNGTH) Set length @H9A 07570000 ST @14,ECARECLN of record @H9A 07580000 * 07590000 MVI ECADRF,X'00' Reset Record Desc @H9A 07600000 OI ECADRF,ECADSR Set Data Stream Flag @H9A 07610000 OI ECADRF,ECAANSI Set ANSI Carriage Cntl@H9A 07620000 * 07630000 L @15,ECAPUTP Call @H9A 07640000 BALR @14,@15 APSUPUT @H9A 07650000 * 07660000 LTR @15,@15 Check APSUPUT Rtn Code@H9A 07670000 BNZ OUT IF NOT Zero, EXIT @H9A 07680000 * 07690000 ********************************************************************** 07700000 * OBTAIN TIME AND DATE 07710000 * 07720000 * The date is returned in register 1 as packed decimal @01A 07730000 * digits of the form: @01A 07740000 * @01A 07750000 * 0CYYDDDF where @01A 07760000 * @01A 07770000 * C is a digit representing centuries beyond the twentieth. @01A 07780000 * In the years 1900 through 1999, C = 0. In the years @01A 07790000 * 2000 through 2099, C = 1. @01A 07800000 * YY is the last 2 digits of the year. @01A 07810000 * DDD is the day of the year. @01A 07820000 * F is a 4-bit sign character that allows the data to be @01A 07830000 * unpacked and printed. @01A 07840000 * 07850000 ********************************************************************** 07860000 * 07870000 USING PRTWRK,ECAWKPTR BASE INFO PRINT LINE @H9P 07880000 * CTX ON ECAWKPTR @H9P 07890000 LA @01,2 @H9P 07900000 SLR @00,@00 RESET R0 @H9P 07910000 SVC 11 ISSUE TIME SVC @H9P 07920000 STCM @01,15,WRKDATE SAVE THE DATE @H9P 07930000 * (PACKED DEC) @H9P 07940000 * 07950000 ********************************************************************** 07960000 * ADJUST TIME FOR AM/PM 07970000 ********************************************************************** 07980000 * 07990000 MVI PRTTIME,C' ' RESET PRINT TIME IN @H9P 08000000 MVC PRTTIME+1(10),PRTTIME THE OUTPUT @H9P 08010000 LA WRKPTR,WRKTIME SET R2 TO ADDRESS OF @H9P 08020000 * TIME WORK AREA @H9P 08030000 LA AMPMPTR,WRKAMPM SET R8 TO ADD OF AM/PM@H9A 08040000 * WORK AREA @H9P 08050000 MVC WRKAMPM(2),AM INIT TO AM @H9A 08060000 CL @00,=X'12000000' TEST FOR ZERO HOURS @H9P 08070000 BL PMORNIN BRANCH IF AM @H9P 08080000 MVI 0(@08),C'P' CHANGE FROM AM TO PM @H9P 08090000 SL @00,=X'12000000' SUBTRACT TWELVE HOURS @H9P 08100000 PMORNIN ST @00,0(,@02) STORE ADJUSTED TIME @H9P 08110000 CLI 0(@02),X'00' TEST FOR ZERO HOURS @H9P 08120000 BNE PADJERR1 BR IF NOT TO TEST ADJ @H9P 08130000 * ERROR @H9P 08140000 MVI 0(@02),X'12' CONVERT ZERO TO TWELVE@H9P 08150000 PADJERR1 TM 0(@02),X'08' TEST FOR ADJUSTMENT @H9P 08160000 * ERRORS @H9P 08170000 BZ PEDTIME1 BRANCH IF NO ERROR @H9P 08180000 NI 0(@02),X'09' CORRECT FOR BIN. @H9P 08190000 * SUBTRACT ERROR @H9P 08200000 PEDTIME1 DS 0H @H9P 08210000 MVI WRKTH,X'0C' RESET LOW ORDER 2 @H9P 08220000 * BYTES WITH SIGN FOR @H9P 08230000 * PACK DEC @H9P 08240000 UNPK WRKUTIME(7),WRKTIME(4) UNPACK TIME @H9P 08250000 * 08260000 ********************************************************************** 08270000 * OBTAIN MONTH, DAY AND YEAR 08280000 ********************************************************************** 08290000 * 08300000 LA @01,4 ADDRESSABILITY TO @H9P 08310000 AL @01,ECAUCOMP JULIAN TABLE @H9P 08320000 MVC WRKJTBL(48),DAYTBL(@01) COPY TABLE FOR LEAP @H9P 08330000 * YEAR ADJUSTMENT @H9P 08340000 MVC WRKWORK+4(4),WRKDATE OBTAIN DATE FROM SAVED@H9P 08350000 * AREA @H9P 08360000 TM WRKWORK+5,X'01' TEST @H9P 08370000 BO NOLEPYR FOR @H9P 08380000 TM WRKWORK+5,X'12' LEAP @H9P 08390000 BM NOLEPYR YEAR @H9P 08400000 MVI WRKJTBL+4,29 ADJUST FEB FOR LEAP @H9P 08410000 * YEAR @H9P 08420000 NOLEPYR MVC WRKED(3),=X'F02120' PLACE PATTERN FOR EDIT@01C 08430000 ED WRKED(3),WRKWORK+5 EDIT THE YEAR @01C 08440000 MVC WRKYY(2),WRKED+1 STORE THE YEAR @01A 08450000 MVC WRKWORK(6),ZEROES RESET ALL BUT JULIAN @H9P 08460000 * DATE @H9P 08470000 SLR @00,@00 CLEAR FOR IC @H9P 08480000 CVB 1,WRKWORK CONVERT TO BINARY DAY @H9P 08490000 LA 2,WRKJTBL-4 ADDRESS OF DATE @H9P 08500000 * CONVERSION TABLE @H9P 08510000 SEARCH1 SLR @01,@00 CONVERT @H9P 08520000 LA @02,4(,@02) JULIAN DAY @H9P 08530000 IC @00,0(,@02) TO @H9P 08540000 CLR @00,@01 STANDARD DAY @H9P 08550000 BL SEARCH1 @H9P 08560000 CVD 1,WRKWORK CONVERT TO DECIMAL DAY@H9P 08570000 UNPK WRKDD(2),WRKWORK+6(2) UNPACK THE DAY @H9P 08580000 OI WRKDD+1,X'F0' INSURE SIGN NIBBLE @H9P 08590000 MVC WRKMMM(3),1(@02) SET EBCIDIC ALPHA @H9P 08600000 * MONTH 08610000 MVC WCEN(4),XZERO CLEAR CENTURY FIELD @01A 08620000 MVC WCEN+3(1),WRKDATE OBTAIN CENTURY FROM @01A 08630000 * SAVED AREA @01A 08640000 L @02,WCEN LOAD CENTURY @01A 08650000 A @02,NINETEEN BUMP CENTURY BY 19 @01A 08660000 CVD @02,WRKWORK CONVERT TO DECIMAL @01A 08670000 UNPK WRKCEN(2),WRKWORK+6(2) UNPACK THE CENTURY @01A 08680000 OI WRKCEN+1,X'F0' ENSURE SIGN NIBBLE @01A 08690000 * 08700000 ********************************************************************** 08710000 * CONVERT THE JOE (JOB OUTPUT ELEMENT) ID'S TO UNPACKED FORMAT 08720000 ********************************************************************** 08730000 * 08740000 LH @14,JSPJGRP1 Get JOE ID1 @H9A 08750000 ST @14,WRKJID1 Store in 4 byte field @H9A 08760000 CVD @14,WRKJIDEC Convert to pkd decimal@H9A 08770000 UNPK WRKJID1Z,WRKJIDEC+5(3) Unpack NODE2 @H9A 08780000 OI WRKJID1Z+7,X'F0' Insure positive sign @H9A 08790000 * 08800000 LH @00,JSPJGRP2 Get JOE ID2 @H9A 08810000 ST @00,WRKJID2 Store in 4 byte field @H9A 08820000 CVD @00,WRKJIDEC Convert to pkd decimal@H9A 08830000 UNPK WRKJID2Z,WRKJIDEC+5(3) Unpack GRP NODE3 @H9A 08840000 OI WRKJID2Z+7,X'F0' Insure positive sign @H9A 08850000 * 08860000 ********************************************************************** 08870000 * * 08880000 * Fill in the SWBTUREQ RETRIEVE parameter list, IEFSJTRP. * 08890000 * * 08900000 * * 08910000 ********************************************************************** 08920000 * 08930000 XC SJTRP(SJTRLGTH),SJTRP Clear parameter list @H9A 08940000 MVC SJTRID,=A(SJTRCID) Assign function @H9A 08950000 MVI SJTRVERS,SJTRCVER Assign version number @H9A 08960000 LA @01,SJTRLGTH Set parameter list @H9A 08970000 STH @01,SJTRLEN length @H9A 08980000 * 08990000 * The Work Area is a 1K work area in ECAWKBUF that is used as 09000000 * a work area by the SWBTUREQ macro. 09010000 * 09020000 USING SWBTUWS,@02 Establish @H9A 09030000 LA @02,ECAWKBUF addressability @H9A 09040000 * 09050000 LA @01,SWBTUWS Set work area @H9A 09060000 ST @01,SJTRSTOR address @H9A 09070000 L @01,=A(PRTWRKLN) Set work area @H9A 09080000 STH @01,SJTRSTSZ length @H9A 09090000 DROP @02 @H9A 09100000 * 09110000 LA @01,1 Indicate only ONE @H9A 09120000 STH @01,SJTRSWBN SWBTU pointer @H9A 09130000 LA @01,SBTLAREA Set SWBTU addr. list @H9A 09140000 ST @01,SJTRSWBA address (SJTRSBTL) @H9A 09150000 * 09160000 LA @01,6 Indicate six keys in @H9A 09170000 STH @01,SJTRKIDN key list @H9A 09180000 LA @01,KEYLIST Set key list @H9A 09190000 ST @01,SJTRKIDL address @H9A 09200000 ST @01,WRKKYLST Save keylist address @H9A 09210000 * 09220000 USING APSUECE,@02 Get addressability @H9A 09230000 L @02,ECAECEP to ECE @H9A 09240000 * 09250000 * This is a 1K Text Unit Output Area where the parameters are 09260000 * returned by the SWBTUREQ macro. 09270000 * 09280000 L @01,ECEWKPTR Set output area @H9A 09290000 ST @01,SJTRAREA address @H9A 09300000 L @01,ECEWKLEN Set output area @H9A 09310000 STH @01,SJTRSIZE length @H9A 09320000 * 09330000 ********************************************************************** 09340000 * * 09350000 * Initialize the SWBTU pointer list * 09360000 * * 09370000 ********************************************************************** 09380000 * 09390000 USING SJTRSBTL,@07 Establish @H9A 09400000 LA @07,SBTLAREA addressability @H9A 09410000 * 09420000 XC SBTLAREA(L'SBTLAREA),SBTLAREA Clear SWBTU list @H9A 09430000 * 09440000 * Set the address of the area containing the SWBTU data from the 09450000 * JCL for the SWBTUREQ macro. 09460000 * 09470000 MVC SJTRSTUP,ECETUPTR Set input SWBTU ptr @H9A 09480000 DROP @07 09490000 DROP @02 @H9A 09500000 * 09510000 ********************************************************************** 09520000 * * 09530000 * Insert the keys for all of the ESS * 09540000 * parameters being used into the key list. * 09550000 * * 09560000 ********************************************************************** 09570000 * 09580000 $JTRKEYL DS 0H 09590000 USING SJTRKEYL,@07 Establish @H9A 09600000 L @07,WRKKYLST addressability 09610000 * 09620000 XC SJTRKEYL(6*SJTRKLEN),SJTRKEYL Clear key list @H9A 09630000 * 09640000 LA @01,DOTITLE Request @H9A 09650000 STH @01,SJTRKYID+KYLSTTL TITLE key @H9A 09660000 * 09670000 LA @01,DONAME Request @H9A 09680000 STH @01,SJTRKYID+KYLSTNM NAME key @H9A 09690000 * 09700000 LA @01,DOROOM Request @H9A 09710000 STH @01,SJTRKYID+KYLSTRM ROOM key @H9A 09720000 * 09730000 LA @01,DOBUILD Request @H9A 09740000 STH @01,SJTRKYID+KYLSTBL BUILDING key @H9A 09750000 * 09760000 LA @01,DODEPT Request @H9A 09770000 STH @01,SJTRKYID+KYLSTDP DEPARTMENT key @H9A 09780000 * 09790000 LA @01,DOADDRES Request @H9A 09800000 STH @01,SJTRKYID+KYLSTAD ADDRESS key @H9A 09810000 * 09820000 DROP @07 09830000 * 09840000 ********************************************************************** 09850000 * * 09860000 * INVOKE the SWBTUREQ REQUEST=RETRIEVE Macro * 09870000 * ------------------------------------------ * 09880000 * * 09890000 * Set up R1 to point to a word of storage that * 09900000 * contains the address of the parameter list, IEFSJTRP. * 09910000 * * 09920000 ********************************************************************** 09930000 * 09940000 MVI SWBERR,C'N' Initialize to no @H9A 09950000 * SWBTUREQ error 09960000 * 09970000 LA @01,SJTRP Address of @H9A 09980000 ST @01,WRKPLPTR the SWBTUREQ @H9A 09990000 LA @01,WRKPLPTR parameter list @H9A 10000000 * 10010000 * 10020000 SWBTUREQ REQUEST=RETRIEVE INVOKE the Macro @H9A 10030000 * 10040000 * 10050000 C @15,FOUR Check return code @H9A 10060000 BL ESSINFO GOOD retrieval @H9A 10070000 * 10080000 * No keys matched indicates that none of the JCL keywords 10090000 * were specified on the OUTPUT JCL. No error message is 10100000 * printed. Instead the keywords are just left blank on the 10110000 * header sheet. 10120000 * 10130000 CLC SJTRREAS,=A(SJTRNOKY) No keys matched? @H9A 10140000 BE ESSINFO YES---Go to ESSINFO @H9A 10150000 * 10160000 ********************************************************************** 10170000 * * 10180000 * If the SWBTUREQ returns an error, the detail box is * 10190000 * still printed. An error message is printed on the * 10200000 * ADDRESS line. * 10210000 * * 10220000 * NOTE: The PSF-supplied exits should not receive any * 10230000 * errors from the SWBTUREQ. This code is mainly * 10240000 * supplied for diagnostic purposes when changing * 10250000 * the exit. * 10260000 * * 10270000 ********************************************************************** 10280000 * 10290000 REQ_BAD DS 0H 10300000 CVD @15,DBLWORD Convert to pkd dec. @H9A 10310000 MVC FULLWORD(4),DBLWORD+4 Move packed ret. cde @H9A 10320000 UNPK DBLWORD,FULLWORD Unpack return code @H9A 10330000 MVZ DBLWORD+7(1),DBLWORD+6 Correct the sign @H9A 10340000 * 10350000 MVC SWBRC(4),DBLWORD+4 Save return code @H9A 10360000 * 10370000 LH @01,SJTRREAS Load reason code 10380000 CVD @01,DBLWORD Convert to pkd dec. @H9A 10390000 MVC FULLWORD(4),DBLWORD+4 Move packed reas. cde @H9A 10400000 UNPK DBLWORD,FULLWORD Unpack reason code 10410000 MVZ DBLWORD+7(1),DBLWORD+6 Correct the sign @H9A 10420000 * 10430000 MVC SWBRS(4),DBLWORD+4 Save reason code @H9A 10440000 * 10450000 MVI SWBERR,C'Y' Indicate a SWBTUREQ @H9A 10460000 * error occurred and 10470000 * a msg is required 10480000 ********************************************************************** 10490000 * Compose the ESS Detail Box * 10500000 ********************************************************************** 10510000 * 10520000 ESSINFO DS 0H @H9A 10530000 LA @00,PRTWRKE @ of Info Print Lines @H9A 10540000 L @01,=A(PRTWRKLN) Len of Info Print Line@H9A 10550000 LA @14,ESSAREA @ of ESS Detail Box @H9A 10560000 L @15,=A(ESSDLNTH) Len of ESS Detail Box @H9A 10570000 ICM @15,B'1000',BLANKS Set pad char to blank @H9A 10580000 MVCL @00,@14 Compose ESS Detail Box@H9A 10590000 * 10600000 ********************************************************************** 10610000 * Compose JOB NUMBER data * 10620000 ********************************************************************** 10630000 * 10640000 #JOBID DS 0H @H9A 10650000 MVC PRTJNE(8),JSPAJBID Set JOB NUMBER @H9A 10660000 * 10670000 ********************************************************************** 10680000 * Compose SEGMENT ID data * 10690000 ********************************************************************** 10700000 * 10710000 TM JSPAFLG1,JSPA1EXT Does JSP Ext Exist? @H9A 10720000 BZ #JOBNAME NO--Branch #JOBNAME @H9A 10730000 * 10740000 USING JSPEXT,@07 Est. Addressability @H9A 10750000 LR @07,@11 Load JSPA Address @H9A 10760000 AH @07,JSPALEN Add JSPA Length @H9A 10770000 * 10780000 CLC JSPCESEG,XZERO Is this SYSOUT segm? @H9A 10790000 BE #JOBNAME NO--Omit SEGMENT ID @H9A 10800000 MVC PRTSEGH(14),LBLSEGID Set SEGMENT ID label @H9A 10810000 * 10820000 L @14,JSPCESEG Load R14 with SEGMENT#@H9A 10830000 CVD @14,DBLWORD Convert to pkd decimal@H9A 10840000 CP DBLWORD,PZERO Is SEGMENT# < 0 ? @H9A 10850000 BL NVALSEGM Yes --branch NVALSEGM @H9A 10860000 CP DBLWORD,MAXSEG# Is SEGMENT# > 99999 ? @H9A 10870000 BNH #SEGMENT NO--branch #SEGMENT @H9A 10880000 DROP @07 10890000 * 10900000 NVALSEGM MVC PRTSEGID(5),=C'*****' Not valid SEGMENT @H9A 10910000 B #JOBNAME Branch #JOBNAME @H9A 10920000 #SEGMENT DS 0H 10930000 UNPK PRTSEGID,DBLWORD+5(3) Put SEGMENT ID @H9A 10940000 OI PRTSEGID+4,X'F0' Insure prtable number @H9A 10950000 * 10960000 ********************************************************************** 10970000 * Compose JOB NAME data 10980000 ********************************************************************** 10990000 * 11000000 #JOBNAME DS 0H @H9A 11010000 MVC PRTJNME(8),JSPAJBNM Set JOB NAME @H9A 11020000 * 11030000 ********************************************************************** 11040000 * Compose USER ID data 11050000 ********************************************************************** 11060000 * 11070000 #USERID DS 0H @H9A 11080000 TM JSPAFLG1,JSPA1EXT Does JSP Ext Exist? @H9A 11090000 BZ #SYSOUT NO--Branch #SYSOUT @H9A 11100000 * 11110000 USING JSPEXT,@07 Est. Addressability @H9A 11120000 LR @07,@11 Load JSPA Address @H9A 11130000 AH @07,JSPALEN Add JSPA Length @H9A 11140000 * 11150000 MVC PRTUSER(8),JSPCEUID Put USER ID @H9A 11160000 DROP @07 @H9A 11170000 * 11180000 ********************************************************************** 11190000 * Compose SYSOUT CLASS data 11200000 ********************************************************************** 11210000 * 11220000 #SYSOUT DS 0H @H9A 11230000 MVC PRTSCLE(1),JSPJSOCL Set SYSOUT CLASS @H9A 11240000 * 11250000 ********************************************************************** 11260000 * Compose OUTPUT GROUP data 11270000 ********************************************************************** 11280000 * 11290000 #OUTPUTG DS 0H @H9A 11300000 MVC PRTOG1E(8),JSPJGRPN Set JOE NAME @H9A 11310000 MVI PRTOG1E+8,C'.' Set separator @H9A 11320000 MVC PRTOG2E(5),WRKJID1Z+3 Set JOE ID#1 @H9A 11330000 MVI PRTOG2E+5,C'.' Set separator @H9A 11340000 MVC PRTOG3E(5),WRKJID2Z+3 Set JOE ID#2 @H9A 11350000 * 11360000 ********************************************************************** 11370000 * Compose TITLE data 11380000 ********************************************************************** 11390000 * 11400000 #TITLE DS 0H @H9A 11410000 USING SJTRKEYL,@02 Est. addressability @H9A 11420000 ICM @02,B'1111',WRKKYLST Load KEYLIST address @H9A 11430000 BZ #DEST Branch if no KEYLIST @H9A 11440000 * 11450000 LA @02,KYLSTTL(,@02) Locate addr of TITLE @H9A 11460000 * key in the KEYLIST @H9A 11470000 ICM @01,B'1111',SJTRTPAD Load TITLE TU address @H9A 11480000 BZ #DEST Branch if no TITLE @H9A 11490000 * 11500000 LA @06,DOCNTENT-DOCNUNIT(,@01) Addr of TEXT UNIT pair@H9a 11510000 LA @00,PRTTITLE Addr of rcving field @H9A 11520000 LA @01,L'PRTTITLE Length of rcving field@H9A 11530000 * 11540000 BAL @08,MOVETU Get TITLE data from TU@H9A 11550000 DROP @02 11560000 * 11570000 ********************************************************************** 11580000 * Compose DESTINATION data * 11590000 ********************************************************************** 11600000 * 11610000 #DEST DS 0H @H9A 11620000 MVC PRTDEST(8),JSPJGRPD Put DESTINATION @H9A 11630000 * 11640000 ********************************************************************** 11650000 * Compose NAME data * 11660000 ********************************************************************** 11670000 * 11680000 #NAME DS 0H @H9A 11690000 * 11700000 USING SJTRKEYL,@02 Est. addressability @H9A 11710000 ICM @02,B'1111',WRKKYLST Load KEYLIST address @H9A 11720000 BZ NONAME Branch if no KEYLIST @H9A 11730000 * 11740000 LA @02,KYLSTNM(,@02) Locate address of NAME@H9A 11750000 * key in the KEYLIST @H9A 11760000 ICM @01,B'1111',SJTRTPAD Load NAME TU address @H9A 11770000 BZ NONAME Branch if no NAME @H9A 11780000 * 11790000 LA @06,DOCNTENT-DOCNUNIT(,@01) Addr of TEXT UNIT pair@H9A 11800000 LA @00,PRTNAME Addr of rcving field @H9A 11810000 LA @01,L'PRTNAME Length of rcving field@H9A 11820000 * 11830000 BAL @08,MOVETU Get NAME from TU @H9A 11840000 B #ROOM Branch #ROOM @H9A 11850000 * 11860000 NONAME DS 0H @H9A 11870000 MVC PRTNAME(L'JSPJPNAM),JSPJPNAM Put NAME from JSPA @H9A 11880000 DROP @02 @H9A 11890000 * 11900000 ********************************************************************** 11910000 * Compose ROOM data 11920000 ********************************************************************** 11930000 * 11940000 #ROOM DS 0H @H9A 11950000 USING SJTRKEYL,@02 Est. addressability @H9A 11960000 ICM @02,B'1111',WRKKYLST Load KEYLIST address @H9A 11970000 BZ NOROOM Branch if no KEYLIST @H9A 11980000 * 11990000 LA @02,KYLSTRM(,@02) Locate address of ROOM@H9A 12000000 * key in the KEYLIST @H9A 12010000 ICM @01,B'1111',SJTRTPAD Load ROOM TU address @H9A 12020000 BZ NOROOM Branch if no ROOM @H9A 12030000 * 12040000 LA @06,DOCNTENT-DOCNUNIT(,@01) Addr of TEXT UNIT pair@H9A 12050000 LA @00,PRTROOME Addr of rcving field @H9A 12060000 LA @01,L'PRTROOME Length of rcving field@H9A 12070000 * 12080000 BAL @08,MOVETU Get ROOM data from TU @H9A 12090000 B #BLDG Branch to #BLDG @H9A 12100000 NOROOM DS 0H @H9A 12110000 MVC PRTROOME(L'JSPJRMNO),JSPJRMNO Set from job stmt @H9A 12120000 DROP @02 @H9A 12130000 * 12140000 ********************************************************************** 12150000 * Compose BUILDING data * 12160000 ********************************************************************** 12170000 * 12180000 #BLDG DS 0H @H9A 12190000 USING SJTRKEYL,@02 Est addressability @H9A 12200000 ICM @02,B'1111',WRKKYLST Load KEYLIST address @H9A 12210000 BZ #DEPT Branch if no KEYLIST @H9A 12220000 * 12230000 LA @02,KYLSTBL(,@02) Locate address of BLDG@H9A 12240000 * key in the KEYLIST @H9A 12250000 ICM @01,B'1111',SJTRTPAD Load BLDG TU address @H9A 12260000 BZ #DEPT Branch if no BLDG @H9A 12270000 * 12280000 LA @06,DOCNTENT-DOCNUNIT(,@01) Addr of TEXT UNIT pair@H9A 12290000 LA @00,PRTBLDG Addr of rcving field @H9A 12300000 LA @01,L'PRTBLDG Length of rcving field@H9A 12310000 * 12320000 BAL @08,MOVETU Get BLDG data from TU @H9A 12330000 DROP @02 @H9A 12340000 * 12350000 ********************************************************************** 12360000 * Compose DEPARTMENT data * 12370000 ********************************************************************** 12380000 * 12390000 #DEPT DS 0H 12400000 USING SJTRKEYL,@02 Est addressability @H9A 12410000 ICM @02,B'1111',WRKKYLST Load KEYLIST address @H9A 12420000 BZ #ADDRESS Branch if no KEYLIST @H9A 12430000 * 12440000 LA @02,KYLSTDP(,@02) Locate address of DEPT@H9A 12450000 * key in the KEYLIST @H9A 12460000 ICM @01,B'1111',SJTRTPAD Load DEPT TU address @H9A 12470000 BZ #ADDRESS Branch if no DEPT @H9A 12480000 * 12490000 LA @06,DOCNTENT-DOCNUNIT(,@01) Addr of TEXT UNIT pair@H9A 12500000 LA @00,PRTDEPT Addr of rcving field @H9A 12510000 LA @01,L'PRTDEPT Length of rcving field@H9A 12520000 * 12530000 BAL @08,MOVETU Get DEPT data from TU @H9A 12540000 DROP @02 @H9A 12550000 * 12560000 ********************************************************************** 12570000 * * 12580000 * BUILD AND PRINT ADDRESS LINES * 12590000 * ----------------------------- * 12600000 * The address can be from 1 to 4 lines long. Any lines * 12610000 * that are unused must be printed as blank lines, but the * 12620000 * label "ADDRESS:" must appear on the first line even if * 12630000 * no address was specified on the OUTPUT JCL. * 12640000 * * 12650000 * A blank line is printed after the four ADDRESS lines. * 12660000 * * 12670000 * If the SWBTUREQ macro returned an error, the ADDRESS * 12680000 * line is not printed. An error message is printed * 12690000 * in the four lines that would have contained the ADDRESS. * 12700000 * * 12710000 ********************************************************************** 12720000 * 12730000 ********************************************************************** 12740000 * Check for SWBTUREQ error * 12750000 ********************************************************************** 12760000 * 12770000 #ADDRESS DS 0H @H9A 12780000 CLI SWBERR,C'Y' SWBTUREQ error ? @H9A 12790000 BNE ADDRLBL NO-Go print ADDR label@H9A 12800000 * 12810000 ********************************************************************** 12820000 * Compose the SWBTUREQ error message * 12830000 ********************************************************************** 12840000 * 12850000 MVC PRTADDR1(60),LBMSG Set error message text@H9A 12860000 MVC PRTADDR2(L'LBRC),LBRC Set RETURN CODE label @H9A 12870000 MVC PRTADDR2+13(L'SWBRC),SWBRC Set SWBTUREQ return cd@H9A 12880000 MVC PRTADDR3(L'LBRS),LBRS Set REASON CODE label @H9A 12890000 MVC PRTADDR3+13(L'SWBRS),SWBRS Set SWBTUREQ reason cd@H9A 12900000 B PTIME Branch to compose TIME@H9A 12910000 * 12920000 ********************************************************************** 12930000 * Compose ADDRESS data * 12940000 ********************************************************************** 12950000 * 12960000 ADDRLBL DS 0H 12970000 USING SJTRKEYL,@02 Est addressability @H9A 12980000 ICM @02,B'1111',WRKKYLST Load KEYLIST address @H9A 12990000 BZ PTIME Branch if no KEYLIST @H9A 13000000 * 13010000 LA @02,KYLSTAD(,@02) Locate address of ADDR@H9A 13020000 * key in the KEYLIST @H9A 13030000 ICM @01,B'1111',SJTRTPAD Load ADDRESS#1 TU addr@H9A 13040000 BZ PTIME Branch if no ADDRESS#1@H9A 13050000 * 13060000 LH @07,DOCNTNUM-DOCNUNIT(,@01) Load number of ADDRESS@H9A 13070000 * TU pairs 13080000 LTR @07,@07 Number of TU pairs >0?@H9A 13090000 BZ PTIME Branch if no ADDRESS#1@H9A 13100000 * 13110000 LA @01,DOCNTENT-DOCNUNIT(,@01) Addr of TEXT UNIT pair@H9A 13120000 LR @06,@01 Save TEXT UNIT pr addr@H9A 13130000 LA @00,PRTADDR1 Addr of rcving field @H9A 13140000 LA @01,L'PRTADDR1 Length of rcving field@H9A 13150000 BAL @08,MOVETU Get ADDR data from TU @H9A 13160000 * 13170000 BCT @07,#ADDR2 Subt 1 and GOTO #ADDR2@H9A 13180000 B PTIME When zero-branch PTIME@H9A 13190000 * 13200000 #ADDR2 DS 0H 13210000 USING DOCNTFLD,@06 Est addressability @H9A 13220000 LH @15,DOCNTLEN Bump down to next @H9A 13230000 LA @06,L'DOCNTLEN(@15,@06) ADDR length/data pair@H9A 13240000 * 13250000 LA @00,PRTADDR2 Addr of rcving field @H9A 13260000 LA @01,L'PRTADDR2 Length of rcving field@H9A 13270000 BAL @08,MOVETU Get ADDR data from TU @H9A 13280000 * 13290000 BCT @07,#ADDR3 Subt 1 and GOTO #ADDR3@H9A 13300000 B PTIME When zero-branch PTIME@H9A 13310000 * 13320000 #ADDR3 DS 0H @H9A 13330000 LH @15,DOCNTLEN Bump down to next @H9A 13340000 LA @06,L'DOCNTLEN(@15,@06) ADDR length/data pair@H9A 13350000 * 13360000 LA @00,PRTADDR3 Addr of rcving field @H9A 13370000 LA @01,L'PRTADDR3 Length of rcving field@H9A 13380000 * 13390000 BAL @08,MOVETU Get ADDR data from TU @H9A 13400000 * 13410000 BCT @07,#ADDR4 Subt 1 and GOTO #ADDR4@H9A 13420000 B PTIME When zero-branch PTIME@H9A 13430000 #ADDR4 DS 0H @H9A 13440000 LH @15,DOCNTLEN Bump down to next @H9A 13450000 LA @06,L'DOCNTLEN(@15,@06) ADDR length/data pair@H9A 13460000 * 13470000 LA @00,PRTADDR4 Addr of rcving field @H9A 13480000 LA @01,L'PRTADDR4 Length of rcving field@H9A 13490000 * 13500000 BAL @08,MOVETU Get ADDR data from TU @H9A 13510000 DROP @06 @H9A 13520000 DROP @02 @H9A 13530000 * 13540000 ********************************************************************** 13550000 * COMPOSE PRINT TIME 13560000 ********************************************************************** 13570000 * 13580000 PTIME DS 0H @H9A 13590000 * 13600000 MVC PRTHRE(2),WRKHR Set current hour @H9A 13610000 MVI PRTTS1,X'7A' Set time separator @H9A 13620000 MVC PRTMINE(2),WRKMIN Set current minute @H9A 13630000 MVI PRTTS2,X'7A' Set time separator @H9A 13640000 MVC PRTSECE(2),WRKSEC Set current second @H9A 13650000 MVC PRTAMPME(2),WRKAMPM Set AM/PM @H9A 13660000 * 13670000 ********************************************************************** 13680000 * COMPOSE PRINT DATE 13690000 ********************************************************************** 13700000 * 13710000 PDATE DS 0H @H9A 13720000 * 13730000 MVC PRTDDD(2),WRKDD Put today's DAY @H9A 13740000 MVC PRTMMM(3),WRKMMM Put today's MONTH @H9A 13750000 MVC PRTCCC(2),WRKCEN Put today's CENTURY @01A 13760000 MVC PRTYYY(2),WRKYY Put today's YEAR @H9A 13770000 * 13780000 ********************************************************************** 13790000 * Compose PRINTER ID 13800000 ********************************************************************** 13810000 * 13820000 #PRINTER DS 0H @H9A 13830000 MVC PRTNME(8),JSPADEVN Printer name @H9A 13840000 * 13850000 ********************************************************************** 13860000 * Compose SYSTEM ID 13870000 ********************************************************************** 13880000 * 13890000 #SYSID DS 0H @H9A 13900000 USING JMR,@07 Base JMR @H9A 13910000 L @07,JSPAJMR Load address of JMR @H9A 13920000 MVC PRTSIDE(4),JMRCPUID SYSTEM ID @H9A 13930000 ********************************************************************** 13940000 * When running in an MAS environment and you want the system ID 13950000 * of the system on which the job was printed, uncomment the 13960000 * following 3 lines, compile, and linkedit the exit. @DYA 13970000 ********************************************************************** 13980000 * L @02,CVTPTR LOCATE @DYA 13990000 * L @02,CVTSMCA-CVT(,@02) SMCA @DYA 14000000 * MVC PRTSIDE(4),SMCASID-SMCABASE(@02) USE SMF ID @DYA 14010000 DROP @07 @H9A 14020000 * 14030000 ********************************************************************** 14040000 * Compose START/CONT tag * 14050000 ********************************************************************** 14060000 * 14070000 #TAG DS 0H 14080000 TM JSPAFLG1,JSPA1CON Is this continuation? @H9A 14090000 BNZ TAGCONT YES--branch TAGCONT @H9A 14100000 TAGSTART DS 0H @H9A 14110000 MVC PRTTAG(5),START Move in START tag @H9A 14120000 B PRT_CTX Branch PRT_CTX @H9A 14130000 TAGCONT DS 0H @H9A 14140000 MVC PRTTAG(5),CONT Movein CONT tag @H9A 14150000 * 14160000 ********************************************************************** 14170000 * Write the detail box CTX * 14180000 ********************************************************************** 14190000 * 14200000 PRT_CTX DS 0H @H9A 14210000 L @14,=A(PRTWRKLN) Get lngth of info line@H9A 14220000 ST @14,ECARECLN Str lngth of info line@H9A 14230000 * 14240000 OI ECADRF,ECADSR Indicate data strm rec@H9A 14250000 OI ECADRF,ECAANSI Set ANSI CHAR cntrl @H9A 14260000 * 14270000 LA @14,PRTWRKE Get addr of info line @H9A 14280000 ST @14,ECARECAD Store info line addr @H9A 14290000 * 14300000 L @15,ECAPUTP CALL @H9A 14310000 BALR @14,@15 APSUPUT @H9A 14320000 B OUT Branch to PSF @H9A 14330000 EJECT 14340000 * 14350000 *********************************************************************** 14360000 * * 14370000 * MOVETU - Move the TU text from the TU output area to the * 14380000 * detail box. * 14390000 * * 14400000 * FUNCTION: * 14410000 * * 14420000 * This subroutine is called to move the TU text from the * 14430000 * TU output area to the detail box. Since * 14440000 * TUs are variable length (up to sixty characters long), * 14450000 * the detail line is padded with blanks on the right after * 14460000 * the move is performed. * 14470000 * * 14480000 * LINKAGE: * 14490000 * * 14500000 * Accessed via BAL using the label as the entry address * 14510000 * and register 8 as the return address. * 14520000 * * 14530000 * INPUT: * 14540000 * R0 - Address of the receiving field * 14550000 * R1 - Length of the receiving field * 14560000 * R6 - Address of TU length/parameter pair * 14570000 * * 14580000 * OUTPUT: * 14590000 * The text from the TU parameter is copied into the * 14600000 * detail box. * 14610000 * * 14620000 * REGISTER USAGE: * 14630000 * * 14640000 * REG VALUE ON ENTRY VALUE ON EXIT * 14650000 * * 14660000 * R0 Rcving Field Address Unchanged * 14670000 * R1 Rcving Field Length Unchanged * 14680000 * R2-R5 N/A Unchanged * 14690000 * R6 Length/parameter pair Unchanged * 14700000 * R7 N/A Unchanged * 14710000 * R8 Return Address Unchanged * 14720000 * R9-R13 N/A Unchanged * 14730000 * R14-R15 N/A Destroyed * 14740000 * * 14750000 * RETURN CODES: * 14760000 * * 14770000 * None * 14780000 * * 14790000 * OTHER CONSIDERATIONS: * 14800000 * * 14810000 * None * 14820000 * * 14830000 *********************************************************************** 14840000 * 14850000 MOVETU DS 0H @H9A 14860000 USING DOCNTFLD,@06 Est addressability @H9A 14870000 LA @14,DOCNTPRM Load TU text address @H9A 14880000 LH @15,DOCNTLEN Length of TU text @H9A 14890000 ICM @15,B'1000',BLANKS Set pad char to blank @H9A 14900000 * 14910000 * @00 POINTS TO THE RECEIVING FIELD 14920000 * @01 CONTAINS LENGTH OF THE RECEIVING FIELD 14930000 * 14940000 MVCL @00,@14 Move the TU text @H9A 14950000 BR @08 Return to caller @H9A 14960000 DROP @06 @H9A 14970000 * 14980000 ********************************************************************** 14990000 * 15000000 .NOESS02 ANOP @H9A 15010000 * 15020000 ********************************************************************** 15030000 * 15040000 PSIZE EQU ((*-APSUX01+99)/100)*5 PATCH AREA SIZE 15050000 DC C'PATCH AREA - APSUX01 88.XXX' 15060000 PSPACE DC 25S(*) PATCH AREA 15070000 ORG PSPACE 15080000 DC ((PSIZE+1)/2)S(*) 15090000 ORG , 15100000 DATA DS 0H 15110000 * 15120000 ********************************************************************** 15130000 * MISC CONSTANTS 15140000 ********************************************************************** 15150000 * 15160000 NINEFOUR DC H'94' BLOCK LETTER LINE LENGTH + 15170000 * LENGTH OF TEXT CONTROL 15180000 BEG DC H'926' POINTER TO THE BEGINNING 15190000 * OF THE LAST LINE OF BLOCK 15200000 * LETTERS 15210000 END DC H'1009' POINTER TO THE END OF THE 15220000 * LAST LINE OF BLOCK LETTER 15230000 LINELGTH DC F'84' BLOCK LETTER LINE LENGTH 15240000 CTXLGTH DC F'184' LENGTH OF COMPOSED TEXT 15250000 * DATA AREA FOR BOXES 15260000 PRTLGTH DC F'356' LENGTH OF COMPOSED TEXT 15270000 * DATA AREA FOR INFO 15280000 * PRINT LINES @01C 15290000 BLKLGTH DC F'1138' LENGTH OF COMPOSED TEXT 15300000 * DATA AREA FOR BLOCK 15310000 * LETTERS 15320000 BLANKS DC CL8' ' Constant eight X'40' @H9A 15330000 XZERO DC F'0' Constant X'00' @H9A 15340000 FOUR DC F'4' Constant 4 @H9A 15350000 NINETEEN DC F'19' @01A 15360000 MAXSEG# DC PL8'99999' @H9A 15370000 PZERO DC PL8'00000' @H9A 15380000 * 15390000 LBLSEGID DC C'SEGMENT ID: ' SEGMENT ID label @H9A 15400000 * 15410000 LBMSG DC CL(L'PRTADDR1)'EXIT ERROR -- SWBTUREQ MACRO FAILED' 15420000 * 15430000 LBRC DC CL12'RETURN CODE:' @H9A 15440000 LBRS DC CL12'REASON CODE:' @H9A 15450000 * 15460000 ********************************************************************** 15470000 * INFORMATION PRINT LINE HEADINGS 15480000 ********************************************************************** 15490000 * 15500000 HEADP0 DC C'JOB NUMBER: ' 15510000 HEADP1 DC C'SYSOUT CLASS: ' 15520000 HEADP2 DC C'PRINTER: ' 15530000 HEADP3 DC C'SYSTEM ID: ' 15540000 HEADP4 DC C'PRINT DATE: ' 15550000 HEADP5 DC C'PRINT TIME: ' 15560000 HEADP6 DC C'USER: ' 15570000 HEADP7 DC C'JOB NAME: ' 15580000 HEADP8 DC C'OUTPUT GROUP: ' 15590000 HEADP9 DC C'ROOM: ' 15600000 START DC C'START' 15610000 CONT DC C' CONT' 15620000 AM DC C'AM' 15630000 * 15640000 ********************************************************************** 15650000 * TEXT CONTROL CONSTANTS (Original Header Sheet) 15660000 ********************************************************************** 15670000 * 15680000 DRB2 DC X'07E7068F00090007E506BC000900' DRAW 15690000 DRB4 DC X'07E5F944FFF70007E7F971FFF700' RULE 15700000 DRB6 DC X'07E7003600090007E500B4000900' TEXT 15710000 DRB8 DC X'07E70036FFF700' CONTROLS 15720000 DRT2 DC X'07E704B000030007E5067C000300' TO 15730000 DRT4 DC X'07E7FB70FFFD0007E5F984FFFD00' PRINT 15740000 DRT6 DC X'07E701A4000300' BOLD 15750000 DRT8 DC X'07E7FE2000030007E502EEFFFD00' AND THIN 15760000 DRT0 DC X'07E7FE20FFFD0007E5FD20FFFD00' BOXES 15770000 SFI01 DC X'00B8D3EE9B0006002BD3' STRUCTURE FIELD INTRODUCER 15780000 * FOR BOXES 15790000 SFI02 DC X'0472D3EE9B0005002BD3' STRUCTURE FIELD INTRODUCER 15800000 * FOR BLOCK LETTERS 15810000 SFI03 DC X'0164D3EE9B0009002BD3' STRUCTURE FIELD INTRODUCER 15820000 * FOR INFO LINES @01C 15830000 AMB1 DC X'04D3000004C70042' ABSULUTE 15840000 AMB3 DC X'04D3068F04C706FE' MOVE 15850000 AMB5 DC X'04D3065404C7034F' INLINES 15860000 AMB7 DC X'04C70403' AND 15870000 AMT1 DC X'04D3002004C70062' ABSOLUTE 15880000 AMT3 DC X'04D304B004C706DE' MOVE 15890000 AMT5 DC X'04C703A8' BASELINES 15900000 AMT7 DC X'04C7006204D3066F' TO 15910000 AMT9 DC X'04C706DE' CONTROL 15920000 AMP0 DC X'04D3050A04C700D2' THE 15930000 AMP1 DC X'04D3054604C700D2' STARTING 15940000 AMP2 DC X'04D3058204C700D2' POSITIONS 15950000 AMP3 DC X'04D305BE04C700D2' FOR 15960000 AMP4 DC X'04D305FA04C700D2' THE 15970000 AMP5 DC X'04D3063604C700D2' DRAW 15980000 AMP6 DC X'04D3050A04C7041A' RULES 15990000 AMP7 DC X'04D3054604C7041A' 16000000 AMP8 DC X'04D3058204C7041A' 16010000 AMP9 DC X'04D305BE04C7041A' 16020000 AMP10 DC X'04D3068104C70375' 16030000 YPOS1 DC X'04D5001404C70073' RELATIVE MOVE INLINE AND 16040000 * ABSOLUTE MOVE BASELINE FOR 16050000 * LINES 2-12 OF BLK LETTERS 16060000 YPOS2 DC X'04D30168' ABSOLUTE MOVE INLINE FOR 16070000 * LINE 1 OF BLK LETTERS 16080000 NOP DC X'02F8' 16090000 SLL DC X'0073' INLINE POSITION-SLANT LEFT 16100000 SLC DC X'005A' INLINE POSITION-SLANT CENTER 16110000 STL DC X'00C9' INLINE POSITION-STRAIGHT LEFT 16120000 STC DC X'0056' INLINE POSITION-STRAIGHT CENTER 16130000 TRN1 DC X'56DB' TRN FOR 16140000 TRN2 DC X'56DA' BLOCK LETTERS 16150000 TRNP0 DC X'18DB' TRN FOR JOB #, PRINTER NAME 16160000 TRNP1 DC X'11DB' TRN FOR SYSOUT CLASS 16170000 TRNP3 DC X'14DB' TRN FOR SYSTEM ID 16180000 TRNP4 DC X'1BDB' TRN FOR PRINT DATE @01C 16190000 TRNP5 DC X'1BDB' TRN FOR PRINT TIME 16200000 TRNP6 DC X'24DB' TRN FOR USER NAME 16210000 TRNP8 DC X'20DB' TRN FOR OUTPUT GROUP 16220000 TRNP10 DC X'07DA' TRN FOR HEADER TYPE 16230000 ZEROES DC X'000000000000' 16240000 * 16250000 ********************************************************************** 16260000 * 16270000 * Conditional assembly check for ESS 16280000 * 16290000 * The code between the AIF and the label .NOESS03 will be 16300000 * suppressed if SYSPARM is NULL. 16310000 * 16320000 ********************************************************************** 16330000 * 16340000 AIF ('&SYSPARM' EQ '').NOESS03 Branch - ESS not supp @H9A 16350000 * 16360000 ********************************************************************** 16370000 * Key list equates * 16380000 ********************************************************************** 16390000 * 16400000 KYLSTTL EQU 0*SJTRKLEN Title key @H9A 16410000 KYLSTNM EQU 1*SJTRKLEN Name key @H9A 16420000 KYLSTRM EQU 2*SJTRKLEN Room key @H9A 16430000 KYLSTBL EQU 3*SJTRKLEN Building key @H9A 16440000 KYLSTDP EQU 4*SJTRKLEN Dept key @H9A 16450000 KYLSTAD EQU 5*SJTRKLEN Address key @H9A 16460000 * 16470000 ********************************************************************** 16480000 * 16490000 .NOESS03 ANOP @H9A 16500000 * 16510000 ********************************************************************** 16520000 * Constants for AFPDS 16530000 ********************************************************************** 16540000 * 16550000 AMB EQU X'04D3' Absolute move baseline @H9A 16560000 AMI EQU X'04C7' Absolute move inline @H9A 16570000 RMB EQU X'04D5' Relative move baseline @H9A 16580000 DBR EQU X'07E7' Draw baseline rule @H9A 16590000 DIR EQU X'07E5' Draw inline rule @H9A 16600000 BOLD EQU 9 Bold line 9 l-units wide @H9A 16610000 THIN EQU 3 Thin line 3 l-units wide @H9A 16620000 * 16630000 ********************************************************************** 16640000 * EQUATES FOR REGISTERS 0-15 16650000 ********************************************************************** 16660000 * 16670000 @00 EQU 00 16680000 @01 EQU 01 16690000 @02 EQU 02 16700000 @03 EQU 03 16710000 @04 EQU 04 16720000 @05 EQU 05 16730000 @06 EQU 06 16740000 @07 EQU 07 16750000 @08 EQU 08 16760000 @09 EQU 09 16770000 @10 EQU 10 16780000 @11 EQU 11 16790000 @12 EQU 12 16800000 @13 EQU 13 16810000 @14 EQU 14 16820000 @15 EQU 15 16830000 * 16840000 ********************************************************************** 16850000 * POINTER REGISTERS AND ROUTINES 16860000 ********************************************************************** 16870000 * 16880000 JSPAPTR EQU @11 JSPA POINTER 16890000 PUTPTR EQU @10 APSUPUT POINTER 16900000 WRKPTR EQU @02 WORK AREA POINTER 16910000 AMPMPTR EQU @08 POINTER TO AM/PM AREA IN 16920000 * INFO PRINT LINE 16930000 XTPPTR EQU @04 APSGEXTP POINTER 16940000 ECAPTR EQU @05 APSUECA POINTER 16950000 JMRPTR EQU @07 IEFJMR POINTER 16960000 ECAWKPTR EQU @09 ECA WORK BUF POINTER 16970000 RTNCODE EQU @15 RETURN CODE 16980000 APSUPUT EQU 0 PUT RECORD TO PSF ROUTINE 16990000 APSUBLK EQU 0 CREATE BLK LETTER ROUTINE 17000000 DAYTBL EQU 0 LEAP YEAR ADJUSTMENT TABLE 17010000 BLKPTR EQU ECABLKP APSUBLK POINTER 17020000 BUFWRK EQU ECAWKBUF 17030000 BLKCHAR EQU BUFWRK BUFFER FOR BLK LETTERS 17040000 * 17050000 ********************************************************************** 17060000 * Constants to draw boxes (ESS) 17070000 ********************************************************************** 17080000 * 17090000 ESSBOX DS 0H AFPDS to draw boxes @H9A 17100000 DC X'5A' Carriage control @H9A 17110000 ESSLEN DC AL2(ESSLNGTH-1) Length of data @H9A 17120000 DC X'D3EE9B0000012BD3' CTX structured field @H9A 17130000 * introducer for boxes @H9A 17140000 DC AL2(AMB) Position @H9A 17150000 DC AL2(0) baseline 0 l-units @H9A 17160000 DC AL2(AMI) and @H9A 17170000 DC AL2(66) inline 66 l-units @H9A 17180000 DC AL2(DBR) Draw @H9A 17190000 DC AL2(1679) left side (1679 l-units) @H9A 17200000 DC AL2(BOLD) of outer box @H9A 17210000 DC AL1(0) @H9A 17220000 DC AL2(DIR) Draw @H9A 17230000 DC AL2(1724) top side (1724 l-units) @H9A 17240000 DC AL2(BOLD) of outer box @H9A 17250000 DC AL1(0) @H9A 17260000 DC AL2(AMB) Position @H9A 17270000 DC AL2(1679) baseline 1679 l-units @H9A 17280000 DC AL2(AMI) and @H9A 17290000 DC AL2(1790) inline 1790 l-units @H9A 17300000 DC AL2(DIR) Draw @H9A 17310000 DC AL2(-1724) bottom side (-1724) @H9A 17320000 DC AL2(-BOLD) of outer box @H9A 17330000 DC AL1(0) @H9A 17340000 DC AL2(DBR) Draw @H9A 17350000 DC AL2(-1679) right side (-1679) @H9A 17360000 DC AL2(-BOLD) of outer box @H9A 17370000 DC AL1(0) @H9A 17380000 DC AL2(AMB) Position @H9A 17390000 DC AL2(1620) baseline 1620 l-units @H9A 17400000 DC AL2(AMI) and @H9A 17410000 DC AL2(847) inline 847 l-units @H9A 17420000 DC AL2(DBR) Draw @H9A 17430000 DC AL2(54) left side (54 l-units) @H9A 17440000 DC AL2(BOLD) of "START/CONT" box @H9A 17450000 DC AL1(0) @H9A 17460000 DC AL2(DIR) Draw @H9A 17470000 DC AL2(180) top side (180 l-units) @H9A 17480000 DC AL2(BOLD) of "START/CONT" box @H9A 17490000 DC AL1(0) @H9A 17500000 DC AL2(AMI) Position @H9A 17510000 DC AL2(1027) inline 1027 l-units @H9A 17520000 DC AL2(DBR) Draw @H9A 17530000 DC AL2(54) right side (54 l-units) @H9A 17540000 DC AL2(-BOLD) of "START/CONT" box @H9A 17550000 DC AL1(0) @H9A 17560000 DC AL2(AMB) Position @H9A 17570000 DC AL2(32) baseline 32 l-units @H9A 17580000 DC AL2(AMI) and @H9A 17590000 DC AL2(98) inline 98 l-units @H9A 17600000 DC AL2(DBR) Draw @H9A 17610000 DC AL2(780) upper left side (780) @H9A 17620000 DC AL2(THIN) of thin inner box @H9A 17630000 DC AL1(0) @H9A 17640000 DC AL2(DIR) Draw @H9A 17650000 DC AL2(1660) top side (1660 l-units) @H9A 17660000 DC AL2(THIN) of thin inner box @H9A 17670000 DC AL1(0) @H9A 17680000 DC AL2(AMB) Position @H9A 17690000 DC AL2(812) baseline 812 l-units @H9A 17700000 DC AL2(AMI) and @H9A 17710000 DC AL2(1758) inline 1758 l-units @H9A 17720000 DC AL2(DBR) Draw @H9A 17730000 DC AL2(-780) upper right side (-780) @H9A 17740000 DC AL2(-THIN) of thin inner box @H9A 17750000 DC AL1(0) @H9A 17760000 DC AL2(DIR) Draw @H9A 17770000 DC AL2(-1660) middle divider (-1660) @H9A 17780000 DC AL2(-THIN) of thin inner box @H9A 17790000 DC AL1(0) @H9A 17800000 DC AL2(AMB) Position @H9A 17810000 DC AL2(1647) baseline 1647 l-units @H9A 17820000 DC AL2(AMI) and @H9A 17830000 DC AL2(98) inline 98 l-units @H9A 17840000 DC AL2(DBR) Draw @H9A 17850000 DC AL2(-835) lower left side (-835) @H9A 17860000 DC AL2(THIN) of thin inner box @H9A 17870000 DC AL1(0) @H9A 17880000 DC AL2(DIR) Draw @H9A 17890000 DC AL2(750) left bottom side (750) @H9A 17900000 DC AL2(-THIN) of thin inner box @H9A 17910000 DC AL1(0) @H9A 17920000 DC AL2(AMB) Position @H9A 17930000 DC AL2(1647) baseline 1647 l-units @H9A 17940000 DC AL2(AMI) and @H9A 17950000 DC AL2(1758) inline 1758 l-units @H9A 17960000 DC AL2(DBR) Draw @H9A 17970000 DC AL2(-835) lower right side (-835) @H9A 17980000 DC AL2(-THIN) of thin inner box @H9A 17990000 DC AL1(0) @H9A 18000000 DC AL2(DIR) Draw @H9A 18010000 DC AL2(-736) right bottom side (-736)@H9A 18020000 DC AL2(-THIN) of thin inner box @H9A 18030000 DC AL1(0) @H9A 18040000 DC X'02F8' NOP, UNCHAINED @H9A 18050000 ESSLNGTH EQU *-ESSBOX @H9A 18060000 * 18070000 ********************************************************************** 18080000 * Constants for ESS Detail Box * 18090000 ********************************************************************** 18100000 * 18110000 ESSAREA DS 0H AFPDS for ESS box lines @H9A 18120000 DC X'5A' Carriage control @H9A 18130000 ESSDLEN DC AL2(ESSDLNTH-1) Length @H9A 18140000 DC X'D3EE9B0000032BD3' CTX introducer @H9A 18150000 * for ESS lines @H9A 18160000 DC AL2(AMI) Set inline @H9A 18170000 DC AL2(128) for JOB NUMBER @H9A 18180000 DC AL2(AMB) Set baseline @H9A 18190000 DC AL2(900) for JOB NUMBER @H9A 18200000 DC X'19DB' TRN @H9A 18210000 DC C'JOBID ' Heading @H9A 18220000 DC CL8' ' JOB NUMBER @H9A 18230000 * @H9A 18240000 DC AL2(AMI) Set inline @H9A 18250000 DC AL2(128) for JOB NAME @H9A 18260000 DC AL2(AMB) Set baseline @H9A 18270000 DC AL2(930) for JOB NAME @H9A 18280000 DC X'19DB' TRN @H9A 18290000 DC C'JOB NAME: ' Heading @H9A 18300000 DC CL8' ' JOB NAME @H9A 18310000 * @H9A 18320000 DC AL2(AMI) Set inline @H9A 18330000 DC AL2(128) for USER ID @H9A 18340000 DC AL2(AMB) Set baseline @H9A 18350000 DC AL2(960) for USER ID @H9A 18360000 DC X'19DB' TRN @H9A 18370000 DC C'USERID: ' Heading @H9A 18380000 DC CL8' ' USERID @H9A 18390000 * @H9A 18400000 DC AL2(AMI) Set inline @H9A 18410000 DC AL2(128) for SYSOUT CLASS @H9A 18420000 DC AL2(AMB) Set baseline @H9A 18430000 DC AL2(990) for SYSOUT CLASS @H9A 18440000 DC X'12DB' TRN @H9A 18450000 DC C'SYSOUT CLASS: ' Heading @H9A 18460000 DC CL1' ' SYSOUT CLASS @H9A 18470000 * @H9A 18480000 DC AL2(AMI) Set inline @H9A 18490000 DC AL2(128) for OUTPUT GRP @H9A 18500000 DC AL2(AMB) Set baseline @H9A 18510000 DC AL2(1020) for OUTPUT GRP @H9A 18520000 DC X'25DB' TRN @H9A 18530000 DC C'OUTPUT GROUP: ' Heading @H9A 18540000 DC CL20' ' OUTPUT GROUP @H9A 18550000 * @H9A 18560000 DC AL2(AMI) Set inline @H9A 18570000 DC AL2(128) for TITLE @H9A 18580000 DC AL2(AMB) Set baseline @H9A 18590000 DC AL2(1050) for TITLE @H9A 18600000 DC X'4DDB' TRN @H9A 18610000 DC C'TITLE: ' Heading @H9A 18620000 DC CL60' ' TITLE @H9A 18630000 * @H9A 18640000 DC AL2(AMI) Set inline @H9A 18650000 DC AL2(128) for DESTINATION @H9A 18660000 DC AL2(AMB) Set baseline @H9A 18670000 DC AL2(1110) for DESTINATION @H9A 18680000 DC X'19DB' TRN @H9A 18690000 DC C'DESTINATION: ' Heading @H9A 18700000 DC CL8' ' DESTINATION @H9A 18710000 * @H9A 18720000 DC AL2(AMI) Set inline @H9A 18730000 DC AL2(128) for NAME @H9A 18740000 DC AL2(AMB) Set baseline @H9A 18750000 DC AL2(1140) for NAME @H9A 18760000 DC X'4DDB' TRN @H9A 18770000 DC C'NAME: ' Heading @H9A 18780000 DC CL60' ' NAME @H9A 18790000 * @H9A 18800000 DC AL2(AMI) Set inline @H9A 18810000 DC AL2(128) for ROOM @H9A 18820000 DC AL2(AMB) Set baseline @H9A 18830000 DC AL2(1170) for ROOM @H9A 18840000 DC X'4DDB' TRN @H9A 18850000 DC C'ROOM: ' Heading @H9A 18860000 DC CL60' ' ROOM @H9A 18870000 * @H9A 18880000 DC AL2(AMI) Set inline @H9A 18890000 DC AL2(128) for BUILD @H9A 18900000 DC AL2(AMB) Set baseline @H9A 18910000 DC AL2(1200) for BUILD @H9A 18920000 DC X'4DDB' TRN @H9A 18930000 DC C'BUILDING: ' Heading @H9A 18940000 DC CL60' ' BUILDING @H9A 18950000 * @H9A 18960000 DC AL2(AMI) Set inline @H9A 18970000 DC AL2(128) for DEPT @H9A 18980000 DC AL2(AMB) Set baseline @H9A 18990000 DC AL2(1230) for DEPT @H9A 19000000 DC X'4DDB' TRN @H9A 19010000 DC C'DEPARTMENT: ' Heading @H9A 19020000 DC CL60' ' DEPARTMENT data @H9A 19030000 * @H9A 19040000 DC AL2(AMI) Set inline @H9A 19050000 DC AL2(128) for ADDR line #1 @H9A 19060000 DC AL2(AMB) Set baseline @H9A 19070000 DC AL2(1260) for ADDR line #1 @H9A 19080000 DC X'4DDB' TRN @H9A 19090000 DC C'ADDRESS: ' Heading @H9A 19100000 DC CL60' ' ADDR line #1 data @H9A 19110000 * @H9A 19120000 DC AL2(AMI) Set inline @H9A 19130000 DC AL2(128) for ADDR line #2 @H9A 19140000 DC AL2(AMB) Set baseline @H9A 19150000 DC AL2(1290) for ADDR line #2 @H9A 19160000 DC X'4DDB' TRN @H9A 19170000 DC C' ' Heading @H9A 19180000 DC CL60' ' ADDR line #2 data @H9A 19190000 * @H9A 19200000 DC AL2(AMI) Set inline @H9A 19210000 DC AL2(128) for ADDR line #3 @H9A 19220000 DC AL2(AMB) Set baseline @H9A 19230000 DC AL2(1320) for ADDR line #3 @H9A 19240000 DC X'4DDB' TRN @H9A 19250000 DC C' ' Heading @H9A 19260000 DC CL60' ' ADDR line #3 data @H9A 19270000 * @H9A 19280000 DC AL2(AMI) Set inline @H9A 19290000 DC AL2(128) for ADDR line #4 @H9A 19300000 DC AL2(AMB) Set baseline @H9A 19310000 DC AL2(1350) for ADDR line #4 @H9A 19320000 DC X'4DDB' TRN @H9A 19330000 DC C' ' Heading @H9A 19340000 DC CL60' ' ADDR line #4 data @H9A 19350000 * @H9A 19360000 DC AL2(AMI) Set inline @H9A 19370000 DC AL2(128) for PRINT TIME @H9A 19380000 DC AL2(AMB) Set baseline @H9A 19390000 DC AL2(1410) for PRINT TIME @H9A 19400000 DC X'1CDB' TRN @H9A 19410000 DC C'PRINT TIME: ' Heading @H9A 19420000 DC CL11' ' PRINT TIME @H9A 19430000 * @H9A 19440000 DC AL2(AMI) Set inline @H9A 19450000 DC AL2(128) for PRINT DATE @H9A 19460000 DC AL2(AMB) Set baseline @H9A 19470000 DC AL2(1440) for PRINT DATE @H9A 19480000 DC X'1CDB' TRN @01C 19490000 DC C'PRINT DATE: ' Heading @H9A 19500000 DC CL11' ' PRINT DATE @01C 19510000 * @H9A 19520000 DC AL2(AMI) Set inline @H9A 19530000 DC AL2(128) for PRINTER @H9A 19540000 DC AL2(AMB) Set baseline @H9A 19550000 DC AL2(1470) for PRINTER @H9A 19560000 DC X'19DB' TRN @H9A 19570000 DC C'PRINTER: ' Heading @H9A 19580000 DC CL8' ' PRINTER @H9A 19590000 * @H9A 19600000 DC AL2(AMI) Set inline @H9A 19610000 DC AL2(128) for SYSTEM ID @H9A 19620000 DC AL2(AMB) Set baseline @H9A 19630000 DC AL2(1500) for SYSTEM ID @H9A 19640000 DC X'15DB' TRN @H9A 19650000 DC C'SYSTEM ID: ' Heading @H9A 19660000 DC CL4' ' SYSTEM ID @H9A 19670000 * @H9A 19680000 DC AL2(AMI) Set inline @H9A 19690000 DC AL2(885) for "START" / "CONT" @H9A 19700000 DC AL2(AMB) Set baseline @H9A 19710000 DC AL2(1665) for "START" / "CONT" @H9A 19720000 DC X'07DB' TRN @H9A 19730000 DC CL5' ' "START" or "CONT" @H9A 19740000 * @H9A 19750000 DC AL2(AMI) Set inline @H9A 19760000 DC AL2(860) for SEGMENT ID @H9A 19770000 DC AL2(AMB) Set baseline @H9A 19780000 DC AL2(900) for SEGMENT ID @H9A 19790000 DC X'15DB' TRN @H9A 19800000 DC CL15' ' Heading @H9A 19810000 DC CL4' ' SEGMENT ID @H9A 19820000 * @H9A 19830000 DC X'02F8' NOP, UNCHAINED @H9A 19840000 ESSDLNTH EQU *-ESSAREA @H9A 19850000 * 19860000 ********************************************************************** 19870000 * COMPOSED TEXT DATA AREA FOR BOXES (Original Header) 19880000 ********************************************************************** 19890000 * 19900000 BOXCTX DSECT 19910000 BOXSFI DS CL10 19920000 BOXBOLD DS CL77 19930000 ORG BOXBOLD 19940000 BOXB1 DS CL8 19950000 BOXB2 DS CL14 19960000 BOXB3 DS CL8 19970000 BOXB4 DS CL14 19980000 BOXB5 DS CL8 19990000 BOXB6 DS CL14 20000000 BOXB7 DS CL4 20010000 BOXB8 DS CL7 20020000 BOXTHIN DS CL95 20030000 ORG BOXTHIN 20040000 BOXT1 DS CL8 20050000 BOXT2 DS CL14 20060000 BOXT3 DS CL8 20070000 BOXT4 DS CL14 20080000 BOXT5 DS CL4 20090000 BOXT6 DS CL7 20100000 BOXT7 DS CL8 20110000 BOXT8 DS CL14 20120000 BOXT9 DS CL4 20130000 BOXT0 DS CL14 20140000 BOXNOP DS CL2 20150000 * 20160000 ********************************************************************** 20170000 * COMPOSED TEXT DATA AREA FOR BLOCK LETTERS (Both header sheets) 20180000 ********************************************************************** 20190000 * 20200000 BLKWRK DSECT 20210000 DS CL200 20220000 BLKCTX DS CL1138 20230000 ORG BLKCTX 20240000 BLKSFI DS CL10 20250000 BLKPRINT DS CL94 20260000 ORG BLKPRINT 20270000 BLKPOS DS CL8 20280000 ORG BLKPOS 20290000 BLKY DS CL4 20300000 DS CL2 20310000 BLKX DS CL2 20320000 BLKTRN DS CL2 20330000 BLKTEXT DS CL84 20340000 * THE MAPPING OF BLKPRINT WILL REPEAT 11 TIMES MORE FOLLOWING HERE 20350000 * TO REPRESENT 12 BLOCK LETTER LINES 20360000 ********************************************************************** 20370000 * MISC VARIABLES FOR BLOCK LETTER PROCESSING 20380000 ********************************************************************** 20390000 ORG BLKWRK+1338 20400000 FROM DS H 20410000 TO DS H 20420000 XPOS DS CL2 20430000 TEMPBUF DS CL84 20440000 * 20450000 ********************************************************************** 20460000 * COMPOSED TEXT DATA AREA FOR BOXES (ESS) 20470000 ********************************************************************** 20480000 * 20490000 BOXWRK DSECT @H9A 20500000 BOXCTXN DS CL(ESSLNGTH) @H9A 20510000 BOXWRKLN EQU *-BOXWRK @H9A 20520000 * 20530000 ********************************************************************** 20540000 * COMPOSED TEST DATA AREA FOR INFORMATION PRINT LINES (Original) 20550000 ********************************************************************** 20560000 * 20570000 PRTWRK DSECT 20580000 PRTCTX DS CL356 @01C 20590000 ORG PRTCTX 20600000 PRTSFI DS CL10 COMPOSED-TEXT CONTROL 20610000 PRTPOS0 DS CL8 PRINT POSITION FOR JOB # 20620000 PRTTRN0 DS CL2 TRN FOR JOB # 20630000 PRTJNH DS CL14 JOB # HEADING 20640000 PRTJN DS CL8 JOB # 20650000 PRTPOS1 DS CL8 PRINT POSITION FOR SYSOUT 20660000 * CLASS 20670000 PRTTRN1 DS CL2 TRN FOR SYSOUT CLASS 20680000 PRTSCLH DS CL14 SYSOUT CLASS HEADING 20690000 PRTSCL DS CL1 SYSOUT CLASS 20700000 PRTPOS2 DS CL8 PRINT POSITION FOR PRINTER 20710000 * NAME 20720000 PRTTRN2 DS CL2 TRN FOR PRINTER NAME 20730000 PRTNMH DS CL14 PRINTER NAME HEADING 20740000 PRTNM DS CL8 PRINTER NAME 20750000 PRTPOS3 DS CL8 PRINT POSITION FOR SYS ID 20760000 PRTTRN3 DS CL2 TRN FOR SYS ID 20770000 PRTSIDH DS CL14 SYS ID HEADING 20780000 PRTSID DS CL4 SYS ID 20790000 PRTPOS4 DS CL8 PRINT POSITION FOR PRINT 20800000 * DATE 20810000 PRTTRN4 DS CL2 TRN FOR PRINT DATE 20820000 PRTDATEH DS CL14 PRINT DATE HEADING 20830000 PRTDATE DS CL11 PRINT DATE @01C 20840000 ORG PRTDATE 20850000 PRTDAY DS CL2 DAY 20860000 DS CL1 SPACE 20870000 PRTMTH DS CL3 MONTH 20880000 DS CL1 SPACE 20890000 PRTCEN DS CL2 CENTURY @01A 20900000 PRTYR DS CL2 YEAR 20910000 PRTPOS5 DS CL8 PRINT POSITION FOR PRINT 20920000 * TIME 20930000 PRTTRN5 DS CL2 TRN FOR PRINT TIME 20940000 PRTTIMEH DS CL14 PRINT TIME HEADING 20950000 PRTTIME DS CL11 PRINT TIME 20960000 ORG PRTTIME 20970000 PRTHR DS CL2 HOUR 20980000 PRTCL1 DS CL1 COLON 20990000 PRTMIN DS CL2 MINUTE 21000000 PRTCL2 DS CL1 COLON 21010000 PRTSEC DS CL2 SECOND 21020000 DS CL1 21030000 PRTAMPM DS CL2 AM/PM 21040000 PRTPOS6 DS CL8 PRINT POSITION FOR USER 21050000 * NAME 21060000 PRTTRN6 DS CL2 TRN FOR USER NAME 21070000 PRTUSRH DS CL14 USER NAME HEADING 21080000 PRTUSR DS CL20 USER NAME 21090000 PRTPOS7 DS CL8 PRINT POSITION FOR JOB NAME 21100000 PRTTRN7 DS CL2 TRN FOR JOB NAME 21110000 PRTJNMH DS CL14 JOB NAME HEADING 21120000 PRTJNM DS CL8 JOB NAME 21130000 PRTPOS8 DS CL8 PRINT POSITION FOR OUTPUT 21140000 * GROUP 21150000 PRTTRN8 DS CL2 TRN FOR OUTPUT GROUP 21160000 PRTOGH DS CL14 OUTPUT GROUP HEADING 21170000 PRTOG DS CL16 OUTPUT GROUP 21180000 ORG PRTOG 21190000 PRTOG1 DS CL8 JOE NAME 21200000 DS CL1 21210000 PRTOG2 DS CL3 21220000 DS CL1 JOE ID 1 21230000 PRTOG3 DS CL3 JOE ID 2 21240000 PRTPOS9 DS CL8 PRINT POSITION FOR ROOM # 21250000 PRTTRN9 DS CL2 TRN FOR ROOM # 21260000 PRTROOMH DS CL14 ROOM # HEADING 21270000 PRTROOM DS CL4 ROOM # 21280000 PRTPOS10 DS CL8 PRINT POSITION FOR 21290000 * HEADER TYPE 21300000 PRTTRN10 DS CL2 TRN FOR HEADER TYPE 21310000 PRTSEPTY DS CL5 HEADER TYPE 21320000 * 21330000 ********************************************************************** 21340000 * Composed text data area for information print lines (ESS) 21350000 ********************************************************************** 21360000 * 21370000 PRTWRKE EQU PRTCTX @H9A 21380000 ORG PRTCTX @H9A 21390000 PRTSFIE DS CL11 Composed-text control @H9A 21400000 *********************************** 21410000 PRTPOS0E DS CL8 Print position for @H9A 21420000 * JOB NUMBER @H9A 21430000 PRTTRN0E DS CL2 TRN for JOB NUMBER @H9A 21440000 PRTJNHE DS CL15 JOB NUMBER heading @H9A 21450000 PRTJNE DS CL8 JOB NUMBER @H9A 21460000 *********************************** 21470000 PRTPOS1E DS CL8 Print position for @H9A 21480000 * JOB NAME @H9A 21490000 PRTTRN1E DS CL2 TRN for JOB NAME @H9A 21500000 PRTJNMHE DS CL15 JOB NAME heading @H9A 21510000 PRTJNME DS CL8 JOB NAME @H9A 21520000 *********************************** 21530000 PRTPOS2E DS CL8 Print position for @H9A 21540000 * USER ID @H9A 21550000 PRTTRN2E DS CL2 TRN for USER ID @H9A 21560000 PRTUSERH DS CL15 USER ID heading @H9A 21570000 PRTUSER DS CL8 USER ID @H9A 21580000 *********************************** 21590000 PRTPOS3E DS CL8 Print position for @H9A 21600000 * SYSOUT CLASS @H9A 21610000 PRTTRN3E DS CL2 TRN for SYSOUT CLASS @H9A 21620000 PRTSCLHE DS CL15 SYSOUT CLASS heading @H9A 21630000 PRTSCLE DS CL1 SYSOUT CLASS @H9A 21640000 *********************************** 21650000 PRTOG$ DS CL45 OUTPUT GROUP string @H9A 21660000 ORG PRTOG$ @H9A 21670000 PRTPOS4E DS CL8 Print position for @H9A 21680000 * OUTPUT GROUP @H9A 21690000 PRTTRN4E DS CL2 TRN for OUTPUT GROUP @H9A 21700000 PRTOGHE DS CL15 OUTPUT GROUP heading @H9A 21710000 PRTOG1E DS CL8 JOE NAME @H9A 21720000 DS CL1 @H9A 21730000 PRTOG2E DS CL5 JOE ID#1 @H9A 21740000 DS CL1 @H9A 21750000 PRTOG3E DS CL5 JOE ID#2 @H9A 21760000 *********************************** 21770000 PRTPOS5E DS CL8 Print position for @H9A 21780000 * TITLE @H9A 21790000 PRTTRN5E DS CL2 TRN for TITLE @H9A 21800000 PRTTITLH DS CL15 TITLE heading @H9A 21810000 PRTTITLE DS CL60 TITLE @H9A 21820000 *********************************** 21830000 PRTPOS6E DS CL8 Print position for @H9A 21840000 * DESTINATION @H9A 21850000 PRTTRN6E DS CL2 TRN for DESTINATION @H9A 21860000 PRTDESTH DS CL15 DESTINATION heading @H9A 21870000 PRTDEST DS CL8 DESTINATION @H9A 21880000 *********************************** 21890000 PRTPOS7E DS CL8 Print position for @H9A 21900000 * NAME @H9A 21910000 PRTTRN7E DS CL2 TRN for NAME @H9A 21920000 PRTNAMEH DS CL15 NAME heading @H9A 21930000 PRTNAME DS CL60 NAME @H9A 21940000 *********************************** 21950000 PRTPOS8E DS CL8 Print position for @H9A 21960000 * ROOM @H9A 21970000 PRTTRN8E DS CL2 TRN for ROOM @H9A 21980000 PRTROMHE DS CL15 ROOM heading @H9A 21990000 PRTROOME DS CL60 ROOM @H9A 22000000 *********************************** 22010000 PRTPOS9E DS CL8 Print position for @H9A 22020000 * BUILDING @H9A 22030000 PRTTRN9E DS CL2 TRN for BUILDING @H9A 22040000 PRTBLDGH DS CL15 BLDG heading @H9A 22050000 PRTBLDG DS CL60 BUILDING @H9A 22060000 *********************************** 22070000 PRTPOSTE DS CL8 Print position for @H9A 22080000 * DEPARTMENT @H9A 22090000 PRTTRNTE DS CL2 TRN for DEPARTMENT @H9A 22100000 PRTDEPTH DS CL15 DEPT heading @H9A 22110000 PRTDEPT DS CL60 DEPARTMENT @H9A 22120000 *********************************** 22130000 PRTADDR$ DS CL340 ADDRESS#1-#4 string @H9A 22140000 ORG PRTADDR$ 22150000 PRTPOS11 DS CL8 Print position for @H9A 22160000 * ADDRESS#1 @H9A 22170000 PRTTRN11 DS CL2 TRN for ADDRESS#1 @H9A 22180000 PRTADDRH DS CL15 ADDR#1 heading @H9A 22190000 PRTADDR1 DS CL60 ADDRESS#1 @H9A 22200000 *********************************** 22210000 PRTPOS12 DS CL8 Print position for @H9A 22220000 * ADDRESS#2 @H9A 22230000 PRTTRN12 DS CL2 TRN for ADDRESS#2 @H9A 22240000 DS CL15 ADDR#2 heading @H9A 22250000 PRTADDR2 DS CL60 ADDRESS#2 @H9A 22260000 *********************************** 22270000 PRTPOS13 DS CL8 Print position for @H9A 22280000 * ADDRESS#3 @H9A 22290000 PRTTRN13 DS CL2 TRN for ADDRESS#3 @H9A 22300000 DS CL15 ADDR#3 heading @H9A 22310000 PRTADDR3 DS CL60 ADDRESS#3 @H9A 22320000 *********************************** 22330000 PRTPOS14 DS CL8 Print position for @H9A 22340000 * ADDRESS#4 @H9A 22350000 PRTTRN14 DS CL2 TRN for ADDRESS#4 @H9A 22360000 DS CL15 ADDR#4 heading @H9A 22370000 PRTADDR4 DS CL60 ADDRESS#4 @H9A 22380000 *********************************** 22390000 PRTTIME$ DS CL33 PRINT TIME string @H9A 22400000 ORG PRTTIME$ @H9A 22410000 PRTPOS15 DS CL8 Print position for @H9A 22420000 * PRINT TIME @H9A 22430000 PRTTRN15 DS CL2 TRN for PRINT TIME @H9A 22440000 PRTTMEHE DS CL15 PRINT TIME heading @H9A 22450000 PRTTIMEE DS CL8 Print HH:MM:SS @H9A 22460000 ORG PRTTIMEE @H9A 22470000 PRTHRE DS CL2 Hour @H9A 22480000 PRTTS1 DS CL1 Colon @H9A 22490000 PRTMINE DS CL2 Minute @H9A 22500000 PRTTS2 DS CL1 Colon @H9A 22510000 PRTSECE DS CL2 Second @H9A 22520000 DS CL1 @H9A 22530000 PRTAMPME DS CL2 Print AM/PM @H9A 22540000 *********************************** 22550000 PRTDATE$ DS CL36 PRINT DATE string @01C 22560000 ORG PRTDATE$ @H9A 22570000 PRTPOS16 DS CL8 Print position for @H9A 22580000 * PRINT DATE @H9A 22590000 PRTTRN16 DS CL2 TRN for PRINT DATE @H9A 22600000 PRTDTEHE DS CL15 PRINT DATE heading @H9A 22610000 PRTDDD DS CL2 Print day @H9A 22620000 DS CL1 @H9A 22630000 PRTMMM DS CL3 Print month @H9A 22640000 DS CL1 @H9A 22650000 PRTCCC DS CL2 Print century @01A 22660000 PRTYYY DS CL2 Print year @H9A 22670000 *********************************** 22680000 PRTPOS17 DS CL8 Print position for @H9A 22690000 * PRINTER ID @H9A 22700000 PRTTRN17 DS CL2 TRN for PRINTER ID @H9A 22710000 PRTNMHE DS CL15 PRINTER ID heading @H9A 22720000 PRTNME DS CL8 PRINTER ID @H9A 22730000 *********************************** 22740000 PRTPOS18 DS CL8 Print position for @H9A 22750000 * SYSTEM ID @H9A 22760000 PRTTRN18 DS CL2 TRN for SYSTEM ID @H9A 22770000 PRTSIDHE DS CL15 SYSTEM ID heading @H9A 22780000 PRTSIDE DS CL4 SYSTEM ID @H9A 22790000 *********************************** 22800000 PRTPOS19 DS CL8 Print position for @H9A 22810000 * START, CONT, END @H9A 22820000 PRTTRN19 DS CL2 TRN for START,CONT,END@H9A 22830000 PRTTAG DS CL5 START, CONT, END TAG @H9A 22840000 *********************************** 22850000 PRTSEG$ DS CL29 SEGMENT ID string @H9A 22860000 ORG PRTSEG$ @H9A 22870000 PRTPOS20 DS CL8 Print position for @H9A 22880000 * SEGMENT ID @H9A 22890000 PRTTRN20 DS CL2 TRN for SEGMENT ID @H9A 22900000 PRTSEGH DS CL14 SEGMENT ID heading @H9A 22910000 PRTSEGID DS CL5 SEGMENT # @H9A 22920000 *********************************** 22930000 DS CL2 NOP unchained @H9A 22940000 *********************************** 22950000 PRTWRKLN EQU *-PRTWRKE Length of PRTWRKE @H9A 22960000 * 22970000 **NOTE - PRTWRKLN must match ESSDLNTH 22980000 * 22990000 ********************************************************************** 23000000 * WORK AREAS (Common for both Original & ESS Header Sheets) 23010000 ********************************************************************** 23020000 * 23030000 WRKDATE DS CL4 CURRENT DATE-PACKED 23040000 WRKTIME DS CL4 CURRENT TIME-PACKED 23050000 ORG WRKTIME 23060000 DS CL3 23070000 WRKTH DS CL1 TENTHS & HUNDREDS 23080000 WRKUDATE DS CL10 CURRENT DATE-UNPACKED @01C 23090000 ORG WRKUDATE 23100000 WRKMMM DS CL3 CURRENT MONTH 23110000 WRKDD DS CL2 CURRENT DAY 23120000 WRKCEN DS CL2 CURRENT CENTURY @01A 23130000 WRKYY DS CL2 CURRENT YEAR 23140000 DS CL1 23150000 WRKAMPM DS CL2 CURRENT AM/PM @H9A 23160000 WRKUTIME DS CL7 CURRENT TIME-UNPACKED 23170000 ORG WRKUTIME 23180000 WRKHR DS CL2 CURRENT HOUR 23190000 WRKMIN DS CL2 CURRENT MINUTE 23200000 WRKSEC DS CL2 CURRENT SECOND 23210000 DS CL1 RESERVED 23220000 DS CL1 RESERVED 23230000 WRKED DS CL3 EDIT PATTERN @01A 23240000 DS CL1 RESERVED @01A 23250000 WRKJID1 DS F JOE ID 1 WORK AREA 23260000 WRKJID2 DS F JOE ID 2 WORK AREA 23270000 WCEN DS F CENTURY WORK AREA @01A 23280000 DS 0D ALIGNMENT @H9A 23290000 WRKJIDEC DS CL8 JOE ID DECIMAL CONVERSION 23300000 * WORK AREA 23310000 WRKJID1Z DS CL8 JOE ID 1 ZONE CONVERSION 23320000 * WORK AREA 23330000 WRKJID2Z DS CL8 JOE ID 2 ZONE CONVERSION 23340000 * WORK AREA 23350000 WRKWORK DS CL8 JULIAN CONVERSION WORK AREA 23360000 WRKJTBL DS CL48 JULIAN CONVERSION TABLE 23370000 INDEX EQU ECAGWRK LOOP INDEX 23380000 * 23390000 ********************************************************************** 23400000 * SWBTUREQ DECLARES 23410000 ********************************************************************** 23420000 * 23430000 DS 0F 23440000 WRKJSPE@ DS F Pointer to JSPA Extension 23450000 WRKADNUM DS H Number of ADDRESS @H9A 23460000 * lines 23470000 WRKPLPTR DS F Address of SWBTUREQ @H9A 23480000 * parm list 23490000 WRKKYLST DS F Keylist address @H9A 23500000 * (SJTRKEYL) 23510000 * 23520000 FULLWORD DS F Full word work area @H9A 23530000 DBLWORD DS D Double word work area @H9A 23540000 * 23550000 SWBRC DS F SWBTUREQ return code @H9A 23560000 SWBRS DS F SWBTUREQ reason code @H9A 23570000 SWBERR DS CL1 SWBTUREQ error = "Y" @H9A 23580000 * 23590000 DS 0F 23600000 KEYLIST DS CL64 SJTRKEYL Area @H9A 23610000 SBTLAREA DS CL16 SJTRSBTL Area @H9A 23620000 * 23630000 ********************************************************************** 23640000 * 23650000 * Conditional assembly check for ESS 23660000 * 23670000 * The code between the AIF and the label .NOESS04 will be 23680000 * suppressed if SYSPARM is NULL. 23690000 * 23700000 ********************************************************************** 23710000 * 23720000 AIF ('&SYSPARM' EQ '').NOESS04 Branch - ESS not supp @H9A 23730000 * 23740000 ********************************************************************** 23750000 * 23760000 ********************************************************************** 23770000 * 23780000 * Even though the SWBTUREQ parameter list is invoked 23790000 * with DSECT=NO, there are still DSECTs in the macro. 23800000 * Therefore do NOT attempt to add DCs or DSs after this 23810000 * macro that are not part of a DSECT. 23820000 * 23830000 ********************************************************************** 23840000 * 23850000 IEFSJTRP DSECT=NO SWBTUREQ parm. list @H9A 23860000 * 23870000 ********************************************************************** 23880000 * 23890000 SWBTUWS DSECT SWBTUREQ Work Area @H9A 23900000 DS CL(PRTWRKLN) @H9A 23910000 * 23920000 ********************************************************************** 23930000 * * 23940000 * End of APSUECA work buffer * 23950000 * * 23960000 ********************************************************************** 23970000 * 23980000 * 23990000 IEFDOTUM Text unit mapping @H9A 24000000 IEFDOKEY OUTPUT key mapping @H9A 24010000 IEFSJTRC SWBTUREQ return codes @H9A 24020000 * 24030000 ********************************************************************** 24040000 * 24050000 .NOESS04 ANOP @H9A 24060000 * 24070000 END APSUX01 24080000