433 lines
34 KiB
COBOL
433 lines
34 KiB
COBOL
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
|