Files
DUTAS/Batch/DTSBR506.cob
2025-07-21 11:20:11 -04:00

437 lines
34 KiB
COBOL

00001 IDENTIFICATION DIVISION. 11/27/01
00002 PROGRAM-ID. DTSBR506. DTSBR506
00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV041
00004 DATE-WRITTEN. DECEMBER 1994. DTSBR506
00005 DATE-COMPILED. DTSBR506
00006 SKIP3 DTSBR506
00007 ***** DTSBR506
00008 * DTSBR506
00009 * CALLING SEQUENCE: DTSBD720 WRITES DTSIR506 RECORDS DTSBR506
00010 * DTSBR506 READS DTSIR506 RECORDS DTSBR506
00011 * TO PRODUCE THE RATE CUTOFF DTSBR506
00012 * TRANSFERS OF EXPERIENCE REPORT. DTSBR506
00013 * DTSBR506
00014 * FUNCTION: RATE CUTOFF TRANSFERS OF EXPERIENCE. DTSBR506
00015 * DTSBR506
00016 * DTSBR506
00017 * MODIFICATION HISTORY: DTSBR506
00018 * DTSBR506
00019 * 11-27-2001 CHANGED TO PROCESS PAGE LENGTH PROPERLY - LEFT OVER DTSBR506
00020 * FROM CONVERSION FROM REPRT WRTR & OLD MONT. CODE DTSBR506
00021 * AUTHOR OF CHANGE - JHPDTSBR506
00022 * DTSBR506
00023 * 07-19-1999 PICKUP MODIFICATION. WHEN R506-EFF-QTR IS EQUAL TO DTSBR506
00024 * LRCM-PICKUP-YRQ, DISPLAY PICKUP 'PU' ON REPORT DTSBR506
00025 * REFERENCE: PICKUP DIR AUTHOR OF CHANGE - DVSDTSBR506
00026 * DTSBR506
00027 * 04-29-1999 MODIFIED TO MEET DUTAS PROGRAMMING SPECIFICATIONS. DTSBR506
00028 * REFERENCE RFP #**** AUTHOR OF CHANGE - DVSDTSBR506
00029 * DTSBR506
00030 * 12-16-94 INITIAL DEVELOPMENT DTSBR506
00031 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR506
00032 * DTSBR506
00033 * DESCRIPTION: DTSBR506
00034 * DTSBR506
00035 * THE MODULE LISTS ALL TRANSFERS OF EXPERIENCE THAT WENT DTSBR506
00036 * INTO THE CREATION OF RATE CUTOFF RECORDS IN THE YEARLY DTSBR506
00037 * RATING RUN. DTSBR506
00038 * DTSBR506
00039 * DTSBR506
00040 * RECORDS READ: DTSBR506
00041 * DTSBR506
00042 * NONE. DTSBR506
00043 * DTSBR506
00044 * DTSBR506
00045 * PRINTED OUTPUTS: DTSBR506
00046 * DTSBR506
00047 * 506R1 RATE CUTOFF TRANSFERS OF EXPERIENCE DTSBR506
00048 * DTSBR506
00049 * DTSBR506
00050 * RECORDS WRITTEN: DTSBR506
00051 * DTSBR506
00052 * NONE. DTSBR506
00053 * DTSBR506
00054 * DTSBR506
00055 * MODULES CALLED: DTSBR506
00056 * DTSBR506
00057 * DTSBU001 DATE EDIT/CONVERSION MODULE DTSBR506
00058 * DTSBU004 QUARTER CONVERSION MODULE DTSBR506
00059 * DTSBU031 TRANSFER CODE EDIT/DESCRIPTION MODULE DTSBR506
00060 * DTSBR506
00061 * DTSBR506
00062 ***** DTSBR506
00063 EJECT DTSBR506
00064 ENVIRONMENT DIVISION. DTSBR506
00065 DTSBR506
00066 CONFIGURATION SECTION. DTSBR506
00067 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR506
00068 DTSBR506
00069 INPUT-OUTPUT SECTION. DTSBR506
00070 DTSBR506
00071 FILE-CONTROL. DTSBR506
00072 SELECT PRT-FILE ASSIGN TO RPT506R1. DTSBR506
00073 DTSBR506
00074 DATA DIVISION. DTSBR506
00075 DTSBR506
00076 FILE SECTION. DTSBR506
00077 DTSBR506
00078 FD PRT-FILE DTSBR506
00079 RECORDING MODE IS F. DTSBR506
00080 01 REPORT-LISTING1 PIC X(133). DTSBR506
00081 DTSBR506
00082 WORKING-STORAGE SECTION. DTSBR506
000825 77 PAN-VALET PICTURE X(24) VALUE '041DTSBR506 11/27/01'. DTSBR506
00083 DTSBR506
00084 01 WRK-AREA. DTSBR506
00085 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +506.DTSBR506
00086 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR506
00087 05 SUB PIC S9(04) COMP VALUE ZERO.DTSBR506
00088 DTSBR506
00089 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR506
00090 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR506
00091 DTSBR506
00092 05 WS-MISS-RPT-CNT PIC S9(03). DTSBR506
00093 05 WS-EARLIEST-LIAB-DATE-X PIC 9(08) BLANK WHEN ZEROES. DTSBR506
00094 05 WS-EARLIEST-LIAB-DATE REDEFINES DTSBR506
00095 WS-EARLIEST-LIAB-DATE-X PIC X(08). DTSBR506
00096 05 WS-TOT-UI-TAX-BALANCE-AMT PIC S9(09)V99. DTSBR506
00097 05 WS-UI-TAX-PAID-AMT PIC S9(09)V99. DTSBR506
00098 05 WS-PRIOR-RESERVE-AMT PIC S9(09)V99. DTSBR506
00099 05 WS-BENEFITS-CHARGED-AMT PIC S9(09)V99. DTSBR506
00100 05 WS-WAGES-TABLE. DTSBR506
00101 10 WS-WAGES-AREA OCCURS 3 TIMES. DTSBR506
00102 15 WS-WAGES-DATE-AREA. DTSBR506
00103 20 WS-WAGES-FROM-YRQ PIC X(04). DTSBR506
00104 20 WS-FILLER-1 PIC X(01). DTSBR506
00105 20 WS-WAGES-THRU-YRQ PIC X(04). DTSBR506
00106 15 WS-TOT-WAGE PIC S9(11)V9(02). DTSBR506
00107 15 WS-TAX-WAGE PIC S9(11)V9(02). DTSBR506
00108 EJECT DTSBR506
00109 01 PAGE-HEADING. DTSBR506
00110 05 HDR-LINE-1. DTSBR506
00111 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00112 10 FILLER PIC X(05) DTSBR506
00113 VALUE '506R1'. DTSBR506
00114 10 FILLER PIC X(35) VALUE SPACES. DTSBR506
00115 10 HDR-AGY-NAME-LINE1 PIC X(50). DTSBR506
00116 10 FILLER PIC X(28) VALUE SPACES. DTSBR506
00117 10 FILLER PIC X(05) DTSBR506
00118 VALUE 'DATE:'. DTSBR506
00119 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00120 10 HDR-SYS-DATE PIC X(08). DTSBR506
00121 05 HDR-LINE-2. DTSBR506
00122 10 FILLER PIC X(41) VALUE SPACES. DTSBR506
00123 10 HDR-AGY-NAME-LINE2 PIC X(50). DTSBR506
00124 10 FILLER PIC X(28) VALUE SPACES. DTSBR506
00125 10 FILLER PIC X(05) DTSBR506
00126 VALUE 'TIME:'. DTSBR506
00127 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00128 10 HDR-SYS-TIME PIC X(08). DTSBR506
00129 05 HDR-LINE-3. DTSBR506
00130 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00131 10 FILLER PIC X(33) DTSBR506
00132 VALUE 'ROUTE TO: REGISTRATION AND RATES '. DTSBR506
00133 10 FILLER PIC X(85) VALUE SPACES. DTSBR506
00134 10 FILLER PIC X(05) DTSBR506
00135 VALUE 'PAGE:'. DTSBR506
00136 10 FILLER PIC X(03) VALUE SPACES. DTSBR506
00137 10 HDR-PAGE-CNT PIC ZZ,ZZ9. DTSBR506
00138 05 HDR-LINE-4. DTSBR506
00139 10 FILLER PIC X(12) VALUE SPACES. DTSBR506
00140 10 FILLER PIC X(20) DTSBR506
00141 VALUE ' '. DTSBR506
00142 10 FILLER PIC X(16) VALUE SPACES. DTSBR506
00143 10 FILLER PIC X(35) DTSBR506
00144 VALUE 'RATE CUTOFF TRANSFERS OF EXPERIENCE'. DTSBR506
00145 05 HDR-LINE-5 PIC X(133) VALUE SPACES. DTSBR506
00146 05 HDR-LINE-6. DTSBR506
00147 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00148 10 FILLER PIC X(20) DTSBR506
00149 VALUE ' RATE EXP CUTOFF: '. DTSBR506
00150 10 WS-EXP-CUTOFF-DATE PIC X(08). DTSBR506
00151 05 HDR-LINE-7. DTSBR506
00152 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00153 10 FILLER PIC X(20) DTSBR506
00154 VALUE 'RATE EFFECTIVE QTR: '. DTSBR506
00155 10 WS-EFF-QTR PIC X(04). DTSBR506
00156 05 HDR-LINE-8 PIC X(133) VALUE SPACES. DTSBR506
00157 05 HDR-LINE-9. DTSBR506
00158 10 FILLER PIC X(13) VALUE SPACES. DTSBR506
00159 10 FILLER PIC X(04) DTSBR506
00160 VALUE 'PRED'. DTSBR506
00161 05 HDR-LINE-10. DTSBR506
00162 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00163 10 FILLER PIC X(30) DTSBR506
00164 VALUE 'EMP NO EMP NO EFF DATE'. DTSBR506
00165 10 FILLER PIC X(35) VALUE SPACES. DTSBR506
00166 10 FILLER PIC X(10) DTSBR506
00167 VALUE ' TOT WAGES'. DTSBR506
00168 10 FILLER PIC X(07) VALUE SPACES. DTSBR506
00169 10 FILLER PIC X(11) DTSBR506
00170 VALUE ' TAX WAGES'. DTSBR506
00171 DTSBR506
00172 01 DETAIL-LINE. DTSBR506
00173 05 DTL-LINE-2. DTSBR506
00174 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00175 10 DTL-SUCC-EMP-NO PIC 999B999. DTSBR506
00176 10 FILLER PIC X(03) VALUE SPACES. DTSBR506
00177 10 DTL-PRED-EMP-NO PIC 999B999. DTSBR506
00178 10 FILLER PIC X(05) VALUE SPACES. DTSBR506
00179 10 WS-REL-EFF-DATE PIC X(08). DTSBR506
00180 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00181 10 DTL-PRIOR-RESERVE-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR506
00182 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00183 10 FILLER PIC X(11) DTSBR506
00184 VALUE ':RESERVE '. DTSBR506
00185 10 DTL-TOT-WAGE-1 PIC ZZ,ZZZ,ZZZ,ZZ9.99-. DTSBR506
00186 10 DTL-TAX-WAGE-1 PIC ZZ,ZZZ,ZZZ,ZZ9.99-. DTSBR506
00187 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00188 10 FILLER PIC X(01) DTSBR506
00189 VALUE ':'. DTSBR506
00190 10 DTL-WAGES-DATE-AREA-1 PIC X(09). DTSBR506
00191 10 FILLER PIC X(06) VALUE SPACES. DTSBR506
00192 10 DTL-EARLIEST-LIAB-DATE PIC X(08). DTSBR506
00193 10 FILLER PIC X(02) VALUE SPACES. DTSBR506
00194 10 FILLER PIC X(11) DTSBR506
00195 VALUE ':FRST LIAB '. DTSBR506
00196 DTSBR506
00197 05 DTL-LINE-3. DTSBR506
00198 10 FILLER PIC X(32) VALUE SPACES. DTSBR506
00199 10 DTL-UI-TAX-PAID-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR506
00200 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00201 10 FILLER PIC X(11) DTSBR506
00202 VALUE ':UI TAX PD '. DTSBR506
00203 10 DTL-TOT-WAGE-2 PIC ZZ,ZZZ,ZZZ,ZZ9.99-. DTSBR506
00204 10 DTL-TAX-WAGE-2 PIC ZZ,ZZZ,ZZZ,ZZ9.99-. DTSBR506
00205 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00206 10 FILLER PIC X(01) DTSBR506
00207 VALUE ':'. DTSBR506
00208 10 DTL-WAGES-DATE-AREA-2 PIC X(09). DTSBR506
00209 10 FILLER PIC X(11) VALUE SPACE. DTSBR506
00210 10 DTL-MISS-RPT-CNT PIC ZZ9. DTSBR506
00211 10 FILLER PIC X(02) VALUE SPACES. DTSBR506
00212 10 FILLER PIC X(11) DTSBR506
00213 VALUE ':MISS RPTS '. DTSBR506
00214 DTSBR506
00215 05 DTL-LINE-4. DTSBR506
00216 10 FILLER PIC X(32) VALUE SPACES. DTSBR506
00217 10 DTL-BENEFITS-CHARGED-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR506
00218 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00219 10 FILLER PIC X(11) DTSBR506
00220 VALUE ':BEN CHGD '. DTSBR506
00221 10 DTL-TOT-WAGE-3 PIC ZZ,ZZZ,ZZZ,ZZ9.99-. DTSBR506
00222 10 DTL-TAX-WAGE-3 PIC ZZ,ZZZ,ZZZ,ZZ9.99-. DTSBR506
00223 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00224 10 FILLER PIC X(01) DTSBR506
00225 VALUE ':'. DTSBR506
00226 10 DTL-WAGES-DATE-AREA-3 PIC X(09). DTSBR506
00227 10 DTL-TOT-UI-TAX-BALANCE-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR506
00228 10 FILLER PIC X(01) VALUE SPACE. DTSBR506
00229 10 FILLER PIC X(11) DTSBR506
00230 VALUE ':UI TAX DUE'. DTSBR506
00231 DTSBR506
00232 01 CONTROL-FOOTING-FINAL. DTSBR506
00233 05 CTF-LINE-4. DTSBR506
00234 10 FILLER PIC X(17) VALUE SPACES. DTSBR506
00235 10 FILLER PIC X(17) DTSBR506
00236 VALUE '*** END OF REPORT'. DTSBR506
00237 EJECT DTSBR506
00238 01 L001-LINK-AREA. DTSBR506
00239 ++INCLUDE DTSIL001 DTSBR506
00240 EJECT DTSBR506
00241 01 L004-LINK-AREA. DTSBR506
00242 ++INCLUDE DTSIL004 DTSBR506
00243 EJECT DTSBR506
00244 01 L031-LINK-AREA. DTSBR506
00245 ++INCLUDE DTSIL031 DTSBR506
00246 EJECT DTSBR506
00247 LINKAGE SECTION. DTSBR506
00248 DTSBR506
00249 01 LRCM-LINK-AREA. DTSBR506
00250 ++INCLUDE DTSILRCM DTSBR506
00251 EJECT DTSBR506
00252 01 R506-REC. DTSBR506
00253 ++INCLUDE DTSIR506 DTSBR506
00254 EJECT DTSBR506
00255 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR506
00256 R506-REC. DTSBR506
00257 IF FIRST-TIME-IND = 'Y' DTSBR506
00258 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR506
00259 MOVE 'N' TO FIRST-TIME-IND. DTSBR506
00260 DTSBR506
00261 IF LRCM-EOR-88 DTSBR506
00262 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR506
00263 ELSE DTSBR506
00264 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR506
00265 DTSBR506
00266 GOBACK. DTSBR506
00267 DTSBR506
00268 DTSBR506
00269 I1000-INITIATE. DTSBR506
00270 DTSBR506
00271 OPEN OUTPUT PRT-FILE. DTSBR506
00272 MOVE LRCM-SYS-DATE TO HDR-SYS-DATE. DTSBR506
00273 MOVE LRCM-SYS-TIME TO HDR-SYS-TIME. DTSBR506
00274 MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1. DTSBR506
00275 MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2. DTSBR506
00276 MOVE SPACES TO REPORT-LISTING1. DTSBR506
00277 DTSBR506
00278 MOVE R506-EXP-CUTOFF-DATE TO L001-FED-8-DATE-9. DTSBR506
00279 SET L001-FROM-FED-8 TO TRUE. DTSBR506
00280 PERFORM S001-DATE THRU S001-EXIT. DTSBR506
00281 MOVE L001-SLASH-DATE TO WS-EXP-CUTOFF-DATE. DTSBR506
00282 DTSBR506
00283 IF LRCM-PICKUP-YRQ = R506-EFF-QTR DTSBR506
00284 MOVE 'PU ' TO WS-EFF-QTR DTSBR506
00285 ELSE DTSBR506
00286 MOVE R506-EFF-QTR TO L004-QTR-5-9 DTSBR506
00287 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR506
00288 MOVE L004-SLASH-QTR TO WS-EFF-QTR. DTSBR506
00289 DTSBR506
00290 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR506
00291 I1000-EXIT. DTSBR506
00292 EXIT. DTSBR506
00293 EJECT DTSBR506
00294 P1000-PROCESS. DTSBR506
00295 DTSBR506
00296 MOVE R506-PRIOR-RESERVE-AMT TO WS-PRIOR-RESERVE-AMT. DTSBR506
00297 MOVE R506-UI-TAX-PAID-AMT TO WS-UI-TAX-PAID-AMT. DTSBR506
00298 MOVE R506-BENEFITS-CHARGED-AMT TO WS-BENEFITS-CHARGED-AMT. DTSBR506
00299 MOVE R506-REL-EFF-DATE TO L001-FED-8-DATE-9. DTSBR506
00300 SET L001-FROM-FED-8 TO TRUE. DTSBR506
00301 PERFORM S001-DATE THRU S001-EXIT. DTSBR506
00302 MOVE L001-SLASH-DATE TO WS-REL-EFF-DATE. DTSBR506
00303 DTSBR506
00304 INITIALIZE SUB. DTSBR506
00305 PERFORM P1010-WAGES-AREA THRU P1010-EXIT DTSBR506
00306 VARYING R506-WAGES-IDX FROM 1 BY 1 DTSBR506
00307 UNTIL R506-WAGES-IDX GREATER THAN 3. DTSBR506
00308 DTSBR506
00309 INITIALIZE WS-EARLIEST-LIAB-DATE-X DTSBR506
00310 IF R506-EARLIEST-LIAB-DATE GREATER ZEROES DTSBR506
00311 MOVE R506-EARLIEST-LIAB-DATE TO L001-FED-8-DATE-9 DTSBR506
00312 SET L001-FROM-FED-8 TO TRUE DTSBR506
00313 PERFORM S001-DATE THRU S001-EXIT DTSBR506
00314 MOVE L001-SLASH-DATE TO WS-EARLIEST-LIAB-DATE. DTSBR506
00315 DTSBR506
00316 MOVE R506-MISS-RPT-CNT TO WS-MISS-RPT-CNT. DTSBR506
00317 MOVE R506-TOT-UI-TAX-BALANCE-AMT TO WS-TOT-UI-TAX-BALANCE-AMTDTSBR506
00318 DTSBR506
00319 MOVE R506-SUCC-EMP-NO TO DTL-SUCC-EMP-NO. DTSBR506
00320 MOVE R506-PRED-EMP-NO TO DTL-PRED-EMP-NO. DTSBR506
00321 MOVE WS-PRIOR-RESERVE-AMT TO DTL-PRIOR-RESERVE-AMT. DTSBR506
00322 MOVE WS-TOT-WAGE (1) TO DTL-TOT-WAGE-1. DTSBR506
00323 MOVE WS-TAX-WAGE (1) TO DTL-TAX-WAGE-1. DTSBR506
00324 MOVE WS-WAGES-DATE-AREA (1) TO DTL-WAGES-DATE-AREA-1. DTSBR506
00325 MOVE WS-EARLIEST-LIAB-DATE TO DTL-EARLIEST-LIAB-DATE. DTSBR506
00326 MOVE WS-UI-TAX-PAID-AMT TO DTL-UI-TAX-PAID-AMT. DTSBR506
00327 MOVE WS-TOT-WAGE (2) TO DTL-TOT-WAGE-2. DTSBR506
00328 MOVE WS-TAX-WAGE (2) TO DTL-TAX-WAGE-2. DTSBR506
00329 MOVE WS-WAGES-DATE-AREA (2) TO DTL-WAGES-DATE-AREA-2. DTSBR506
00330 MOVE WS-MISS-RPT-CNT TO DTL-MISS-RPT-CNT. DTSBR506
00331 MOVE WS-BENEFITS-CHARGED-AMT TO DTL-BENEFITS-CHARGED-AMT. DTSBR506
00332 MOVE WS-TOT-WAGE (3) TO DTL-TOT-WAGE-3. DTSBR506
00333 MOVE WS-TAX-WAGE (3) TO DTL-TAX-WAGE-3. DTSBR506
00334 MOVE WS-WAGES-DATE-AREA (3) TO DTL-WAGES-DATE-AREA-3. DTSBR506
00335 MOVE WS-TOT-UI-TAX-BALANCE-AMT TO DTL-TOT-UI-TAX-BALANCE-AMT.DTSBR506
00336 DTSBR506
00337 WRITE REPORT-LISTING1 FROM DTL-LINE-2 AFTER 2. DTSBR506
00338 WRITE REPORT-LISTING1 FROM DTL-LINE-3 AFTER 1. DTSBR506
00339 WRITE REPORT-LISTING1 FROM DTL-LINE-4 AFTER 1. DTSBR506
00340 ADD +4 TO WS-LINE-CNT. DTSBR506
00341 DTSBR506
00342 IF WS-LINE-CNT > 55 DTSBR506
00343 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR506
00344 DTSBR506
00345 P1000-EXIT. DTSBR506
00346 EXIT. DTSBR506
00347 EJECT DTSBR506
00348 P1010-WAGES-AREA. DTSBR506
00349 ADD 1 TO SUB. DTSBR506
00350 IF R506-WAGES-FROM-YRQ (R506-WAGES-IDX) GREATER ZEROS DTSBR506
00351 MOVE R506-WAGES-FROM-YRQ (R506-WAGES-IDX) DTSBR506
00352 TO L004-QTR-5-9 DTSBR506
00353 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR506
00354 MOVE L004-SLASH-QTR TO WS-WAGES-FROM-YRQ (SUB) DTSBR506
00355 MOVE '-' TO WS-FILLER-1 (SUB) DTSBR506
00356 ELSE DTSBR506
00357 MOVE SPACES TO WS-WAGES-FROM-YRQ (SUB) DTSBR506
00358 MOVE SPACES TO WS-FILLER-1 (SUB) DTSBR506
00359 END-IF. DTSBR506
00360 DTSBR506
00361 IF R506-WAGES-THRU-YRQ (R506-WAGES-IDX) GREATER ZEROS DTSBR506
00362 MOVE R506-WAGES-THRU-YRQ (R506-WAGES-IDX) DTSBR506
00363 TO L004-QTR-5-9 DTSBR506
00364 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR506
00365 MOVE L004-SLASH-QTR TO WS-WAGES-THRU-YRQ (SUB) DTSBR506
00366 MOVE '-' TO WS-FILLER-1 (SUB) DTSBR506
00367 ELSE DTSBR506
00368 MOVE SPACES TO WS-WAGES-THRU-YRQ (SUB) DTSBR506
00369 MOVE SPACES TO WS-FILLER-1 (SUB) DTSBR506
00370 END-IF. DTSBR506
00371 DTSBR506
00372 MOVE R506-TOT-WAGE (R506-WAGES-IDX) TO WS-TOT-WAGE (SUB). DTSBR506
00373 MOVE R506-TAX-WAGE (R506-WAGES-IDX) TO WS-TAX-WAGE (SUB). DTSBR506
00374 P1010-EXIT. DTSBR506
00375 EXIT. DTSBR506
00376 DTSBR506
00377 P2000-PRINT-HEADER. DTSBR506
00378 DTSBR506
00379 MOVE +0 TO WS-LINE-CNT DTSBR506
00380 ADD +1 TO WS-PAGE-CNT DTSBR506
00381 MOVE WS-PAGE-CNT TO HDR-PAGE-CNT DTSBR506
00382 WRITE REPORT-LISTING1 FROM HDR-LINE-1 DTSBR506
00383 AFTER TOP-OF-PAGE. DTSBR506
00384 WRITE REPORT-LISTING1 FROM HDR-LINE-2 AFTER 1 DTSBR506
00385 WRITE REPORT-LISTING1 FROM HDR-LINE-3 AFTER 1 DTSBR506
00386 WRITE REPORT-LISTING1 FROM HDR-LINE-4 AFTER 1 DTSBR506
00387 WRITE REPORT-LISTING1 FROM HDR-LINE-5 AFTER 1 DTSBR506
00388 WRITE REPORT-LISTING1 FROM HDR-LINE-6 AFTER 1 DTSBR506
00389 WRITE REPORT-LISTING1 FROM HDR-LINE-7 AFTER 1 DTSBR506
00390 WRITE REPORT-LISTING1 FROM HDR-LINE-8 AFTER 1 DTSBR506
00391 WRITE REPORT-LISTING1 FROM HDR-LINE-9 AFTER 1 DTSBR506
00392 WRITE REPORT-LISTING1 FROM HDR-LINE-10 AFTER 1 DTSBR506
00393 ADD +10 TO WS-LINE-CNT. DTSBR506
00394 DTSBR506
00395 P2000-EXIT. DTSBR506
00396 EXIT. DTSBR506
00397 DTSBR506
00398 T1000-TERMINATE. DTSBR506
00399 DTSBR506
00400 DTSBR506
00401 WRITE REPORT-LISTING1 FROM CTF-LINE-4 AFTER 2. DTSBR506
00402 CLOSE PRT-FILE. DTSBR506
00403 DTSBR506
00404 T1000-EXIT. DTSBR506
00405 EXIT. DTSBR506
00406 DTSBR506
00407 S001-DATE. DTSBR506
00408 DTSBR506
00409 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR506
00410 DTSBR506
00411 S001-EXIT. DTSBR506
00412 EXIT. DTSBR506
00413 DTSBR506
00414 S004-FROM-5. DTSBR506
00415 DTSBR506
00416 SET L004-FROM-5 TO TRUE. DTSBR506
00417 DTSBR506
00418 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR506
00419 DTSBR506
00420 S004-EXIT. DTSBR506
00421 EXIT. DTSBR506
00422 DTSBR506
00423 *S031-CODES-DESCRIPTION. DTSBR506
00424 * DTSBR506
00425 * CALL 'DTSBU031' USING L031-LINK-AREA. DTSBR506
00426 * DTSBR506
00427 *S031-EXIT. DTSBR506
00428 * EXIT. DTSBR506
00429 DTSBR506
00430 *S999-ABEND. DTSBR506
00431 * DTSBR506
00432 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR506
00433 * DTSBR506
00434 *S999-EXIT. DTSBR506
00435 * EXIT. DTSBR506