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