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