00001  IDENTIFICATION DIVISION.                                         08/06/02
00002  PROGRAM-ID.             DTSBR120.                                DTSBR120
00003  AUTHOR.                 MT DEPT OF LABOR/UI PROGRAMMING SECTION     LV015
00004                          MODIFIED BY TRW/BDM OCT. 1998.           DTSBR120
00005  DATE-WRITTEN.           SEPTEMBER 1994.                          DTSBR120
00006  DATE-COMPILED.                                                   DTSBR120
00007                                                                   DTSBR120
00008 *****                                                             DTSBR120
00009 *                                                                 DTSBR120
00010 *    CALLING SEQUENCE:  DTSBD400 CALLS                            DTSBR120
00011 *                       DTSBE120 WHICH UPDATES DTSIR120           DTSBR120
00012 *                       DTSBR120 READS DTSIR120 RECORDS.          DTSBR120
00013 *                                                                 DTSBR120
00014 *    FUNCTION:  POTENTIALLY FICTITIOUS EMPLOYERS LIST.            DTSBR120
00015 *                                                                 DTSBR120
00016 *                                                                 DTSBR120
00017 *    MODIFICATION HISTORY:                                        DTSBR120
00018 *                                                                 DTSBR120
00019 * 09-25-94 INITIAL DEVELOPMENT                                    DTSBR120
00020 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - SFW  DTSBR120
00021 *                                                                 DTSBR120
00022 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR120
00023 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR120
00024 *          REFERENCE RFP #****            AUTHOR OF CHANGE - XXX  DTSBR120
00025 *                                                                 DTSBR120
00026 *                                                                 DTSBR120
00027 *    DESCRIPTION:                                                 DTSBR120
00028 *                                                                 DTSBR120
00029 *        THIS MODULE ATTEMPTS TO IDENTIFY FICTITIOUS EMPLOYERS    DTSBR120
00030 *        ESTABLISHED FOR THE PURPOSES OF FRAUDULENT BENEFIT       DTSBR120
00031 *        CLAIMS.                                                  DTSBR120
00032 *                                                                 DTSBR120
00033 *                                                                 DTSBR120
00034 *    RECORDS READ:                                                DTSBR120
00035 *                                                                 DTSBR120
00036 *        NONE.                                                    DTSBR120
00037 *                                                                 DTSBR120
00038 *                                                                 DTSBR120
00039 *    PRINTED OUTPUTS:                                             DTSBR120
00040 *                                                                 DTSBR120
00041 *        120R1  POTENTIALLY FICTITIOUS EMPLOYERS LIST             DTSBR120
00042 *                                                                 DTSBR120
00043 *                                                                 DTSBR120
00044 *    RECORDS WRITTEN:                                             DTSBR120
00045 *                                                                 DTSBR120
00046 *        NONE.                                                    DTSBR120
00047 *                                                                 DTSBR120
00048 *                                                                 DTSBR120
00049 *    MODULES CALLED:                                              DTSBR120
00050 *                                                                 DTSBR120
00051 *        DTSBU001 DATE EDIT/CONVERSION MODULE                     DTSBR120
00052 *                                                                 DTSBR120
00053 *                                                                 DTSBR120
00054 *****                                                             DTSBR120
00055      EJECT                                                        DTSBR120
00056  ENVIRONMENT DIVISION.                                            DTSBR120
00057                                                                   DTSBR120
00058  CONFIGURATION SECTION.                                           DTSBR120
00059  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBR120
00060                                                                   DTSBR120
00061  INPUT-OUTPUT SECTION.                                            DTSBR120
00062                                                                   DTSBR120
00063  FILE-CONTROL.                                                    DTSBR120
00064      SELECT PRT-FILE ASSIGN TO RPT120R1.                          DTSBR120
00065                                                                   DTSBR120
00066      SELECT CHG-PARM-FILE  ASSIGN TO CHGPARM                      DTSBR120
00067             FILE STATUS IS CHG-PARM-STATUS.                       DTSBR120
00068                                                                   DTSBR120
00069  DATA DIVISION.                                                   DTSBR120
00070                                                                   DTSBR120
00071  FILE SECTION.                                                    DTSBR120
00072                                                                   DTSBR120
00073  FD  PRT-FILE                                                     DTSBR120
00074      RECORDING MODE IS F.                                         DTSBR120
00075  01  PRT-RECORD              PIC X(133).                          DTSBR120
00076                                                                   DTSBR120
00077  FD  CHG-PARM-FILE                                                DTSBR120
00078      RECORDING MODE IS F                                          DTSBR120
00079      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBR120
00080      SKIP1                                                        DTSBR120
00081  01  CHG-PARM-REC.                                                DTSBR120
00082  ++INCLUDE CHGIM003                                               DTSBR120
00083                                                                   DTSBR120
00084      EJECT                                                        DTSBR120
00085  WORKING-STORAGE SECTION.                                         DTSBR120
000855 77  PAN-VALET PICTURE X(24) VALUE '015DTSBR120  08/06/02'.       DTSBR120
00086                                                                   DTSBR120
00087  01  WRK-AREA.                                                    DTSBR120
00088      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +120.DTSBR120
00089      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBR120
00090      05  WS-NUMBER-ONE               PIC S9(03)  COMP-3 VALUE +0. DTSBR120
00091                                                                   DTSBR120
00092      05  WS-LINE-CNT                 PIC S9(02) COMP-3 VALUE 56.  DTSBR120
00093      05  WS-LINE-CNT2                PIC S9(02) COMP-3 VALUE +0.  DTSBR120
00094      05  WS-PAGE-CNT                 PIC S9(03) COMP-3 VALUE +0.  DTSBR120
00095                                                                   DTSBR120
00096      05  CHG-PARM-STATUS             PIC  X(02) VALUE SPACES.     DTSBR120
00097           88  CHG-PARM-FILE-OK-88      VALUE ZERO.                DTSBR120
00098           88  CHG-PARM-FILE-EOF-88     VALUE '10'.                DTSBR120
00099                                                                   DTSBR120
00100      EJECT                                                        DTSBR120
00101  01  L001-LINK-AREA.                                              DTSBR120
00102  ++INCLUDE DTSIL001                                               DTSBR120
00103      EJECT                                                        DTSBR120
00104                                                                   DTSBR120
00105  01  HEADER-1.                                                    DTSBR120
00106      05  FILLER                   PIC X(01) VALUE SPACES.         DTSBR120
00107      05  FILLER                   PIC X(49) VALUE '120R1'.        DTSBR120
00108      05  FILLER                   PIC X(60) VALUE                 DTSBR120
00109          'DISTRICT OF COLUMBIA'.                                  DTSBR120
00110      05  FILLER                   PIC X(06) VALUE 'DATE:'.        DTSBR120
00111      05  HDR1-LRCM-SYS-DATE       PIC X(08).                      DTSBR120
00112                                                                   DTSBR120
00113  01  HEADER-2.                                                    DTSBR120
00114      05  FILLER                   PIC X(54) VALUE SPACES.         DTSBR120
00115      05  FILLER                   PIC X(56) VALUE                 DTSBR120
00116          'TAX DIVISION'.                                          DTSBR120
00117      05  FILLER                   PIC X(06) VALUE 'TIME:'.        DTSBR120
00118      05  HDR2-LRCM-SYS-TIME       PIC X(08).                      DTSBR120
00119                                                                   DTSBR120
00120  01  HEADER-3.                                                    DTSBR120
00121      05  FILLER                   PIC X(01) VALUE SPACES.         DTSBR120
00122      05  FILLER                   PIC X(41) VALUE                 DTSBR120
00123          'ROUTE TO:  TAX CHIEF'.                                  DTSBR120
00124      05  HDR3-LITERAL             PIC X(60) VALUE                 DTSBR120
00125          'POTENTIALLY FICTITIOUS EMPLOYERS LIST'.                 DTSBR120
00126      05  FILLER                   PIC X(08) VALUE SPACES.         DTSBR120
00127      05  FILLER                   PIC X(06) VALUE 'PAGE:'.        DTSBR120
00128      05  HDR3-PAGE                PIC ZZ,ZZ9.                     DTSBR120
00129                                                                   DTSBR120
00130  01  HEADER-4.                                                    DTSBR120
00131      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00132      05  FILLER                   PIC X(132) VALUE SPACES.        DTSBR120
00133                                                                   DTSBR120
00134  01  HEADER-5.                                                    DTSBR120
00135      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00136      05  FILLER                   PIC X(16)  VALUE                DTSBR120
00137                       'LIABILITY DATES:'.                         DTSBR120
00138      05  FILLER                   PIC X(13)  VALUE SPACES.        DTSBR120
00139      05  FILLER                   PIC X(21)  VALUE                DTSBR120
00140                       'BENEFIT CHARGE DATES:'.                    DTSBR120
00141                                                                   DTSBR120
00142  01  HEADER-6.                                                    DTSBR120
00143      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00144      05  FILLER                   PIC X(132) VALUE SPACES.        DTSBR120
00145                                                                   DTSBR120
00146  01  HEADER-7.                                                    DTSBR120
00147      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00148      05  WS-BEGIN-LIAB-DATE       PIC X(08).                      DTSBR120
00149      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00150      05  FILLER                   PIC X(01)  VALUE '-'.           DTSBR120
00151      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00152      05  WS-END-LIAB-DATE         PIC X(08).                      DTSBR120
00153      05  FILLER                   PIC X(10)  VALUE SPACES.        DTSBR120
00154      05  WS-BEGIN-CHRG-DATE       PIC X(08).                      DTSBR120
00155      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00156      05  FILLER                   PIC X(01)  VALUE '-'.           DTSBR120
00157      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00158      05  WS-END-CHRG-DATE         PIC X(08).                      DTSBR120
00159                                                                   DTSBR120
00160  01  HEADER-8.                                                    DTSBR120
00161      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00162      05  FILLER                   PIC X(132) VALUE SPACES.        DTSBR120
00163                                                                   DTSBR120
00164  01  HEADER-9.                                                    DTSBR120
00165      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00166      05  FILLER                   PIC X(19)  VALUE                DTSBR120
00167                       'MAXIMUM # EMPLOYEES'.                      DTSBR120
00168                                                                   DTSBR120
00169  01  HEADER-10.                                                   DTSBR120
00170      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00171      05  FILLER                   PIC X(02)  VALUE SPACES.        DTSBR120
00172      05  WS-MAX-EMPLOYEES         PIC ZZ9.                        DTSBR120
00173                                                                   DTSBR120
00174  01  HEADER-11.                                                   DTSBR120
00175      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00176      05  FILLER                   PIC X(132) VALUE SPACES.        DTSBR120
00177                                                                   DTSBR120
00178  01  HEADER-12.                                                   DTSBR120
00179      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00180      05  FILLER                   PIC X(58)  VALUE SPACES.        DTSBR120
00181      05  FILLER                   PIC X(09)  VALUE                DTSBR120
00182                       'LIABILITY'.                                DTSBR120
00183      05  FILLER                   PIC X(07)  VALUE SPACES.        DTSBR120
00184      05  FILLER                   PIC X(08)  VALUE                DTSBR120
00185                       'BENEFITS'.                                 DTSBR120
00186                                                                   DTSBR120
00187  01  HEADER-13.                                                   DTSBR120
00188      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00189      05  FILLER                   PIC X(04)  VALUE SPACES.        DTSBR120
00190      05  FILLER                   PIC X(06)  VALUE                DTSBR120
00191                       'EMP NO'.                                   DTSBR120
00192      05  FILLER                   PIC X(05)  VALUE SPACES.        DTSBR120
00193      05  FILLER                   PIC X(13)  VALUE                DTSBR120
00194                       'PRIMARY NAME'.                             DTSBR120
00195      05  FILLER                   PIC X(32)  VALUE SPACES.        DTSBR120
00196      05  FILLER                   PIC X(04)  VALUE                DTSBR120
00197                       'DATE'.                                     DTSBR120
00198      05  FILLER                   PIC X(10)  VALUE SPACES.        DTSBR120
00199      05  FILLER                   PIC X(07)  VALUE                DTSBR120
00200                       'CHARGED'.                                  DTSBR120
00201      05  FILLER                   PIC X(09)  VALUE SPACES.        DTSBR120
00202      05  FILLER                   PIC X(10)  VALUE                DTSBR120
00203                       'TAXES PAID'.                               DTSBR120
00204                                                                   DTSBR120
00205  01  HEADER-14.                                                   DTSBR120
00206      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR120
00207      05  FILLER                   PIC X(132) VALUE SPACES.        DTSBR120
00208                                                                   DTSBR120
00209  01  DETAIL-LINE-15.                                              DTSBR120
00210      05  FILLER                  PIC  X(05)  VALUE SPACES.        DTSBR120
00211      05  WS-EMP-NO               PIC  999B999.                    DTSBR120
00212      05  FILLER                  PIC  X(02)  VALUE SPACES.        DTSBR120
00213      05  WS-PRIMARY-NAME         PIC  X(40).                      DTSBR120
00214      05  FILLER                  PIC  X(05)  VALUE SPACES.        DTSBR120
00215      05  WS-OLDEST-LIAB-DATE     PIC  X(08).                      DTSBR120
00216      05  FILLER                  PIC  X(04)  VALUE SPACES.        DTSBR120
00217      05  WS-BENEFIT-CHARGES      PIC  ZZZ,ZZZ,ZZ9.99.             DTSBR120
00218      05  FILLER                  PIC  X(04)  VALUE SPACES.        DTSBR120
00219      05  WS-PAID-AMT             PIC  ZZZ,ZZZ,ZZ9.99.             DTSBR120
00220                                                                   DTSBR120
00221  01  FOOTING-LINE-1               PIC X(133) VALUE SPACES.        DTSBR120
00222  01  FOOTING-LINE-2               PIC X(133) VALUE SPACES.        DTSBR120
00223                                                                   DTSBR120
00224  01  FOOTING-LINE-3.                                              DTSBR120
00225      05  FILLER                   PIC  X(69)  VALUE SPACES.       DTSBR120
00226      05  WS-FOOTING-CNT           PIC  ZZ,ZZ9.                    DTSBR120
00227      05  FILLER                   PIC  X(02)  VALUE SPACES.       DTSBR120
00228      05  FILLER                   PIC  X(24)  VALUE               DTSBR120
00229                       'EMPLOYER ACCOUNTS LISTED'.                 DTSBR120
00230  01  FOOTING-LINE-4               PIC X(133)  VALUE SPACES.       DTSBR120
00231  01  FOOTING-LINE-5.                                              DTSBR120
00232      05  FILLER                   PIC  X(25) VALUE SPACES.        DTSBR120
00233      05  FILLER                   PIC  X(17) VALUE                DTSBR120
00234                       '*** END OF REPORT'.                        DTSBR120
00235      EJECT                                                        DTSBR120
00236  LINKAGE SECTION.                                                 DTSBR120
00237                                                                   DTSBR120
00238  01  LRCM-LINK-AREA.                                              DTSBR120
00239  ++INCLUDE DTSILRCM                                               DTSBR120
00240      EJECT                                                        DTSBR120
00241  01  R120-REC.                                                    DTSBR120
00242  ++INCLUDE DTSIR120                                               DTSBR120
00243      EJECT                                                        DTSBR120
00244  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR120
00245                           R120-REC.                               DTSBR120
00246                                                                   DTSBR120
00247      IF FIRST-TIME-IND = 'Y'                                      DTSBR120
00248          PERFORM I1000-INITIATE THRU I1000-EXIT                   DTSBR120
00249          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR120
00250                                                                   DTSBR120
00251      IF LRCM-EOR-88                                               DTSBR120
00252          PERFORM T1000-TERMINATE THRU T1000-EXIT                  DTSBR120
00253      ELSE                                                         DTSBR120
00254          PERFORM P1000-PROCESS THRU P1000-EXIT.                   DTSBR120
00255                                                                   DTSBR120
00256      GOBACK.                                                      DTSBR120
00257      EJECT                                                        DTSBR120
00258  I1000-INITIATE.                                                  DTSBR120
00259                                                                   DTSBR120
00260      MOVE R120-MAX-EMPLOYEES   TO WS-MAX-EMPLOYEES.               DTSBR120
00261                                                                   DTSBR120
00262      MOVE R120-BEGIN-LIAB-DATE TO L001-FED-8-DATE-9.              DTSBR120
00263      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR120
00264      PERFORM S001-DATE THRU S001-EXIT.                            DTSBR120
00265      MOVE L001-SLASH-DATE TO WS-BEGIN-LIAB-DATE.                  DTSBR120
00266                                                                   DTSBR120
00267      MOVE R120-END-LIAB-DATE TO L001-FED-8-DATE-9.                DTSBR120
00268      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR120
00269      PERFORM S001-DATE THRU S001-EXIT.                            DTSBR120
00270      MOVE L001-SLASH-DATE TO WS-END-LIAB-DATE.                    DTSBR120
00271                                                                   DTSBR120
00272      OPEN OUTPUT PRT-FILE.                                        DTSBR120
00273      MOVE LRCM-SYS-DATE TO HDR1-LRCM-SYS-DATE.                    DTSBR120
00274      MOVE LRCM-SYS-TIME TO HDR2-LRCM-SYS-TIME.                    DTSBR120
00275      MOVE SPACES TO PRT-RECORD.                                   DTSBR120
00276                                                                   DTSBR120
00277      OPEN INPUT CHG-PARM-FILE.                                    DTSBR120
00278      IF NOT CHG-PARM-FILE-OK-88                                   DTSBR120
00279          DISPLAY 'PARM5 FILE OPEN ERROR: ' CHG-PARM-STATUS        DTSBR120
00280          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBR120
00281                                                                   DTSBR120
00282      READ CHG-PARM-FILE.                                          DTSBR120
00283      IF NOT CHG-PARM-FILE-OK-88                                   DTSBR120
00284          DISPLAY 'PARM FILE READ ERROR: ' CHG-PARM-STATUS         DTSBR120
00285          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBR120
00286                                                                   DTSBR120
00287      MOVE CHG3-BEGIN-DATE TO L001-FED-8-DATE-9.                   DTSBR120
00288      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR120
00289      PERFORM S001-DATE THRU S001-EXIT.                            DTSBR120
00290      MOVE L001-SLASH-DATE TO WS-BEGIN-CHRG-DATE.                  DTSBR120
00291                                                                   DTSBR120
00292      MOVE CHG3-END-DATE TO L001-FED-8-DATE-9.                     DTSBR120
00293      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR120
00294      PERFORM S001-DATE THRU S001-EXIT.                            DTSBR120
00295      MOVE L001-SLASH-DATE TO WS-END-CHRG-DATE.                    DTSBR120
00296                                                                   DTSBR120
00297      CLOSE CHG-PARM-FILE.                                         DTSBR120
00298                                                                   DTSBR120
00299  I1000-EXIT.                                                      DTSBR120
00300      EXIT.                                                        DTSBR120
00301      EJECT                                                        DTSBR120
00302  P1000-PROCESS.                                                   DTSBR120
00303                                                                   DTSBR120
00304      MOVE R120-OLDEST-LIAB-DATE TO L001-FED-8-DATE-9.             DTSBR120
00305      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR120
00306      PERFORM S001-DATE THRU S001-EXIT.                            DTSBR120
00307      MOVE L001-SLASH-DATE TO WS-OLDEST-LIAB-DATE.                 DTSBR120
00308      MOVE R120-EMP-NO           TO WS-EMP-NO.                     DTSBR120
00309      MOVE R120-PRIMARY-NAME     TO WS-PRIMARY-NAME.               DTSBR120
00310      MOVE R120-BENEFIT-CHARGES  TO WS-BENEFIT-CHARGES.            DTSBR120
00311      MOVE R120-PAID-AMT         TO WS-PAID-AMT.                   DTSBR120
00312                                                                   DTSBR120
00313      PERFORM P2000-PRINT-HEADER THRU P2000-EXIT.                  DTSBR120
00314      WRITE PRT-RECORD FROM DETAIL-LINE-15 AFTER 1.                DTSBR120
00315      ADD  1    TO WS-LINE-CNT2.                                   DTSBR120
00316      ADD +1    TO WS-NUMBER-ONE.                                  DTSBR120
00317                                                                   DTSBR120
00318  P1000-EXIT.                                                      DTSBR120
00319      EXIT.                                                        DTSBR120
00320      EJECT                                                        DTSBR120
00321                                                                   DTSBR120
00322  P2000-PRINT-HEADER.                                              DTSBR120
00323      IF WS-LINE-CNT GREATER 55 OR                                 DTSBR120
00324           WS-LINE-CNT2 GREATER 55                                 DTSBR120
00325         MOVE +0          TO WS-LINE-CNT                           DTSBR120
00326         MOVE +0          TO WS-LINE-CNT2                          DTSBR120
00327         ADD  +1          TO WS-PAGE-CNT                           DTSBR120
00328         MOVE WS-PAGE-CNT TO HDR3-PAGE                             DTSBR120
00329         WRITE PRT-RECORD FROM HEADER-1 AFTER TOP-OF-PAGE          DTSBR120
00330         WRITE PRT-RECORD FROM HEADER-2 AFTER 1                    DTSBR120
00331         WRITE PRT-RECORD FROM HEADER-3 AFTER 1                    DTSBR120
00332         WRITE PRT-RECORD FROM HEADER-4 AFTER 1                    DTSBR120
00333         WRITE PRT-RECORD FROM HEADER-5 AFTER 1                    DTSBR120
00334         WRITE PRT-RECORD FROM HEADER-6 AFTER 1                    DTSBR120
00335         WRITE PRT-RECORD FROM HEADER-7 AFTER 1                    DTSBR120
00336         WRITE PRT-RECORD FROM HEADER-8 AFTER 1                    DTSBR120
00337         WRITE PRT-RECORD FROM HEADER-9 AFTER 1                    DTSBR120
00338         WRITE PRT-RECORD FROM HEADER-10 AFTER 1                   DTSBR120
00339         WRITE PRT-RECORD FROM HEADER-11 AFTER 1                   DTSBR120
00340         WRITE PRT-RECORD FROM HEADER-12 AFTER 1                   DTSBR120
00341         WRITE PRT-RECORD FROM HEADER-13 AFTER 1                   DTSBR120
00342         WRITE PRT-RECORD FROM HEADER-14 AFTER 1                   DTSBR120
00343         ADD +14   TO WS-LINE-CNT2.                                DTSBR120
00344  P2000-EXIT.                                                      DTSBR120
00345      EXIT.                                                        DTSBR120
00346  T1000-TERMINATE.                                                 DTSBR120
00347                                                                   DTSBR120
00348      IF WS-LINE-CNT2 > 52                                         DTSBR120
00349         PERFORM P2000-PRINT-HEADER THRU P2000-EXIT                DTSBR120
00350      END-IF.                                                      DTSBR120
00351      MOVE WS-NUMBER-ONE TO WS-FOOTING-CNT.                        DTSBR120
00352      WRITE PRT-RECORD FROM FOOTING-LINE-1 AFTER 1.                DTSBR120
00353      WRITE PRT-RECORD FROM FOOTING-LINE-2 AFTER 1.                DTSBR120
00354      WRITE PRT-RECORD FROM FOOTING-LINE-3 AFTER 1.                DTSBR120
00355      WRITE PRT-RECORD FROM FOOTING-LINE-4 AFTER 1.                DTSBR120
00356      WRITE PRT-RECORD FROM FOOTING-LINE-5 AFTER 1.                DTSBR120
00357      CLOSE PRT-FILE.                                              DTSBR120
00358                                                                   DTSBR120
00359  T1000-EXIT.                                                      DTSBR120
00360      EXIT.                                                        DTSBR120
00361      EJECT                                                        DTSBR120
00362  S001-DATE.                                                       DTSBR120
00363                                                                   DTSBR120
00364      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBR120
00365                                                                   DTSBR120
00366  S001-EXIT.                                                       DTSBR120
00367      EXIT.                                                        DTSBR120
00368                                                                   DTSBR120
00369  S999-ABEND.                                                      DTSBR120
00370                                                                   DTSBR120
00371      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBR120
00372                                                                   DTSBR120
00373  S999-EXIT.                                                       DTSBR120
00374      EXIT.                                                        DTSBR120
