00001 IDENTIFICATION DIVISION. 07/09/04 00002 PROGRAM-ID. DTSBR751. DTSBR751 00003 AUTHOR. TRW. LV022 00004 DATE-WRITTEN. NOVEMBER 2002. DTSBR751 00005 DATE-COMPILED. DTSBR751 00006 SKIP3 DTSBR751 00007 ***** DTSBR751 00008 * DTSBR751 00009 * CALLING SEQUENCE: DTSCS7D CREATES BR751 RECORDS DIRECTLY. DTSBR751 00010 * DTSBR751 00011 * FUNCTION: PRINT EMPLOYER WAGE REQUEST NOTICE. DTSBR751 00012 * DTSBR751 00013 * DTSBR751 00014 * MODIFICATION HISTORY: DTSBR751 00015 * DTSBR751 00016 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR751 00017 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR751 00018 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR751 00019 * DTSBR751 00020 * DTSBR751 00021 * DESCRIPTION: DTSBR751 00022 * DTSBR751 00023 * THIS MODULE PRINTS A NOTICE TO AN EMPLOYER REQUESTING DTSBR751 00024 * THE WAGES PAID TO A UI BENEFIT CLAIMANT. DTSBR751 00025 * DTSBR751 00026 * RECORDS READ: DTSBR751 00027 * DTSBR751 00028 * NONE. DTSBR751 00029 * DTSBR751 00030 * DTSBR751 00031 * PRINTED OUTPUTS: DTSBR751 00032 * DTSBR751 00033 * 751R1 EMPLOYER WAGE REQUEST NOTICE (XEROX FORM). DTSBR751 00034 * DTSBR751 00035 * DTSBR751 00036 * RECORDS WRITTEN: DTSBR751 00037 * DTSBR751 00038 * NONE. DTSBR751 00039 * DTSBR751 00040 * DTSBR751 00041 * MODULES CALLED: DTSBR751 00042 * DTSBR751 00043 * DTSBU001 DATE CONVERSION DTSBR751 00044 * DTSBU002 MIXED CASE CONVERSION DTSBR751 00045 * DTSBR751 00046 ***** DTSBR751 00047 EJECT DTSBR751 00048 ENVIRONMENT DIVISION. DTSBR751 00049 DTSBR751 00050 CONFIGURATION SECTION. DTSBR751 00051 SPECIAL-NAMES. C01 IS TOP-PAGE. DTSBR751 00052 DTSBR751 00053 INPUT-OUTPUT SECTION. DTSBR751 00054 DTSBR751 00055 FILE-CONTROL. DTSBR751 00056 SELECT PRT-FILE ASSIGN TO RPT751R1. DTSBR751 00057 DTSBR751 00058 DATA DIVISION. DTSBR751 00059 DTSBR751 00060 FILE SECTION. DTSBR751 00061 DTSBR751 00062 FD PRT-FILE DTSBR751 00063 RECORDING MODE IS F DTSBR751 00064 BLOCK CONTAINS 0 RECORDS DTSBR751 00065 LABEL RECORDS ARE OMITTED. DTSBR751 00066 DTSBR751 00067 01 PRINT-RECORD PIC X(133). DTSBR751 00068 EJECT DTSBR751 00069 WORKING-STORAGE SECTION. DTSBR751 000695 77 PAN-VALET PICTURE X(24) VALUE '022DTSBR751 07/09/04'. DTSBR751 00070 DTSBR751 00071 01 WRK-AREA. DTSBR751 00072 05 SUB1 PIC S9(04) COMP VALUE +0. DTSBR751 00073 05 SUB2 PIC S9(04) COMP VALUE +0. DTSBR751 00074 05 SUB3 PIC S9(04) COMP VALUE +0. DTSBR751 00075 05 SPACER PIC X(01) VALUE SPACE. DTSBR751 00076 05 PROGRAM-ESP902D PIC X(08) VALUE 'ESP902D'. DTSBR751 00077 DTSBR751 00078 05 ESP902-WORK-NAME. DTSBR751 00079 10 ESP902-NAME-FORMAT PIC 9(1). DTSBR751 00080 88 ESP902-FIRST-NAME-FIRST VALUE 1. DTSBR751 00081 88 ESP902-LAST-NAME-FIRST VALUE 2. DTSBR751 00082 10 ESP902-NAME-RETURN PIC 9(1). DTSBR751 00083 88 ESP902-NAME-CONVERTED VALUE 0. DTSBR751 00084 88 ESP902-NAME-INVALID VALUE 8. DTSBR751 00085 88 ESP902-INVALID-FORMAT-CODE VALUE 9. DTSBR751 00086 10 ESP902-NAM. DTSBR751 00087 15 ESP902-NAME DTSBR751 00088 OCCURS 32 TIMES PIC X(1) VALUE SPACE. DTSBR751 00089 10 ESP902-NAME-SEGMENT. DTSBR751 00090 15 ESP902-NAME-FIRST PIC X(32) VALUE SPACE. DTSBR751 00091 15 ESP902-NAME-LAST PIC X(32) VALUE SPACE. DTSBR751 00092 DTSBR751 00093 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR751 00094 DTSBR751 00095 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +751.DTSBR751 00096 05 ABEND-MSG PIC X(60). DTSBR751 00097 DTSBR751 00098 05 WRK-HOLD-YRQ PIC 9(5). DTSBR751 00099 05 WRK-HOLD-EMP-NO PIC 9(6). DTSBR751 00100 05 WRK-HOLD-OP-NAME PIC X(32) VALUE SPACES. DTSBR751 00101 05 WRK-MONTH-LITERAL-TO-USE PIC 9(1). DTSBR751 00102 DTSBR751 00103 05 WRK-DATE. DTSBR751 00104 10 WRK-DATE-YEAR PIC 9(04). DTSBR751 00105 10 FILLER PIC X(04) VALUE '0301'. DTSBR751 00106 05 WRK-DATE-RE REDEFINES WRK-DATE PIC 9(08). DTSBR751 00107 DTSBR751 00108 05 WRK-FORMAT-QUARTER. DTSBR751 00109 10 WRK-FQ-QTR PIC X(04). DTSBR751 00110 10 FILLER PIC X(08) VALUE 'QUARTER'. DTSBR751 00111 10 WRK-FQ-YEAR PIC X(04). DTSBR751 00112 DTSBR751 00113 05 WRK-QTR-BEGIN-DATE PIC 9(08). DTSBR751 00114 05 WRK-PREV-QTR-END-DAY PIC 9(02). DTSBR751 00115 05 WRK-QTR-BEGIN-DAY PIC 9(01). DTSBR751 00116 05 WRK-DAYS-IN-MONTH. DTSBR751 00117 10 WRK-MONTH1-DAYS PIC 9(02). DTSBR751 00118 10 WRK-MONTH2-DAYS PIC 9(02). DTSBR751 00119 10 WRK-MONTH3-DAYS PIC 9(02). DTSBR751 00120 05 WRK-MONTH-LITERAL. DTSBR751 00121 10 WRK-MONTH1-LITERAL. DTSBR751 00122 15 WRK-MTH1-ALPHA PIC X(04). DTSBR751 00123 15 WRK-MTH1-ALPHA-YR PIC X(02). DTSBR751 00124 10 WRK-MONTH2-LITERAL. DTSBR751 00125 15 WRK-MTH2-ALPHA PIC X(04). DTSBR751 00126 15 WRK-MTH2-ALPHA-YR PIC X(02). DTSBR751 00127 10 WRK-MONTH3-LITERAL. DTSBR751 00128 15 WRK-MTH3-ALPHA PIC X(04). DTSBR751 00129 15 WRK-MTH3-ALPHA-YR PIC X(02). DTSBR751 00130 DTSBR751 00131 05 WRK-FORMAT-SSN. DTSBR751 00132 10 WRK-FS-SSN1 PIC X(03). DTSBR751 00133 10 FILLER PIC X(01) VALUE '-'. DTSBR751 00134 10 WRK-FS-SSN2 PIC X(02). DTSBR751 00135 10 FILLER PIC X(01) VALUE '-'. DTSBR751 00136 10 WRK-FS-SSN3 PIC X(04). DTSBR751 00137 DTSBR751 00138 05 WRK-QUARTER-ARRAY. DTSBR751 00139 10 WRK-QTR-DAY OCCURS 91 TIMES PIC 9(02). DTSBR751 00140 DTSBR751 00141 05 RPT-LINE-1. DTSBR751 00142 10 FILLER PIC X(58) VALUE SPACES. DTSBR751 00143 10 RPT-MAIL-DATE PIC X(20) JUSTIFIED RIGHT. DTSBR751 00144 DTSBR751 00145 05 RPT-LINE-2. DTSBR751 00146 * 10 FILLER PIC X(01) VALUE SPACES. DTSBR751 00147 10 RPT-EMP-ACCT PIC X(07). DTSBR751 00148 10 FILLER PIC X(01) VALUE SPACES. DTSBR751 00149 10 RPT-EMP-NAME PIC X(40). DTSBR751 00150 10 FILLER PIC X(08) VALUE SPACES. DTSBR751 00151 10 RPT-YRQ PIC X(16). DTSBR751 00152 DTSBR751 00153 05 RPT-LINE-3. DTSBR751 00154 10 FILLER PIC X(18) VALUE SPACES. DTSBR751 00155 10 RPT-CLAIMANT-NAME PIC X(28). DTSBR751 00156 10 FILLER PIC X(15) VALUE SPACES. DTSBR751 00157 10 RPT-SSN PIC X(11). DTSBR751 00158 DTSBR751 00159 05 RPT-LINE-4. DTSBR751 00160 10 FILLER PIC X(08) VALUE SPACES. DTSBR751 00161 10 RPT-DAY OCCURS 7 TIMES PIC X(05). DTSBR751 00162 10 RPT-ALPHA-MTH PIC X(06). DTSBR751 00163 DTSBR751 00164 01 L001-LINK-AREA. DTSBR751 00165 ++INCLUDE DTSIL001 DTSBR751 00166 DTSBR751 00167 01 L002-LINK-AREA. DTSBR751 00168 ++INCLUDE DTSIL002 DTSBR751 00169 DTSBR751 00170 ++INCLUDE DTSXL751 DTSBR751 00171 DTSBR751 00172 LINKAGE SECTION. DTSBR751 00173 01 LRCM-LINK-AREA. DTSBR751 00174 ++INCLUDE DTSILRCM DTSBR751 00175 DTSBR751 00176 01 R751-REC. DTSBR751 00177 ++INCLUDE DTSIR751 DTSBR751 00178 EJECT DTSBR751 00179 PROCEDURE DIVISION USING LRCM-LINK-AREA, DTSBR751 00180 R751-REC. DTSBR751 00181 DTSBR751 00182 IF FIRST-TIME-IND = 'Y' DTSBR751 00183 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR751 00184 MOVE 'N' TO FIRST-TIME-IND. DTSBR751 00185 DTSBR751 00186 IF LRCM-EOR-88 DTSBR751 00187 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR751 00188 ELSE DTSBR751 00189 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR751 00190 DTSBR751 00191 GOBACK. DTSBR751 00192 DTSBR751 00193 I1000-INITIATE. DTSBR751 00194 OPEN OUTPUT PRT-FILE. DTSBR751 00195 WRITE PRINT-RECORD FROM XEROX-CNTL-LINE AFTER TOP-PAGE. DTSBR751 00196 ** WRITE PRINT-RECORD FROM XEROX-CNTL-LINE2 AFTER 1. DTSBR751 00197 I1000-EXIT. DTSBR751 00198 EXIT. DTSBR751 00199 DTSBR751 00200 P1000-PROCESS. DTSBR751 00201 IF R751-OP-NAME NOT EQUAL WRK-HOLD-OP-NAME DTSBR751 00202 MOVE R751-OP-NAME TO WRK-HOLD-OP-NAME, DTSBR751 00203 ROUTE-OP-NAME DTSBR751 00204 WRITE PRINT-RECORD FROM SPACER AFTER TOP-PAGE DTSBR751 00205 WRITE PRINT-RECORD FROM SPACER AFTER ADVANCING 4 DTSBR751 00206 WRITE PRINT-RECORD FROM ROUTE-INFO-LINE1 DTSBR751 00207 WRITE PRINT-RECORD FROM ROUTE-INFO-LINE2 DTSBR751 00208 WRITE PRINT-RECORD FROM ROUTE-INFO-LINE3 DTSBR751 00209 WRITE PRINT-RECORD FROM ROUTE-INFO-LINE4 DTSBR751 00210 WRITE PRINT-RECORD FROM ROUTE-INFO-LINE5. DTSBR751 00211 DTSBR751 00212 MOVE R751-MAIL-DATE TO L002-DATE. DTSBR751 00213 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR751 00214 MOVE L002-LONG-TEXT-AREA TO RPT-MAIL-DATE. DTSBR751 00215 DTSBR751 00216 IF R751-EMP-NO GREATER ZEROS DTSBR751 00217 MOVE R751-EMP-NO TO WRK-HOLD-EMP-NO DTSBR751 00218 MOVE WRK-HOLD-EMP-NO (1:3) TO RPT-EMP-ACCT (1:3) DTSBR751 00219 MOVE '-' TO RPT-EMP-ACCT (4:1) DTSBR751 00220 MOVE WRK-HOLD-EMP-NO (4:3) TO RPT-EMP-ACCT (5:3) DTSBR751 00221 ELSE DTSBR751 00222 MOVE SPACES TO RPT-EMP-ACCT. DTSBR751 00223 DTSBR751 00224 MOVE R751-CLAIMANT-NAME TO RPT-CLAIMANT-NAME. DTSBR751 00225 MOVE R751-EMP-PRIMARY-NAME TO RPT-EMP-NAME. DTSBR751 00226 DTSBR751 00227 PERFORM P1100-FORMAT-DATA THRU P1100-EXIT. DTSBR751 00228 MOVE WRK-FORMAT-QUARTER TO RPT-YRQ. DTSBR751 00229 MOVE WRK-FORMAT-SSN TO RPT-SSN. DTSBR751 00230 DTSBR751 00231 MOVE WRK-QTR-BEGIN-DATE TO L001-FED-8-DATE-9. DTSBR751 00232 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR751 00233 MOVE L001-DAY-OF-WEEK TO WRK-QTR-BEGIN-DAY. DTSBR751 00234 DTSBR751 00235 PERFORM P1300-SET-QUARTER-ARRAY THRU P1300-EXIT. DTSBR751 00236 DTSBR751 00237 MOVE ZERO TO SUB3. DTSBR751 00238 MOVE 1 TO WRK-MONTH-LITERAL-TO-USE. DTSBR751 00239 WRITE PRINT-RECORD FROM SPACER AFTER TOP-PAGE. DTSBR751 00240 WRITE PRINT-RECORD FROM RPT-LINE-1 AFTER 3. DTSBR751 00241 WRITE PRINT-RECORD FROM RPT-LINE-2 AFTER 2. DTSBR751 00242 WRITE PRINT-RECORD FROM RPT-LINE-3 AFTER 3. DTSBR751 00243 WRITE PRINT-RECORD FROM SPACER AFTER 14. DTSBR751 00244 DTSBR751 00245 PERFORM P1400-PRINT-QTR-ARRAY THRU P1400-EXIT DTSBR751 00246 VARYING SUB1 FROM 1 BY 1 DTSBR751 00247 UNTIL SUB1 GREATER 13. DTSBR751 00248 DTSBR751 00249 P1000-EXIT. DTSBR751 00250 EXIT. DTSBR751 00251 DTSBR751 00252 P1100-FORMAT-DATA. DTSBR751 00253 MOVE R751-YRQ TO WRK-HOLD-YRQ. DTSBR751 00254 MOVE WRK-HOLD-YRQ (1:4) TO WRK-FQ-YEAR, DTSBR751 00255 WRK-QTR-BEGIN-DATE (1:4), DTSBR751 00256 WRK-DATE-YEAR. DTSBR751 00257 DTSBR751 00258 MOVE WRK-HOLD-YRQ (3:2) TO WRK-MTH1-ALPHA-YR, DTSBR751 00259 WRK-MTH2-ALPHA-YR, DTSBR751 00260 WRK-MTH3-ALPHA-YR. DTSBR751 00261 DTSBR751 00262 IF WRK-HOLD-YRQ (5:1) EQUAL 1 DTSBR751 00263 MOVE '1ST' TO WRK-FQ-QTR DTSBR751 00264 MOVE 'JAN-' TO WRK-MTH1-ALPHA DTSBR751 00265 MOVE 'FEB-' TO WRK-MTH2-ALPHA DTSBR751 00266 MOVE 'MAR-' TO WRK-MTH3-ALPHA DTSBR751 00267 MOVE 0101 TO WRK-QTR-BEGIN-DATE (5:4) DTSBR751 00268 MOVE 31 TO WRK-MONTH1-DAYS DTSBR751 00269 PERFORM P1200-GET-FEB-DAYS THRU P1200-EXIT DTSBR751 00270 MOVE 31 TO WRK-MONTH3-DAYS DTSBR751 00271 MOVE 31 TO WRK-PREV-QTR-END-DAY DTSBR751 00272 ELSE DTSBR751 00273 IF WRK-HOLD-YRQ (5:1) EQUAL 2 DTSBR751 00274 MOVE '2ND' TO WRK-FQ-QTR DTSBR751 00275 MOVE 'APR-' TO WRK-MTH1-ALPHA DTSBR751 00276 MOVE 'MAY-' TO WRK-MTH2-ALPHA DTSBR751 00277 MOVE 'JUN-' TO WRK-MTH3-ALPHA DTSBR751 00278 MOVE 0401 TO WRK-QTR-BEGIN-DATE (5:4) DTSBR751 00279 MOVE 30 TO WRK-MONTH1-DAYS DTSBR751 00280 MOVE 31 TO WRK-MONTH2-DAYS DTSBR751 00281 MOVE 30 TO WRK-MONTH3-DAYS DTSBR751 00282 MOVE 31 TO WRK-PREV-QTR-END-DAY DTSBR751 00283 ELSE DTSBR751 00284 IF WRK-HOLD-YRQ (5:1) EQUAL 3 DTSBR751 00285 MOVE '3RD' TO WRK-FQ-QTR DTSBR751 00286 MOVE 'JUL-' TO WRK-MTH1-ALPHA DTSBR751 00287 MOVE 'AUG-' TO WRK-MTH2-ALPHA DTSBR751 00288 MOVE 'SEP-' TO WRK-MTH3-ALPHA DTSBR751 00289 MOVE 0701 TO WRK-QTR-BEGIN-DATE (5:4) DTSBR751 00290 MOVE 31 TO WRK-MONTH1-DAYS DTSBR751 00291 MOVE 31 TO WRK-MONTH2-DAYS DTSBR751 00292 MOVE 30 TO WRK-MONTH3-DAYS DTSBR751 00293 MOVE 30 TO WRK-PREV-QTR-END-DAY DTSBR751 00294 ELSE DTSBR751 00295 MOVE '4TH' TO WRK-FQ-QTR DTSBR751 00296 MOVE 'OCT-' TO WRK-MTH1-ALPHA DTSBR751 00297 MOVE 'NOV-' TO WRK-MTH2-ALPHA DTSBR751 00298 MOVE 'DEC-' TO WRK-MTH3-ALPHA DTSBR751 00299 MOVE 1001 TO WRK-QTR-BEGIN-DATE (5:4) DTSBR751 00300 MOVE 31 TO WRK-MONTH1-DAYS DTSBR751 00301 MOVE 30 TO WRK-MONTH2-DAYS DTSBR751 00302 MOVE 31 TO WRK-MONTH3-DAYS DTSBR751 00303 MOVE 30 TO WRK-PREV-QTR-END-DAY. DTSBR751 00304 DTSBR751 00305 MOVE R751-SSN (1:3) TO WRK-FS-SSN1. DTSBR751 00306 MOVE R751-SSN (4:2) TO WRK-FS-SSN2. DTSBR751 00307 MOVE R751-SSN (6:4) TO WRK-FS-SSN3. DTSBR751 00308 DTSBR751 00309 P1100-EXIT. DTSBR751 00310 EXIT. DTSBR751 00311 DTSBR751 00312 P1200-GET-FEB-DAYS. DTSBR751 00313 **************************************************************** DTSBR751 00314 * WRK-DATE CONTAINS THE 1ST OF MARCH DATE FOR CURRENT YEAR. DTSBR751 00315 * USING THIS DATE IN A CALL TO THE DATE ROUTINE, YOU CAN DTSBR751 00316 * DETERMINE THE NUMBER OF DAYS IN FEBRUARY BY SUBTRACTING DTSBR751 00317 * 1 FROM THE ABSOLUTE DATE, THEN CALL THE DATE ROUTINE AGAIN. DTSBR751 00318 *************************************************************** DTSBR751 00319 DTSBR751 00320 MOVE WRK-DATE TO L001-FED-8-DATE-9. DTSBR751 00321 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR751 00322 SUBTRACT 1 FROM L001-JUL-ABS-DAY. DTSBR751 00323 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBR751 00324 MOVE L001-SLASH-8-DA TO WRK-MONTH2-DAYS. DTSBR751 00325 P1200-EXIT. DTSBR751 00326 EXIT. DTSBR751 00327 DTSBR751 00328 P1300-SET-QUARTER-ARRAY. DTSBR751 00329 SUBTRACT 1 FROM WRK-QTR-BEGIN-DAY GIVING SUB1. DTSBR751 00330 PERFORM P1310-SQA THRU P1310-EXIT DTSBR751 00331 VARYING SUB1 FROM SUB1 BY -1 DTSBR751 00332 UNTIL SUB1 EQUAL ZERO. DTSBR751 00333 DTSBR751 00334 MOVE WRK-QTR-BEGIN-DAY TO SUB1. DTSBR751 00335 MOVE ZEROS TO SUB2. DTSBR751 00336 PERFORM P1320-SQA THRU P1320-EXIT DTSBR751 00337 VARYING SUB1 FROM SUB1 BY +1 DTSBR751 00338 UNTIL SUB2 EQUAL WRK-MONTH1-DAYS. DTSBR751 00339 DTSBR751 00340 MOVE ZEROS TO SUB2. DTSBR751 00341 PERFORM P1320-SQA THRU P1320-EXIT DTSBR751 00342 VARYING SUB1 FROM SUB1 BY +1 DTSBR751 00343 UNTIL SUB2 EQUAL WRK-MONTH2-DAYS. DTSBR751 00344 DTSBR751 00345 MOVE ZEROS TO SUB2. DTSBR751 00346 PERFORM P1320-SQA THRU P1320-EXIT DTSBR751 00347 VARYING SUB1 FROM SUB1 BY +1 DTSBR751 00348 UNTIL SUB1 GREATER 91. DTSBR751 00349 P1300-EXIT. DTSBR751 00350 EXIT. DTSBR751 00351 DTSBR751 00352 P1310-SQA. DTSBR751 00353 MOVE WRK-PREV-QTR-END-DAY TO WRK-QTR-DAY (SUB1). DTSBR751 00354 SUBTRACT 1 FROM WRK-PREV-QTR-END-DAY. DTSBR751 00355 P1310-EXIT. DTSBR751 00356 EXIT. DTSBR751 00357 DTSBR751 00358 P1320-SQA. DTSBR751 00359 ADD 1 TO SUB2. DTSBR751 00360 MOVE SUB2 TO WRK-QTR-DAY (SUB1). DTSBR751 00361 P1320-EXIT. DTSBR751 00362 EXIT. DTSBR751 00363 DTSBR751 00364 P1400-PRINT-QTR-ARRAY. DTSBR751 00365 PERFORM P1410-PQA THRU P1410-EXIT DTSBR751 00366 VARYING SUB2 FROM 1 BY 1 DTSBR751 00367 UNTIL SUB2 GREATER 7. DTSBR751 00368 DTSBR751 00369 IF WRK-MONTH-LITERAL-TO-USE EQUAL 1 DTSBR751 00370 MOVE WRK-MONTH1-LITERAL TO RPT-ALPHA-MTH DTSBR751 00371 ELSE DTSBR751 00372 IF WRK-MONTH-LITERAL-TO-USE EQUAL 2 DTSBR751 00373 MOVE WRK-MONTH2-LITERAL TO RPT-ALPHA-MTH DTSBR751 00374 ELSE DTSBR751 00375 MOVE WRK-MONTH3-LITERAL TO RPT-ALPHA-MTH. DTSBR751 00376 DTSBR751 00377 WRITE PRINT-RECORD FROM SPACER AFTER 1. DTSBR751 00378 WRITE PRINT-RECORD FROM RPT-LINE-4 AFTER 1. DTSBR751 00379 P1400-EXIT. DTSBR751 00380 EXIT. DTSBR751 00381 DTSBR751 00382 P1410-PQA. DTSBR751 00383 ADD 1 TO SUB3. DTSBR751 00384 IF SUB3 GREATER 7 DTSBR751 00385 IF WRK-QTR-DAY (SUB3) LESS WRK-QTR-DAY (SUB3 - 1) DTSBR751 00386 ADD 1 TO WRK-MONTH-LITERAL-TO-USE. DTSBR751 00387 MOVE WRK-QTR-DAY (SUB3) TO RPT-DAY (SUB2). DTSBR751 00388 P1410-EXIT. DTSBR751 00389 EXIT. DTSBR751 00390 DTSBR751 00391 T1000-TERMINATE. DTSBR751 00392 CLOSE PRT-FILE. DTSBR751 00393 T1000-EXIT. DTSBR751 00394 EXIT. DTSBR751 00395 DTSBR751 00396 S001-FROM-FED-8. DTSBR751 00397 SET L001-FROM-FED-8 TO TRUE. DTSBR751 00398 GO TO S001-DATE. DTSBR751 00399 DTSBR751 00400 S001-FROM-ABS-DAY. DTSBR751 00401 SET L001-FROM-ABS-DAY TO TRUE. DTSBR751 00402 GO TO S001-DATE. DTSBR751 00403 DTSBR751 00404 S001-DATE. DTSBR751 00405 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR751 00406 S001-EXIT. DTSBR751 00407 EXIT. DTSBR751 00408 DTSBR751 00409 S002-UPPER-CASE. DTSBR751 00410 SET L002-UPPER-CASE TO TRUE. DTSBR751 00411 GO TO S002-DATE-ALPHA. DTSBR751 00412 DTSBR751 00413 S002-MIXED-CASE. DTSBR751 00414 SET L002-MIXED-CASE TO TRUE. DTSBR751 00415 GO TO S002-DATE-ALPHA. DTSBR751 00416 DTSBR751 00417 S002-DATE-ALPHA. DTSBR751 00418 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR751 00419 S002-EXIT. DTSBR751 00420 EXIT. DTSBR751 00421 DTSBR751 00422 S999-ABEND. DTSBR751 00423 DISPLAY '***'. DTSBR751 00424 DISPLAY '*** ' DTSBR751 00425 ABEND-MSG. DTSBR751 00426 DISPLAY '***'. DTSBR751 00427 DTSBR751 00428 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR751 00429 S999-EXIT. DTSBR751 00430 EXIT. DTSBR751 00431 DTSBR751