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