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

402 lines
32 KiB
COBOL

00001 IDENTIFICATION DIVISION. 06/06/01
00002 PROGRAM-ID. DTSBR418. DTSBR418
00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV004
00004 MODIFIED BY TRW S&ITG. DTSBR418
00005 DATE-WRITTEN. DECEMBER 1994. DTSBR418
00006 DATE-COMPILED. DTSBR418
00007 SKIP3 DTSBR418
00008 ***** DTSBR418
00009 * DTSBR418
00010 * CALLING SEQUENCE: DTSBD400 CALLS DTSBR418
00011 * DTSBE417 WHICH UPDATES DTSIR418 DTSBR418
00012 * DTSBR418 READS DTSIR418 RECORDS. DTSBR418
00013 * DTSBR418
00014 * FUNCTION: DELINQUENT ACCOUNT NUMBER LIST. DTSBR418
00015 * DTSBR418
00016 * DTSBR418
00017 * MODIFICATION HISTORY: DTSBR418
00018 * DTSBR418
00019 * 12-29-94 INITIAL DEVELOPMENT DTSBR418
00020 * REFERENCE RFP #RAP AUTHOR OF CHANGE - RHC DTSBR418
00021 * DTSBR418
00022 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR418
00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR418
00024 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR418
00025 * DTSBR418
00026 * DTSBR418
00027 * DESCRIPTION: DTSBR418
00028 * DTSBR418
00029 * THIS MODULE PRODUCES THE DELINQUENT ACCOUNT NUMBER LIST. DTSBR418
00030 * DTSBR418
00031 * DTSBR418
00032 * RECORDS READ: DTSBR418
00033 * DTSBR418
00034 * NONE. DTSBR418
00035 * DTSBR418
00036 * DTSBR418
00037 * PRINTED OUTPUTS: DTSBR418
00038 * DTSBR418
00039 * 418R1 DELINQUENT ACCOUNT NUMBER LIST DTSBR418
00040 * DTSBR418
00041 * DTSBR418
00042 * RECORDS WRITTEN: DTSBR418
00043 * DTSBR418
00044 * NONE. DTSBR418
00045 * DTSBR418
00046 * DTSBR418
00047 * MODULES CALLED: DTSBR418
00048 * DTSBR418
00049 * DTSBU004 QUARTER CONVERT. DTSBR418
00050 * DTSBU056 RATE FORMAT. DTSBR418
00051 * DTSBR418
00052 * DTSBR418
00053 ***** DTSBR418
00054 EJECT DTSBR418
00055 ENVIRONMENT DIVISION. DTSBR418
00056 DTSBR418
00057 CONFIGURATION SECTION. DTSBR418
00058 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR418
00059 DTSBR418
00060 INPUT-OUTPUT SECTION. DTSBR418
00061 FILE-CONTROL. DTSBR418
00062 SELECT PRT-FILE ASSIGN TO RPT418R1. DTSBR418
00063 DTSBR418
00064 DATA DIVISION. DTSBR418
00065 FILE SECTION. DTSBR418
00066 DTSBR418
00067 FD PRT-FILE DTSBR418
00068 RECORDING MODE IS F. DTSBR418
00069 01 REPORT-LISTING1 PIC X(133). DTSBR418
00070 DTSBR418
00071 WORKING-STORAGE SECTION. DTSBR418
000715 77 PAN-VALET PICTURE X(24) VALUE '004DTSBR418 06/06/01'. DTSBR418
00072 DTSBR418
00073 01 WRK-AREA. DTSBR418
00074 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +418.DTSBR418
00075 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR418
00076 DTSBR418
00077 05 WS-BLANK-PAGE PIC X(133) VALUE SPACES. DTSBR418
00078 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR418
00079 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR418
00080 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR418
00081 05 WS-FOOT-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBR418
00082 DTSBR418
00083 05 WRK-ADDR PIC X(07). DTSBR418
00084 DTSBR418
00085 EJECT DTSBR418
00086 01 L004-LINK-AREA. DTSBR418
00087 ++INCLUDE DTSIL004 DTSBR418
00088 EJECT DTSBR418
00089 01 L056-LINK-AREA. DTSBR418
00090 ++INCLUDE DTSIL056 DTSBR418
00091 EJECT DTSBR418
00092 01 PAGE-HEADING. DTSBR418
00093 05 HDR1-LINE-1. DTSBR418
00094 10 FILLER PIC X(01) VALUE SPACE. DTSBR418
00095 10 FILLER PIC X(05) DTSBR418
00096 VALUE '418R1'. DTSBR418
00097 10 FILLER PIC X(35) VALUE SPACES. DTSBR418
00098 10 HDR1-AGY-NAME-LINE1 PIC X(50). DTSBR418
00099 10 FILLER PIC X(27) VALUE SPACES. DTSBR418
00100 10 FILLER PIC X(05) DTSBR418
00101 VALUE 'DATE:'. DTSBR418
00102 10 FILLER PIC X(01) VALUE SPACE. DTSBR418
00103 10 HDR1-SYS-DATE PIC X(08). DTSBR418
00104 05 HDR1-LINE-2. DTSBR418
00105 10 FILLER PIC X(41) VALUE SPACES. DTSBR418
00106 10 HDR1-AGY-NAME-LINE2 PIC X(50). DTSBR418
00107 10 FILLER PIC X(27) VALUE SPACES. DTSBR418
00108 10 FILLER PIC X(05) DTSBR418
00109 VALUE 'TIME:'. DTSBR418
00110 10 FILLER PIC X(01) VALUE SPACE. DTSBR418
00111 10 HDR1-SYS-TIME PIC X(08). DTSBR418
00112 05 HDR1-LINE-3. DTSBR418
00113 10 FILLER PIC X(01) VALUE SPACE. DTSBR418
00114 10 FILLER PIC X(27) DTSBR418
00115 VALUE 'ROUTE TO: ENFORCEMENT UNIT'. DTSBR418
00116 10 FILLER PIC X(90) VALUE SPACES. DTSBR418
00117 10 FILLER PIC X(05) DTSBR418
00118 VALUE 'PAGE:'. DTSBR418
00119 10 FILLER PIC X(03) VALUE SPACES. DTSBR418
00120 10 HDR1-PAGE-CNT PIC ZZ,ZZ9. DTSBR418
00121 05 HDR1-LINE-4. DTSBR418
00122 10 FILLER PIC X(51) VALUE SPACES. DTSBR418
00123 10 FILLER PIC X(43) DTSBR418
00124 VALUE 'DELINQUENT ACCOUNT NUMBER LIST'. DTSBR418
00125 05 HDR1-LINE-5 PIC X(133) VALUE SPACES. DTSBR418
00126 05 HDR1-LINE-6. DTSBR418
00127 10 FILLER PIC X(01) VALUE SPACE. DTSBR418
00128 10 FILLER PIC X(12) DTSBR418
00129 VALUE 'SUBJECT YRQ:'. DTSBR418
00130 10 FILLER PIC X(01) VALUE SPACE. DTSBR418
00131 10 WRK-SUBJECT-SLASH-QTR PIC X(04). DTSBR418
00132 05 HDR1-LINE-7 PIC X(133) VALUE SPACES. DTSBR418
00133 05 HDR1-LINE-8. DTSBR418
00134 10 FILLER PIC X(09) VALUE SPACES. DTSBR418
00135 10 FILLER PIC X(08) DTSBR418
00136 VALUE 'SUBJ YRQ'. DTSBR418
00137 10 FILLER PIC X(48) VALUE SPACES. DTSBR418
00138 10 FILLER PIC X(07) DTSBR418
00139 VALUE 'SENT TO'. DTSBR418
00140 05 HDR1-LINE-9. DTSBR418
00141 10 FILLER PIC X(01) VALUE SPACE. DTSBR418
00142 10 FILLER PIC X(06) DTSBR418
00143 VALUE 'EMP NO'. DTSBR418
00144 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00145 10 FILLER PIC X(08) DTSBR418
00146 VALUE 'TOT RATE'. DTSBR418
00147 10 FILLER PIC X(07) VALUE SPACES. DTSBR418
00148 10 FILLER PIC X(13) DTSBR418
00149 VALUE 'PRIMARY NAME'. DTSBR418
00150 10 FILLER PIC X(28) VALUE SPACES. DTSBR418
00151 10 FILLER PIC X(08) DTSBR418
00152 VALUE 'TAX ADDR'. DTSBR418
00153 10 FILLER PIC X(06) VALUE SPACES. DTSBR418
00154 10 FILLER PIC X(04) DTSBR418
00155 VALUE 'CITY'. DTSBR418
00156 10 FILLER PIC X(21) VALUE SPACES. DTSBR418
00157 10 FILLER PIC X(05) DTSBR418
00158 VALUE 'STATE'. DTSBR418
00159 10 FILLER PIC X(03) VALUE SPACES. DTSBR418
00160 10 FILLER PIC X(03) DTSBR418
00161 VALUE 'ZIP'. DTSBR418
00162 10 FILLER PIC X(09) VALUE SPACES. DTSBR418
00163 10 FILLER PIC X(08) DTSBR418
00164 VALUE 'FLD CODE'. DTSBR418
00165 DTSBR418
00166 01 DETAIL-LINE. DTSBR418
00167 05 DTL1-LINE-3. DTSBR418
00168 10 FILLER PIC X(01) VALUE SPACE. DTSBR418
00169 10 DTL1-EMP-NO PIC 999B999. DTSBR418
00170 10 FILLER PIC X(01) VALUE SPACE. DTSBR418
00171 10 DTL1-DISP-RATE PIC X(07). DTSBR418
00172 10 FILLER PIC X(08) VALUE SPACES. DTSBR418
00173 10 DTL1-PRIMARY-NAME PIC X(40). DTSBR418
00174 10 FILLER PIC X(01) VALUE SPACE. DTSBR418
00175 10 DTL1-ADDR PIC X(07). DTSBR418
00176 10 FILLER PIC X(05) VALUE SPACES. DTSBR418
00177 10 DTL1-CITY PIC X(25). DTSBR418
00178 10 FILLER PIC X(04) VALUE SPACES. DTSBR418
00179 10 DTL1-STATE PIC X(02). DTSBR418
00180 10 FILLER PIC X(04) VALUE SPACES. DTSBR418
00181 10 DTL1-ZIP PIC X(10). DTSBR418
00182 10 FILLER PIC X(05) VALUE SPACES. DTSBR418
00183 10 DTL1-FIELD-REP-ID PIC X(02). DTSBR418
00184 DTSBR418
00185 05 DTL1-LINE-5. DTSBR418
00186 10 FILLER PIC X(03) VALUE SPACES. DTSBR418
00187 10 FILLER PIC X(20) DTSBR418
00188 VALUE 'ADDITIONAL DELQ YRQ:'. DTSBR418
00189 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00190 10 DTL1-ADD-RPT-YRQ-1 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00191 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00192 10 DTL1-ADD-RPT-YRQ-2 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00193 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00194 10 DTL1-ADD-RPT-YRQ-3 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00195 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00196 10 DTL1-ADD-RPT-YRQ-4 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00197 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00198 10 DTL1-ADD-RPT-YRQ-5 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00199 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00200 10 DTL1-ADD-RPT-YRQ-6 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00201 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00202 10 DTL1-ADD-RPT-YRQ-7 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00203 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00204 10 DTL1-ADD-RPT-YRQ-8 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00205 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00206 10 DTL1-ADD-RPT-YRQ-9 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00207 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00208 10 DTL1-ADD-RPT-YRQ-10 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00209 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00210 10 DTL1-ADD-RPT-YRQ-11 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00211 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00212 10 DTL1-ADD-RPT-YRQ-12 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00213 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00214 10 DTL1-ADD-RPT-YRQ-13 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00215 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00216 10 DTL1-ADD-RPT-YRQ-14 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00217 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00218 10 DTL1-ADD-RPT-YRQ-15 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00219 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00220 10 DTL1-ADD-RPT-YRQ-16 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00221 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00222 10 DTL1-ADD-RPT-YRQ-17 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00223 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00224 10 DTL1-ADD-RPT-YRQ-18 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00225 10 FILLER PIC X(02) VALUE SPACES. DTSBR418
00226 10 DTL1-ADD-RPT-YRQ-19 PIC 9(03) BLANK WHEN ZEROS.DTSBR418
00227 DTSBR418
00228 01 CONTROL-FOOTING-FINAL. DTSBR418
00229 05 CTF-LINE-3. DTSBR418
00230 10 FILLER PIC X(15) VALUE SPACES. DTSBR418
00231 10 CTF-REC-CNT PIC ZZ,ZZ9. DTSBR418
00232 10 FILLER PIC X(01) VALUE SPACE. DTSBR418
00233 10 FILLER PIC X(40) DTSBR418
00234 VALUE 'EMPLOYERS WITH MISSING QUARTERLY REPORTS'. DTSBR418
00235 10 FILLER PIC X(11) DTSBR418
00236 VALUE ' ARE LISTED'. DTSBR418
00237 EJECT DTSBR418
00238 LINKAGE SECTION. DTSBR418
00239 SKIP3 DTSBR418
00240 01 LRCM-LINK-AREA. DTSBR418
00241 ++INCLUDE DTSILRCM DTSBR418
00242 EJECT DTSBR418
00243 01 R418-REC. DTSBR418
00244 ++INCLUDE DTSIR418 DTSBR418
00245 EJECT DTSBR418
00246 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR418
00247 R418-REC. DTSBR418
00248 DTSBR418
00249 IF FIRST-TIME-IND = 'Y' DTSBR418
00250 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR418
00251 MOVE 'N' TO FIRST-TIME-IND. DTSBR418
00252 DTSBR418
00253 IF LRCM-EOR-88 DTSBR418
00254 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR418
00255 ELSE DTSBR418
00256 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR418
00257 DTSBR418
00258 GOBACK. DTSBR418
00259 EJECT DTSBR418
00260 I1000-INITIATE. DTSBR418
00261 DTSBR418
00262 MOVE R418-YRQ TO L004-QTR-5-9. DTSBR418
00263 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBR418
00264 MOVE L004-SLASH-QTR TO WRK-SUBJECT-SLASH-QTR. DTSBR418
00265 DTSBR418
00266 OPEN OUTPUT PRT-FILE. DTSBR418
00267 MOVE LRCM-SYS-DATE TO HDR1-SYS-DATE. DTSBR418
00268 MOVE LRCM-SYS-TIME TO HDR1-SYS-TIME. DTSBR418
00269 MOVE LRCM-AGY-NAME-LINE1 TO HDR1-AGY-NAME-LINE1. DTSBR418
00270 MOVE LRCM-AGY-NAME-LINE2 TO HDR1-AGY-NAME-LINE2. DTSBR418
00271 MOVE SPACES TO REPORT-LISTING1. DTSBR418
00272 DTSBR418
00273 I1000-EXIT. DTSBR418
00274 EXIT. DTSBR418
00275 DTSBR418
00276 P1000-PROCESS. DTSBR418
00277 DTSBR418
00278 MOVE R418-TOTAL-RATE TO L056-RATE. DTSBR418
00279 PERFORM S056-RATE-FORMAT THRU S056-EXIT. DTSBR418
00280 DTSBR418
00281 IF R418-ADDRESS1-SENT-YES DTSBR418
00282 IF R418-ADDRESS2-SENT-YES DTSBR418
00283 IF R418-ADDRESS3-SENT-YES DTSBR418
00284 MOVE '1, 2, 3' TO WRK-ADDR DTSBR418
00285 ELSE DTSBR418
00286 MOVE '1, 2' TO WRK-ADDR DTSBR418
00287 ELSE DTSBR418
00288 IF R418-ADDRESS3-SENT-YES DTSBR418
00289 MOVE '1, 3' TO WRK-ADDR DTSBR418
00290 ELSE DTSBR418
00291 MOVE '1' TO WRK-ADDR DTSBR418
00292 ELSE DTSBR418
00293 IF R418-ADDRESS2-SENT-YES DTSBR418
00294 IF R418-ADDRESS3-SENT-YES DTSBR418
00295 MOVE '2, 3' TO WRK-ADDR DTSBR418
00296 ELSE DTSBR418
00297 MOVE '2' TO WRK-ADDR DTSBR418
00298 ELSE DTSBR418
00299 IF R418-ADDRESS3-SENT-YES DTSBR418
00300 MOVE '3' TO WRK-ADDR DTSBR418
00301 ELSE DTSBR418
00302 MOVE 'XXX' TO WRK-ADDR. DTSBR418
00303 DTSBR418
00304 MOVE R418-EMP-NO TO DTL1-EMP-NO. DTSBR418
00305 MOVE L056-DISP-RATE TO DTL1-DISP-RATE. DTSBR418
00306 MOVE R418-PRIMARY-NAME TO DTL1-PRIMARY-NAME. DTSBR418
00307 MOVE WRK-ADDR TO DTL1-ADDR. DTSBR418
00308 MOVE R418-CITY TO DTL1-CITY. DTSBR418
00309 MOVE R418-STATE TO DTL1-STATE. DTSBR418
00310 MOVE R418-ZIP TO DTL1-ZIP. DTSBR418
00311 MOVE R418-FIELD-REP-ID TO DTL1-FIELD-REP-ID. DTSBR418
00312 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR418
00313 WRITE REPORT-LISTING1 FROM DTL1-LINE-3 AFTER 3. DTSBR418
00314 ADD +3 TO WS-LINE-CNT2. DTSBR418
00315 ADD +1 TO WS-FOOT-NUMBER-ONE. DTSBR418
00316 DTSBR418
00317 IF R418-ADDITIONAL-RPT-CNT > 0 DTSBR418
00318 MOVE R418-ADDITIONAL-RPT-YRQ (1) TO DTL1-ADD-RPT-YRQ-1 DTSBR418
00319 MOVE R418-ADDITIONAL-RPT-YRQ (2) TO DTL1-ADD-RPT-YRQ-2 DTSBR418
00320 MOVE R418-ADDITIONAL-RPT-YRQ (3) TO DTL1-ADD-RPT-YRQ-3 DTSBR418
00321 MOVE R418-ADDITIONAL-RPT-YRQ (4) TO DTL1-ADD-RPT-YRQ-4 DTSBR418
00322 MOVE R418-ADDITIONAL-RPT-YRQ (5) TO DTL1-ADD-RPT-YRQ-5 DTSBR418
00323 MOVE R418-ADDITIONAL-RPT-YRQ (6) TO DTL1-ADD-RPT-YRQ-6 DTSBR418
00324 MOVE R418-ADDITIONAL-RPT-YRQ (7) TO DTL1-ADD-RPT-YRQ-7 DTSBR418
00325 MOVE R418-ADDITIONAL-RPT-YRQ (8) TO DTL1-ADD-RPT-YRQ-8 DTSBR418
00326 MOVE R418-ADDITIONAL-RPT-YRQ (9) TO DTL1-ADD-RPT-YRQ-9 DTSBR418
00327 MOVE R418-ADDITIONAL-RPT-YRQ (10) TO DTL1-ADD-RPT-YRQ-10 DTSBR418
00328 MOVE R418-ADDITIONAL-RPT-YRQ (11) TO DTL1-ADD-RPT-YRQ-11 DTSBR418
00329 MOVE R418-ADDITIONAL-RPT-YRQ (12) TO DTL1-ADD-RPT-YRQ-12 DTSBR418
00330 MOVE R418-ADDITIONAL-RPT-YRQ (13) TO DTL1-ADD-RPT-YRQ-13 DTSBR418
00331 MOVE R418-ADDITIONAL-RPT-YRQ (14) TO DTL1-ADD-RPT-YRQ-14 DTSBR418
00332 MOVE R418-ADDITIONAL-RPT-YRQ (15) TO DTL1-ADD-RPT-YRQ-15 DTSBR418
00333 MOVE R418-ADDITIONAL-RPT-YRQ (16) TO DTL1-ADD-RPT-YRQ-16 DTSBR418
00334 MOVE R418-ADDITIONAL-RPT-YRQ (17) TO DTL1-ADD-RPT-YRQ-17 DTSBR418
00335 MOVE R418-ADDITIONAL-RPT-YRQ (18) TO DTL1-ADD-RPT-YRQ-18 DTSBR418
00336 MOVE R418-ADDITIONAL-RPT-YRQ (19) TO DTL1-ADD-RPT-YRQ-19 DTSBR418
00337 WRITE REPORT-LISTING1 FROM DTL1-LINE-5 AFTER 2 DTSBR418
00338 ADD +2 TO WS-LINE-CNT2 DTSBR418
00339 END-IF. DTSBR418
00340 DTSBR418
00341 P1000-EXIT. DTSBR418
00342 EXIT. DTSBR418
00343 DTSBR418
00344 P2000-PRINT-HEADER. DTSBR418
00345 DTSBR418
00346 IF WS-LINE-CNT GREATER 56 OR DTSBR418
00347 WS-LINE-CNT2 GREATER 56 DTSBR418
00348 MOVE +0 TO WS-LINE-CNT DTSBR418
00349 MOVE +0 TO WS-LINE-CNT2 DTSBR418
00350 ADD +1 TO WS-PAGE-CNT DTSBR418
00351 MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT DTSBR418
00352 WRITE REPORT-LISTING1 FROM HDR1-LINE-1 DTSBR418
00353 AFTER TOP-OF-PAGE DTSBR418
00354 WRITE REPORT-LISTING1 FROM HDR1-LINE-2 AFTER 1 DTSBR418
00355 WRITE REPORT-LISTING1 FROM HDR1-LINE-3 AFTER 1 DTSBR418
00356 WRITE REPORT-LISTING1 FROM HDR1-LINE-4 AFTER 1 DTSBR418
00357 WRITE REPORT-LISTING1 FROM HDR1-LINE-5 AFTER 1 DTSBR418
00358 WRITE REPORT-LISTING1 FROM HDR1-LINE-6 AFTER 1 DTSBR418
00359 WRITE REPORT-LISTING1 FROM HDR1-LINE-7 AFTER 1 DTSBR418
00360 WRITE REPORT-LISTING1 FROM HDR1-LINE-8 AFTER 1 DTSBR418
00361 WRITE REPORT-LISTING1 FROM HDR1-LINE-9 AFTER 1 DTSBR418
00362 ADD +9 TO WS-LINE-CNT2. DTSBR418
00363 DTSBR418
00364 P2000-EXIT. DTSBR418
00365 EXIT. DTSBR418
00366 DTSBR418
00367 T1000-TERMINATE. DTSBR418
00368 DTSBR418
00369 MOVE WS-FOOT-NUMBER-ONE TO CTF-REC-CNT. DTSBR418
00370 WRITE REPORT-LISTING1 FROM CTF-LINE-3 AFTER 3. DTSBR418
00371 CLOSE PRT-FILE. DTSBR418
00372 DTSBR418
00373 T1000-EXIT. DTSBR418
00374 EXIT. DTSBR418
00375 DTSBR418
00376 S004-FROM-5. DTSBR418
00377 DTSBR418
00378 SET L004-FROM-5 TO TRUE. DTSBR418
00379 DTSBR418
00380 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR418
00381 DTSBR418
00382 S004-EXIT. DTSBR418
00383 EXIT. DTSBR418
00384 DTSBR418
00385 S056-RATE-FORMAT. DTSBR418
00386 DTSBR418
00387 SET L056-DISP2-RIGHT-PCT-88 TO TRUE. DTSBR418
00388 DTSBR418
00389 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR418
00390 DTSBR418
00391 S056-EXIT. DTSBR418
00392 EXIT. DTSBR418
00393 DTSBR418
00394 *S999-ABEND. DTSBR418
00395 * DTSBR418
00396 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR418
00397 * DTSBR418
00398 *S999-EXIT. DTSBR418
00399 * EXIT. DTSBR418
00400 DTSBR418