00001 IDENTIFICATION DIVISION. 01/30/01 00002 PROGRAM-ID. DTSBR408. DTSBR408 00003 AUTHOR. TRICOASTAL CONSULTING LTD LV008 00004 MODIFIED BY TRW S&ITG. DTSBR408 00005 DATE-WRITTEN. DECEMBER 1994. DTSBR408 00006 DATE-COMPILED. DTSBR408 00007 SKIP3 DTSBR408 00008 ***** DTSBR408 00009 * DTSBR408 00010 * CALLING SEQUENCE: DTSBE408 CREATES DTSIR408 RECORDS. DTSBR408 00011 * DTSBD800 CALLS DTSBR408 DTSBR408 00012 * WHICH PRODUCES THE LIST. DTSBR408 00013 * DTSBR408 00014 * FUNCTION: PAYMENT PLANS SATISFIED LIST. DTSBR408 00015 * DTSBR408 00016 * DTSBR408 00017 * MODIFICATION HISTORY: DTSBR408 00018 * DTSBR408 00019 * 12-21-94 INITIAL DEVELOPMENT DTSBR408 00020 * REFERENCE RFP #RAP AUTHOR OF CHANGE - RHC DTSBR408 00021 * DTSBR408 00022 * 03-29-95 MODIFY FOR DUPLEX. DTSBR408 00023 * REFERENCE RFP #CR056 AUTHOR OF CHANGE - RHC DTSBR408 00024 * DTSBR408 00025 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR408 00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR408 00027 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR408 00028 * DTSBR408 00029 * DTSBR408 00030 * DESCRIPTION: DTSBR408 00031 * DTSBR408 00032 * THIS MODULE PRODUCES THE PAYMENT PLANS SATISFIED LIST. DTSBR408 00033 * DTSBR408 00034 * DTSBR408 00035 * RECORDS READ: DTSBR408 00036 * DTSBR408 00037 * NONE. DTSBR408 00038 * DTSBR408 00039 * DTSBR408 00040 * PRINTED OUTPUTS: DTSBR408 00041 * DTSBR408 00042 * 408R1 PAYMENT PLANS SATISFIED LIST. DTSBR408 00043 * DTSBR408 00044 * DTSBR408 00045 * RECORDS WRITTEN: DTSBR408 00046 * DTSBR408 00047 * NONE. DTSBR408 00048 * DTSBR408 00049 * DTSBR408 00050 * MODULES CALLED: DTSBR408 00051 * DTSBR408 00052 * DTSBU001 DATE CONVERT. DTSBR408 00053 * DTSBU004 QUARTER CONVERT. DTSBR408 00054 * DTSBR408 00055 * DTSBR408 00056 ***** DTSBR408 00057 EJECT DTSBR408 00058 ENVIRONMENT DIVISION. DTSBR408 00059 DTSBR408 00060 CONFIGURATION SECTION. DTSBR408 00061 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR408 00062 DTSBR408 00063 INPUT-OUTPUT SECTION. DTSBR408 00064 FILE-CONTROL. DTSBR408 00065 SELECT PRT-FILE ASSIGN TO RPT408R1. DTSBR408 00066 SKIP3 DTSBR408 00067 DATA DIVISION. DTSBR408 00068 FILE SECTION. DTSBR408 00069 DTSBR408 00070 FD PRT-FILE DTSBR408 00071 RECORDING MODE IS F. DTSBR408 00072 01 PRT-RECORD PIC X(133). DTSBR408 00073 DTSBR408 00074 WORKING-STORAGE SECTION. DTSBR408 000745 77 PAN-VALET PICTURE X(24) VALUE '008DTSBR408 01/30/01'. DTSBR408 00075 SKIP3 DTSBR408 00076 01 WRK-AREA. DTSBR408 00077 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +408.DTSBR408 00078 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR408 00079 05 FIRST-PAGE-IND PIC X(01) VALUE 'Y'. DTSBR408 00080 05 WS-BLANK-PAGE PIC X(133) VALUE SPACES. DTSBR408 00081 DTSBR408 00082 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR408 00083 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR408 00084 05 WS-FOOTER-CNT PIC S9(02) COMP-3 VALUE +0. DTSBR408 00085 05 WS-SUM-CNT PIC S9(02) COMP-3 VALUE +0. DTSBR408 00086 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR408 00087 DTSBR408 00088 05 WRK-PAGE-TRUNCATE PIC 9(01). DTSBR408 00089 88 WRK-ODD-PAGE-88 VALUE 1 3 5 7 9. DTSBR408 00090 DTSBR408 00091 05 WRK-YRQ-CNT PIC S9(04) COMP. DTSBR408 00092 05 WRK-YRQ-AREA. DTSBR408 00093 10 WRK-YRQ OCCURS 20 PIC X(04) VALUE SPACES. DTSBR408 00094 EJECT DTSBR408 00095 01 L001-LINK-AREA. DTSBR408 00096 ++INCLUDE DTSIL001 DTSBR408 00097 SKIP3 DTSBR408 00098 01 L004-LINK-AREA. DTSBR408 00099 ++INCLUDE DTSIL004 DTSBR408 00100 EJECT DTSBR408 00101 01 PAGE-HEADING. DTSBR408 00102 05 HEADER-1. DTSBR408 00103 10 FILLER PIC X(01) VALUE SPACE. DTSBR408 00104 10 FILLER PIC X(05) DTSBR408 00105 VALUE '408R1'. DTSBR408 00106 10 FILLER PIC X(35) VALUE SPACES.DTSBR408 00107 10 WS-AGY-NAME-LINE1 PIC X(50) VALUE SPACES. DTSBR408 00108 10 FILLER PIC X(27) VALUE SPACES.DTSBR408 00109 10 FILLER PIC X(05) DTSBR408 00110 VALUE 'DATE:'. DTSBR408 00111 10 FILLER PIC X(01) VALUE SPACE. DTSBR408 00112 10 WS-SYS-DATE PIC X(08) VALUE SPACES. DTSBR408 00113 05 HEADER-2. DTSBR408 00114 10 FILLER PIC X(41) VALUE SPACES.DTSBR408 00115 10 WS-AGY-NAME-LINE2 PIC X(50) VALUE SPACES. DTSBR408 00116 10 FILLER PIC X(27) VALUE SPACES.DTSBR408 00117 10 FILLER PIC X(05) DTSBR408 00118 VALUE 'TIME:'. DTSBR408 00119 10 FILLER PIC X(01) VALUE SPACE. DTSBR408 00120 10 WS-SYS-TIME PIC X(08) VALUE SPACES. DTSBR408 00121 05 HEADER-3. DTSBR408 00122 10 FILLER PIC X(01) VALUE SPACE. DTSBR408 00123 10 FILLER PIC X(35) DTSBR408 00124 VALUE 'ROUTE TO: ENFORCEMENT UNIT '. DTSBR408 00125 10 FILLER PIC X(82) VALUE SPACES.DTSBR408 00126 10 FILLER PIC X(05) DTSBR408 00127 VALUE 'PAGE:'. DTSBR408 00128 10 FILLER PIC X(03) VALUE SPACES.DTSBR408 00129 10 HDR1-PAGE-CNT PIC ZZ,ZZ9. DTSBR408 00130 05 HEADER-4. DTSBR408 00131 10 FILLER PIC X(55) VALUE SPACES.DTSBR408 00132 10 FILLER PIC X(23) DTSBR408 00133 VALUE 'PAYMENT PLANS SATISFIED'. DTSBR408 00134 05 HEADER-5 PIC X(133) VALUE SPACES. DTSBR408 00135 05 HEADER-6. DTSBR408 00136 10 FILLER PIC X(01) VALUE SPACE. DTSBR408 00137 10 FILLER PIC X(11) DTSBR408 00138 VALUE 'START DATE:'. DTSBR408 00139 10 FILLER PIC X(01) VALUE SPACE. DTSBR408 00140 10 WRK-START-DATE PIC X(08) VALUE SPACES. DTSBR408 00141 10 FILLER PIC X(112) VALUE SPACES.DTSBR408 00142 05 HEADER-7. DTSBR408 00143 10 FILLER PIC X(03) VALUE SPACES.DTSBR408 00144 10 FILLER PIC X(09) DTSBR408 00145 VALUE 'END DATE:'. DTSBR408 00146 10 FILLER PIC X(01) VALUE SPACE. DTSBR408 00147 10 WRK-END-DATE PIC X(08) VALUE SPACES. DTSBR408 00148 10 FILLER PIC X(113) VALUE SPACES.DTSBR408 00149 05 HEADER-8 PIC X(133) VALUE SPACES. DTSBR408 00150 05 HEADER-9. DTSBR408 00151 10 FILLER PIC X(07) VALUE SPACES.DTSBR408 00152 10 FILLER PIC X(05) DTSBR408 00153 VALUE 'OPID:'. DTSBR408 00154 10 FILLER PIC X(01) VALUE SPACE. DTSBR408 00155 10 WS-OP-ID PIC X(06) VALUE SPACES. DTSBR408 00156 10 FILLER PIC X(115) VALUE SPACES.DTSBR408 00157 05 HEADER-10. DTSBR408 00158 10 FILLER PIC X(72) VALUE SPACES.DTSBR408 00159 10 FILLER PIC X(22) DTSBR408 00160 VALUE '-- QUARTERS COVERED --'. DTSBR408 00161 10 FILLER PIC X(19) VALUE SPACES.DTSBR408 00162 05 HEADER-11. DTSBR408 00163 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00164 10 FILLER PIC X(06) DTSBR408 00165 VALUE 'EMP NO'. DTSBR408 00166 10 FILLER PIC X(06) VALUE SPACES.DTSBR408 00167 10 FILLER PIC X(13) DTSBR408 00168 VALUE 'PRIMARY NAME'. DTSBR408 00169 10 FILLER PIC X(45) VALUE SPACES.DTSBR408 00170 10 FILLER PIC X(22) DTSBR408 00171 VALUE 'YR/Q YR/Q YR/Q YR/Q'. DTSBR408 00172 10 FILLER PIC X(19) VALUE SPACES.DTSBR408 00173 DTSBR408 00174 01 DETAIL-LINE. DTSBR408 00175 05 DTL-LINE-2. DTSBR408 00176 10 FILLER PIC X(01) VALUE SPACE. DTSBR408 00177 10 WS-EMP-NO PIC 999B999. DTSBR408 00178 10 FILLER PIC X(06) VALUE SPACES.DTSBR408 00179 10 WS-PRIMARY-NAME PIC X(40) VALUE SPACES. DTSBR408 00180 10 FILLER PIC X(18) VALUE SPACES.DTSBR408 00181 10 WRK-YRQ-1 PIC X(04) VALUE SPACES. DTSBR408 00182 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00183 10 WRK-YRQ-2 PIC X(04) VALUE SPACES. DTSBR408 00184 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00185 10 WRK-YRQ-3 PIC X(04) VALUE SPACES. DTSBR408 00186 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00187 10 WRK-YRQ-4 PIC X(04) VALUE SPACES. DTSBR408 00188 05 DTL-LINE-3. DTSBR408 00189 10 FILLER PIC X(72) VALUE SPACES.DTSBR408 00190 10 WRK-YRQ-5 PIC X(04) VALUE SPACES. DTSBR408 00191 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00192 10 WRK-YRQ-6 PIC X(04) VALUE SPACES. DTSBR408 00193 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00194 10 WRK-YRQ-7 PIC X(04) VALUE SPACES. DTSBR408 00195 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00196 10 WRK-YRQ-8 PIC X(04) VALUE SPACES. DTSBR408 00197 05 DTL-LINE-4. DTSBR408 00198 10 FILLER PIC X(72) VALUE SPACES.DTSBR408 00199 10 WRK-YRQ-9 PIC X(04) VALUE SPACES. DTSBR408 00200 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00201 10 WRK-YRQ-10 PIC X(04) VALUE SPACES. DTSBR408 00202 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00203 10 WRK-YRQ-11 PIC X(04) VALUE SPACES. DTSBR408 00204 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00205 10 WRK-YRQ-12 PIC X(04) VALUE SPACES. DTSBR408 00206 05 DTL-LINE-5. DTSBR408 00207 10 FILLER PIC X(72) VALUE SPACES.DTSBR408 00208 10 WRK-YRQ-13 PIC X(04) VALUE SPACES. DTSBR408 00209 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00210 10 WRK-YRQ-14 PIC X(04) VALUE SPACES. DTSBR408 00211 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00212 10 WRK-YRQ-15 PIC X(04) VALUE SPACES. DTSBR408 00213 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00214 10 WRK-YRQ-16 PIC X(04) VALUE SPACES. DTSBR408 00215 05 DTL-LINE-6. DTSBR408 00216 10 FILLER PIC X(72) VALUE SPACES.DTSBR408 00217 10 WRK-YRQ-17 PIC X(04) VALUE SPACES. DTSBR408 00218 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00219 10 WRK-YRQ-18 PIC X(04) VALUE SPACES. DTSBR408 00220 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00221 10 WRK-YRQ-19 PIC X(04) VALUE SPACES. DTSBR408 00222 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00223 10 WRK-YRQ-20 PIC X(04) VALUE SPACES. DTSBR408 00224 SKIP3 DTSBR408 00225 01 CONTROL-FOOTING. DTSBR408 00226 05 CTF-LINE-3. DTSBR408 00227 10 FILLER PIC X(36) VALUE SPACES.DTSBR408 00228 10 WS-CTF-CNT PIC Z,ZZ9. DTSBR408 00229 10 FILLER PIC X(02) VALUE SPACES.DTSBR408 00230 10 FILLER PIC X(21) DTSBR408 00231 VALUE 'DPC''S LISTED FOR OPID'. DTSBR408 00232 10 FILLER PIC X(01) VALUE SPACE. DTSBR408 00233 10 WS-CTF-OP-ID PIC X(06) VALUE SPACES. DTSBR408 00234 SKIP3 DTSBR408 00235 01 CONTROL-FOOTING-FINAL. DTSBR408 00236 05 CFF-LINE-2. DTSBR408 00237 10 FILLER PIC X(36) VALUE SPACES.DTSBR408 00238 10 WS-CFF-SUM-CNT PIC Z,ZZ9. DTSBR408 00239 10 FILLER PIC X(02) VALUE SPACE. DTSBR408 00240 10 FILLER PIC X(12) DTSBR408 00241 VALUE 'DPC''S LISTED'. DTSBR408 00242 EJECT DTSBR408 00243 LINKAGE SECTION. DTSBR408 00244 SKIP3 DTSBR408 00245 01 LRCM-LINK-AREA. DTSBR408 00246 ++INCLUDE DTSILRCM DTSBR408 00247 EJECT DTSBR408 00248 01 R408-REC. DTSBR408 00249 ++INCLUDE DTSIR408 DTSBR408 00250 EJECT DTSBR408 00251 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR408 00252 R408-REC. DTSBR408 00253 IF FIRST-TIME-IND = 'Y' DTSBR408 00254 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR408 00255 MOVE 'N' TO FIRST-TIME-IND. DTSBR408 00256 DTSBR408 00257 IF LRCM-EOR-88 DTSBR408 00258 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR408 00259 ELSE DTSBR408 00260 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR408 00261 SKIP3 DTSBR408 00262 GOBACK. DTSBR408 00263 EJECT DTSBR408 00264 I1000-INITIATE. DTSBR408 00265 MOVE R408-PERIOD-START-DATE TO L001-FED-8-DATE-9. DTSBR408 00266 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR408 00267 MOVE L001-SLASH-DATE TO WRK-START-DATE. DTSBR408 00268 DTSBR408 00269 MOVE R408-PERIOD-END-DATE TO L001-FED-8-DATE-9. DTSBR408 00270 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR408 00271 MOVE L001-SLASH-DATE TO WRK-END-DATE. DTSBR408 00272 DTSBR408 00273 OPEN OUTPUT PRT-FILE. DTSBR408 00274 MOVE LRCM-SYS-DATE TO WS-SYS-DATE. DTSBR408 00275 MOVE LRCM-SYS-TIME TO WS-SYS-TIME. DTSBR408 00276 MOVE LRCM-AGY-NAME-LINE1 TO WS-AGY-NAME-LINE1. DTSBR408 00277 MOVE LRCM-AGY-NAME-LINE2 TO WS-AGY-NAME-LINE2. DTSBR408 00278 MOVE SPACES TO PRT-RECORD. DTSBR408 00279 DTSBR408 00280 I1000-EXIT. DTSBR408 00281 EXIT. DTSBR408 00282 EJECT DTSBR408 00283 P1000-PROCESS. DTSBR408 00284 DTSBR408 00285 MOVE SPACE TO WRK-YRQ-AREA. DTSBR408 00286 DTSBR408 00287 PERFORM VARYING WRK-YRQ-CNT FROM 1 BY 1 DTSBR408 00288 UNTIL WRK-YRQ-CNT > R408-COVERED-YRQ-CNT DTSBR408 00289 IF R408-COVERED-YRQ (WRK-YRQ-CNT) > 0 DTSBR408 00290 PERFORM P1100-PICKUP-YRQ THRU P1100-EXIT DTSBR408 00291 END-IF DTSBR408 00292 END-PERFORM. DTSBR408 00293 DTSBR408 00294 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR408 00295 PERFORM P3000-PRINT-DETAIL THRU P3000-EXIT. DTSBR408 00296 PERFORM P4000-PRINT-FOOTER THRU P4000-EXIT. DTSBR408 00297 DTSBR408 00298 P1000-EXIT. DTSBR408 00299 EXIT. DTSBR408 00300 DTSBR408 00301 P1100-PICKUP-YRQ. DTSBR408 00302 IF LRCM-PICKUP-YRQ = R408-COVERED-YRQ (WRK-YRQ-CNT) DTSBR408 00303 MOVE 'PU ' TO WRK-YRQ (WRK-YRQ-CNT) DTSBR408 00304 ELSE DTSBR408 00305 MOVE R408-COVERED-YRQ (WRK-YRQ-CNT) TO L004-QTR-5-9 DTSBR408 00306 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR408 00307 MOVE L004-SLASH-QTR TO WRK-YRQ (WRK-YRQ-CNT) DTSBR408 00308 END-IF. DTSBR408 00309 P1100-EXIT. DTSBR408 00310 EXIT. DTSBR408 00311 DTSBR408 00312 P2000-PRINT-HEADER. DTSBR408 00313 DTSBR408 00314 MOVE R408-OP-ID TO WS-OP-ID. DTSBR408 00315 IF WS-LINE-CNT GREATER 58 OR DTSBR408 00316 WS-LINE-CNT2 GREATER 58 DTSBR408 00317 MOVE +0 TO WS-LINE-CNT DTSBR408 00318 MOVE +0 TO WS-LINE-CNT2 DTSBR408 00319 ADD +1 TO WS-PAGE-CNT DTSBR408 00320 MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT DTSBR408 00321 WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE DTSBR408 00322 WRITE PRT-RECORD FROM HEADER-2 AFTER 1 DTSBR408 00323 WRITE PRT-RECORD FROM HEADER-3 AFTER 1 DTSBR408 00324 WRITE PRT-RECORD FROM HEADER-4 AFTER 1 DTSBR408 00325 WRITE PRT-RECORD FROM HEADER-5 AFTER 1 DTSBR408 00326 WRITE PRT-RECORD FROM HEADER-6 AFTER 1 DTSBR408 00327 WRITE PRT-RECORD FROM HEADER-7 AFTER 1 DTSBR408 00328 WRITE PRT-RECORD FROM HEADER-8 AFTER 1 DTSBR408 00329 WRITE PRT-RECORD FROM HEADER-9 AFTER 1 DTSBR408 00330 WRITE PRT-RECORD FROM HEADER-10 AFTER 1 DTSBR408 00331 WRITE PRT-RECORD FROM HEADER-11 AFTER 1 DTSBR408 00332 ADD +11 TO WS-LINE-CNT2 DTSBR408 00333 ELSE DTSBR408 00334 MOVE WS-PAGE-CNT TO WRK-PAGE-TRUNCATE DTSBR408 00335 IF WRK-ODD-PAGE-88 DTSBR408 00336 WRITE PRT-RECORD FROM WS-BLANK-PAGE AFTER TOP-OF-PAGE DTSBR408 00337 WRITE PRT-RECORD FROM WS-BLANK-PAGE AFTER 58 DTSBR408 00338 ADD +60 TO WS-LINE-CNT2 DTSBR408 00339 END-IF DTSBR408 00340 END-IF. DTSBR408 00341 DTSBR408 00342 P2000-EXIT. DTSBR408 00343 EXIT. DTSBR408 00344 DTSBR408 00345 P3000-PRINT-DETAIL. DTSBR408 00346 DTSBR408 00347 IF WS-LINE-CNT GREATER 58 OR DTSBR408 00348 WS-LINE-CNT2 GREATER 58 DTSBR408 00349 MOVE +0 TO WS-LINE-CNT DTSBR408 00350 MOVE +0 TO WS-LINE-CNT2 DTSBR408 00351 ADD +1 TO WS-PAGE-CNT DTSBR408 00352 MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT DTSBR408 00353 WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE DTSBR408 00354 WRITE PRT-RECORD FROM HEADER-2 AFTER 1 DTSBR408 00355 WRITE PRT-RECORD FROM HEADER-3 AFTER 1 DTSBR408 00356 WRITE PRT-RECORD FROM HEADER-4 AFTER 1 DTSBR408 00357 WRITE PRT-RECORD FROM HEADER-5 AFTER 1 DTSBR408 00358 WRITE PRT-RECORD FROM HEADER-6 AFTER 1 DTSBR408 00359 WRITE PRT-RECORD FROM HEADER-7 AFTER 1 DTSBR408 00360 WRITE PRT-RECORD FROM HEADER-8 AFTER 1 DTSBR408 00361 WRITE PRT-RECORD FROM HEADER-9 AFTER 1 DTSBR408 00362 WRITE PRT-RECORD FROM HEADER-10 AFTER 1 DTSBR408 00363 WRITE PRT-RECORD FROM HEADER-11 AFTER 1 DTSBR408 00364 ADD +11 TO WS-LINE-CNT2. DTSBR408 00365 DTSBR408 00366 MOVE R408-EMP-NO TO WS-EMP-NO. DTSBR408 00367 MOVE R408-PRIMARY-NAME TO WS-PRIMARY-NAME. DTSBR408 00368 DTSBR408 00369 MOVE WRK-YRQ (1) TO WRK-YRQ-1. DTSBR408 00370 MOVE WRK-YRQ (2) TO WRK-YRQ-2. DTSBR408 00371 MOVE WRK-YRQ (3) TO WRK-YRQ-3. DTSBR408 00372 MOVE WRK-YRQ (4) TO WRK-YRQ-4. DTSBR408 00373 WRITE PRT-RECORD FROM DTL-LINE-2 AFTER 2. DTSBR408 00374 ADD +1 TO WS-LINE-CNT2. DTSBR408 00375 DTSBR408 00376 IF R408-COVERED-YRQ-CNT > 4 DTSBR408 00377 MOVE WRK-YRQ (5) TO WRK-YRQ-5 DTSBR408 00378 MOVE WRK-YRQ (6) TO WRK-YRQ-6 DTSBR408 00379 MOVE WRK-YRQ (7) TO WRK-YRQ-7 DTSBR408 00380 MOVE WRK-YRQ (8) TO WRK-YRQ-8 DTSBR408 00381 WRITE PRT-RECORD FROM DTL-LINE-3 AFTER 1 DTSBR408 00382 ADD +1 TO WS-LINE-CNT2. DTSBR408 00383 DTSBR408 00384 IF R408-COVERED-YRQ-CNT > 8 DTSBR408 00385 MOVE WRK-YRQ (9) TO WRK-YRQ-9 DTSBR408 00386 MOVE WRK-YRQ (10) TO WRK-YRQ-10 DTSBR408 00387 MOVE WRK-YRQ (11) TO WRK-YRQ-11 DTSBR408 00388 MOVE WRK-YRQ (12) TO WRK-YRQ-12 DTSBR408 00389 WRITE PRT-RECORD FROM DTL-LINE-4 AFTER 1 DTSBR408 00390 ADD +1 TO WS-LINE-CNT2. DTSBR408 00391 DTSBR408 00392 IF R408-COVERED-YRQ-CNT > 12 DTSBR408 00393 MOVE WRK-YRQ (13) TO WRK-YRQ-13 DTSBR408 00394 MOVE WRK-YRQ (14) TO WRK-YRQ-14 DTSBR408 00395 MOVE WRK-YRQ (15) TO WRK-YRQ-15 DTSBR408 00396 MOVE WRK-YRQ (16) TO WRK-YRQ-16 DTSBR408 00397 WRITE PRT-RECORD FROM DTL-LINE-5 AFTER 1 DTSBR408 00398 ADD +1 TO WS-LINE-CNT2. DTSBR408 00399 DTSBR408 00400 IF R408-COVERED-YRQ-CNT > 16 DTSBR408 00401 MOVE WRK-YRQ (17) TO WRK-YRQ-17 DTSBR408 00402 MOVE WRK-YRQ (18) TO WRK-YRQ-18 DTSBR408 00403 MOVE WRK-YRQ (19) TO WRK-YRQ-19 DTSBR408 00404 MOVE WRK-YRQ (20) TO WRK-YRQ-20 DTSBR408 00405 WRITE PRT-RECORD FROM DTL-LINE-6 AFTER 1 DTSBR408 00406 ADD +1 TO WS-LINE-CNT2. DTSBR408 00407 ADD +1 TO WS-FOOTER-CNT. DTSBR408 00408 DTSBR408 00409 P3000-EXIT. DTSBR408 00410 EXIT. DTSBR408 00411 DTSBR408 00412 P4000-PRINT-FOOTER. DTSBR408 00413 IF WS-LINE-CNT2 > 52 DTSBR408 00414 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT DTSBR408 00415 END-IF. DTSBR408 00416 DTSBR408 00417 MOVE R408-OP-ID TO WS-CTF-OP-ID. DTSBR408 00418 MOVE WS-FOOTER-CNT TO WS-CTF-CNT. DTSBR408 00419 WRITE PRT-RECORD FROM CTF-LINE-3 AFTER 3. DTSBR408 00420 MOVE +0 TO WS-FOOTER-CNT. DTSBR408 00421 ADD +1 TO WS-SUM-CNT. DTSBR408 00422 MOVE +3 TO WS-LINE-CNT2. DTSBR408 00423 DTSBR408 00424 P4000-EXIT. DTSBR408 00425 EXIT. DTSBR408 00426 DTSBR408 00427 T1000-TERMINATE. DTSBR408 00428 DTSBR408 00429 MOVE WS-SUM-CNT TO WS-CFF-SUM-CNT. DTSBR408 00430 WRITE PRT-RECORD FROM CFF-LINE-2 AFTER 2. DTSBR408 00431 CLOSE PRT-FILE. DTSBR408 00432 DTSBR408 00433 T1000-EXIT. DTSBR408 00434 EXIT. DTSBR408 00435 EJECT DTSBR408 00436 S001-FROM-FED-8. DTSBR408 00437 DTSBR408 00438 SET L001-FROM-FED-8 TO TRUE. DTSBR408 00439 DTSBR408 00440 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR408 00441 DTSBR408 00442 S001-EXIT. DTSBR408 00443 EXIT. DTSBR408 00444 SKIP3 DTSBR408 00445 S004-FROM-5. DTSBR408 00446 DTSBR408 00447 SET L004-FROM-5 TO TRUE. DTSBR408 00448 DTSBR408 00449 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR408 00450 DTSBR408 00451 S004-EXIT. DTSBR408 00452 EXIT. DTSBR408 00453 SKIP3 DTSBR408 00454 *S999-ABEND. DTSBR408 00455 * DTSBR408 00456 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR408 00457 * DTSBR408 00458 *S999-EXIT. DTSBR408 00459 * EXIT. DTSBR408 00460 DTSBR408