00001  IDENTIFICATION DIVISION.                                         05/19/21
00002  PROGRAM-ID.             DTSBR439.                                DTSBR439
00003  AUTHOR.                 TRW/RW1.                                    LV023
00004  DATE-WRITTEN.           APRIL 2002.                              DTSBR439
00005  DATE-COMPILED.                                                   DTSBR439
00006                                                                   DTSBR439
00007 ***                                                                  CL*20
00008 *                                                                 DTSBR439
00009 *    CALLING SEQUENCE:  DTSBD400 CALLS                            DTSBR439
00010 *                       DTSBE439 WHICH UPDATES DTSIR439           DTSBR439
00011 *                       DTSBR439 READS DTSIR439 RECORDS.          DTSBR439
00012 *                                                                 DTSBR439
00013 *    FUNCTION:  REPORT EMPLOYERS WITH BALANCE DUE WHO HAVE BEEN   DTSBR439
00014 *               INACTIVE FOR AT LEAST THREE YEARS AND WHO DO NOT  DTSBR439
00015 *               HAVE A SUCCESSOR.                                 DTSBR439
00016 *                                                                 DTSBR439
00017 *    MODIFICATION HISTORY:                                        DTSBR439
00018 *                                                                 DTSBR439
00019 * 04-09-02 INITIAL DEVELOPMENT                                    DTSBR439
00020 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - RW1  DTSBR439
00021 *                                                                 DTSBR439
00022 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR439
00023 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR439
00024 *          REFERENCE RFP #****            AUTHOR OF CHANGE - XXX  DTSBR439
00025 *                                                                 DTSBR439
00026 *                                                                 DTSBR439
00027 *    DESCRIPTION:                                                 DTSBR439
00028 *                                                                 DTSBR439
00029 *        THIS MODULE ATTEMPTS TO WRITE-OFF CANDIDATES WITH A      DTSBR439
00030 *        BALANCE DUE WHO HAVE BEEN INACTIVE AT LEAST 3 YEARS.     DTSBR439
00031 *                                                                 DTSBR439
00032 *                                                                 DTSBR439
00033 *    RECORDS READ:                                                DTSBR439
00034 *                                                                 DTSBR439
00035 *        NONE.                                                    DTSBR439
00036 *                                                                 DTSBR439
00037 *                                                                 DTSBR439
00038 *    PRINTED OUTPUTS:                                             DTSBR439
00039 *                                                                 DTSBR439
00040 *        430R1  WRITE-OFF CANDIDATES AS REQUEST'S REPORT.         DTSBR439
00041 *                                                                 DTSBR439
00042 *                                                                 DTSBR439
00043 *    RECORDS WRITTEN:                                             DTSBR439
00044 *                                                                 DTSBR439
00045 *        NONE.                                                    DTSBR439
00046 *                                                                 DTSBR439
00047 *                                                                 DTSBR439
00048 *    MODULES CALLED:                                              DTSBR439
00049 *                                                                 DTSBR439
00050 *        DTSBU001 DATE EDIT/CONVERSION MODULE                     DTSBR439
00051 *                                                                 DTSBR439
00052 *                                                                 DTSBR439
00053 *****                                                             DTSBR439
00054      EJECT                                                        DTSBR439
00055  ENVIRONMENT DIVISION.                                            DTSBR439
00056                                                                   DTSBR439
00057  CONFIGURATION SECTION.                                           DTSBR439
00058  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBR439
00059                                                                   DTSBR439
00060  INPUT-OUTPUT SECTION.                                            DTSBR439
00061                                                                   DTSBR439
00062  FILE-CONTROL.                                                    DTSBR439
00063      SELECT PRT-FILE1 ASSIGN TO RPT439R1.                         DTSBR439
00064      SELECT PRT-FILE2 ASSIGN TO RPT439R2.                            CL**3
00065                                                                   DTSBR439
00066  DATA DIVISION.                                                   DTSBR439
00067                                                                   DTSBR439
00068  FILE SECTION.                                                    DTSBR439
00069                                                                   DTSBR439
00070  FD  PRT-FILE1                                                    DTSBR439
00071      RECORDING MODE IS F.                                         DTSBR439
00072  01  PRT-CREDITS             PIC X(133).                             CL**3
00073      EJECT                                                        DTSBR439
00074                                                                   DTSBR439
00075  FD  PRT-FILE2                                                       CL**3
00076      RECORDING MODE IS F.                                            CL**3
00077  01  PRT-DEBITS              PIC X(133).                             CL**3
00078      EJECT                                                           CL**3
00079                                                                      CL**3
00080  WORKING-STORAGE SECTION.                                         DTSBR439
000805 77  PAN-VALET PICTURE X(24) VALUE '023DTSBR439  05/19/21'.       DTSBR439
00081  77  PAN-VALET PICTURE X(24) VALUE '022DTSBR439  10/02/07'.       DTSBR439
00082                                                                   DTSBR439
00083  01  WRK-AREA.                                                    DTSBR439
00084      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +439.DTSBR439
00085      05  WRK-ABEND-MSG               PIC  X(60)  VALUE SPACES.    DTSBR439
00086      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBR439
00087      05  WS-NUMBER-ONE               PIC S9(05)  COMP-3 VALUE +0. DTSBR439
00088      05  WS-DNUMBER-ONE              PIC S9(05)  COMP-3 VALUE +0.    CL**5
00089      05  WS-TOTAL-CDT-AMT        PIC S9(11)V99   COMP-3 VALUE +0.    CL*19
00090      05  WS-TOTAL-DBT-AMT        PIC S9(11)V99   COMP-3 VALUE +0.    CL*19
00091                                                                   DTSBR439
00092      05  WS-LINE-CNT                 PIC S9(02) COMP-3 VALUE 60.  DTSBR439
00093      05  WS-LINE-CNT2                PIC S9(02) COMP-3 VALUE +0.  DTSBR439
00094      05  WS-PAGE-CNT                 PIC S9(03) COMP-3 VALUE +0.  DTSBR439
00095      05  WS-DLINE-CNT                PIC S9(02) COMP-3 VALUE 60.     CL**5
00096      05  WS-DLINE-CNT2               PIC S9(02) COMP-3 VALUE +0.     CL**5
00097      05  WS-DPAGE-CNT                PIC S9(03) COMP-3 VALUE +0.     CL**5
00098                                                                   DTSBR439
00099      05  WRK-START-YRQ               PIC  9(05).                  DTSBR439
00100      05  FILLER REDEFINES WRK-START-YRQ.                          DTSBR439
00101          10  WRK-START-YRQ-Y         PIC  X(04).                  DTSBR439
00102          10  WRK-START-YRQ-Q         PIC  X(01).                  DTSBR439
00103                                                                   DTSBR439
00104      EJECT                                                        DTSBR439
00105  01  L001-LINK-AREA.                                              DTSBR439
00106  ++INCLUDE DTSIL001                                               DTSBR439
00107      EJECT                                                        DTSBR439
00108  01  L004-LINK-AREA.                                              DTSBR439
00109  ++INCLUDE DTSIL004                                               DTSBR439
00110                                                                   DTSBR439
00111  01  HEADER-VAR.                                                     CL**5
00112      05  HDR-CREDITS              PIC X(50) VALUE                    CL**3
00113          '    WRITE OFF CANDIDATES LIST - CREDITS           '.       CL**3
00114                                                                      CL**3
00115      05  HDR-DEBITS               PIC X(50) VALUE                    CL**3
00116          '    WRITE OFF CANDIDATES LIST - DEBITS            '.       CL**3
00117                                                                      CL**3
00118      05  FOOTING-CREDITS       PIC  X(45) VALUE                      CL**3
00119           'CREDITS WRITE OFF CANDIDATES                 '.           CL*19
00120                                                                      CL**3
00121      05  FOOTING-DEBITS        PIC  X(45) VALUE                      CL**3
00122           'DEBITS WRITE OFF CANDIDATES                  '.           CL*19
00123                                                                      CL**3
00124  01  HEADER-1.                                                       CL**5
00125      05  FILLER                   PIC X(01) VALUE SPACES.            CL**5
00126      05  FILLER                   PIC X(49) VALUE '439R1'.           CL**5
00127      05  FILLER                   PIC X(60) VALUE                    CL**5
00128          'DISTRICT OF COLUMBIA'.                                     CL**5
00129      05  FILLER                   PIC X(06) VALUE 'DATE:'.           CL**5
00130      05  HDR1-LRCM-SYS-DATE       PIC X(08).                         CL**5
00131                                                                      CL**5
00132  01  HEADER-2.                                                       CL**5
00133      05  FILLER                   PIC X(54) VALUE SPACES.            CL**5
00134      05  FILLER                   PIC X(56) VALUE                    CL**5
00135          'TAX DIVISION'.                                             CL**5
00136      05  FILLER                   PIC X(06) VALUE 'TIME:'.           CL**5
00137      05  HDR2-LRCM-SYS-TIME       PIC X(08).                         CL**5
00138                                                                      CL**5
00139  01  HEADER-3.                                                    DTSBR439
00140      05  FILLER                   PIC X(01) VALUE SPACES.         DTSBR439
00141      05  FILLER                   PIC X(38) VALUE                 DTSBR439
00142          'ROUTE TO:  ACCOUNTING UNIT'.                            DTSBR439
00143      05  HDR3-LITERAL             PIC X(50) VALUE SPACES.            CL**6
00144      05  FILLER                   PIC X(21) VALUE SPACES.         DTSBR439
00145      05  FILLER                   PIC X(06) VALUE 'PAGE:'.        DTSBR439
00146      05  HDR3-PAGE                PIC ZZ,ZZ9.                     DTSBR439
00147                                                                   DTSBR439
00148  01  HEADER-4.                                                    DTSBR439
00149      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR439
00150      05  FILLER                   PIC X(25) VALUE                 DTSBR439
00151          'INACTIVITY CUTOFF YRQ  : '.                             DTSBR439
00152      05  HDR4-CUTOFF-YRQ          PIC X(06).                      DTSBR439
00153      05  FILLER                   PIC X(101) VALUE SPACES.        DTSBR439
00154                                                                   DTSBR439
00155  01  HEADER-5.                                                    DTSBR439
00156      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR439
00157      05  FILLER                   PIC X(132) VALUE SPACES.        DTSBR439
00158                                                                   DTSBR439
00159  01  HEADER-6.                                                    DTSBR439
00160      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR439
00161      05  FILLER                   PIC X(55)  VALUE SPACES.           CL**9
00162      05  FILLER                   PIC X(05)  VALUE 'FIELD'.       DTSBR439
00163      05  FILLER                   PIC X(05)  VALUE SPACES.        DTSBR439
00164      05  FILLER                   PIC X(14)  VALUE                DTSBR439
00165                       '      BALANCE '.                              CL*11
00166      05  FILLER                   PIC X(03)  VALUE SPACES.           CL*14
00167      05  FILLER                   PIC X(11)  VALUE                DTSBR439
00168                       ' MISS      '.                                 CL*15
00169      05  FILLER                   PIC X(12)  VALUE SPACES.           CL*14
00170      05  FILLER                   PIC X(11)  VALUE                   CL*11
00171                       'LAST       '.                                 CL*11
00172      05  FILLER                   PIC X(04)  VALUE SPACES.           CL*12
00173      05  FILLER                   PIC X(11)  VALUE                   CL*12
00174                       'LAST       '.                                 CL*12
00175                                                                   DTSBR439
00176  01  HEADER-7.                                                    DTSBR439
00177      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR439
00178      05  FILLER                   PIC X(05)  VALUE SPACES.        DTSBR439
00179      05  FILLER                   PIC X(06)  VALUE                DTSBR439
00180                       'EMP NO'.                                   DTSBR439
00181      05  FILLER                   PIC X(05)  VALUE SPACES.        DTSBR439
00182      05  FILLER                   PIC X(12)  VALUE                DTSBR439
00183                       'PRIMARY NAME'.                             DTSBR439
00184      05  FILLER                   PIC X(27)  VALUE SPACES.           CL*14
00185      05  FILLER                   PIC X(04)  VALUE 'CODE'.        DTSBR439
00186      05  FILLER                   PIC X(15)  VALUE SPACES.           CL*14
00187      05  FILLER                   PIC X(03)  VALUE 'DUE'.         DTSBR439
00188      05  FILLER                   PIC X(07)  VALUE SPACES.           CL*17
00189      05  FILLER                   PIC X(05)  VALUE                   CL*18
00190                       'RPT  '.                                       CL*14
00191      05  FILLER                   PIC X(01)  VALUE SPACES.           CL*14
00192      05  FILLER                   PIC X(03)  VALUE 'DPC'.         DTSBR439
00193      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*16
00194      05  FILLER                   PIC X(04)  VALUE 'LIEN'.        DTSBR439
00195      05  FILLER                   PIC X(03)  VALUE SPACES.           CL*18
00196      05  FILLER                   PIC X(07)  VALUE 'LIA-YRQ'.        CL**8
00197      05  FILLER                   PIC X(08)  VALUE SPACES.           CL*19
00198      05  FILLER                   PIC X(07)  VALUE 'UPD-DTE'.        CL*14
00199                                                                   DTSBR439
00200  01  HEADER-8.                                                    DTSBR439
00201      05  FILLER                   PIC X(01)  VALUE SPACES.        DTSBR439
00202      05  FILLER                   PIC X(132) VALUE SPACES.        DTSBR439
00203                                                                   DTSBR439
00204  01  DETAIL-LINE-1.                                               DTSBR439
00205      05  FILLER                  PIC  X(05)  VALUE SPACES.        DTSBR439
00206      05  WS-EMP-NO               PIC  999B999.                    DTSBR439
00207      05  FILLER                  PIC  X(02)  VALUE SPACES.        DTSBR439
00208      05  WS-PRIMARY-NAME         PIC  X(36).                         CL**8
00209      05  FILLER                  PIC  X(02)  VALUE SPACES.           CL**2
00210      05  WS-EMP-STATUS           PIC  X(04).                         CL**2
00211      05  FILLER                  PIC  X(02)  VALUE SPACES.           CL**2
00212      05  WS-FIELD-CODE           PIC  X(02).                      DTSBR439
00213      05  FILLER                  PIC  X(05)  VALUE SPACES.        DTSBR439
00214      05  WS-BALANCE-AMT          PIC  ZZZ,ZZZ,ZZ9.99-.            DTSBR439
00215      05  FILLER                  PIC  X(05)  VALUE SPACES.           CL**8
00216      05  WS-PURSUED-RPT          PIC  ZZ9.                        DTSBR439
00217      05  FILLER                  PIC  X(05)  VALUE SPACES.           CL**8
00218      05  WS-DPC                  PIC  X(01).                      DTSBR439
00219      05  FILLER                  PIC  X(05)  VALUE SPACES.           CL**8
00220      05  WS-LIEN                 PIC  X(03).                         CL*10
00221      05  FILLER                  PIC  X(02)  VALUE SPACES.           CL**2
00222      05  WS-LIAB-YRQ             PIC  X(06)  VALUE SPACES.           CL**7
00223      05  FILLER                  PIC  X(05).                         CL*10
00224      05  WS-LAST-DTE             PIC  X(10)  VALUE SPACES.           CL**7
00225                                                                   DTSBR439
00226  01  FOOTING-LINE-1               PIC X(133) VALUE SPACES.        DTSBR439
00227  01  FOOTING-LINE-2               PIC X(133) VALUE SPACES.        DTSBR439
00228                                                                   DTSBR439
00229  01  FOOTING-LINE-3.                                              DTSBR439
00230      05  FILLER                   PIC  X(25)  VALUE SPACES.       DTSBR439
00231      05  WS-FOOTING-CNT           PIC  ZZ,ZZ9.                    DTSBR439
00232      05  FILLER                   PIC  X(02)  VALUE SPACES.       DTSBR439
00233      05  WS-FOOTING-CRE-DBT       PIC  X(33) VALUE SPACES.           CL*19
00234      05  WS-FOOTING-TOT-AMT       PIC  $$$,$$$,$$9.99-.              CL*19
00235  01  FOOTING-LINE-4               PIC X(133) VALUE SPACES.        DTSBR439
00236  01  FOOTING-LINE-5               PIC X(133) VALUE SPACES.        DTSBR439
00237  01  FOOTING-LINE-6.                                              DTSBR439
00238      05  FILLER                   PIC X(25)  VALUE SPACES.        DTSBR439
00239      05  FILLER                   PIC  X(17) VALUE                DTSBR439
00240                       '*** END OF REPORT'.                        DTSBR439
00241      EJECT                                                        DTSBR439
00242  LINKAGE SECTION.                                                 DTSBR439
00243                                                                   DTSBR439
00244  01  LRCM-LINK-AREA.                                              DTSBR439
00245  ++INCLUDE DTSILRCM                                               DTSBR439
00246      EJECT                                                        DTSBR439
00247  01  R439-REC.                                                    DTSBR439
00248  ++INCLUDE DTSIR439                                               DTSBR439
00249      EJECT                                                        DTSBR439
00250  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR439
00251                           R439-REC.                               DTSBR439
00252                                                                   DTSBR439
00253      IF FIRST-TIME-IND = 'Y'                                      DTSBR439
00254          PERFORM I1000-INITIATE THRU I1000-EXIT                   DTSBR439
00255          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR439
00256                                                                   DTSBR439
00257      IF LRCM-EOR-88                                               DTSBR439
00258          PERFORM T1000-TERMINATE THRU T1000-EXIT                  DTSBR439
00259      ELSE                                                         DTSBR439
00260          PERFORM P0000-PROCESS THRU P0000-EXIT.                   DTSBR439
00261                                                                   DTSBR439
00262      GOBACK.                                                      DTSBR439
00263      EJECT                                                        DTSBR439
00264  I1000-INITIATE.                                                  DTSBR439
00265                                                                   DTSBR439
00266      OPEN OUTPUT PRT-FILE1                                           CL*21
00267                  PRT-FILE2.                                          CL*21
00268      MOVE LRCM-SYS-DATE TO HDR1-LRCM-SYS-DATE.                    DTSBR439
00269      MOVE LRCM-SYS-TIME TO HDR2-LRCM-SYS-TIME.                    DTSBR439
00270                                                                   DTSBR439
00271      MOVE R439-CUTOFF-YRQ      TO L004-QTR-5-9.                   DTSBR439
00272      PERFORM S004-FROM-FIVE    THRU S004-EXIT.                    DTSBR439
00273      MOVE L004-SLASH-5-QTR     TO HDR4-CUTOFF-YRQ.                DTSBR439
00274                                                                   DTSBR439
00275      MOVE SPACES               TO PRT-CREDITS PRT-DEBITS.            CL**3
00276                                                                   DTSBR439
00277  I1000-EXIT.                                                      DTSBR439
00278      EXIT.                                                        DTSBR439
00279      EJECT                                                        DTSBR439
00280                                                                   DTSBR439
00281  P0000-PROCESS.                                                   DTSBR439
00282                                                                   DTSBR439
00283      MOVE R439-EMP-NO             TO WS-EMP-NO.                   DTSBR439
00284      MOVE R439-PRIMARY-NAME       TO WS-PRIMARY-NAME.             DTSBR439
00285      MOVE R439-FLD-REP-ID         TO WS-FIELD-CODE.               DTSBR439
00286      MOVE R439-TOT-BALANCE-AMT    TO WS-BALANCE-AMT.              DTSBR439
00287      MOVE R439-PURSUED-RPT-CNT    TO WS-PURSUED-RPT.              DTSBR439
00288      MOVE R439-MDPC-IND           TO WS-DPC.                      DTSBR439
00289      MOVE R439-MLIN-IND           TO WS-LIEN.                     DTSBR439
00290      MOVE R439-LAST-LIAB-YRQ      TO WS-LIAB-YRQ.                    CL**4
00291      MOVE R439-LAST-UPD-DATE      TO WS-LAST-DTE.                    CL**4
00292      IF R439-DEBIT-RPT-88                                            CL**4
00293         MOVE  HDR-DEBITS   TO  HDR3-LITERAL                          CL**5
00294         PERFORM P2000-PRINT-HEADER THRU P2000-EXIT                   CL**9
00295         WRITE PRT-DEBITS  FROM DETAIL-LINE-1  AFTER 1                CL**4
00296         ADD  R439-TOT-BALANCE-AMT    TO WS-TOTAL-DBT-AMT             CL*19
00297         ADD  1    TO WS-DLINE-CNT2                                   CL*22
00298         ADD +1    TO WS-DNUMBER-ONE                                  CL*22
00299      ELSE                                                            CL**4
00300         MOVE  HDR-DEBITS   TO  HDR3-LITERAL                          CL*23
00301         PERFORM P1000-PRINT-HEADER THRU P1000-EXIT                   CL**9
00302         WRITE PRT-CREDITS FROM DETAIL-LINE-1  AFTER 1                CL**4
00303         ADD  R439-TOT-BALANCE-AMT    TO WS-TOTAL-CDT-AMT             CL*19
00304         ADD  1    TO WS-LINE-CNT2                                    CL*22
00305         ADD +1    TO WS-NUMBER-ONE.                                  CL*22
00306                                                                   DTSBR439
00307  P0000-EXIT.                                                      DTSBR439
00308      EXIT.                                                        DTSBR439
00309                                                                   DTSBR439
00310  P1000-PRINT-HEADER.                                              DTSBR439
00311      IF WS-LINE-CNT GREATER 58 OR                                 DTSBR439
00312           WS-LINE-CNT2 GREATER 58                                 DTSBR439
00313         MOVE +0          TO WS-LINE-CNT                           DTSBR439
00314         MOVE +0          TO WS-LINE-CNT2                          DTSBR439
00315         ADD  +1          TO WS-PAGE-CNT                           DTSBR439
00316         MOVE WS-PAGE-CNT TO HDR3-PAGE                             DTSBR439
00317         WRITE PRT-CREDITS FROM HEADER-1 AFTER TOP-OF-PAGE            CL**5
00318         WRITE PRT-CREDITS FROM HEADER-2 AFTER 1                      CL**5
00319         WRITE PRT-CREDITS FROM HEADER-3 AFTER 1                      CL**5
00320         WRITE PRT-CREDITS FROM HEADER-4 AFTER 1                      CL**5
00321         WRITE PRT-CREDITS FROM HEADER-5 AFTER 1                      CL**5
00322         WRITE PRT-CREDITS FROM HEADER-6 AFTER 1                      CL**5
00323         WRITE PRT-CREDITS FROM HEADER-7 AFTER 1                      CL**5
00324         WRITE PRT-CREDITS FROM HEADER-8 AFTER 1                      CL**5
00325         ADD +8    TO WS-LINE-CNT2.                                DTSBR439
00326  P1000-EXIT.                                                      DTSBR439
00327      EXIT.                                                        DTSBR439
00328                                                                   DTSBR439
00329                                                                      CL**5
00330  P2000-PRINT-HEADER.                                                 CL**5
00331      IF WS-DLINE-CNT GREATER 58 OR                                   CL**5
00332           WS-DLINE-CNT2 GREATER 58                                   CL**5
00333         MOVE +0          TO WS-DLINE-CNT                             CL**5
00334         MOVE +0          TO WS-DLINE-CNT2                            CL**5
00335         ADD  +1          TO WS-DPAGE-CNT                             CL**5
00336         MOVE WS-DPAGE-CNT TO HDR3-PAGE                               CL**5
00337         WRITE PRT-DEBITS  FROM HEADER-1 AFTER TOP-OF-PAGE            CL**5
00338         WRITE PRT-DEBITS  FROM HEADER-2 AFTER 1                      CL**5
00339         WRITE PRT-DEBITS  FROM HEADER-3 AFTER 1                      CL**5
00340         WRITE PRT-DEBITS  FROM HEADER-4 AFTER 1                      CL**5
00341         WRITE PRT-DEBITS  FROM HEADER-5 AFTER 1                      CL**5
00342         WRITE PRT-DEBITS  FROM HEADER-6 AFTER 1                      CL**5
00343         WRITE PRT-DEBITS  FROM HEADER-7 AFTER 1                      CL**5
00344         WRITE PRT-DEBITS  FROM HEADER-8 AFTER 1                      CL**5
00345         ADD +8    TO WS-DLINE-CNT2.                                  CL**5
00346  P2000-EXIT.                                                         CL**6
00347      EXIT.                                                           CL**5
00348                                                                      CL**5
00349  T1000-TERMINATE.                                                 DTSBR439
00350                                                                   DTSBR439
00351      IF WS-LINE-CNT2 > 52 OR WS-NUMBER-ONE = ZERO                 DTSBR439
00352         PERFORM P1000-PRINT-HEADER THRU P1000-EXIT                DTSBR439
00353      END-IF.                                                      DTSBR439
00354      MOVE FOOTING-CREDITS  TO   WS-FOOTING-CRE-DBT.                  CL**5
00355      MOVE WS-TOTAL-CDT-AMT TO   WS-FOOTING-TOT-AMT                   CL*19
00356      MOVE WS-NUMBER-ONE TO WS-FOOTING-CNT.                        DTSBR439
00357      WRITE PRT-CREDITS FROM FOOTING-LINE-1 AFTER 1.                  CL**5
00358      WRITE PRT-CREDITS FROM FOOTING-LINE-2 AFTER 1.                  CL**5
00359      WRITE PRT-CREDITS FROM FOOTING-LINE-3 AFTER 1.                  CL**5
00360      WRITE PRT-CREDITS FROM FOOTING-LINE-4 AFTER 1.                  CL**5
00361      WRITE PRT-CREDITS FROM FOOTING-LINE-5 AFTER 1.                  CL**5
00362      WRITE PRT-CREDITS FROM FOOTING-LINE-6 AFTER 1.                  CL**5
00363                                                                   DTSBR439
00364      IF WS-DLINE-CNT2 > 52 OR WS-DNUMBER-ONE = ZERO                  CL**5
00365         PERFORM P2000-PRINT-HEADER THRU P2000-EXIT                   CL**5
00366      END-IF.                                                         CL**5
00367      MOVE WS-DNUMBER-ONE TO WS-FOOTING-CNT.                          CL**5
00368      MOVE FOOTING-DEBITS   TO   WS-FOOTING-CRE-DBT.                  CL**5
00369      MOVE WS-TOTAL-DBT-AMT TO   WS-FOOTING-TOT-AMT                   CL*19
00370      WRITE PRT-DEBITS  FROM FOOTING-LINE-1 AFTER 1.                  CL**5
00371      WRITE PRT-DEBITS  FROM FOOTING-LINE-2 AFTER 1.                  CL**5
00372      WRITE PRT-DEBITS  FROM FOOTING-LINE-3 AFTER 1.                  CL**5
00373      WRITE PRT-DEBITS  FROM FOOTING-LINE-4 AFTER 1.                  CL**5
00374      WRITE PRT-DEBITS  FROM FOOTING-LINE-5 AFTER 1.                  CL**5
00375      WRITE PRT-DEBITS  FROM FOOTING-LINE-6 AFTER 1.                  CL**5
00376                                                                      CL**5
00377      CLOSE PRT-FILE1 PRT-FILE2.                                      CL**3
00378                                                                   DTSBR439
00379  T1000-EXIT.                                                      DTSBR439
00380      EXIT.                                                        DTSBR439
00381      EJECT                                                        DTSBR439
00382                                                                   DTSBR439
00383  S001-DATE.                                                       DTSBR439
00384      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBR439
00385  S001-EXIT.                                                       DTSBR439
00386      EXIT.                                                        DTSBR439
00387                                                                   DTSBR439
00388  S004-FROM-DATE.                                                  DTSBR439
00389      SET L004-FROM-DATE TO TRUE.                                  DTSBR439
00390      GO TO S004-YRQ.                                              DTSBR439
00391                                                                   DTSBR439
00392  S004-FROM-FIVE.                                                  DTSBR439
00393      SET L004-FROM-5    TO TRUE.                                  DTSBR439
00394      GO TO S004-YRQ.                                              DTSBR439
00395                                                                   DTSBR439
00396  S004-YRQ.                                                        DTSBR439
00397      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBR439
00398  S004-EXIT.                                                       DTSBR439
00399      EXIT.                                                        DTSBR439
00400                                                                   DTSBR439
00401  S999-ABEND.                                                      DTSBR439
00402                                                                   DTSBR439
00403      DISPLAY '*** DTSBR439 ABENDING.  '                           DTSBR439
00404              WRK-ABEND-MSG.                                       DTSBR439
00405                                                                   DTSBR439
00406      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBR439
00407                                                                   DTSBR439
00408  S999-EXIT.                                                       DTSBR439
00409      EXIT.                                                        DTSBR439
