00001  IDENTIFICATION DIVISION.                                         07/09/24
00002  PROGRAM-ID.             DTSBE444.                                DTSBE444
00003  AUTHOR.                 TRW.                                        LV061
00004  DATE-WRITTEN.           NOVEMBER 2000.                           DTSBE444
00005  DATE-COMPILED.                                                   DTSBE444
00006      SKIP3                                                        DTSBE444
00007 *****                                                             DTSBE444
00008 *                                                                 DTSBE444
00009 *    FUNCTION:  AGING OF ACCOUNTS RECEIVABLE WEEKLY VERSION          CL**2
00010 *                                                                 DTSBE444
00011 *                                                                 DTSBE444
00012 *    MODIFICATION LOG:                                            DTSBE444
00013 *                                                                 DTSBE444
00014 *    11/01/2000  MODIFED FROM DTSBE440.                           DTSBE444
00015 *                WORK ORDER: DIR00084           PROGRAMMER: GD    DTSBE444
00016 *                                                                 DTSBE444
00017 *    01/24/2006  MODIFED FOR CFO - MONTHLY TRACKING.              DTSBE444
00018 *                WORK ORDER:                    PROGRAMMER: GD    DTSBE444
00019 *                                                                 DTSBE444
00020 *    05/13/2008  REQUEST FROM CFO - ADDED EMP CLASS TO AGING      DTSBE444
00021 *                QUARTER EXTRACT.                                 DTSBE444
00022 *                WORK ORDER:                    PROGRAMMER: GD    DTSBE444
00023 *                                                                 DTSBE444
00024 *    02/22/2404  CREATED WEEKLY VERSION OF PROGRAM                   CL**2
00025 *                QUARTER EXTRACT.                                    CL**2
00026 *                WORK ORDER:                    PROGRAMMER: ZL1      CL**2
00027 *                                                                    CL**2
00028 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE444
00029 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE444
00030 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBE444
00031 *                                                                 DTSBE444
00032 *                                                                 DTSBE444
00033 *  DESCRIPTION:                                                   DTSBE444
00034 *                                                                 DTSBE444
00035 *                                                                 DTSBE444
00036 *    INITIATION:                                                  DTSBE444
00037 *                                                                 DTSBE444
00038 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE444
00039 *                                                                 DTSBE444
00040 *      EDIT AND DEFAULT PARAMETERS.                               DTSBE444
00041 *                                                                 DTSBE444
00042 *                                                                 DTSBE444
00043 *    PROCESSING:                                                  DTSBE444
00044 *                                                                 DTSBE444
00045 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (442R1).       DTSBE444
00046 *                                                                 DTSBE444
00047 *                                                                 DTSBE444
00048 *    TERMINATION:                                                 DTSBE444
00049 *                                                                 DTSBE444
00050 *                                                                 DTSBE444
00051 *                                                                 DTSBE444
00052 *                                                                 DTSBE444
00053 *    RECORDS READ:                                                DTSBE444
00054 *                                                                 DTSBE444
00055 *      MASTER:                                                    DTSBE444
00056 *                                                                 DTSBE444
00057 *        MHDR                                                     DTSBE444
00058 *        MSOL                                                     DTSBE444
00059 *        MQTR                                                     DTSBE444
00060 *        MJRN                                                     DTSBE444
00061 *                                                                 DTSBE444
00062 *                                                                 DTSBE444
00063 *      ALTERNATE INDEX:                                           DTSBE444
00064 *                                                                 DTSBE444
00065 *        NONE.                                                    DTSBE444
00066 *                                                                 DTSBE444
00067 *                                                                 DTSBE444
00068 *      REFERENCE:                                                 DTSBE444
00069 *                                                                 DTSBE444
00070 *                                                                 DTSBE444
00071 *                                                                 DTSBE444
00072 *    RECORDS UPDATED:                                             DTSBE444
00073 *                                                                 DTSBE444
00074 *        NONE                                                     DTSBE444
00075 *                                                                 DTSBE444
00076 *                                                                 DTSBE444
00077 *    REPORT RECORDS WRITTEN:                                      DTSBE444
00078 *                                                                 DTSBE444
00079 *        R442 ACCOUNTS RECEIVABLE AGING.                          DTSBE444
00080 *                                                                 DTSBE444
00081 *                                                                 DTSBE444
00082 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE444
00083 *                                                                 DTSBE444
00084 *        NONE.                                                    DTSBE444
00085 *                                                                 DTSBE444
00086 *                                                                 DTSBE444
00087 *    MODULES CALLED:                                              DTSBE444
00088 *                                                                 DTSBE444
00089 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBE444
00090 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBE444
00091 *        DTSBU005  ABSOLUTE TIME CONVERSION/EDIT.                 DTSBE444
00092 *        DTSBU910  MASTER FILE I/O.                               DTSBE444
00093 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBE444
00094 *                                                                 DTSBE444
00095 *                                                                 DTSBE444
00096 *****                                                             DTSBE444
00097      SKIP3                                                        DTSBE444
00098  ENVIRONMENT DIVISION.                                            DTSBE444
00099  INPUT-OUTPUT SECTION.                                            DTSBE444
00100                                                                   DTSBE444
00101  FILE-CONTROL.                                                    DTSBE444
00102                                                                   DTSBE444
00103      SELECT AGING-REPORT ASSIGN TO AGINGFLE                       DTSBE444
00104         FILE STATUS IS AGING-STATUS.                              DTSBE444
00105                                                                   DTSBE444
00106      SELECT AUDIT-FILE  ASSIGN TO AUDTFILE                        DTSBE444
00107         FILE STATUS IS AUDIT-STATUS.                              DTSBE444
00108                                                                   DTSBE444
00109      SELECT QTR-FILE    ASSIGN TO QTRFILE                         DTSBE444
00110         FILE STATUS IS QTR-STATUS.                                DTSBE444
00111                                                                   DTSBE444
00112      SELECT PAY-FILE    ASSIGN TO PAYFILE                         DTSBE444
00113         FILE STATUS IS PAY-STATUS.                                DTSBE444
00114                                                                   DTSBE444
00115      SELECT CREDIT-FILE    ASSIGN TO CREDFILE                     DTSBE444
00116         FILE STATUS IS CREDIT-STATUS.                             DTSBE444
00117                                                                   DTSBE444
00118  DATA DIVISION.                                                   DTSBE444
00119  FILE SECTION.                                                    DTSBE444
00120                                                                   DTSBE444
00121  FD  AGING-REPORT                                                 DTSBE444
00122      RECORDING MODE IS F                                          DTSBE444
00123      BLOCK CONTAINS 0 RECORDS                                     DTSBE444
00124      LABEL RECORDS ARE OMITTED.                                   DTSBE444
00125                                                                   DTSBE444
00126  01  AGING-REC                       PIC X(100).                     CL*16
00127                                                                   DTSBE444
00128  FD  AUDIT-FILE                                                   DTSBE444
00129      RECORDING MODE IS F                                          DTSBE444
00130      BLOCK CONTAINS 0 RECORDS                                     DTSBE444
00131      LABEL RECORDS ARE OMITTED.                                   DTSBE444
00132                                                                   DTSBE444
00133  01  AUDIT-REC                       PIC X(97).                   DTSBE444
00134                                                                   DTSBE444
00135  FD  QTR-FILE                                                     DTSBE444
00136      RECORDING MODE IS F                                          DTSBE444
00137      BLOCK CONTAINS 0 RECORDS                                     DTSBE444
00138      LABEL RECORDS ARE OMITTED.                                   DTSBE444
00139                                                                   DTSBE444
00140  01  QTR-REC                         PIC X(144).                     CL*59
00141                                                                   DTSBE444
00142  FD  PAY-FILE                                                     DTSBE444
00143      RECORDING MODE IS F                                          DTSBE444
00144      BLOCK CONTAINS 0 RECORDS                                     DTSBE444
00145      LABEL RECORDS ARE OMITTED.                                   DTSBE444
00146                                                                   DTSBE444
00147  01  PAY-REC                         PIC X(97).                   DTSBE444
00148                                                                   DTSBE444
00149  FD  CREDIT-FILE                                                  DTSBE444
00150      RECORDING MODE IS F                                          DTSBE444
00151      BLOCK CONTAINS 0 RECORDS                                     DTSBE444
00152      LABEL RECORDS ARE OMITTED.                                   DTSBE444
00153                                                                   DTSBE444
00154  01  CREDIT-REC                         PIC X(86).                DTSBE444
00155                                                                   DTSBE444
00156  WORKING-STORAGE SECTION.                                         DTSBE444
001565 77  PAN-VALET PICTURE X(24) VALUE '061DTSBE444  07/09/24'.       DTSBE444
00157  77  PAN-VALET PICTURE X(24) VALUE '005DTSBE442  05/16/08'.       DTSBE444
00158      SKIP3                                                        DTSBE444
00159  01  WRK-AREA.                                                    DTSBE444
00160      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +442.DTSBE444
00161                                                                   DTSBE444
00162      05  ABEND-MSG                       PIC  X(60).              DTSBE444
00163                                                                   DTSBE444
00164      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE442'.DTSBE444
00165                                                                   DTSBE444
00166      05  AGING-STATUS                PIC  X(02).                  DTSBE444
00167          88  AGING-STATUS-OK-88       VALUE '00'.                 DTSBE444
00168          88  AGING-STATUS-EOF-88      VALUE '10'.                 DTSBE444
00169                                                                   DTSBE444
00170      05  AUDIT-STATUS                PIC  X(02).                  DTSBE444
00171          88  AUDIT-STATUS-OK-88       VALUE '00'.                 DTSBE444
00172                                                                   DTSBE444
00173      05  QTR-STATUS                  PIC  X(02).                  DTSBE444
00174          88  QTR-STATUS-OK-88         VALUE '00'.                 DTSBE444
00175                                                                   DTSBE444
00176      05  PAY-STATUS                  PIC  X(02).                  DTSBE444
00177          88  PAY-STATUS-OK-88         VALUE '00'.                 DTSBE444
00178                                                                   DTSBE444
00179      05  CREDIT-STATUS               PIC  X(02).                  DTSBE444
00180          88  CREDIT-STATUS-OK-88      VALUE '00'.                 DTSBE444
00181                                                                   DTSBE444
00182      05  WRK-SEQ-NO                  PIC S9(07)  COMP-3           DTSBE444
00183                                       VALUE +0.                   DTSBE444
00184                                                                   DTSBE444
00185      05  WRK-LAST-DEL-YRQ            PIC S9(05)  COMP-3.          DTSBE444
00186                                                                   DTSBE444
00187      05  WRK-3-YEARS-AGO-YRQ         PIC S9(05)  COMP-3.          DTSBE444
00188                                                                   DTSBE444
00189      05  WRK-19994-YRQ               PIC S9(05)  COMP-3.          DTSBE444
00190                                                                   DTSBE444
00191      05  WRK-3-YEARS-AGO-DATE        PIC S9(09)  COMP-3.          DTSBE444
00192                                                                   DTSBE444
00193      05  WRK-MTH-BEGIN-DATE          PIC S9(09)  COMP-3.          DTSBE444
00194      05  WRK-MTH-END-DATE            PIC S9(09)  COMP-3.          DTSBE444
00195                                                                   DTSBE444
00196      05  WRK-INACT-DATE              PIC S9(09)  COMP-3.          DTSBE444
00197                                                                   DTSBE444
00198      05  TSUB                       PIC  9(04)  VALUE ZEROS.         CL*24
00199      05  ZSUB                       PIC  9(04)  VALUE ZEROS.         CL*34
00200                                                                   DTSBE444
00201      05  TSUB-MAX                   PIC S9(04)  COMP              DTSBE444
00202                                  VALUE +150.                         CL*35
00203      05  QTR-UIT                    PIC S9(11)V99  COMP-3 VALUE 0.   CL*39
00204      05  QTR-SURT                   PIC S9(11)V99  COMP-3 VALUE 0.   CL*39
00205      05  QTR-LPT                    PIC S9(11)V99  COMP-3 VALUE 0.   CL*39
00206      05  QTR-NSFT                   PIC S9(11)V99  COMP-3 VALUE 0.   CL*39
00207      05  QTR-MSFT                   PIC S9(11)V99  COMP-3 VALUE 0.   CL*39
00208      05  QTR-INTT                   PIC S9(11)V99  COMP-3 VALUE 0.   CL*39
00209      05  QTR-DEFT                   PIC S9(11)V99  COMP-3 VALUE 0.   CL*45
00210                                                                   DTSBE444
00211      05  CTAB-CORRECTION-TABLE OCCURS 150 TIMES.                     CL*35
00212 *                INDEXED BY CTAB-IDX.                                CL*33
00213          10  CTAB-QTR-YRQ        PIC S9(05)     COMP-3 VALUE 0.      CL*36
00214          10  CTAB-QTR-TAX-BAL    PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00215          10  CTAB-QTR-UI-BAL     PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00216          10  CTAB-QTR-SUR-BAL    PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00217          10  CTAB-QTR-PEN-BAL    PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00218          10  CTAB-QTR-LP-BAL     PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00219          10  CTAB-QTR-NSF-BAL    PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00220          10  CTAB-QTR-MSF-BAL    PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00221          10  CTAB-QTR-INT-BAL    PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00222          10  CTAB-QTR-DEF-BAL    PIC S9(11)V99  COMP-3 VALUE 0.      CL*44
00223          10  CTAB-QTR-20051-PEN  PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00224          10  CTAB-JRN-TAX-BAL    PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00225          10  CTAB-JRN-PEN-BAL    PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00226          10  CTAB-JRN-INT-BAL    PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00227          10  CTAB-JRN-20051-PEN  PIC S9(11)V99  COMP-3 VALUE 0.      CL*36
00228                                                                   DTSBE444
00229      05  WRK-MQTR-TAX-BAL            PIC S9(11)V99 COMP-3 VALUE 0.   CL*31
00230      05  WRK-MQTR-PEN-BAL            PIC S9(11)V99 COMP-3 VALUE 0.   CL*31
00231      05  WRK-MQTR-INT-BAL            PIC S9(11)V99 COMP-3 VALUE 0.   CL*31
00232      05  QTR-TOTAL                   PIC S9(11)V99 COMP-3 VALUE 0.   CL*40
00233      05  WRK-AMT                     PIC S9(11)V99  COMP-3.          CL*10
00234      05  WRK-CREDIT-PAID-RATED       PIC S9(11)V99  COMP-3.       DTSBE444
00235      05  WRK-CREDIT-TOL-RATED        PIC S9(11)V99  COMP-3.       DTSBE444
00236      05  WRK-CREDIT-WRITEOFF-RATED   PIC S9(11)V99  COMP-3.       DTSBE444
00237      05  WRK-CREDIT-PAID-SI          PIC S9(11)V99  COMP-3.       DTSBE444
00238      05  WRK-CREDIT-TOL-SI           PIC S9(11)V99  COMP-3.       DTSBE444
00239      05  WRK-CREDIT-WRITEOFF-SI      PIC S9(11)V99  COMP-3.       DTSBE444
00240      05  WRK-CREDIT-PAID-UNK         PIC S9(11)V99  COMP-3.       DTSBE444
00241      05  WRK-CREDIT-TOL-UNK          PIC S9(11)V99  COMP-3.       DTSBE444
00242      05  WRK-CREDIT-WRITEOFF-UNK     PIC S9(11)V99  COMP-3.       DTSBE444
00243      05  WRK-CREDIT-AMT              PIC S9(11)V99  COMP-3.       DTSBE444
00244      05  WRK-TOTAL-RATED-TAX         PIC S9(11)V99  COMP-3        DTSBE444
00245                                        VALUE +0.                  DTSBE444
00246      05  WRK-TOT-SI-TAX              PIC S9(11)V99  COMP-3        DTSBE444
00247                                        VALUE +0.                  DTSBE444
00248                                                                   DTSBE444
00249      05  SUB                         PIC S9(04)  COMP.            DTSBE444
00250                                                                   DTSBE444
00251      05  WRK-QTR-MAX                 PIC S9(04)  COMP             DTSBE444
00252                                  VALUE +7.                        DTSBE444
00253                                                                   DTSBE444
00254      05  WRK-QTR-TABLE OCCURS 7 TIMES                             DTSBE444
00255                  INDEXED BY WRK-QTR-IDX.                          DTSBE444
00256          10  WRK-QTR-YRQ             PIC S9(05)     COMP-3.       DTSBE444
00257          10  WRK-QTR-RATED-TAX       PIC S9(11)V99  COMP-3.       DTSBE444
00258          10  WRK-QTR-RATED-PEN       PIC S9(11)V99  COMP-3.       DTSBE444
00259          10  WRK-QTR-RATED-INT       PIC S9(11)V99  COMP-3.       DTSBE444
00260          10  WRK-QTR-SELF-INS-TAX    PIC S9(11)V99  COMP-3.       DTSBE444
00261          10  WRK-QTR-SELF-INS-PEN    PIC S9(11)V99  COMP-3.       DTSBE444
00262          10  WRK-QTR-SELF-INS-INT    PIC S9(11)V99  COMP-3.       DTSBE444
00263                                                                   DTSBE444
00264      05  WRK-3-YR-RATED-TAX          PIC S9(11)V99  COMP-3.       DTSBE444
00265      05  WRK-3-YR-RATED-PEN          PIC S9(11)V99  COMP-3.       DTSBE444
00266      05  WRK-3-YR-RATED-INT          PIC S9(11)V99  COMP-3.       DTSBE444
00267      05  WRK-3-YR-SELF-INS-TAX       PIC S9(11)V99  COMP-3.       DTSBE444
00268      05  WRK-3-YR-SELF-INS-PEN       PIC S9(11)V99  COMP-3.       DTSBE444
00269      05  WRK-3-YR-SELF-INS-INT       PIC S9(11)V99  COMP-3.       DTSBE444
00270                                                                   DTSBE444
00271      05  WRK-TOT-RATED-TAX           PIC S9(11)V99  COMP-3.       DTSBE444
00272      05  WRK-TOT-RATED-PEN           PIC S9(11)V99  COMP-3.       DTSBE444
00273      05  WRK-TOT-RATED-INT           PIC S9(11)V99  COMP-3.       DTSBE444
00274      05  WRK-TOT-SELF-INS-TAX        PIC S9(11)V99  COMP-3.       DTSBE444
00275      05  WRK-TOT-SELF-INS-PEN        PIC S9(11)V99  COMP-3.       DTSBE444
00276      05  WRK-TOT-SELF-INS-INT        PIC S9(11)V99  COMP-3.       DTSBE444
00277                                                                   DTSBE444
00278      05  WRK-ACTIVE-RATED-TAX        PIC S9(11)V99  COMP-3.       DTSBE444
00279      05  WRK-ACTIVE-RATED-PEN        PIC S9(11)V99  COMP-3.       DTSBE444
00280      05  WRK-ACTIVE-RATED-INT        PIC S9(11)V99  COMP-3.       DTSBE444
00281      05  WRK-ACTIVE-SELF-INS-TAX     PIC S9(11)V99  COMP-3.       DTSBE444
00282      05  WRK-ACTIVE-SELF-INS-PEN     PIC S9(11)V99  COMP-3.       DTSBE444
00283      05  WRK-ACTIVE-SELF-INS-INT     PIC S9(11)V99  COMP-3.       DTSBE444
00284                                                                   DTSBE444
00285      05  WRK-INACT-RATED-TAX         PIC S9(11)V99  COMP-3.       DTSBE444
00286      05  WRK-INACT-RATED-PEN         PIC S9(11)V99  COMP-3.       DTSBE444
00287      05  WRK-INACT-RATED-INT         PIC S9(11)V99  COMP-3.       DTSBE444
00288      05  WRK-INACT-SELF-INS-TAX      PIC S9(11)V99  COMP-3.       DTSBE444
00289      05  WRK-INACT-SELF-INS-PEN      PIC S9(11)V99  COMP-3.       DTSBE444
00290      05  WRK-INACT-SELF-INS-INT      PIC S9(11)V99  COMP-3.       DTSBE444
00291                                                                   DTSBE444
00292      05  WRK-INACT-3YR-RATED-TAX     PIC S9(11)V99  COMP-3.       DTSBE444
00293      05  WRK-INACT-3YR-RATED-PEN     PIC S9(11)V99  COMP-3.       DTSBE444
00294      05  WRK-INACT-3YR-RATED-INT     PIC S9(11)V99  COMP-3.       DTSBE444
00295      05  WRK-INACT-3YR-SELF-INS-TAX  PIC S9(11)V99  COMP-3.       DTSBE444
00296      05  WRK-INACT-3YR-SELF-INS-PEN  PIC S9(11)V99  COMP-3.       DTSBE444
00297      05  WRK-INACT-3YR-SELF-INS-INT  PIC S9(11)V99  COMP-3.       DTSBE444
00298                                                                   DTSBE444
00299      05  WRK-CHAPTER-7-RATED-TAX     PIC S9(11)V99  COMP-3.       DTSBE444
00300      05  WRK-CHAPTER-7-RATED-PEN     PIC S9(11)V99  COMP-3.       DTSBE444
00301      05  WRK-CHAPTER-7-RATED-INT     PIC S9(11)V99  COMP-3.       DTSBE444
00302      05  WRK-CHAPTER-7-SELF-INS-TAX  PIC S9(11)V99  COMP-3.       DTSBE444
00303      05  WRK-CHAPTER-7-SELF-INS-PEN  PIC S9(11)V99  COMP-3.       DTSBE444
00304      05  WRK-CHAPTER-7-SELF-INS-INT  PIC S9(11)V99  COMP-3.       DTSBE444
00305                                                                   DTSBE444
00306      05  WRK-CHAPTER-11-RATED-TAX    PIC S9(11)V99  COMP-3.       DTSBE444
00307      05  WRK-CHAPTER-11-RATED-PEN    PIC S9(11)V99  COMP-3.       DTSBE444
00308      05  WRK-CHAPTER-11-RATED-INT    PIC S9(11)V99  COMP-3.       DTSBE444
00309      05  WRK-CHAPTER-11-SELF-INS-TAX PIC S9(11)V99  COMP-3.       DTSBE444
00310      05  WRK-CHAPTER-11-SELF-INS-PEN PIC S9(11)V99  COMP-3.       DTSBE444
00311      05  WRK-CHAPTER-11-SELF-INS-INT PIC S9(11)V99  COMP-3.       DTSBE444
00312                                                                   DTSBE444
00313      05  WRK-19994-RATED-TAX         PIC S9(11)V99  COMP-3.       DTSBE444
00314      05  WRK-19994-RATED-PEN         PIC S9(11)V99  COMP-3.       DTSBE444
00315      05  WRK-19994-RATED-INT         PIC S9(11)V99  COMP-3.       DTSBE444
00316      05  WRK-19994-SELF-INS-TAX      PIC S9(11)V99  COMP-3.       DTSBE444
00317      05  WRK-19994-SELF-INS-PEN      PIC S9(11)V99  COMP-3.       DTSBE444
00318      05  WRK-19994-SELF-INS-INT      PIC S9(11)V99  COMP-3.       DTSBE444
00319                                                                   DTSBE444
00320      05  WRK-MTH-RATED-TAX-PAY       PIC S9(11)V99  COMP-3.       DTSBE444
00321      05  WRK-MTH-RATED-PEN-PAY       PIC S9(11)V99  COMP-3.       DTSBE444
00322      05  WRK-MTH-RATED-INT-PAY       PIC S9(11)V99  COMP-3.       DTSBE444
00323      05  WRK-MTH-RATED-CRED-PAY      PIC S9(11)V99  COMP-3.       DTSBE444
00324                                                                   DTSBE444
00325      05  WRK-MTH-SI-TAX-PAY          PIC S9(11)V99  COMP-3.       DTSBE444
00326      05  WRK-MTH-SI-PEN-PAY          PIC S9(11)V99  COMP-3.       DTSBE444
00327      05  WRK-MTH-SI-INT-PAY          PIC S9(11)V99  COMP-3.       DTSBE444
00328      05  WRK-MTH-SI-CRED-PAY         PIC S9(11)V99  COMP-3.       DTSBE444
00329                                                                   DTSBE444
00330      05  WRK-MTH-UNK-TAX-PAY         PIC S9(11)V99  COMP-3.       DTSBE444
00331      05  WRK-MTH-UNK-PEN-PAY         PIC S9(11)V99  COMP-3.       DTSBE444
00332      05  WRK-MTH-UNK-INT-PAY         PIC S9(11)V99  COMP-3.       DTSBE444
00333      05  WRK-MTH-UNK-CRED-PAY        PIC S9(11)V99  COMP-3.       DTSBE444
00334                                                                   DTSBE444
00335      05  WRK-ERROR-IND               PIC  X(01).                  DTSBE444
00336                                                                   DTSBE444
00337          88  WRK-ERROR-YES-88    VALUE 'Y'.                       DTSBE444
00338          88  WRK-ERROR-NO-88     VALUE 'N'.                       DTSBE444
00339                                                                   DTSBE444
00340      05  WRK-STATUS-IND              PIC  X(01).                  DTSBE444
00341          88  WRK-STAT-ACTIVE     VALUE '0'.                       DTSBE444
00342          88  WRK-STAT-INACT      VALUE '1'.                       DTSBE444
00343          88  WRK-STAT-INACT-3-YR VALUE '2'.                       DTSBE444
00344          88  WRK-STAT-INVALID    VALUE '9'.                       DTSBE444
00345                                                                   DTSBE444
00346      05  WRK-BANKRUPTCY-IND          PIC  X(01).                  DTSBE444
00347          88  WRK-BNK-NONE        VALUE '0'.                       DTSBE444
00348          88  WRK-BNK-CHAP-7      VALUE '1'.                       DTSBE444
00349          88  WRK-BNK-CHAP-11     VALUE '2'.                       DTSBE444
00350                                                                   DTSBE444
00351      05  WRK-AUDIT-HEADER1.                                       DTSBE444
00352          10  FILLER                      PIC  X(26)               DTSBE444
00353              VALUE 'RECEIVABLE DETAIL THROUGH '.                  DTSBE444
00354          10  AUDIT-HDR1-DATE             PIC  X(10).              DTSBE444
00355                                                                   DTSBE444
00356      05  WRK-AUDIT-HEADER2.                                       DTSBE444
00357          10  FILLER                      PIC  X(08)               DTSBE444
00358              VALUE 'EMPLOYER'.                                    DTSBE444
00359          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00360          10  FILLER                      PIC  X(04)               DTSBE444
00361              VALUE 'NAME'.                                        DTSBE444
00362          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00363          10  FILLER                      PIC  X(05)               DTSBE444
00364              VALUE 'CLASS'.                                       DTSBE444
00365          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00366          10  FILLER                      PIC  X(05)               DTSBE444
00367              VALUE 'BATCH'.                                       DTSBE444
00368          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00369          10  FILLER                      PIC  X(04)               DTSBE444
00370              VALUE 'ITEM'.                                        DTSBE444
00371          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00372          10  FILLER                      PIC  X(04)               DTSBE444
00373              VALUE 'TYPE'.                                        DTSBE444
00374          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00375          10  FILLER                      PIC  X(14)               DTSBE444
00376              VALUE 'PROCESSED DATE'.                              DTSBE444
00377          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00378          10  FILLER                      PIC  X(06)               DTSBE444
00379              VALUE 'AMOUNT'.                                      DTSBE444
00380          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00381          10  FILLER                      PIC  X(07)               DTSBE444
00382              VALUE 'ACCOUNT'.                                     DTSBE444
00383          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00384          10  FILLER                      PIC  X(07)               DTSBE444
00385              VALUE 'QUARTER'.                                     DTSBE444
00386                                                                   DTSBE444
00387      05  WRK-AUDIT-REC.                                           DTSBE444
00388 **       10  AUDIT-SEQ-NO                PIC  9(07).              DTSBE444
00389 **       10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00390          10  AUDIT-EMP-NO                PIC  9(06).              DTSBE444
00391          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00392          10  AUDIT-PRIMARY-NAME          PIC  X(40).              DTSBE444
00393          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00394          10  AUDIT-EMP-CLASS             PIC  X(02).              DTSBE444
00395          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00396          10  AUDIT-BATCH-NO              PIC  9(05).              DTSBE444
00397          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00398          10  AUDIT-ITEM-NO               PIC  9(03).              DTSBE444
00399          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00400          10  AUDIT-TRAN                  PIC  X(02).              DTSBE444
00401          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00402          10  AUDIT-PROC-DATE             PIC  X(10).              DTSBE444
00403          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00404          10  AUDIT-AMT                   PIC  --------9.99.       DTSBE444
00405          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00406          10  AUDIT-ACCT                  PIC  X(02).              DTSBE444
00407          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00408          10  AUDIT-YRQ                   PIC  X(06).              DTSBE444
00409                                                                   DTSBE444
00410      05  WRK-QTR-HEADER1.                                         DTSBE444
00411          10  FILLER                      PIC  X(50) VALUE SPACES.    CL*59
00412          10  FILLER                      PIC  X(28)                  CL*59
00413              VALUE ' WEEKLY RECEIVABLES THROUGH '.                   CL*59
00414          10  QTR-HDR1-DATE               PIC  X(10).              DTSBE444
00415                                                                   DTSBE444
00416      05  WRK-QTR-HEADER2.                                         DTSBE444
00417          10  FILLER                      PIC  X(40) VALUE            CL*61
00418          'EAN,NAME,CLASS,STATUS,QTR,UI-TAX,SU-TAX,'.                 CL*61
00419          10  FILLER                      PIC  X(43) VALUE            CL*59
00420          'LATE-PEN,NSF-PEN,MISC-PEN,INTEREST,AMT-OWED'.              CL*59
00421          10  FILLER                      PIC  X(20) VALUE SPACES.    CL*59
00422                                                                   DTSBE444
00423      05  WRK-QTR-REC.                                             DTSBE444
00424          10  QTR-EMP-NO                  PIC  9(06).              DTSBE444
00425          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00426          10  QTR-PRIMARY-NAME            PIC  X(40).              DTSBE444
00427          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00428          10  QTR-EMP-CLASS               PIC  X(01).              DTSBE444
00429          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00430          10  QTR-EMP-STATUS              PIC  X(01).                 CL*59
00431          10  FILLER                      PIC  X(01) VALUE ','.       CL*59
00432          10  QTR-YRQ                     PIC  X(06).              DTSBE444
00433          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00434          10  QTR-UI                      PIC  -------9.99.           CL**3
00435          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00436          10  QTR-SUR                     PIC  -------9.99.           CL**3
00437          10  FILLER                      PIC  X(01) VALUE ','.       CL**3
00438          10  QTR-LP                      PIC  -------9.99.           CL**3
00439          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00440          10  QTR-NSF                     PIC  -------9.99.           CL**5
00441          10  FILLER                      PIC  X(01) VALUE ','.       CL**3
00442          10  QTR-MSF                     PIC  -------9.99.           CL**5
00443          10  FILLER                      PIC  X(01) VALUE ','.       CL**3
00444          10  QTR-INT                     PIC  -------9.99.           CL**3
00445 *        10  FILLER                      PIC  X(01) VALUE ','.       CL*51
00446 *        10  QTR-DEF                     PIC  ---------9.99.         CL*51
00447          10  FILLER                      PIC  X(01) VALUE ','.       CL*44
00448          10  QTR-TOT                     PIC  ---------9.99.         CL*44
00449                                                                   DTSBE444
00450      05  WRK-CREDIT-HEADER1.                                      DTSBE444
00451          10  FILLER                      PIC  X(16)               DTSBE444
00452              VALUE 'CREDITS THROUGH '.                            DTSBE444
00453          10  CREDIT-HDR1-DATE            PIC  X(10).              DTSBE444
00454                                                                   DTSBE444
00455      05  WRK-CREDIT-HEADER2.                                      DTSBE444
00456          10  FILLER                      PIC  X(08)               DTSBE444
00457              VALUE 'EMPLOYER'.                                    DTSBE444
00458          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00459          10  FILLER                      PIC  X(04)               DTSBE444
00460              VALUE 'NAME'.                                        DTSBE444
00461          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00462          10  FILLER                      PIC  X(05)               DTSBE444
00463              VALUE 'CLASS'.                                       DTSBE444
00464          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00465          10  FILLER                      PIC  X(05)               DTSBE444
00466              VALUE 'BATCH'.                                       DTSBE444
00467          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00468          10  FILLER                      PIC  X(04)               DTSBE444
00469              VALUE 'ITEM'.                                        DTSBE444
00470          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00471          10  FILLER                      PIC  X(14)               DTSBE444
00472              VALUE 'PROCESSED DATE'.                              DTSBE444
00473          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00474          10  FILLER                      PIC  X(06)               DTSBE444
00475              VALUE 'AMOUNT'.                                      DTSBE444
00476                                                                   DTSBE444
00477      05  WRK-CREDIT-REC.                                          DTSBE444
00478          10  CREDIT-EMP-NO               PIC  9(06).              DTSBE444
00479          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00480          10  CREDIT-PRIMARY-NAME         PIC  X(40).              DTSBE444
00481          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00482          10  CREDIT-EMP-CLASS            PIC  X(02).              DTSBE444
00483          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00484          10  CREDIT-BATCH-NO             PIC  9(05).              DTSBE444
00485          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00486          10  CREDIT-ITEM-NO              PIC  9(03).              DTSBE444
00487          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00488          10  CREDIT-PROC-DATE            PIC  X(10).              DTSBE444
00489          10  FILLER                      PIC  X(01) VALUE ','.    DTSBE444
00490          10  CREDIT-AMT                  PIC  ----------9.99.     DTSBE444
00491                                                                   DTSBE444
00492      05  WRK-RPT-HEADER1.                                         DTSBE444
00493          10  FILLER                  PIC  X(31)  VALUE SPACES.    DTSBE444
00494          10  FILLER                  PIC  X(37)                   DTSBE444
00495          VALUE 'AGING OF EMPLOYER ACCOUNTS RECEIVABLE'.           DTSBE444
00496          10  FILLER                  PIC  X(32)  VALUE SPACES.    DTSBE444
00497                                                                   DTSBE444
00498      05  WRK-RPT-HEADER2.                                         DTSBE444
00499          10  FILLER                  PIC  X(44)  VALUE SPACES.    DTSBE444
00500          10  WRK-RPT-EMP-CLASS       PIC  X(12).                  DTSBE444
00501          10  FILLER                  PIC  X(44)  VALUE SPACES.    DTSBE444
00502                                                                   DTSBE444
00503      05  WRK-RPT-HEADER3.                                         DTSBE444
00504          10  FILLER                  PIC  X(30)  VALUE SPACES.    DTSBE444
00505          10  FILLER                  PIC  X(30)  VALUE            DTSBE444
00506              'INCLUDES TRANSACTIONS THROUGH '.                    DTSBE444
00507          10  WRK-RPT-HEADER-DATE     PIC  X(10).                  DTSBE444
00508          10  FILLER                  PIC  X(30)  VALUE SPACES.    DTSBE444
00509                                                                   DTSBE444
00510      05  WRK-RPT-HEADER4.                                         DTSBE444
00511          10  FILLER                  PIC  X(06)  VALUE SPACES.    DTSBE444
00512          10  WRK-RPT-HDR4-DESC       PIC  X(20)  VALUE            DTSBE444
00513              'QUARTER/DESCRIPTION'.                               DTSBE444
00514          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBE444
00515          10  WRK-RPT-HDR4-TAX        PIC  X(17)  VALUE            DTSBE444
00516              '           TAX   '.                                 DTSBE444
00517          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBE444
00518          10  WRK-RPT-HDR4-PEN        PIC  X(17)  VALUE            DTSBE444
00519              '       PENALTY   '.                                 DTSBE444
00520          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBE444
00521          10  WRK-RPT-HDR4-INT        PIC  X(17)  VALUE            DTSBE444
00522              '      INTEREST   '.                                 DTSBE444
00523                                                                   DTSBE444
00524      05  WRK-RPT-DATA-LINE.                                       DTSBE444
00525          10  FILLER                  PIC  X(06)  VALUE SPACES.    DTSBE444
00526          10  WRK-RPT-DESCRIPTION     PIC  X(20).                  DTSBE444
00527          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBE444
00528          10  WRK-RPT-TAX             PIC  --,---,---,--9.99.      DTSBE444
00529          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBE444
00530          10  WRK-RPT-PEN             PIC  --,---,---,--9.99.      DTSBE444
00531          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBE444
00532          10  WRK-RPT-INT             PIC  --,---,---,--9.99.      DTSBE444
00533                                                                   DTSBE444
00534      05  WRK-AUDIT-CNT               PIC S9(07)  COMP-3           DTSBE444
00535                                       VALUE +0.                   DTSBE444
00536      05  WRK-AGING-CNT               PIC S9(07)  COMP-3           DTSBE444
00537                                       VALUE +0.                   DTSBE444
00538      05  WRK-QTR-CNT                 PIC S9(07)  COMP-3           DTSBE444
00539                                       VALUE +0.                   DTSBE444
00540      05  WRK-CREDIT-CNT              PIC S9(07)  COMP-3           DTSBE444
00541                                       VALUE +0.                   DTSBE444
00542                                                                   DTSBE444
00543      05  DISPLAY-TAX            PIC ZZZ,ZZZ,ZZZ,ZZ9.99-.          DTSBE444
00544      05  DISPLAY-TAX1           PIC ZZZ,ZZZ,ZZZ,ZZ9.99-.          DTSBE444
00545      05  DISPLAY-TAX2           PIC ZZZ,ZZZ,ZZZ,ZZ9.99-.          DTSBE444
00546      05  DISPLAY-PEN            PIC ZZZ,ZZZ,ZZZ,ZZ9.99-.          DTSBE444
00547      05  DISPLAY-INT            PIC ZZZ,ZZZ,ZZZ,ZZ9.99-.          DTSBE444
00548                                                                   DTSBE444
00549      EJECT                                                        DTSBE444
00550  01  L001-LINK-AREA.                                              DTSBE444
00551  ++INCLUDE DTSIL001                                               DTSBE444
00552      EJECT                                                        DTSBE444
00553  01  L004-LINK-AREA.                                              DTSBE444
00554  ++INCLUDE DTSIL004                                               DTSBE444
00555      EJECT                                                        DTSBE444
00556  01  L005-LINK-AREA.                                              DTSBE444
00557  ++INCLUDE DTSIL005                                               DTSBE444
00558      EJECT                                                        DTSBE444
00559  01  L910-LINK-AREA.                                              DTSBE444
00560  ++INCLUDE DTSIL910                                               DTSBE444
00561      SKIP3                                                        DTSBE444
00562  01  MSKL-REC.                                                    DTSBE444
00563  ++INCLUDE DTSIMSKL                                               DTSBE444
00564      SKIP3                                                        DTSBE444
00565  01  MHDR-REC.                                                    DTSBE444
00566  ++INCLUDE DTSIMHDR                                               DTSBE444
00567      SKIP3                                                        DTSBE444
00568  01  MSOL-REC.                                                    DTSBE444
00569  ++INCLUDE DTSIMSOL                                               DTSBE444
00570      SKIP3                                                        DTSBE444
00571  01  MRPT-REC.                                                       CL*52
00572  ++INCLUDE DTSIMRPT                                                  CL*52
00573      SKIP3                                                           CL*52
00574  01  MCOL-REC.                                                    DTSBE444
00575  ++INCLUDE DTSIMCOL                                               DTSBE444
00576      SKIP3                                                        DTSBE444
00577  01  MJRN-REC.                                                    DTSBE444
00578  ++INCLUDE DTSIMJRN                                               DTSBE444
00579      SKIP3                                                        DTSBE444
00580  01  MQTR-REC.                                                    DTSBE444
00581  ++INCLUDE DTSIMQTR                                               DTSBE444
00582      SKIP3                                                        DTSBE444
00583  01  MDST-REC.                                                    DTSBE444
00584  ++INCLUDE DTSIMDST                                               DTSBE444
00585      SKIP3                                                        DTSBE444
00586  01  X442-REC.                                                    DTSBE444
00587  ++INCLUDE DTSIX442                                               DTSBE444
00588      SKIP3                                                        DTSBE444
00589  01  R442-REC.                                                    DTSBE444
00590  ++INCLUDE DTSIR442                                               DTSBE444
00591      EJECT                                                        DTSBE444
00592                                                                      CL*44
00593  01  L101-LINK-AREA.                                                 CL*44
00594  ++INCLUDE DTSIL101                                                  CL*44
00595                                                                      CL*44
00596  LINKAGE SECTION.                                                 DTSBE444
00597      SKIP3                                                        DTSBE444
00598  01  LECM-LINK-AREA.                                              DTSBE444
00599  ++INCLUDE DTSILECM                                               DTSBE444
00600      SKIP3                                                        DTSBE444
00601          10  FILLER REDEFINES LECM-EXTRACT-PARMS.                 DTSBE444
00602              15  LECM-PARM-LAST-DEL-YRQ       PIC  9(03).         DTSBE444
00603              15  FILLER                       PIC  X(65).         DTSBE444
00604      EJECT                                                        DTSBE444
00605  01  MPRF-LINK-REC.                                               DTSBE444
00606  ++INCLUDE DTSIMPRF                                               DTSBE444
00607      EJECT                                                        DTSBE444
00608  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE444
00609                           MPRF-LINK-REC.                          DTSBE444
00610      SKIP2                                                        DTSBE444
00611      IF LECM-PROCESS-88                                           DTSBE444
00612          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE444
00613      ELSE                                                         DTSBE444
00614      IF LECM-INITIALIZE-88                                        DTSBE444
00615          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE444
00616      ELSE                                                         DTSBE444
00617      IF LECM-TERMINATE-88                                         DTSBE444
00618          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE444
00619      ELSE                                                         DTSBE444
00620          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE444
00621            TO ABEND-MSG                                           DTSBE444
00622          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE444
00623      SKIP2                                                        DTSBE444
00624      GOBACK.                                                      DTSBE444
00625      EJECT                                                        DTSBE444
00626  I0000-INITIALIZE.                                                DTSBE444
00627      SET WRK-ERROR-NO-88    TO TRUE.                              DTSBE444
00628                                                                   DTSBE444
00629      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE444
00630                                                                   DTSBE444
00631      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE444
00632                                                                   DTSBE444
00633      MOVE LENGTH OF R442-REC TO R442-LENGTH.                      DTSBE444
00634      MOVE '442'  TO R442-REC-TYPE.                                DTSBE444
00635                                                                   DTSBE444
00636      MOVE ZERO               TO WRK-3-YR-RATED-TAX                DTSBE444
00637                                 WRK-3-YR-RATED-PEN                DTSBE444
00638                                 WRK-3-YR-RATED-INT                DTSBE444
00639                                 WRK-3-YR-SELF-INS-TAX             DTSBE444
00640                                 WRK-3-YR-SELF-INS-PEN             DTSBE444
00641                                 WRK-3-YR-SELF-INS-INT             DTSBE444
00642                                 WRK-TOT-RATED-TAX                 DTSBE444
00643                                 WRK-TOT-RATED-PEN                 DTSBE444
00644                                 WRK-TOT-RATED-INT                 DTSBE444
00645                                 WRK-TOT-SELF-INS-TAX              DTSBE444
00646                                 WRK-TOT-SELF-INS-PEN              DTSBE444
00647                                 WRK-TOT-SELF-INS-INT              DTSBE444
00648                                 WRK-ACTIVE-RATED-TAX              DTSBE444
00649                                 WRK-ACTIVE-RATED-PEN              DTSBE444
00650                                 WRK-ACTIVE-RATED-INT              DTSBE444
00651                                 WRK-INACT-RATED-TAX               DTSBE444
00652                                 WRK-INACT-RATED-PEN               DTSBE444
00653                                 WRK-INACT-RATED-INT               DTSBE444
00654                                 WRK-INACT-3YR-RATED-TAX           DTSBE444
00655                                 WRK-INACT-3YR-RATED-PEN           DTSBE444
00656                                 WRK-INACT-3YR-RATED-INT           DTSBE444
00657                                 WRK-CHAPTER-7-RATED-TAX           DTSBE444
00658                                 WRK-CHAPTER-7-RATED-PEN           DTSBE444
00659                                 WRK-CHAPTER-7-RATED-INT           DTSBE444
00660                                 WRK-CHAPTER-11-RATED-TAX          DTSBE444
00661                                 WRK-CHAPTER-11-RATED-PEN          DTSBE444
00662                                 WRK-CHAPTER-11-RATED-INT          DTSBE444
00663                                 WRK-ACTIVE-SELF-INS-TAX           DTSBE444
00664                                 WRK-ACTIVE-SELF-INS-PEN           DTSBE444
00665                                 WRK-ACTIVE-SELF-INS-INT           DTSBE444
00666                                 WRK-INACT-SELF-INS-TAX            DTSBE444
00667                                 WRK-INACT-SELF-INS-PEN            DTSBE444
00668                                 WRK-INACT-SELF-INS-INT            DTSBE444
00669                                 WRK-INACT-3YR-SELF-INS-TAX        DTSBE444
00670                                 WRK-INACT-3YR-SELF-INS-PEN        DTSBE444
00671                                 WRK-INACT-3YR-SELF-INS-INT        DTSBE444
00672                                 WRK-CHAPTER-7-SELF-INS-TAX        DTSBE444
00673                                 WRK-CHAPTER-7-SELF-INS-PEN        DTSBE444
00674                                 WRK-CHAPTER-7-SELF-INS-INT        DTSBE444
00675                                 WRK-CHAPTER-11-SELF-INS-TAX       DTSBE444
00676                                 WRK-CHAPTER-11-SELF-INS-PEN       DTSBE444
00677                                 WRK-CHAPTER-11-SELF-INS-INT       DTSBE444
00678                                 WRK-MTH-RATED-TAX-PAY             DTSBE444
00679                                 WRK-MTH-RATED-PEN-PAY             DTSBE444
00680                                 WRK-MTH-RATED-INT-PAY             DTSBE444
00681                                 WRK-MTH-RATED-CRED-PAY            DTSBE444
00682                                 WRK-MTH-SI-TAX-PAY                DTSBE444
00683                                 WRK-MTH-SI-PEN-PAY                DTSBE444
00684                                 WRK-MTH-SI-INT-PAY                DTSBE444
00685                                 WRK-MTH-SI-CRED-PAY               DTSBE444
00686                                 WRK-MTH-UNK-CRED-PAY              DTSBE444
00687                                 WRK-MTH-UNK-TAX-PAY               DTSBE444
00688                                 WRK-MTH-UNK-PEN-PAY               DTSBE444
00689                                 WRK-MTH-UNK-INT-PAY               DTSBE444
00690                                 WRK-MTH-UNK-CRED-PAY              DTSBE444
00691                                                                   DTSBE444
00692                                 WRK-19994-RATED-TAX               DTSBE444
00693                                 WRK-19994-RATED-PEN               DTSBE444
00694                                 WRK-19994-RATED-INT               DTSBE444
00695                                 WRK-19994-SELF-INS-TAX            DTSBE444
00696                                 WRK-19994-SELF-INS-PEN            DTSBE444
00697                                 WRK-19994-SELF-INS-INT            DTSBE444
00698                                 WRK-CREDIT-PAID-RATED             DTSBE444
00699                                 WRK-CREDIT-TOL-RATED              DTSBE444
00700                                 WRK-CREDIT-WRITEOFF-RATED         DTSBE444
00701                                 WRK-CREDIT-PAID-SI                DTSBE444
00702                                 WRK-CREDIT-TOL-SI                 DTSBE444
00703                                 WRK-CREDIT-WRITEOFF-SI            DTSBE444
00704                                 WRK-CREDIT-PAID-UNK               DTSBE444
00705                                 WRK-CREDIT-TOL-UNK                DTSBE444
00706                                 WRK-CREDIT-WRITEOFF-UNK           DTSBE444
00707                                 WRK-CREDIT-AMT.                   DTSBE444
00708                                                                   DTSBE444
00709                                                                   DTSBE444
00710                                                                   DTSBE444
00711      PERFORM I1000-READ-MHDR              THRU I1000-EXIT.        DTSBE444
00712                                                                   DTSBE444
00713      PERFORM I2000-OPEN-FILE               THRU I2000-EXIT.       DTSBE444
00714                                                                   DTSBE444
00715      PERFORM I3000-EDIT-AND-DEFAULT-PARMS THRU I3000-EXIT.        DTSBE444
00716                                                                   DTSBE444
00717      PERFORM I4000-BUILD-QTR-TABLE        THRU I4000-EXIT.        DTSBE444
00718                                                                   DTSBE444
00719      PERFORM I5000-WRITE-HEADERS          THRU I5000-EXIT.        DTSBE444
00720                                                                   DTSBE444
00721      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE444
00722                                                                   DTSBE444
00723  I0000-EXIT.                                                      DTSBE444
00724      EXIT.                                                        DTSBE444
00725                                                                   DTSBE444
00726  I1000-READ-MHDR.                                                 DTSBE444
00727      MOVE LOW-VALUES       TO MHDR-KEY-AREA.                      DTSBE444
00728      MOVE +0               TO MHDR-EMP-NO.                        DTSBE444
00729      SET MHDR-HDR-88       TO TRUE.                               DTSBE444
00730      MOVE MHDR-KEY-AREA    TO MSKL-KEY-AREA.                      DTSBE444
00731      PERFORM S910-READ     THRU S910-EXIT.                        DTSBE444
00732      IF L910-NO-REC-88                                            DTSBE444
00733         MOVE 'MHDR RECORD NOT FOUND'                              DTSBE444
00734                            TO ABEND-MSG                           DTSBE444
00735         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE444
00736      ELSE                                                         DTSBE444
00737         MOVE MSKL-REC      TO MHDR-REC.                           DTSBE444
00738                                                                   DTSBE444
00739      MOVE MHDR-CURR-RUN-DATE TO R442-CURR-RUN-DATE.               DTSBE444
00740                                                                   DTSBE444
00741  I1000-EXIT.                                                      DTSBE444
00742      EXIT.                                                        DTSBE444
00743                                                                   DTSBE444
00744  I2000-OPEN-FILE.                                                 DTSBE444
00745      OPEN OUTPUT AUDIT-FILE                                       DTSBE444
00746      IF NOT AUDIT-STATUS-OK-88                                    DTSBE444
00747         DISPLAY 'CANNOT OPEN AUDIT FILE ' AUDIT-STATUS            DTSBE444
00748         SET WRK-ERROR-YES-88  TO TRUE                             DTSBE444
00749      END-IF.                                                      DTSBE444
00750                                                                   DTSBE444
00751      OPEN OUTPUT AGING-REPORT.                                    DTSBE444
00752      IF NOT AGING-STATUS-OK-88                                    DTSBE444
00753         DISPLAY 'CANNOT OPEN AGING REPORT ' AGING-STATUS          DTSBE444
00754         SET WRK-ERROR-YES-88  TO TRUE                             DTSBE444
00755      END-IF.                                                      DTSBE444
00756                                                                   DTSBE444
00757      OPEN OUTPUT QTR-FILE.                                        DTSBE444
00758      IF NOT QTR-STATUS-OK-88                                      DTSBE444
00759         DISPLAY 'CANNOT OPEN QTR REPORT ' QTR-STATUS              DTSBE444
00760         SET WRK-ERROR-YES-88  TO TRUE                             DTSBE444
00761      END-IF.                                                      DTSBE444
00762                                                                   DTSBE444
00763      OPEN OUTPUT PAY-FILE.                                        DTSBE444
00764      IF NOT PAY-STATUS-OK-88                                      DTSBE444
00765         DISPLAY 'CANNOT OPEN PAY FILE ' PAY-STATUS                DTSBE444
00766         SET WRK-ERROR-YES-88  TO TRUE                             DTSBE444
00767      END-IF.                                                      DTSBE444
00768                                                                   DTSBE444
00769      OPEN OUTPUT CREDIT-FILE.                                     DTSBE444
00770      IF NOT CREDIT-STATUS-OK-88                                   DTSBE444
00771         DISPLAY 'CANNOT OPEN CREDIT FILE ' CREDIT-STATUS          DTSBE444
00772         SET WRK-ERROR-YES-88  TO TRUE                             DTSBE444
00773      END-IF.                                                      DTSBE444
00774                                                                   DTSBE444
00775  I2000-EXIT.                                                      DTSBE444
00776      EXIT.                                                        DTSBE444
00777                                                                   DTSBE444
00778  I3000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE444
00779      MOVE +19994                         TO WRK-19994-YRQ.        DTSBE444
00780                                                                   DTSBE444
00781      PERFORM I3100-LAST-DEL-YRQ          THRU I3100-EXIT.         DTSBE444
00782                                                                   DTSBE444
00783      PERFORM I3200-3-YEARS-AGO           THRU I3200-EXIT.         DTSBE444
00784                                                                   DTSBE444
00785      MOVE MHDR-CMPL-WEEK-BEGIN-DATE     TO WRK-MTH-BEGIN-DATE.       CL*14
00786      MOVE MHDR-CMPL-WEEK-END-DATE       TO WRK-MTH-END-DATE          CL*14
00787 *    MOVE MHDR-CMPL-MONTH-BEGIN-DATE     TO WRK-MTH-BEGIN-DATE.      CL*14
00788 *    MOVE MHDR-CMPL-MONTH-END-DATE       TO WRK-MTH-END-DATE         CL*14
00789                                             L001-FED-8-DATE-9.    DTSBE444
00790      PERFORM S001-FROM-FED-8             THRU S001-EXIT.          DTSBE444
00791      MOVE L001-SLASH-8-DATE           TO WRK-RPT-HEADER-DATE      DTSBE444
00792                                          AUDIT-HDR1-DATE          DTSBE444
00793                                          QTR-HDR1-DATE            DTSBE444
00794                                          CREDIT-HDR1-DATE.        DTSBE444
00795      DISPLAY SPACE.                                               DTSBE444
00796      DISPLAY '***  DTSBE443 PARMS  ***'                              CL*14
00797      DISPLAY 'LAST DELINQUENT QUARTER ' WRK-LAST-DEL-YRQ.         DTSBE444
00798      DISPLAY '3 YEARS AGO             ' WRK-3-YEARS-AGO-YRQ       DTSBE444
00799         '  ' WRK-3-YEARS-AGO-DATE.                                DTSBE444
00800      DISPLAY 'CURRENT RUN DATE        ' MHDR-CURR-RUN-DATE.       DTSBE444
00801      DISPLAY 'FOURTH QTR 1999         ' WRK-19994-YRQ.            DTSBE444
00802      DISPLAY 'MONTH BEGIN             ' WRK-MTH-BEGIN-DATE.       DTSBE444
00803      DISPLAY 'MONTH END               ' WRK-MTH-END-DATE.         DTSBE444
00804      DISPLAY SPACE.                                               DTSBE444
00805      DISPLAY '************************'.                          DTSBE444
00806                                                                   DTSBE444
00807  I3000-EXIT.                                                      DTSBE444
00808      EXIT.                                                        DTSBE444
00809      SKIP3                                                        DTSBE444
00810  I3100-LAST-DEL-YRQ.                                              DTSBE444
00811      IF LECM-PARM-LAST-DEL-YRQ = SPACES OR LOW-VALUES             DTSBE444
00812         MOVE MHDR-LAST-UC30-DEL-MAIL-YRQ TO WRK-LAST-DEL-YRQ      DTSBE444
00813      ELSE                                                         DTSBE444
00814         PERFORM I3110-EDIT-LAST-DEL-YRQ  THRU I3110-EXIT.         DTSBE444
00815                                                                   DTSBE444
00816  I3100-EXIT.                                                      DTSBE444
00817      EXIT.                                                        DTSBE444
00818                                                                   DTSBE444
00819  I3110-EDIT-LAST-DEL-YRQ.                                         DTSBE444
00820      MOVE LECM-PARM-LAST-DEL-YRQ      TO L004-QTR-3-X.            DTSBE444
00821      PERFORM S004-FROM-3              THRU S004-EXIT.             DTSBE444
00822      IF L004-INVALID-QTR                                          DTSBE444
00823           MOVE 'LECM-PARM-LAST-DEL-YRQ NOT VALID'                 DTSBE444
00824             TO ABEND-MSG                                          DTSBE444
00825           PERFORM S999-ABEND          THRU S999-EXIT              DTSBE444
00826       ELSE                                                        DTSBE444
00827          MOVE L004-QTR-5-9            TO WRK-LAST-DEL-YRQ         DTSBE444
00828       END-IF.                                                     DTSBE444
00829                                                                   DTSBE444
00830  I3110-EXIT.                                                      DTSBE444
00831      EXIT.                                                        DTSBE444
00832                                                                   DTSBE444
00833  I3200-3-YEARS-AGO.                                               DTSBE444
00834      MOVE WRK-LAST-DEL-YRQ    TO L004-QTR-5-9.                    DTSBE444
00835      PERFORM S004-FROM-5      THRU S004-EXIT.                     DTSBE444
00836      SUBTRACT +12             FROM L004-ABS-QTR.                  DTSBE444
00837      PERFORM S004-FROM-ABS    THRU S004-EXIT.                     DTSBE444
00838      MOVE L004-QTR-5-9        TO WRK-3-YEARS-AGO-YRQ.             DTSBE444
00839      MOVE L004-QTR-END-DATE   TO WRK-3-YEARS-AGO-DATE.            DTSBE444
00840                                                                   DTSBE444
00841  I3200-EXIT.                                                      DTSBE444
00842      EXIT.                                                        DTSBE444
00843                                                                   DTSBE444
00844  I4000-BUILD-QTR-TABLE.                                           DTSBE444
00845      MOVE ZERO                TO WRK-QTR-RATED-TAX (1)            DTSBE444
00846                                  WRK-QTR-RATED-PEN (1)            DTSBE444
00847                                  WRK-QTR-RATED-INT (1)            DTSBE444
00848                                  WRK-QTR-SELF-INS-TAX (1)         DTSBE444
00849                                  WRK-QTR-SELF-INS-PEN (1)         DTSBE444
00850                                  WRK-QTR-SELF-INS-INT (1).        DTSBE444
00851                                                                   DTSBE444
00852      MOVE WRK-LAST-DEL-YRQ    TO WRK-QTR-YRQ (1)                  DTSBE444
00853                                  L004-QTR-5-9.                    DTSBE444
00854      PERFORM S004-FROM-5      THRU S004-EXIT.                     DTSBE444
00855                                                                   DTSBE444
00856      PERFORM I4100-PREVIOUS-YRQ THRU I4100-EXIT                   DTSBE444
00857         VARYING SUB FROM +2 BY +1                                 DTSBE444
00858         UNTIL SUB > WRK-QTR-MAX.                                  DTSBE444
00859                                                                   DTSBE444
00860      IF WRK-QTR-YRQ (WRK-QTR-MAX) < MHDR-FIRST-PURSUED-RPT-YRQ    DTSBE444
00861           MOVE 'REQUESTED QTR PURGED FROM DATABASE'               DTSBE444
00862             TO ABEND-MSG                                          DTSBE444
00863           PERFORM S999-ABEND          THRU S999-EXIT.             DTSBE444
00864                                                                   DTSBE444
00865  I4000-EXIT.                                                      DTSBE444
00866      EXIT.                                                        DTSBE444
00867                                                                   DTSBE444
00868  I4100-PREVIOUS-YRQ.                                              DTSBE444
00869      SUBTRACT +1 FROM L004-ABS-QTR.                               DTSBE444
00870      PERFORM S004-FROM-ABS    THRU S004-EXIT.                     DTSBE444
00871      MOVE L004-QTR-5-9        TO WRK-QTR-YRQ (SUB).               DTSBE444
00872                                                                   DTSBE444
00873      MOVE ZERO                TO WRK-QTR-RATED-TAX (SUB)          DTSBE444
00874                                  WRK-QTR-RATED-PEN (SUB)          DTSBE444
00875                                  WRK-QTR-RATED-INT (SUB)          DTSBE444
00876                                  WRK-QTR-SELF-INS-TAX (SUB)       DTSBE444
00877                                  WRK-QTR-SELF-INS-PEN (SUB)       DTSBE444
00878                                  WRK-QTR-SELF-INS-INT (SUB).      DTSBE444
00879                                                                   DTSBE444
00880  I4100-EXIT.                                                      DTSBE444
00881      EXIT.                                                        DTSBE444
00882                                                                   DTSBE444
00883  I5000-WRITE-HEADERS.                                             DTSBE444
00884      WRITE PAY-REC  FROM WRK-AUDIT-HEADER1.                       DTSBE444
00885      WRITE PAY-REC  FROM WRK-AUDIT-HEADER2.                       DTSBE444
00886                                                                   DTSBE444
00887      WRITE QTR-REC FROM WRK-QTR-HEADER1.                          DTSBE444
00888      WRITE QTR-REC FROM WRK-QTR-HEADER2.                          DTSBE444
00889                                                                   DTSBE444
00890      WRITE CREDIT-REC FROM WRK-CREDIT-HEADER1.                    DTSBE444
00891      WRITE CREDIT-REC FROM WRK-CREDIT-HEADER2.                    DTSBE444
00892                                                                   DTSBE444
00893  I5000-EXIT.                                                      DTSBE444
00894      EXIT.                                                        DTSBE444
00895                                                                   DTSBE444
00896  P0000-PROCESS.                                                   DTSBE444
00897      IF WRK-ERROR-YES-88                                          DTSBE444
00898         GO TO P0000-EXIT                                          DTSBE444
00899      END-IF.                                                      DTSBE444
00900                                                                      CL*20
00901      IF MPRF-TOT-BALANCE-AMT < +01                                   CL*20
00902         GO TO P0000-EXIT                                             CL*20
00903                                                                      CL*20
00904      PERFORM P0100-INIT-QTR-TABLE          THRU P0100-EXIT.       DTSBE444
00905                                                                   DTSBE444
00906      IF MPRF-CLASS-SUB-88                                         DTSBE444
00907         PERFORM P1000-DETERMINE-STATUS     THRU P1000-EXIT        DTSBE444
00908         IF WRK-STAT-INVALID                                       DTSBE444
00909            NEXT SENTENCE                                          DTSBE444
00910         ELSE                                                      DTSBE444
00911            PERFORM P2000-QTR-RECEIVABLES   THRU P2000-EXIT        DTSBE444
00912            PERFORM P4000-QTR-SUMMARY       THRU P4000-EXIT           CL*15
00913 *          PERFORM P3000-JRN-RECEIVABLES   THRU P3000-EXIT           CL*18
00914         END-IF                                                    DTSBE444
00915      END-IF.                                                      DTSBE444
00916                                                                   DTSBE444
00917 *    PERFORM P5000-CREDITS                 THRU P5000-EXIT.          CL*18
00918                                                                   DTSBE444
00919                                                                   DTSBE444
00920 *&   PERFORM                                                      DTSBE444
00921 *       VARYING TSUB FROM +1 BY +1                                DTSBE444
00922 *       UNTIL TSUB > TSUB-MAX                                     DTSBE444
00923 *       IF (CTAB-QTR-TAX-BAL(TSUB) NOT =                          DTSBE444
00924 *           CTAB-JRN-TAX-BAL(TSUB))                               DTSBE444
00925 *          MOVE TSUB                  TO L004-ABS-QTR             DTSBE444
00926 *          PERFORM S004-FROM-ABS      THRU S004-EXIT              DTSBE444
00927 *          MOVE CTAB-QTR-TAX-BAL(TSUB) TO DISPLAY-TAX             DTSBE444
00928 *          MOVE CTAB-JRN-TAX-BAL(TSUB) TO DISPLAY-TAX1            DTSBE444
00929 *          DISPLAY 'QTR/JRN TAX ' MPRF-EMP-NO                     DTSBE444
00930 *             '  ' L004-SLASH-5-QTR                               DTSBE444
00931 *             '  ' DISPLAY-TAX ' ' DISPLAY-TAX1                   DTSBE444
00932 *       END-IF                                                    DTSBE444
00933 *                                                                 DTSBE444
00934 *       IF (CTAB-QTR-PEN-BAL(TSUB) NOT =                          DTSBE444
00935 *           CTAB-JRN-PEN-BAL(TSUB))                               DTSBE444
00936 **      IF (CTAB-QTR-20051-PEN(TSUB) NOT =                        DTSBE444
00937 **          CTAB-JRN-20051-PEN(TSUB))                             DTSBE444
00938 *          MOVE TSUB                  TO L004-ABS-QTR             DTSBE444
00939 *          PERFORM S004-FROM-ABS      THRU S004-EXIT              DTSBE444
00940 *          IF L004-QTR-5-9 = 20051                                DTSBE444
00941 *             MOVE CTAB-QTR-PEN-BAL(TSUB) TO DISPLAY-TAX          DTSBE444
00942 *             MOVE CTAB-JRN-PEN-BAL(TSUB) TO DISPLAY-TAX1         DTSBE444
00943 **            MOVE CTAB-QTR-20051-PEN (TSUB) TO DISPLAY-TAX       DTSBE444
00944 **            MOVE CTAB-JRN-20051-PEN (TSUB) TO DISPLAY-TAX1      DTSBE444
00945 *             DISPLAY 'QTR/JRN PEN ' MPRF-EMP-NO                  DTSBE444
00946 *                '  ' L004-SLASH-5-QTR                            DTSBE444
00947 *                '  ' DISPLAY-TAX ' ' DISPLAY-TAX1                DTSBE444
00948 *          END-IF                                                 DTSBE444
00949 *       END-IF                                                    DTSBE444
00950 *                                                                 DTSBE444
00951 *       IF (CTAB-QTR-INT-BAL(TSUB) NOT =                          DTSBE444
00952 *           CTAB-JRN-INT-BAL(TSUB))                               DTSBE444
00953 *          MOVE TSUB                  TO L004-ABS-QTR             DTSBE444
00954 *          PERFORM S004-FROM-ABS      THRU S004-EXIT              DTSBE444
00955 *          MOVE CTAB-QTR-INT-BAL(TSUB) TO DISPLAY-TAX             DTSBE444
00956 *          MOVE CTAB-JRN-INT-BAL(TSUB) TO DISPLAY-TAX1            DTSBE444
00957 *          DISPLAY 'QTR/JRN INT ' MPRF-EMP-NO                     DTSBE444
00958 *             '  ' L004-SLASH-5-QTR                               DTSBE444
00959 *             '  ' DISPLAY-TAX ' ' DISPLAY-TAX1                   DTSBE444
00960 *       END-IF                                                    DTSBE444
00961 *                                                                 DTSBE444
00962 *&   END-PERFORM.                                                 DTSBE444
00963                                                                   DTSBE444
00964  P0000-EXIT.                                                      DTSBE444
00965      EXIT.                                                        DTSBE444
00966      EJECT                                                        DTSBE444
00967  P0100-INIT-QTR-TABLE.                                            DTSBE444
00968      PERFORM                                                      DTSBE444
00969         VARYING TSUB     FROM +1 BY +1                               CL*33
00970         UNTIL  TSUB    > TSUB-MAX                                    CL*33
00971         MOVE ZEROS   TO CTAB-QTR-YRQ (TSUB)                          CL*33
00972                         CTAB-QTR-TAX-BAL (TSUB)                      CL*33
00973                         CTAB-QTR-UI-BAL (TSUB)                       CL*33
00974                         CTAB-QTR-SUR-BAL (TSUB)                      CL*33
00975                         CTAB-QTR-PEN-BAL (TSUB)                      CL*33
00976                         CTAB-QTR-LP-BAL (TSUB)                       CL*33
00977                         CTAB-QTR-NSF-BAL (TSUB)                      CL*33
00978                         CTAB-QTR-MSF-BAL (TSUB)                      CL*33
00979                         CTAB-QTR-INT-BAL (TSUB)                      CL*33
00980                         CTAB-QTR-DEF-BAL (TSUB)                      CL*47
00981                         CTAB-QTR-20051-PEN (TSUB)                    CL*33
00982                         CTAB-JRN-TAX-BAL (TSUB)                      CL*33
00983                         CTAB-JRN-PEN-BAL (TSUB)                      CL*33
00984                         CTAB-JRN-INT-BAL (TSUB)                      CL*33
00985                         CTAB-JRN-20051-PEN (TSUB)                    CL*33
00986      END-PERFORM.                                                 DTSBE444
00987                                                                   DTSBE444
00988  P0100-EXIT.                                                      DTSBE444
00989      EXIT.                                                        DTSBE444
00990                                                                   DTSBE444
00991  P1000-DETERMINE-STATUS.                                          DTSBE444
00992      IF MPRF-STATUS-ACT-88                                        DTSBE444
00993         SET WRK-STAT-ACTIVE TO TRUE                               DTSBE444
00994      ELSE                                                         DTSBE444
00995         PERFORM P1100-INACTIVE THRU P1100-EXIT.                   DTSBE444
00996                                                                   DTSBE444
00997 *    PERFORM P1200-BANKRUPTCY  THRU P1200-EXIT.                      CL*24
00998                                                                   DTSBE444
00999  P1000-EXIT.                                                      DTSBE444
01000      EXIT.                                                        DTSBE444
01001                                                                   DTSBE444
01002  P1100-INACTIVE.                                                  DTSBE444
01003      MOVE LOW-VALUES             TO MSOL-KEY-AREA.                DTSBE444
01004      MOVE MPRF-EMP-NO            TO MSOL-EMP-NO.                  DTSBE444
01005      SET MSOL-SOL-88             TO TRUE.                         DTSBE444
01006      MOVE MSOL-KEY-AREA          TO MSKL-KEY-AREA.                DTSBE444
01007      PERFORM S910-START-BROWSE   THRU S910-EXIT.                  DTSBE444
01008      IF L910-NO-REC-88                                            DTSBE444
01009         SET WRK-STAT-INVALID     TO TRUE                          DTSBE444
01010         GO TO P1100-EXIT.                                         DTSBE444
01011                                                                   DTSBE444
01012      PERFORM P1110-SCAN-MSOL     THRU P1110-EXIT                  DTSBE444
01013          UNTIL L910-NO-REC-88.                                    DTSBE444
01014                                                                   DTSBE444
01015      IF WRK-STAT-INACT                                            DTSBE444
01016         IF WRK-INACT-DATE <= WRK-3-YEARS-AGO-DATE                 DTSBE444
01017            SET WRK-STAT-INACT-3-YR TO TRUE.                       DTSBE444
01018                                                                   DTSBE444
01019  P1100-EXIT.                                                      DTSBE444
01020      EXIT.                                                        DTSBE444
01021                                                                   DTSBE444
01022  P1110-SCAN-MSOL.                                                 DTSBE444
01023      MOVE MSKL-REC TO MSOL-REC.                                   DTSBE444
01024                                                                   DTSBE444
01025      IF MSOL-INACT-WITHDRAWN-88                                   DTSBE444
01026         GO TO P1110-READ-NEXT                                     DTSBE444
01027      ELSE                                                         DTSBE444
01028         IF MSOL-INACT-INACTIVE-88                                 DTSBE444
01029            SET WRK-STAT-INACT TO TRUE                             DTSBE444
01030            MOVE MSOL-INACT-DATE TO WRK-INACT-DATE                 DTSBE444
01031         ELSE                                                      DTSBE444
01032            SET WRK-STAT-ACTIVE TO TRUE                            DTSBE444
01033         END-IF                                                    DTSBE444
01034      END-IF.                                                      DTSBE444
01035                                                                   DTSBE444
01036  P1110-READ-NEXT.                                                 DTSBE444
01037      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE444
01038                                                                   DTSBE444
01039  P1110-EXIT.                                                      DTSBE444
01040      EXIT.                                                        DTSBE444
01041                                                                   DTSBE444
01042  P1200-BANKRUPTCY.                                                DTSBE444
01043      SET WRK-BNK-NONE TO TRUE.                                    DTSBE444
01044                                                                   DTSBE444
01045      MOVE LOW-VALUES             TO MCOL-KEY-AREA.                DTSBE444
01046      MOVE MPRF-EMP-NO            TO MCOL-EMP-NO.                  DTSBE444
01047      SET MCOL-COL-88             TO TRUE.                         DTSBE444
01048      MOVE MCOL-KEY-AREA          TO MSKL-KEY-AREA.                DTSBE444
01049      PERFORM S910-READ           THRU S910-EXIT.                  DTSBE444
01050      IF L910-NO-REC-88                                            DTSBE444
01051         GO TO P1200-EXIT.                                         DTSBE444
01052                                                                   DTSBE444
01053      MOVE MSKL-REC               TO MCOL-REC.                     DTSBE444
01054                                                                   DTSBE444
01055      IF (MCOL-BNK-PETITION-DATE > ZERO                            DTSBE444
01056      AND (MCOL-BNK-DISCHRG-CLOSE-DATE = ZERO                      DTSBE444
01057      AND  MCOL-BNK-DISMISS-DATE = ZERO))                          DTSBE444
01058         IF MCOL-BNK-CHAPTER-7-88                                  DTSBE444
01059            SET WRK-BNK-CHAP-7 TO TRUE                             DTSBE444
01060         ELSE                                                      DTSBE444
01061            IF MCOL-BNK-CHAPTER-11-88                              DTSBE444
01062               SET WRK-BNK-CHAP-11 TO TRUE                         DTSBE444
01063            END-IF                                                 DTSBE444
01064         END-IF                                                    DTSBE444
01065      END-IF.                                                      DTSBE444
01066                                                                   DTSBE444
01067  P1200-EXIT.                                                      DTSBE444
01068      EXIT.                                                        DTSBE444
01069                                                                   DTSBE444
01070  P2000-QTR-RECEIVABLES.                                           DTSBE444
01071      MOVE LOW-VALUES             TO MQTR-KEY-AREA.                DTSBE444
01072      MOVE MPRF-EMP-NO            TO MQTR-EMP-NO.                  DTSBE444
01073      SET MQTR-QTR-88             TO TRUE.                         DTSBE444
01074      MOVE MQTR-KEY-AREA          TO MSKL-KEY-AREA.                DTSBE444
01075      PERFORM S910-START-BROWSE   THRU S910-EXIT.                  DTSBE444
01076      IF L910-NO-REC-88                                            DTSBE444
01077         GO TO P2000-EXIT.                                         DTSBE444
01078                                                                   DTSBE444
01079      DISPLAY 'P2000- ' MPRF-EMP-NO ' '                               CL*55
01080      MOVE +0 TO TSUB ZSUB                                            CL*34
01081      PERFORM P2100-SCAN-MQTR     THRU P2100-EXIT                  DTSBE444
01082          UNTIL L910-NO-REC-88.                                    DTSBE444
01083                                                                   DTSBE444
01084 *&                                                                DTSBE444
01085 *    PERFORM                                                      DTSBE444
01086 *      VARYING TSUB FROM +1 BY +1                                 DTSBE444
01087 *      UNTIL TSUB > TSUB-MAX                                      DTSBE444
01088 *         IF CTAB-QTR-TAX-BAL (TSUB) > ZERO                       DTSBE444
01089 *            MOVE CTAB-QTR-TAX-BAL (TSUB) TO DISPLAY-TAX          DTSBE444
01090 *            MOVE TSUB                  TO L004-ABS-QTR           DTSBE444
01091 *            PERFORM S004-FROM-ABS      THRU S004-EXIT            DTSBE444
01092 *            DISPLAY 'P2 ' MPRF-EMP-NO '  ' L004-SLASH-5-QTR      DTSBE444
01093 *               '  ' DISPLAY-TAX                                  DTSBE444
01094 *         END-IF                                                  DTSBE444
01095 *    END-PERFORM.                                                 DTSBE444
01096 *&                                                                DTSBE444
01097  P2000-EXIT.                                                      DTSBE444
01098      EXIT.                                                        DTSBE444
01099      SKIP2                                                        DTSBE444
01100  P2100-SCAN-MQTR.                                                 DTSBE444
01101 *     DISPLAY 'P2100-SCAN-MQTR......'  MQTR-EMP-NO ' ' MQTR-YRQ.     CL*56
01102      MOVE MSKL-REC TO MQTR-REC.                                   DTSBE444
01103      MOVE ZEROS TO L101-PAID-CHNG.                                   CL*44
01104                                                                   DTSBE444
01105 *&   IF MQTR-YRQ > WRK-LAST-DEL-YRQ                               DTSBE444
01106 *       SET L910-NO-REC-88  TO TRUE                               DTSBE444
01107 *&      GO TO P2100-EXIT.                                         DTSBE444
01108                                                                   DTSBE444
01109      ADD  +1 TO TSUB ZSUB                                            CL*34
01110 *    PERFORM P2110-SET-SUB      THRU P2110-EXIT.                     CL*23
01111 *    IF SUB > ZERO                                                   CL*21
01112         IF MPRF-CLASS-RATED-88                                    DTSBE444
01113            PERFORM P2130-RATED     THRU P2130-EXIT                DTSBE444
01114         ELSE                                                      DTSBE444
01115            IF MPRF-CLASS-SELF-INS-88                              DTSBE444
01116               PERFORM P2140-SELF-INS  THRU P2140-EXIT             DTSBE444
01117            END-IF                                                 DTSBE444
01118 *       END-IF                                                       CL*21
01119      END-IF.                                                      DTSBE444
01120                                                                   DTSBE444
01121      IF L101-PAID-CHNG > +0                                          CL*49
01122         PERFORM P2150-ACC-INT  THRU P2150-EXIT                       CL*55
01123         MOVE ZEROS TO L101-PAID-CHNG.                                CL*55
01124                                                                      CL*49
01125      MOVE MQTR-REC TO MSKL-REC                                       CL*55
01126      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE444
01127                                                                   DTSBE444
01128  P2100-EXIT.                                                      DTSBE444
01129      EXIT.                                                        DTSBE444
01130      SKIP2                                                        DTSBE444
01131 ************************************************************      DTSBE444
01132 *  THIS PARAGRAPH SETS THE SUBSCRIPT INTO WRK-QTR-TABLE.          DTSBE444
01133 *  THE TABLE STORES THE TOTAL AMOUNTS RECEIVABLE FOR THE 6        DTSBE444
01134 *  MOST RECENT DELINQUENT QUARTERS IN THE FIRST 6 TABLE           DTSBE444
01135 *  OCCCURRENCES.                                                  DTSBE444
01136 *  IT STORES ANY RECEIVABLES FOR EARLIER QUARTERS IN THE          DTSBE444
01137 *  SEVENTH OCCURRENCE (WRK-QTR-MAX).                              DTSBE444
01138 ************************************************************      DTSBE444
01139  P2110-SET-SUB.                                                   DTSBE444
01140      MOVE +1 TO SUB.                                                 CL*21
01141                                                                   DTSBE444
01142      MOVE MQTR-YRQ                    TO L004-QTR-5-9.            DTSBE444
01143      PERFORM S004-FROM-5              THRU S004-EXIT.             DTSBE444
01144      MOVE L004-ABS-QTR                TO TSUB.                    DTSBE444
01145      GO TO P2110-EXIT.                                               CL*21
01146                                                                   DTSBE444
01147      IF MQTR-YRQ <= WRK-QTR-YRQ (WRK-QTR-MAX)                     DTSBE444
01148         MOVE WRK-QTR-MAX TO SUB                                   DTSBE444
01149      ELSE                                                         DTSBE444
01150         PERFORM                                                   DTSBE444
01151            VARYING WRK-QTR-IDX FROM +1 BY +1                      DTSBE444
01152            UNTIL WRK-QTR-IDX > WRK-QTR-MAX                        DTSBE444
01153            OR SUB NOT = ZERO                                      DTSBE444
01154               IF WRK-QTR-YRQ (WRK-QTR-IDX) = MQTR-YRQ             DTSBE444
01155                  SET SUB TO WRK-QTR-IDX                           DTSBE444
01156               END-IF                                              DTSBE444
01157         END-PERFORM                                               DTSBE444
01158      END-IF.                                                      DTSBE444
01159                                                                   DTSBE444
01160      IF SUB = ZERO                                                DTSBE444
01161         DISPLAY 'P2110 SUB = 0 ' MPRF-EMP-NO '  ' MQTR-YRQ        DTSBE444
01162      END-IF.                                                      DTSBE444
01163                                                                   DTSBE444
01164  P2110-EXIT.                                                      DTSBE444
01165      EXIT.                                                        DTSBE444
01166                                                                   DTSBE444
01167  P2130-RATED.                                                     DTSBE444
01168      PERFORM                                                      DTSBE444
01169         VARYING MQTR-ACCT-IDX FROM +1 BY +1                       DTSBE444
01170         UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                       DTSBE444
01171 *          IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                       CL*19
01172            IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                        CL*19
01173            OR MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                       CL*17
01174               PERFORM P2131-ADD-RATED-TAX THRU P2131-EXIT         DTSBE444
01175            ELSE                                                   DTSBE444
01176               IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)            DTSBE444
01177               OR MQTR-ACCT-NSF-PEN-88  (MQTR-ACCT-IDX)            DTSBE444
01178               OR MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)            DTSBE444
01179                  PERFORM P2132-ADD-RATED-PEN THRU P2132-EXIT      DTSBE444
01180               ELSE                                                DTSBE444
01181                  IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX)              DTSBE444
01182                     PERFORM P2133-ADD-RATED-INT THRU P2133-EXIT   DTSBE444
01183                  END-IF                                           DTSBE444
01184               END-IF                                              DTSBE444
01185            END-IF                                                 DTSBE444
01186      END-PERFORM.                                                 DTSBE444
01187                                                                   DTSBE444
01188  P2130-EXIT.                                                      DTSBE444
01189      EXIT.                                                        DTSBE444
01190                                                                   DTSBE444
01191  P2131-ADD-RATED-TAX.                                             DTSBE444
01192 *&                                                                DTSBE444
01193 *    DISPLAY 'P2131 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB         CL*56
01194 *       ' ' WRK-MQTR-TAX-BAL                                         CL*38
01195 *&                                                                   CL*24
01196      ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO                      DTSBE444
01197            WRK-TOTAL-RATED-TAX.                                   DTSBE444
01198 *&                                                                DTSBE444
01199      MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                        DTSBE444
01200         TO WRK-MQTR-TAX-BAL.                                      DTSBE444
01201                                                                      CL*53
01202 *    IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                             CL*53
01203      IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                             CL*53
01204        IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > 0                       CL*53
01205          ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                        CL*53
01206           TO L101-PAID-CHNG                                          CL*53
01207         PERFORM P5001-READ-MRPT THRU P5001-EXIT                      CL*53
01208        END-IF                                                        CL*53
01209      END-IF.                                                         CL*53
01210                                                                   DTSBE444
01211      IF WRK-MQTR-TAX-BAL = ZERO                                   DTSBE444
01212         GO TO P2131-EXIT.                                         DTSBE444
01213                                                                   DTSBE444
01214                                                                      CL*50
01215      ADD WRK-MQTR-TAX-BAL                                            CL*30
01216 *       TO WRK-QTR-RATED-TAX (SUB)                                   CL*24
01217         TO CTAB-QTR-TAX-BAL (TSUB)                                   CL*38
01218                                                                      CL*19
01219      MOVE MQTR-YRQ  TO  CTAB-QTR-YRQ (TSUB).                         CL*21
01220                                                                      CL*38
01221      IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                              CL**3
01222      ADD WRK-MQTR-TAX-BAL                                            CL**3
01223         TO CTAB-QTR-UI-BAL(TSUB)                                     CL*33
01224      ELSE                                                            CL*13
01225      IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                             CL**3
01226      ADD WRK-MQTR-TAX-BAL                                            CL**3
01227         TO CTAB-QTR-SUR-BAL (TSUB).                                  CL*50
01228                                                                      CL**3
01229      GO TO  P2131-EXIT.                                              CL*24
01230                                                                      CL*24
01231      IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ                           DTSBE444
01232         ADD WRK-MQTR-TAX-BAL                                      DTSBE444
01233            TO WRK-3-YR-RATED-TAX.                                 DTSBE444
01234                                                                   DTSBE444
01235      IF MQTR-YRQ >= WRK-19994-YRQ                                 DTSBE444
01236         ADD WRK-MQTR-TAX-BAL                                      DTSBE444
01237            TO WRK-19994-RATED-TAX.                                DTSBE444
01238                                                                   DTSBE444
01239      IF WRK-STAT-ACTIVE                                           DTSBE444
01240         ADD WRK-MQTR-TAX-BAL                                      DTSBE444
01241            TO WRK-ACTIVE-RATED-TAX                                DTSBE444
01242      ELSE                                                         DTSBE444
01243         IF WRK-STAT-INACT                                         DTSBE444
01244            ADD WRK-MQTR-TAX-BAL                                   DTSBE444
01245               TO WRK-INACT-RATED-TAX                              DTSBE444
01246         ELSE                                                      DTSBE444
01247            IF WRK-STAT-INACT-3-YR                                 DTSBE444
01248               ADD WRK-MQTR-TAX-BAL                                DTSBE444
01249                  TO WRK-INACT-3YR-RATED-TAX                       DTSBE444
01250            END-IF                                                 DTSBE444
01251         END-IF                                                    DTSBE444
01252      END-IF.                                                      DTSBE444
01253                                                                   DTSBE444
01254      IF WRK-BNK-CHAP-7                                            DTSBE444
01255         ADD WRK-MQTR-TAX-BAL                                      DTSBE444
01256            TO WRK-CHAPTER-7-RATED-TAX                             DTSBE444
01257      ELSE                                                         DTSBE444
01258         IF WRK-BNK-CHAP-11                                        DTSBE444
01259            ADD WRK-MQTR-TAX-BAL                                   DTSBE444
01260               TO WRK-CHAPTER-11-RATED-TAX                         DTSBE444
01261         END-IF                                                    DTSBE444
01262      END-IF.                                                      DTSBE444
01263                                                                   DTSBE444
01264  P2131-EXIT.                                                      DTSBE444
01265      EXIT.                                                        DTSBE444
01266                                                                   DTSBE444
01267  P2132-ADD-RATED-PEN.                                             DTSBE444
01268 *&                                                                DTSBE444
01269 *    DISPLAY 'P2132 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB.        CL*38
01270 *    IF MQTR-YRQ = 20051                                          DTSBE444
01271 *       IF MPRF-EMP-NO = 084792 OR 121420 OR 143098               DTSBE444
01272 *          OR 145516                                              DTSBE444
01273 *          GO TO P2132-EXIT                                       DTSBE444
01274 *       END-IF                                                    DTSBE444
01275 *    END-IF.                                                      DTSBE444
01276 *&                                                                DTSBE444
01277      MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                        DTSBE444
01278         TO WRK-MQTR-PEN-BAL.                                      DTSBE444
01279                                                                   DTSBE444
01280      IF WRK-MQTR-PEN-BAL = ZERO                                   DTSBE444
01281         GO TO P2132-EXIT.                                         DTSBE444
01282                                                                   DTSBE444
01283      MOVE MQTR-YRQ  TO  CTAB-QTR-YRQ (TSUB).                         CL*21
01284 *    ADD WRK-MQTR-PEN-BAL                                            CL*24
01285 *       TO WRK-QTR-RATED-PEN (SUB)                                   CL*24
01286 *       TO CTAB-QTR-PEN-BAL (TSUB).                                  CL*24
01287                                                                   DTSBE444
01288      IF MQTR-ACCT-LATE-PEN-88  (MQTR-ACCT-IDX)                       CL**3
01289      ADD WRK-MQTR-PEN-BAL                                            CL**3
01290         TO CTAB-QTR-LP-BAL (TSUB)                                    CL*13
01291      ELSE                                                            CL*13
01292      IF MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX)                         CL**3
01293      ADD WRK-MQTR-PEN-BAL                                            CL**3
01294         TO CTAB-QTR-NSF-BAL (TSUB)                                   CL*13
01295      ELSE                                                            CL*13
01296      IF  MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)                       CL**3
01297      ADD WRK-MQTR-PEN-BAL                                            CL**3
01298         TO CTAB-QTR-MSF-BAL (TSUB).                                  CL**7
01299                                                                      CL**3
01300      GO TO P2132-EXIT.                                               CL*24
01301                                                                      CL*24
01302      IF MQTR-YRQ = 20051                                          DTSBE444
01303         ADD WRK-MQTR-PEN-BAL                                      DTSBE444
01304            TO CTAB-QTR-20051-PEN (TSUB).                          DTSBE444
01305                                                                   DTSBE444
01306      IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ                           DTSBE444
01307         ADD WRK-MQTR-PEN-BAL                                      DTSBE444
01308            TO WRK-3-YR-RATED-PEN.                                 DTSBE444
01309                                                                   DTSBE444
01310      IF MQTR-YRQ >= WRK-19994-YRQ                                 DTSBE444
01311         ADD WRK-MQTR-PEN-BAL                                      DTSBE444
01312            TO WRK-19994-RATED-PEN.                                DTSBE444
01313                                                                   DTSBE444
01314      IF WRK-STAT-ACTIVE                                           DTSBE444
01315         ADD WRK-MQTR-PEN-BAL                                      DTSBE444
01316            TO WRK-ACTIVE-RATED-PEN                                DTSBE444
01317      ELSE                                                         DTSBE444
01318         IF WRK-STAT-INACT                                         DTSBE444
01319            ADD WRK-MQTR-PEN-BAL                                   DTSBE444
01320               TO WRK-INACT-RATED-PEN                              DTSBE444
01321         ELSE                                                      DTSBE444
01322            IF WRK-STAT-INACT-3-YR                                 DTSBE444
01323               ADD WRK-MQTR-PEN-BAL                                DTSBE444
01324                  TO WRK-INACT-3YR-RATED-PEN                       DTSBE444
01325            END-IF                                                 DTSBE444
01326         END-IF                                                    DTSBE444
01327      END-IF.                                                      DTSBE444
01328                                                                   DTSBE444
01329      IF WRK-BNK-CHAP-7                                            DTSBE444
01330         ADD WRK-MQTR-PEN-BAL                                      DTSBE444
01331            TO WRK-CHAPTER-7-RATED-PEN                             DTSBE444
01332      ELSE                                                         DTSBE444
01333         IF WRK-BNK-CHAP-11                                        DTSBE444
01334            ADD WRK-MQTR-PEN-BAL                                   DTSBE444
01335               TO WRK-CHAPTER-11-RATED-PEN                         DTSBE444
01336         END-IF                                                    DTSBE444
01337      END-IF.                                                      DTSBE444
01338                                                                   DTSBE444
01339  P2132-EXIT.                                                      DTSBE444
01340      EXIT.                                                        DTSBE444
01341                                                                   DTSBE444
01342  P2133-ADD-RATED-INT.                                             DTSBE444
01343      MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                        DTSBE444
01344         TO WRK-MQTR-INT-BAL.                                      DTSBE444
01345                                                                   DTSBE444
01346 *    DISPLAY 'P2133 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB.        CL*38
01347 *&   ADD WRK-CORRECTION-INT-AMT                                   DTSBE444
01348 *       TO WRK-MQTR-INT-BAL.                                      DTSBE444
01349 *                                                                 DTSBE444
01350 *    IF WRK-MQTR-INT-BAL < ZERO                                   DTSBE444
01351 *       MOVE WRK-MQTR-INT-BAL TO DISPLAY-INT                      DTSBE444
01352 *       DISPLAY 'INT BAL < ZERO ' MPRF-EMP-NO                     DTSBE444
01353 *          '  ' MQTR-YRQ                                          DTSBE444
01354 *&         '  ' DISPLAY-INT.                                      DTSBE444
01355                                                                   DTSBE444
01356      IF WRK-MQTR-INT-BAL <= ZERO                                  DTSBE444
01357         GO TO P2133-EXIT.                                         DTSBE444
01358                                                                   DTSBE444
01359      ADD WRK-MQTR-INT-BAL                                         DTSBE444
01360 *       TO WRK-QTR-RATED-INT (SUB)                                   CL*24
01361         TO CTAB-QTR-INT-BAL (TSUB).                                  CL*24
01362                                                                   DTSBE444
01363         GO TO P2133-EXIT.                                            CL*24
01364      MOVE MQTR-YRQ  TO  CTAB-QTR-YRQ (TSUB).                         CL*21
01365      IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ                           DTSBE444
01366         ADD WRK-MQTR-INT-BAL                                      DTSBE444
01367            TO WRK-3-YR-RATED-INT.                                 DTSBE444
01368                                                                   DTSBE444
01369      IF MQTR-YRQ >= WRK-19994-YRQ                                 DTSBE444
01370         ADD WRK-MQTR-INT-BAL                                      DTSBE444
01371            TO WRK-19994-RATED-INT.                                DTSBE444
01372                                                                   DTSBE444
01373      IF WRK-STAT-ACTIVE                                           DTSBE444
01374         ADD WRK-MQTR-INT-BAL                                      DTSBE444
01375            TO WRK-ACTIVE-RATED-INT                                DTSBE444
01376      ELSE                                                         DTSBE444
01377         IF WRK-STAT-INACT                                         DTSBE444
01378            ADD WRK-MQTR-INT-BAL                                   DTSBE444
01379               TO WRK-INACT-RATED-INT                              DTSBE444
01380         ELSE                                                      DTSBE444
01381            IF WRK-STAT-INACT-3-YR                                 DTSBE444
01382               ADD WRK-MQTR-INT-BAL                                DTSBE444
01383                  TO WRK-INACT-3YR-RATED-INT                       DTSBE444
01384            END-IF                                                 DTSBE444
01385         END-IF                                                    DTSBE444
01386      END-IF.                                                      DTSBE444
01387                                                                   DTSBE444
01388      IF WRK-BNK-CHAP-7                                            DTSBE444
01389         ADD WRK-MQTR-INT-BAL                                      DTSBE444
01390            TO WRK-CHAPTER-7-RATED-INT                             DTSBE444
01391      ELSE                                                         DTSBE444
01392         IF WRK-BNK-CHAP-11                                        DTSBE444
01393            ADD WRK-MQTR-INT-BAL                                   DTSBE444
01394               TO WRK-CHAPTER-11-RATED-INT                         DTSBE444
01395         END-IF                                                    DTSBE444
01396      END-IF.                                                      DTSBE444
01397                                                                   DTSBE444
01398  P2133-EXIT.                                                      DTSBE444
01399      EXIT.                                                        DTSBE444
01400                                                                   DTSBE444
01401  P2140-SELF-INS.                                                  DTSBE444
01402      PERFORM                                                      DTSBE444
01403         VARYING MQTR-ACCT-IDX FROM +1 BY +1                       DTSBE444
01404         UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                       DTSBE444
01405 *          IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                       CL*19
01406            IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                        CL*19
01407            OR MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                       CL*17
01408               PERFORM P2141-ADD-SELF-INS-TAX THRU P2141-EXIT      DTSBE444
01409            ELSE                                                   DTSBE444
01410               IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)            DTSBE444
01411               OR MQTR-ACCT-NSF-PEN-88  (MQTR-ACCT-IDX)            DTSBE444
01412               OR MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)            DTSBE444
01413                  PERFORM P2142-ADD-SELF-INS-PEN                   DTSBE444
01414                                              THRU P2142-EXIT      DTSBE444
01415               ELSE                                                DTSBE444
01416                  IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX)              DTSBE444
01417                     PERFORM P2143-ADD-SELF-INS-INT                DTSBE444
01418                                              THRU P2143-EXIT      DTSBE444
01419                  END-IF                                           DTSBE444
01420               END-IF                                              DTSBE444
01421            END-IF                                                 DTSBE444
01422      END-PERFORM.                                                 DTSBE444
01423                                                                   DTSBE444
01424  P2140-EXIT.                                                      DTSBE444
01425      EXIT.                                                        DTSBE444
01426                                                                   DTSBE444
01427  P2141-ADD-SELF-INS-TAX.                                          DTSBE444
01428      MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                        DTSBE444
01429         TO WRK-MQTR-TAX-BAL.                                      DTSBE444
01430                                                                   DTSBE444
01431                                                                      CL*50
01432 *    DISPLAY ' P2141-ADD-SELF-INS-TAX.'                              CL*56
01433 *    IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                             CL*50
01434      IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                             CL*50
01435        IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > 0                       CL*50
01436          ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                        CL*50
01437           TO L101-PAID-CHNG                                          CL*50
01438         PERFORM P5001-READ-MRPT THRU P5001-EXIT                      CL*50
01439        END-IF                                                        CL*50
01440      END-IF.                                                         CL*50
01441 *    DISPLAY 'P2141 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB.        CL*38
01442 *&   ADD WRK-CORRECTION-TAX-AMT                                   DTSBE444
01443 *       TO WRK-MQTR-TAX-BAL                                       DTSBE444
01444 *                                                                 DTSBE444
01445 *    IF WRK-MQTR-TAX-BAL < ZERO                                   DTSBE444
01446 *       MOVE WRK-MQTR-TAX-BAL TO DISPLAY-TAX                      DTSBE444
01447 *       DISPLAY 'TAX BAL < ZERO ' MPRF-EMP-NO                     DTSBE444
01448 *          '  ' MQTR-YRQ                                          DTSBE444
01449 *&         '  ' DISPLAY-TAX.                                      DTSBE444
01450                                                                   DTSBE444
01451      IF WRK-MQTR-TAX-BAL = ZERO                                   DTSBE444
01452         GO TO P2141-EXIT.                                         DTSBE444
01453                                                                   DTSBE444
01454      MOVE MQTR-YRQ  TO  CTAB-QTR-YRQ (TSUB).                         CL*21
01455 *    MOVE WRK-CORRECTION-TAX-AMT                                  DTSBE444
01456 *       TO DISPLAY-TAX.                                           DTSBE444
01457 *    DISPLAY 'CORRECTION AMT '                                    DTSBE444
01458 *       MPRF-EMP-NO                                               DTSBE444
01459 *       '  ' MQTR-YRQ                                             DTSBE444
01460 *       '  ' DISPLAY-TAX.                                         DTSBE444
01461                                                                   DTSBE444
01462 *    IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                             CL*19
01463 *    ADD WRK-MQTR-TAX-BAL                                            CL*24
01464 *       TO WRK-QTR-SELF-INS-TAX (SUB)                                CL*24
01465 *          CTAB-QTR-TAX-BAL (TSUB)                                   CL*24
01466 *          WRK-TOT-SI-TAX.                                           CL*24
01467                                                                      CL*19
01468      IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                              CL**3
01469      ADD WRK-MQTR-TAX-BAL                                            CL**3
01470         TO CTAB-QTR-UI-BAL (TSUB)                                    CL*13
01471      ELSE                                                            CL*13
01472      IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                             CL**3
01473      ADD WRK-MQTR-TAX-BAL                                            CL**3
01474         TO CTAB-QTR-SUR-BAL (TSUB).                                  CL*50
01475                                                                      CL**3
01476         GO TO P2141-EXIT.                                            CL*24
01477                                                                   DTSBE444
01478      IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ                           DTSBE444
01479         ADD WRK-MQTR-TAX-BAL                                      DTSBE444
01480            TO WRK-3-YR-SELF-INS-TAX.                              DTSBE444
01481                                                                   DTSBE444
01482      IF MQTR-YRQ >= WRK-19994-YRQ                                 DTSBE444
01483         ADD WRK-MQTR-TAX-BAL                                      DTSBE444
01484            TO WRK-19994-SELF-INS-TAX.                             DTSBE444
01485                                                                   DTSBE444
01486      IF WRK-STAT-ACTIVE                                           DTSBE444
01487         ADD WRK-MQTR-TAX-BAL                                      DTSBE444
01488            TO WRK-ACTIVE-SELF-INS-TAX                             DTSBE444
01489      ELSE                                                         DTSBE444
01490         IF WRK-STAT-INACT                                         DTSBE444
01491            ADD WRK-MQTR-TAX-BAL                                   DTSBE444
01492               TO WRK-INACT-SELF-INS-TAX                           DTSBE444
01493         ELSE                                                      DTSBE444
01494            IF WRK-STAT-INACT-3-YR                                 DTSBE444
01495               ADD WRK-MQTR-TAX-BAL                                DTSBE444
01496                  TO WRK-INACT-3YR-SELF-INS-TAX                    DTSBE444
01497            END-IF                                                 DTSBE444
01498         END-IF                                                    DTSBE444
01499      END-IF.                                                      DTSBE444
01500                                                                   DTSBE444
01501      IF WRK-BNK-CHAP-7                                            DTSBE444
01502         ADD WRK-MQTR-TAX-BAL                                      DTSBE444
01503            TO WRK-CHAPTER-7-SELF-INS-TAX                          DTSBE444
01504      ELSE                                                         DTSBE444
01505         IF WRK-BNK-CHAP-11                                        DTSBE444
01506            ADD WRK-MQTR-TAX-BAL                                   DTSBE444
01507               TO WRK-CHAPTER-11-SELF-INS-TAX                      DTSBE444
01508         END-IF                                                    DTSBE444
01509      END-IF.                                                      DTSBE444
01510                                                                   DTSBE444
01511  P2141-EXIT.                                                      DTSBE444
01512      EXIT.                                                        DTSBE444
01513                                                                   DTSBE444
01514  P2142-ADD-SELF-INS-PEN.                                          DTSBE444
01515      MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                        DTSBE444
01516         TO WRK-MQTR-PEN-BAL.                                      DTSBE444
01517                                                                   DTSBE444
01518 *    DISPLAY 'P2142 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB.        CL*38
01519 *&   ADD WRK-CORRECTION-PEN-AMT                                   DTSBE444
01520 *       TO WRK-MQTR-PEN-BAL.                                      DTSBE444
01521 *                                                                 DTSBE444
01522 *    IF WRK-MQTR-PEN-BAL < ZERO                                   DTSBE444
01523 *       MOVE WRK-MQTR-PEN-BAL TO DISPLAY-PEN                      DTSBE444
01524 *       DISPLAY 'PEN BAL < ZERO ' MPRF-EMP-NO                     DTSBE444
01525 *          '  ' MQTR-YRQ                                          DTSBE444
01526 *&         '  ' DISPLAY-PEN.                                      DTSBE444
01527                                                                   DTSBE444
01528      IF WRK-MQTR-PEN-BAL = ZERO                                   DTSBE444
01529         GO TO P2142-EXIT.                                         DTSBE444
01530                                                                   DTSBE444
01531 *    ADD WRK-MQTR-PEN-BAL                                            CL*24
01532 *       TO WRK-QTR-SELF-INS-PEN (SUB)                                CL*24
01533 *          CTAB-QTR-PEN-BAL (TSUB).                                  CL*24
01534                                                                   DTSBE444
01535      MOVE MQTR-YRQ  TO  CTAB-QTR-YRQ (TSUB).                         CL*21
01536      IF MQTR-ACCT-LATE-PEN-88  (MQTR-ACCT-IDX)                       CL**3
01537      ADD WRK-MQTR-PEN-BAL                                            CL**3
01538         TO CTAB-QTR-LP-BAL (TSUB)                                    CL*13
01539      ELSE                                                            CL*13
01540      IF MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX)                         CL**3
01541      ADD WRK-MQTR-PEN-BAL                                            CL**3
01542         TO CTAB-QTR-NSF-BAL (TSUB)                                   CL*13
01543      ELSE                                                            CL*13
01544      IF  MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)                       CL**3
01545      ADD WRK-MQTR-PEN-BAL                                            CL**3
01546         TO CTAB-QTR-MSF-BAL (TSUB).                                  CL**7
01547                                                                      CL*24
01548      GO TO P2142-EXIT.                                               CL*24
01549                                                                      CL**3
01550      IF MQTR-YRQ = 20051                                          DTSBE444
01551         ADD WRK-MQTR-PEN-BAL                                      DTSBE444
01552            TO CTAB-QTR-20051-PEN (TSUB).                          DTSBE444
01553                                                                   DTSBE444
01554      IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ                           DTSBE444
01555         ADD WRK-MQTR-PEN-BAL                                      DTSBE444
01556            TO WRK-3-YR-SELF-INS-PEN.                              DTSBE444
01557                                                                   DTSBE444
01558      IF MQTR-YRQ >= WRK-19994-YRQ                                 DTSBE444
01559         ADD WRK-MQTR-PEN-BAL                                      DTSBE444
01560            TO WRK-19994-SELF-INS-PEN.                             DTSBE444
01561                                                                   DTSBE444
01562      IF WRK-STAT-ACTIVE                                           DTSBE444
01563         ADD WRK-MQTR-PEN-BAL                                      DTSBE444
01564            TO WRK-ACTIVE-SELF-INS-PEN                             DTSBE444
01565      ELSE                                                         DTSBE444
01566         IF WRK-STAT-INACT                                         DTSBE444
01567            ADD WRK-MQTR-PEN-BAL                                   DTSBE444
01568               TO WRK-INACT-SELF-INS-PEN                           DTSBE444
01569         ELSE                                                      DTSBE444
01570            IF WRK-STAT-INACT-3-YR                                 DTSBE444
01571               ADD WRK-MQTR-PEN-BAL                                DTSBE444
01572                  TO WRK-INACT-3YR-SELF-INS-PEN                    DTSBE444
01573            END-IF                                                 DTSBE444
01574         END-IF                                                    DTSBE444
01575      END-IF.                                                      DTSBE444
01576                                                                   DTSBE444
01577      IF WRK-BNK-CHAP-7                                            DTSBE444
01578         ADD WRK-MQTR-PEN-BAL                                      DTSBE444
01579            TO WRK-CHAPTER-7-SELF-INS-PEN                          DTSBE444
01580      ELSE                                                         DTSBE444
01581         IF WRK-BNK-CHAP-11                                        DTSBE444
01582            ADD WRK-MQTR-PEN-BAL                                   DTSBE444
01583               TO WRK-CHAPTER-11-SELF-INS-PEN                      DTSBE444
01584         END-IF                                                    DTSBE444
01585      END-IF.                                                      DTSBE444
01586                                                                   DTSBE444
01587  P2142-EXIT.                                                      DTSBE444
01588      EXIT.                                                        DTSBE444
01589                                                                   DTSBE444
01590  P2143-ADD-SELF-INS-INT.                                          DTSBE444
01591      MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                        DTSBE444
01592         TO WRK-MQTR-INT-BAL.                                      DTSBE444
01593                                                                   DTSBE444
01594 *    DISPLAY 'P2143 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB.        CL*38
01595 *&   ADD WRK-CORRECTION-INT-AMT                                   DTSBE444
01596 *       TO WRK-MQTR-INT-BAL.                                      DTSBE444
01597 *                                                                 DTSBE444
01598 *    IF WRK-MQTR-INT-BAL < ZERO                                   DTSBE444
01599 *       MOVE WRK-MQTR-INT-BAL TO DISPLAY-INT                      DTSBE444
01600 *       DISPLAY 'PEN INT < ZERO ' MPRF-EMP-NO                     DTSBE444
01601 *          '  ' MQTR-YRQ                                          DTSBE444
01602 *&         '  ' DISPLAY-INT.                                      DTSBE444
01603                                                                   DTSBE444
01604      IF WRK-MQTR-INT-BAL = ZERO                                   DTSBE444
01605         GO TO P2143-EXIT.                                         DTSBE444
01606                                                                   DTSBE444
01607      ADD WRK-MQTR-INT-BAL                                         DTSBE444
01608 *       TO WRK-QTR-SELF-INS-INT (SUB)                                CL*24
01609         TO CTAB-QTR-INT-BAL (TSUB).                                  CL*24
01610                                                                   DTSBE444
01611         GO TO P2143-EXIT.                                            CL*24
01612                                                                      CL*24
01613      IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ                           DTSBE444
01614         ADD WRK-MQTR-INT-BAL                                      DTSBE444
01615            TO WRK-3-YR-SELF-INS-INT.                              DTSBE444
01616                                                                   DTSBE444
01617      IF MQTR-YRQ >= WRK-19994-YRQ                                 DTSBE444
01618         ADD WRK-MQTR-INT-BAL                                      DTSBE444
01619            TO WRK-19994-SELF-INS-INT.                             DTSBE444
01620                                                                   DTSBE444
01621      IF WRK-STAT-ACTIVE                                           DTSBE444
01622         ADD WRK-MQTR-INT-BAL                                      DTSBE444
01623            TO WRK-ACTIVE-SELF-INS-INT                             DTSBE444
01624      ELSE                                                         DTSBE444
01625         IF WRK-STAT-INACT                                         DTSBE444
01626            ADD WRK-MQTR-INT-BAL                                   DTSBE444
01627               TO WRK-INACT-SELF-INS-INT                           DTSBE444
01628         ELSE                                                      DTSBE444
01629            IF WRK-STAT-INACT-3-YR                                 DTSBE444
01630               ADD WRK-MQTR-INT-BAL                                DTSBE444
01631                  TO WRK-INACT-3YR-SELF-INS-INT                    DTSBE444
01632            END-IF                                                 DTSBE444
01633         END-IF                                                    DTSBE444
01634      END-IF.                                                      DTSBE444
01635                                                                   DTSBE444
01636      IF WRK-BNK-CHAP-7                                            DTSBE444
01637         ADD WRK-MQTR-INT-BAL                                      DTSBE444
01638            TO WRK-CHAPTER-7-SELF-INS-INT                          DTSBE444
01639      ELSE                                                         DTSBE444
01640         IF WRK-BNK-CHAP-11                                        DTSBE444
01641            ADD WRK-MQTR-INT-BAL                                   DTSBE444
01642               TO WRK-CHAPTER-11-SELF-INS-INT                      DTSBE444
01643         END-IF                                                    DTSBE444
01644      END-IF.                                                      DTSBE444
01645                                                                   DTSBE444
01646  P2143-EXIT.                                                      DTSBE444
01647      EXIT.                                                        DTSBE444
01648                                                                   DTSBE444
01649  P2150-ACC-INT.                                                      CL*44
01650      DISPLAY 'P2150 '  MPRF-EMP-NO ' ' MQTR-YRQ.                     CL*54
01651       IF L101-PAID-CHNG > +0                                         CL*44
01652           NEXT SENTENCE                                              CL*44
01653       ELSE                                                           CL*44
01654           GO TO P2150-EXIT.                                          CL*44
01655                                                                      CL*44
01656       SET L101-WAIVE-INT-NO-88 TO TRUE.                              CL*44
01657 *     SET L101-ABATE-PEN-NO-88 TO TRUE.                              CL*44
01658                                                                      CL*44
01659       MOVE MHDR-PRIOR-MAIL-DATE   TO L101-RECEIVED-DATE              CL*58
01660       MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE.                   CL*44
01661                                                                      CL*44
01662       MOVE MQTR-INT-AREA TO L101-INT-AREA.                           CL*44
01663                                                                      CL*44
01664 *    DISPLAY 'B101 ======= INT '  MPRF-EMP-NO                        CL*56
01665       PERFORM S101-PER-MONTH-NO  THRU S101-EXIT.                     CL*57
01666 *    DISPLAY 'A101 ======= INT '  MPRF-EMP-NO                        CL*56
01667                                                                      CL*44
01668       ADD L101-INT-CHARGE-CHNG                                       CL*44
01669         TO CTAB-QTR-DEF-BAL (TSUB).                                  CL*44
01670                                                                      CL*44
01671                                                                      CL*44
01672      DISPLAY 'EMP N0  : ' MQTR-EMP-NO ' ' MQTR-YRQ                   CL*54
01673              ' TAX  AMT: ' L101-PAID-CHNG                            CL*44
01674              ' INT AMT: ' L101-INT-CHARGE-CHNG.                      CL*44
01675                                                                      CL*44
01676  P2150-EXIT.                                                         CL*44
01677      EXIT.                                                           CL*44
01678  P3000-JRN-RECEIVABLES.                                           DTSBE444
01679      MOVE LOW-VALUES             TO MJRN-KEY-AREA.                DTSBE444
01680      MOVE MPRF-EMP-NO            TO MJRN-EMP-NO.                  DTSBE444
01681      SET MJRN-JRN-88             TO TRUE.                         DTSBE444
01682      MOVE MJRN-KEY-AREA          TO MSKL-KEY-AREA.                DTSBE444
01683      PERFORM S910-START-BROWSE   THRU S910-EXIT.                  DTSBE444
01684      IF L910-NO-REC-88                                            DTSBE444
01685         GO TO P3000-EXIT.                                         DTSBE444
01686                                                                   DTSBE444
01687      PERFORM P3200-SCAN-MJRN     THRU P3200-EXIT                  DTSBE444
01688          UNTIL L910-NO-REC-88.                                    DTSBE444
01689                                                                   DTSBE444
01690                                                                   DTSBE444
01691  P3000-EXIT.                                                      DTSBE444
01692      EXIT.                                                        DTSBE444
01693 *                                                                 DTSBE444
01694  P3200-SCAN-MJRN.                                                 DTSBE444
01695      MOVE MSKL-REC               TO MJRN-REC.                     DTSBE444
01696                                                                   DTSBE444
01697 *& >> BYPASS INVALID TRANSACTIONS  <<                             DTSBE444
01698      IF (MJRN-BATCH-NO = 36870                                    DTSBE444
01699      AND MJRN-ITEM-NO = 29)                                       DTSBE444
01700      OR (MJRN-BATCH-NO = 37955                                    DTSBE444
01701      AND MJRN-ITEM-NO = 9)                                        DTSBE444
01702         NEXT SENTENCE                                             DTSBE444
01703      ELSE                                                         DTSBE444
01704 *&                                                                DTSBE444
01705      IF MJRN-REFUND-PAY-88                                        DTSBE444
01706      OR MJRN-TRAN-CNVR-88                                         DTSBE444
01707         NEXT SENTENCE                                             DTSBE444
01708      ELSE                                                         DTSBE444
01709         PERFORM P3210-MJRN-ACCT-GROUP THRU P3210-EXIT             DTSBE444
01710            VARYING MJRN-OCC-IDX FROM +1 BY +1                     DTSBE444
01711            UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT                      DTSBE444
01712      END-IF.                                                      DTSBE444
01713                                                                   DTSBE444
01714      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE444
01715                                                                   DTSBE444
01716  P3200-EXIT.                                                      DTSBE444
01717      EXIT.                                                        DTSBE444
01718                                                                   DTSBE444
01719  P3210-MJRN-ACCT-GROUP.                                           DTSBE444
01720      PERFORM P3230-WRITE-PAY             THRU P3230-EXIT.         DTSBE444
01721                                                                   DTSBE444
01722      IF MJRN-YRQ (MJRN-OCC-IDX) > WRK-LAST-DEL-YRQ                DTSBE444
01723      OR MJRN-YRQ (MJRN-OCC-IDX) < 19994                           DTSBE444
01724         GO TO P3210-EXIT                                          DTSBE444
01725      ELSE                                                         DTSBE444
01726         MOVE MJRN-YRQ (MJRN-OCC-IDX)  TO L004-QTR-5-9             DTSBE444
01727         PERFORM S004-FROM-5           THRU S004-EXIT              DTSBE444
01728         IF L004-VALID-QTR                                         DTSBE444
01729            MOVE L004-ABS-QTR          TO TSUB                     DTSBE444
01730         ELSE                                                      DTSBE444
01731            MOVE ZERO                  TO TSUB                     DTSBE444
01732         END-IF                                                    DTSBE444
01733      END-IF.                                                      DTSBE444
01734                                                                   DTSBE444
01735      IF TSUB > ZERO                                               DTSBE444
01736         IF (CTAB-QTR-TAX-BAL(TSUB) > ZERO                         DTSBE444
01737         OR  CTAB-QTR-PEN-BAL(TSUB) > ZERO                         DTSBE444
01738         OR  CTAB-QTR-INT-BAL(TSUB) > ZERO)                        DTSBE444
01739            PERFORM P3220-WRITE-OUTPUT       THRU P3220-EXIT       DTSBE444
01740         END-IF                                                    DTSBE444
01741      END-IF.                                                      DTSBE444
01742                                                                   DTSBE444
01743      IF MJRN-ROW-UI-88 (MJRN-OCC-IDX)                             DTSBE444
01744         PERFORM P3211-TAX          THRU P3211-EXIT                DTSBE444
01745      ELSE                                                         DTSBE444
01746         IF MJRN-ROW-LATE-PEN-88 (MJRN-OCC-IDX)                    DTSBE444
01747         OR MJRN-ROW-NSF-PEN-88   (MJRN-OCC-IDX)                   DTSBE444
01748         OR MJRN-ROW-MISC-PEN-88 (MJRN-OCC-IDX)                    DTSBE444
01749            PERFORM P3212-PEN          THRU P3212-EXIT             DTSBE444
01750         ELSE                                                      DTSBE444
01751            IF MJRN-ROW-INT-88 (MJRN-OCC-IDX)                      DTSBE444
01752               PERFORM P3213-INT          THRU P3213-EXIT          DTSBE444
01753            END-IF                                                 DTSBE444
01754         END-IF                                                    DTSBE444
01755      END-IF.                                                      DTSBE444
01756                                                                   DTSBE444
01757  P3210-EXIT.                                                      DTSBE444
01758      EXIT.                                                        DTSBE444
01759                                                                   DTSBE444
01760  P3211-TAX.                                                       DTSBE444
01761      IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                        DTSBE444
01762         ADD     MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01763            TO CTAB-JRN-TAX-BAL (TSUB)                             DTSBE444
01764      ELSE                                                         DTSBE444
01765         SUBTRACT MJRN-AMT (MJRN-OCC-IDX)                          DTSBE444
01766            FROM CTAB-JRN-TAX-BAL (TSUB)                           DTSBE444
01767      END-IF.                                                      DTSBE444
01768                                                                   DTSBE444
01769  P3211-EXIT.                                                      DTSBE444
01770      EXIT.                                                        DTSBE444
01771                                                                   DTSBE444
01772  P3212-PEN.                                                       DTSBE444
01773      IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                        DTSBE444
01774         ADD      MJRN-AMT (MJRN-OCC-IDX)                          DTSBE444
01775            TO   CTAB-JRN-PEN-BAL (TSUB)                           DTSBE444
01776      ELSE                                                         DTSBE444
01777         SUBTRACT MJRN-AMT (MJRN-OCC-IDX)                          DTSBE444
01778            FROM CTAB-JRN-PEN-BAL (TSUB)                           DTSBE444
01779      END-IF.                                                      DTSBE444
01780                                                                   DTSBE444
01781 *&                                                                DTSBE444
01782      IF MJRN-YRQ (MJRN-OCC-IDX) = 20051                           DTSBE444
01783         IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                     DTSBE444
01784            ADD      MJRN-AMT (MJRN-OCC-IDX)                       DTSBE444
01785               TO   CTAB-JRN-20051-PEN (TSUB)                      DTSBE444
01786         ELSE                                                      DTSBE444
01787            SUBTRACT MJRN-AMT (MJRN-OCC-IDX)                       DTSBE444
01788               FROM CTAB-JRN-20051-PEN (TSUB)                      DTSBE444
01789         END-IF                                                    DTSBE444
01790      END-IF.                                                      DTSBE444
01791                                                                   DTSBE444
01792 *&                                                                DTSBE444
01793  P3212-EXIT.                                                      DTSBE444
01794      EXIT.                                                        DTSBE444
01795                                                                   DTSBE444
01796  P3213-INT.                                                       DTSBE444
01797      IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                        DTSBE444
01798         ADD MJRN-AMT (MJRN-OCC-IDX)                               DTSBE444
01799            TO CTAB-JRN-INT-BAL (TSUB)                             DTSBE444
01800      ELSE                                                         DTSBE444
01801         SUBTRACT MJRN-AMT (MJRN-OCC-IDX)                          DTSBE444
01802            FROM CTAB-JRN-INT-BAL (TSUB)                           DTSBE444
01803      END-IF.                                                      DTSBE444
01804                                                                   DTSBE444
01805  P3213-EXIT.                                                      DTSBE444
01806      EXIT.                                                        DTSBE444
01807                                                                   DTSBE444
01808  P3220-WRITE-OUTPUT.                                              DTSBE444
01809 *&                                                                DTSBE444
01810 *    MOVE CTAB-QTR-TAX-BAL(TSUB)   TO DISPLAY-TAX.                DTSBE444
01811 *    MOVE MJRN-AMT (MJRN-OCC-IDX)   TO DISPLAY-TAX1               DTSBE444
01812 *    DISPLAY 'P322 ' MPRF-EMP-NO '  ' MJRN-YRQ (MJRN-OCC-IDX)     DTSBE444
01813 *       '  ' DISPLAY-TAX '  ' MJRN-BATCH-NO ' ' MJRN-ITEM-NO.     DTSBE444
01814 *    DISPLAY '    JRN ' DISPLAY-TAX1                              DTSBE444
01815 *       '  ' MJRN-ACCT-ROW (MJRN-OCC-IDX)                         DTSBE444
01816 *       '  ' MJRN-ACCT-COL (MJRN-OCC-IDX).                        DTSBE444
01817 *&                                                                DTSBE444
01818                                                                   DTSBE444
01819 **   ADD +1                         TO WRK-SEQ-NO.                DTSBE444
01820 **   MOVE WRK-SEQ-NO                TO AUDIT-SEQ-NO.              DTSBE444
01821      MOVE MPRF-EMP-NO               TO AUDIT-EMP-NO.              DTSBE444
01822      MOVE MPRF-PRIMARY-NAME         TO AUDIT-PRIMARY-NAME.        DTSBE444
01823      INSPECT AUDIT-PRIMARY-NAME REPLACING ALL ',' BY SPACE.       DTSBE444
01824      MOVE MPRF-EMP-CLASS            TO AUDIT-EMP-CLASS.           DTSBE444
01825      MOVE MJRN-BATCH-NO             TO AUDIT-BATCH-NO.            DTSBE444
01826      MOVE MJRN-ITEM-NO              TO AUDIT-ITEM-NO.             DTSBE444
01827                                                                   DTSBE444
01828      MOVE MJRN-ESTB-DATE            TO L001-FED-8-DATE-9.         DTSBE444
01829      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBE444
01830      MOVE L001-SLASH-8-DATE         TO AUDIT-PROC-DATE.           DTSBE444
01831                                                                   DTSBE444
01832 *    MOVE MJRN-RECEIVED-DATE        TO L001-FED-8-DATE-9.         DTSBE444
01833 *    PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBE444
01834 *    MOVE L001-SLASH-8-DATE         TO AUDIT-RCVD-DATE.           DTSBE444
01835                                                                   DTSBE444
01836      IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX)                        DTSBE444
01837         MOVE MJRN-AMT (MJRN-OCC-IDX)   TO AUDIT-AMT               DTSBE444
01838      ELSE                                                         DTSBE444
01839         COMPUTE WRK-AMT =                                         DTSBE444
01840           (MJRN-AMT (MJRN-OCC-IDX) * -1)                          DTSBE444
01841         MOVE WRK-AMT   TO AUDIT-AMT                               DTSBE444
01842      END-IF.                                                      DTSBE444
01843                                                                   DTSBE444
01844      MOVE MJRN-TRAN-TYPE            TO AUDIT-TRAN.                DTSBE444
01845      MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX)   TO AUDIT-ACCT.           DTSBE444
01846                                                                   DTSBE444
01847      MOVE MJRN-YRQ (MJRN-OCC-IDX)   TO L004-QTR-5-9.              DTSBE444
01848      PERFORM S004-FROM-5            THRU S004-EXIT.               DTSBE444
01849      MOVE L004-SLASH-5-QTR          TO AUDIT-YRQ.                 DTSBE444
01850                                                                   DTSBE444
01851 *&   WRITE TEMP-REC  FROM WRK-AUDIT-REC.                          DTSBE444
01852      WRITE AUDIT-REC  FROM WRK-AUDIT-REC.                         DTSBE444
01853      ADD +1          TO WRK-AUDIT-CNT.                            DTSBE444
01854                                                                   DTSBE444
01855  P3220-EXIT.                                                      DTSBE444
01856      EXIT.                                                        DTSBE444
01857                                                                   DTSBE444
01858  P3230-WRITE-PAY.                                                 DTSBE444
01859      IF MJRN-ESTB-DATE >= WRK-MTH-BEGIN-DATE                      DTSBE444
01860      AND MJRN-ESTB-DATE <= WRK-MTH-END-DATE                       DTSBE444
01861         NEXT SENTENCE                                             DTSBE444
01862      ELSE                                                         DTSBE444
01863         GO TO P3230-EXIT                                          DTSBE444
01864      END-IF.                                                      DTSBE444
01865                                                                   DTSBE444
01866 ***  IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX)                         DTSBE444
01867 *       EVALUATE TRUE                                             DTSBE444
01868 *         WHEN MPRF-CLASS-RATED-88                                DTSBE444
01869 *           ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01870 *                                   TO WRK-MTH-RATED-CRED-PAY     DTSBE444
01871 *         WHEN MPRF-CLASS-SELF-INS-88                             DTSBE444
01872 *           ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01873 *                                   TO WRK-MTH-SI-CRED-PAY        DTSBE444
01874 *         WHEN OTHER                                              DTSBE444
01875 *           ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01876 *                                   TO WRK-MTH-UNK-CRED-PAY       DTSBE444
01877 *       END-EVALUATE                                              DTSBE444
01878 ***  END-IF.                                                      DTSBE444
01879                                                                   DTSBE444
01880      IF MJRN-COL-PAID-88 (MJRN-OCC-IDX)                           DTSBE444
01881         NEXT SENTENCE                                             DTSBE444
01882      ELSE                                                         DTSBE444
01883         GO TO P3230-EXIT                                          DTSBE444
01884      END-IF.                                                      DTSBE444
01885                                                                   DTSBE444
01886      IF MJRN-ROW-UI-88 (MJRN-OCC-IDX)                             DTSBE444
01887      OR MJRN-ROW-SUR-88 (MJRN-OCC-IDX)                            DTSBE444
01888         EVALUATE TRUE                                             DTSBE444
01889           WHEN MPRF-CLASS-RATED-88                                DTSBE444
01890             ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01891                                     TO WRK-MTH-RATED-TAX-PAY      DTSBE444
01892           WHEN MPRF-CLASS-SELF-INS-88                             DTSBE444
01893             ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01894                                     TO WRK-MTH-SI-TAX-PAY         DTSBE444
01895           WHEN OTHER                                              DTSBE444
01896             ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01897                                     TO WRK-MTH-UNK-TAX-PAY        DTSBE444
01898         END-EVALUATE                                              DTSBE444
01899      END-IF.                                                      DTSBE444
01900                                                                   DTSBE444
01901      IF MJRN-ROW-LATE-PEN-88 (MJRN-OCC-IDX)                       DTSBE444
01902      OR MJRN-ROW-NSF-PEN-88 (MJRN-OCC-IDX)                        DTSBE444
01903      OR MJRN-ROW-MISC-PEN-88 (MJRN-OCC-IDX)                       DTSBE444
01904         EVALUATE TRUE                                             DTSBE444
01905           WHEN MPRF-CLASS-RATED-88                                DTSBE444
01906             ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01907                                     TO WRK-MTH-RATED-PEN-PAY      DTSBE444
01908           WHEN MPRF-CLASS-SELF-INS-88                             DTSBE444
01909             ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01910                                     TO WRK-MTH-SI-PEN-PAY         DTSBE444
01911           WHEN OTHER                                              DTSBE444
01912             ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01913                                     TO WRK-MTH-UNK-PEN-PAY        DTSBE444
01914         END-EVALUATE                                              DTSBE444
01915      END-IF.                                                      DTSBE444
01916                                                                   DTSBE444
01917      IF MJRN-ROW-INT-88 (MJRN-OCC-IDX)                            DTSBE444
01918         EVALUATE TRUE                                             DTSBE444
01919           WHEN MPRF-CLASS-RATED-88                                DTSBE444
01920             ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01921                                     TO WRK-MTH-RATED-INT-PAY      DTSBE444
01922           WHEN MPRF-CLASS-SELF-INS-88                             DTSBE444
01923             ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01924                                     TO WRK-MTH-SI-INT-PAY         DTSBE444
01925           WHEN OTHER                                              DTSBE444
01926             ADD MJRN-AMT (MJRN-OCC-IDX)                           DTSBE444
01927                                     TO WRK-MTH-UNK-INT-PAY        DTSBE444
01928         END-EVALUATE                                              DTSBE444
01929      END-IF.                                                      DTSBE444
01930                                                                   DTSBE444
01931                                                                   DTSBE444
01932 **   ADD +1                         TO WRK-SEQ-NO.                DTSBE444
01933 **   MOVE WRK-SEQ-NO                TO AUDIT-SEQ-NO.              DTSBE444
01934      MOVE MPRF-EMP-NO               TO AUDIT-EMP-NO.              DTSBE444
01935      MOVE MPRF-PRIMARY-NAME         TO AUDIT-PRIMARY-NAME.        DTSBE444
01936      INSPECT AUDIT-PRIMARY-NAME REPLACING ALL ',' BY SPACE.       DTSBE444
01937      MOVE MPRF-EMP-CLASS            TO AUDIT-EMP-CLASS.           DTSBE444
01938      MOVE MJRN-BATCH-NO             TO AUDIT-BATCH-NO.            DTSBE444
01939      MOVE MJRN-ITEM-NO              TO AUDIT-ITEM-NO.             DTSBE444
01940                                                                   DTSBE444
01941      MOVE MJRN-ESTB-DATE            TO L001-FED-8-DATE-9.         DTSBE444
01942      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBE444
01943      MOVE L001-SLASH-8-DATE         TO AUDIT-PROC-DATE.           DTSBE444
01944                                                                   DTSBE444
01945 *    MOVE MJRN-RECEIVED-DATE        TO L001-FED-8-DATE-9.         DTSBE444
01946 *    PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBE444
01947 *    MOVE L001-SLASH-8-DATE         TO AUDIT-RCVD-DATE.           DTSBE444
01948                                                                   DTSBE444
01949      MOVE MJRN-AMT (MJRN-OCC-IDX)   TO AUDIT-AMT,                 DTSBE444
01950                                                                   DTSBE444
01951      MOVE MJRN-TRAN-TYPE            TO AUDIT-TRAN.                DTSBE444
01952      MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX)   TO AUDIT-ACCT.           DTSBE444
01953                                                                   DTSBE444
01954      MOVE MJRN-YRQ (MJRN-OCC-IDX)   TO L004-QTR-5-9.              DTSBE444
01955      PERFORM S004-FROM-5            THRU S004-EXIT.               DTSBE444
01956      MOVE L004-SLASH-5-QTR          TO AUDIT-YRQ.                 DTSBE444
01957                                                                   DTSBE444
01958      WRITE PAY-REC  FROM WRK-AUDIT-REC.                           DTSBE444
01959      ADD +1          TO WRK-AUDIT-CNT.                            DTSBE444
01960                                                                   DTSBE444
01961  P3230-EXIT.                                                      DTSBE444
01962      EXIT.                                                        DTSBE444
01963                                                                   DTSBE444
01964  P4000-QTR-SUMMARY.                                               DTSBE444
01965      DISPLAY 'P4000 '  MPRF-EMP-NO                                   CL*48
01966      MOVE MPRF-EMP-NO               TO QTR-EMP-NO.                DTSBE444
01967      MOVE MPRF-PRIMARY-NAME         TO QTR-PRIMARY-NAME.          DTSBE444
01968      INSPECT QTR-PRIMARY-NAME REPLACING ALL ',' BY SPACE.         DTSBE444
01969      MOVE MPRF-EMP-STATUS           TO QTR-EMP-STATUS.               CL*60
01970      MOVE MPRF-EMP-CLASS            TO QTR-EMP-CLASS.                CL*60
01971      MOVE ZEROS                     TO QTR-TOTAL.                    CL*10
01972                                                                      CL**9
01973       MOVE ZEROS TO QTR-UIT                                          CL*40
01974            QTR-SURT                                                  CL*40
01975            QTR-LPT                                                   CL*40
01976            QTR-NSFT                                                  CL*40
01977            QTR-MSFT                                                  CL*40
01978            QTR-INTT                                                  CL*40
01979            QTR-DEFT                                                  CL*44
01980            QTR-TOTAL.                                                CL*40
01981                                                                      CL*40
01982      PERFORM                                                      DTSBE444
01983         VARYING TSUB FROM +1 BY +1                                DTSBE444
01984         UNTIL TSUB > TSUB-MAX                                     DTSBE444
01985            IF CTAB-QTR-SUR-BAL(TSUB) > ZERO                          CL*42
01986            OR CTAB-QTR-UI-BAL(TSUB) > ZERO                           CL*42
01987            OR CTAB-QTR-LP-BAL(TSUB) > ZERO                           CL*42
01988            OR CTAB-QTR-INT-BAL(TSUB) > ZERO                       DTSBE444
01989            DISPLAY 'EMP ' MPRF-EMP-NO ' YRQ ' CTAB-QTR-YRQ(TSUB)     CL*42
01990 *             MOVE TSUB                    TO L004-ABS-QTR           CL*23
01991 *             PERFORM S004-FROM-ABS        THRU S004-EXIT            CL*23
01992 *             MOVE L004-SLASH-5-QTR        TO QTR-YRQ                CL*23
01993 *             MOVE ZEROS         TO QTR-TOTAL                        CL*41
01994               MOVE CTAB-QTR-YRQ(TSUB)   TO QTR-YRQ                   CL*23
01995 *             MOVE CTAB-QTR-UI-BAL(TSUB)   TO QTR-UI                 CL*38
01996 *             MOVE CTAB-QTR-SUR-BAL(TSUB)   TO QTR-SUR               CL*38
01997 *             MOVE CTAB-QTR-LP-BAL(TSUB)   TO QTR-LP                 CL*38
01998 *             MOVE CTAB-QTR-NSF-BAL(TSUB)   TO QTR-NSF               CL*38
01999 *             MOVE CTAB-QTR-MSF-BAL(TSUB)   TO QTR-MSF               CL*38
02000 *             MOVE CTAB-QTR-INT-BAL(TSUB)   TO QTR-INT               CL*38
02001           ADD  CTAB-QTR-UI-BAL(TSUB)  TO QTR-UIT  QTR-TOTAL          CL*38
02002           ADD  CTAB-QTR-SUR-BAL(TSUB) TO QTR-SURT QTR-TOTAL          CL*38
02003           ADD  CTAB-QTR-LP-BAL(TSUB)  TO QTR-LPT  QTR-TOTAL          CL*38
02004           ADD  CTAB-QTR-NSF-BAL(TSUB) TO QTR-NSFT QTR-TOTAL          CL*38
02005           ADD  CTAB-QTR-MSF-BAL(TSUB) TO QTR-MSFT QTR-TOTAL          CL*38
02006           ADD  CTAB-QTR-INT-BAL(TSUB) TO QTR-INTT QTR-TOTAL          CL*38
02007           ADD  CTAB-QTR-DEF-BAL(TSUB) TO QTR-INTT QTR-TOTAL          CL*51
02008 *         MOVE QTR-TOTAL                TO QTR-TOT                   CL*38
02009 *             WRITE QTR-REC FROM WRK-QTR-REC                         CL*38
02010               ADD +1                        TO WRK-QTR-CNT        DTSBE444
02011            END-IF                                                 DTSBE444
02012      END-PERFORM.                                                 DTSBE444
02013                                                                      CL*38
02014       MOVE QTR-UIT    TO QTR-UI                                      CL*38
02015       MOVE QTR-SURT   TO QTR-SUR                                     CL*38
02016       MOVE QTR-LPT    TO QTR-LP                                      CL*38
02017       MOVE QTR-NSFT   TO QTR-NSF                                     CL*38
02018       MOVE QTR-MSFT   TO QTR-MSF                                     CL*38
02019       MOVE QTR-INTT   TO QTR-INT                                     CL*38
02020 *     MOVE QTR-DEFT   TO QTR-DEF                                     CL*51
02021       MOVE QTR-TOTAL  TO QTR-TOT                                     CL*38
02022       WRITE QTR-REC FROM WRK-QTR-REC.                                CL*38
02023                                                                   DTSBE444
02024       PERFORM P0100-INIT-QTR-TABLE THRU P0100-EXIT.                  CL*43
02025                                                                      CL*42
02026  P4000-EXIT.                                                      DTSBE444
02027      EXIT.                                                        DTSBE444
02028  P5001-READ-MRPT.                                                    CL*51
02029      MOVE LOW-VALUES  TO MRPT-KEY-AREA.                              CL*51
02030      MOVE MPRF-EMP-NO TO MRPT-EMP-NO.                                CL*51
02031      MOVE MQTR-YRQ    TO MRPT-YRQ                                    CL*51
02032                                                                      CL*51
02033 *    DISPLAY '>>>> P5001-READ-MRPT> ' MPRF-EMP-NO ' ' MQTR-YRQ.      CL*56
02034      SET MRPT-RPT-88  TO TRUE.                                       CL*51
02035      MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA.                            CL*51
02036                                                                      CL*51
02037      MOVE ZEROS              TO L101-RECEIVED-DATE.                  CL*51
02038      PERFORM S910-START-BROWSE  THRU S910-EXIT.                      CL*51
02039                                                                      CL*51
02040      IF L910-NO-REC-88                                               CL*51
02041         DISPLAY ' RPT REC NOT FOUND ' MPRF-EMP-NO                    CL*51
02042         MOVE MHDR-CURR-RUN-DATE TO L101-RECEIVED-DATE                CL*51
02043         GO TO P5001-EXIT.                                            CL*51
02044                                                                      CL*51
02045      PERFORM P5002-MRPT-SCAN THRU P5002-EXIT                         CL*51
02046            UNTIL L910-NO-REC-88.                                     CL*51
02047                                                                      CL*51
02048                                                                      CL*51
02049  P5001-EXIT.                                                         CL*51
02050      EXIT.                                                           CL*51
02051                                                                      CL*51
02052  P5002-MRPT-SCAN.                                                    CL*51
02053      MOVE MSKL-REC TO MRPT-REC.                                      CL*51
02054 *      DISPLAY '> P5002-SCAN-MRPT>>> ' MPRF-EMP-NO ' ' MQTR-YRQ.     CL*56
02055      IF MRPT-ORIG-88 OR MRPT-ESTIM-88                                CL*51
02056         MOVE MRPT-RECEIVED-DATE TO L101-RECEIVED-DATE                CL*51
02057 *     DISPLAY ' MRPT ' MRPT-RECEIVED-DATE ' ' L101-RECEIVED-DATE     CL*56
02058         SET L910-NO-REC-88 TO TRUE                                   CL*51
02059         GO TO P5002-EXIT.                                            CL*51
02060                                                                      CL*51
02061       MOVE MRPT-REC TO MSKL-REC.                                     CL*51
02062        PERFORM S910-READ-NEXT THRU S910-EXIT.                        CL*51
02063        IF L910-NO-REC-88                                             CL*51
02064         SET L910-NO-REC-88 TO TRUE                                   CL*51
02065         GO TO P5002-EXIT.                                            CL*51
02066                                                                      CL*51
02067                                                                      CL*51
02068  P5002-EXIT.                                                         CL*51
02069      EXIT.                                                           CL*51
02070                                                                   DTSBE444
02071  P5000-CREDITS.                                                   DTSBE444
02072      MOVE LOW-VALUES             TO MDST-KEY-AREA.                DTSBE444
02073      MOVE MPRF-EMP-NO            TO MDST-EMP-NO.                  DTSBE444
02074      SET MDST-DST-88             TO TRUE.                         DTSBE444
02075      SET MDST-CREDIT-REC-88      TO TRUE.                         DTSBE444
02076      MOVE MDST-KEY-AREA          TO MSKL-KEY-AREA.                DTSBE444
02077      PERFORM S910-START-BROWSE   THRU S910-EXIT.                  DTSBE444
02078      PERFORM P5100-SCAN-MDST     THRU P5100-EXIT                  DTSBE444
02079          UNTIL L910-NO-REC-88.                                    DTSBE444
02080                                                                   DTSBE444
02081  P5000-EXIT.                                                      DTSBE444
02082      EXIT.                                                        DTSBE444
02083                                                                   DTSBE444
02084  P5100-SCAN-MDST.                                                 DTSBE444
02085      MOVE MSKL-REC TO MDST-REC.                                   DTSBE444
02086                                                                   DTSBE444
02087      IF MDST-CREDIT-REC-88                                        DTSBE444
02088          NEXT SENTENCE                                            DTSBE444
02089      ELSE                                                         DTSBE444
02090          SET L910-NO-REC-88 TO TRUE                               DTSBE444
02091          GO TO P5100-EXIT.                                        DTSBE444
02092                                                                   DTSBE444
02093      PERFORM P5110-MDST-ACCT THRU P5110-EXIT                      DTSBE444
02094          VARYING MDST-ACCT-IDX FROM 1 BY 1                        DTSBE444
02095          UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT.                     DTSBE444
02096                                                                   DTSBE444
02097      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE444
02098                                                                   DTSBE444
02099  P5100-EXIT.                                                      DTSBE444
02100      EXIT.                                                        DTSBE444
02101                                                                   DTSBE444
02102  P5110-MDST-ACCT.                                                 DTSBE444
02103                                                                   DTSBE444
02104      EVALUATE TRUE                                                DTSBE444
02105        WHEN MPRF-CLASS-RATED-88                                   DTSBE444
02106          EVALUATE TRUE                                            DTSBE444
02107            WHEN MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)             DTSBE444
02108              ADD MDST-AMT (MDST-ACCT-IDX)                         DTSBE444
02109                 TO WRK-CREDIT-PAID-RATED                          DTSBE444
02110                    WRK-MTH-RATED-CRED-PAY                         DTSBE444
02111              PERFORM P5111-WRITE-OUTPUT    THRU P5111-EXIT        DTSBE444
02112            WHEN MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX)               DTSBE444
02113              ADD MDST-AMT (MDST-ACCT-IDX)                         DTSBE444
02114                 TO WRK-CREDIT-TOL-RATED                           DTSBE444
02115            WHEN MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-IDX)         DTSBE444
02116              ADD MDST-AMT (MDST-ACCT-IDX)                         DTSBE444
02117                 TO WRK-CREDIT-WRITEOFF-RATED                      DTSBE444
02118          END-EVALUATE                                             DTSBE444
02119                                                                   DTSBE444
02120        WHEN MPRF-CLASS-SELF-INS-88                                DTSBE444
02121          EVALUATE TRUE                                            DTSBE444
02122            WHEN MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)             DTSBE444
02123              ADD MDST-AMT (MDST-ACCT-IDX)                         DTSBE444
02124                 TO WRK-CREDIT-PAID-SI                             DTSBE444
02125                    WRK-MTH-SI-CRED-PAY                            DTSBE444
02126              PERFORM P5111-WRITE-OUTPUT    THRU P5111-EXIT        DTSBE444
02127            WHEN MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX)               DTSBE444
02128              ADD MDST-AMT (MDST-ACCT-IDX)                         DTSBE444
02129                 TO WRK-CREDIT-TOL-SI                              DTSBE444
02130            WHEN MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-IDX)         DTSBE444
02131              ADD MDST-AMT (MDST-ACCT-IDX)                         DTSBE444
02132                 TO WRK-CREDIT-WRITEOFF-SI                         DTSBE444
02133          END-EVALUATE                                             DTSBE444
02134                                                                   DTSBE444
02135        WHEN OTHER                                                 DTSBE444
02136          EVALUATE TRUE                                            DTSBE444
02137            WHEN MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)             DTSBE444
02138              ADD MDST-AMT (MDST-ACCT-IDX)                         DTSBE444
02139                 TO WRK-CREDIT-PAID-UNK                            DTSBE444
02140                    WRK-MTH-UNK-CRED-PAY                           DTSBE444
02141              PERFORM P5111-WRITE-OUTPUT    THRU P5111-EXIT        DTSBE444
02142            WHEN MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX)               DTSBE444
02143              ADD MDST-AMT (MDST-ACCT-IDX)                         DTSBE444
02144                 TO WRK-CREDIT-TOL-UNK                             DTSBE444
02145            WHEN MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-IDX)         DTSBE444
02146              ADD MDST-AMT (MDST-ACCT-IDX)                         DTSBE444
02147                 TO WRK-CREDIT-WRITEOFF-UNK                        DTSBE444
02148          END-EVALUATE                                             DTSBE444
02149                                                                   DTSBE444
02150      END-EVALUATE.                                                DTSBE444
02151                                                                   DTSBE444
02152                                                                   DTSBE444
02153  P5110-EXIT.                                                      DTSBE444
02154      EXIT.                                                        DTSBE444
02155                                                                   DTSBE444
02156  P5111-WRITE-OUTPUT.                                              DTSBE444
02157      MOVE MPRF-EMP-NO               TO CREDIT-EMP-NO.             DTSBE444
02158      MOVE MPRF-PRIMARY-NAME         TO CREDIT-PRIMARY-NAME.       DTSBE444
02159      INSPECT CREDIT-PRIMARY-NAME REPLACING ALL ',' BY SPACE.      DTSBE444
02160      MOVE MPRF-EMP-CLASS            TO CREDIT-EMP-CLASS.          DTSBE444
02161      MOVE MDST-BATCH-NO             TO CREDIT-BATCH-NO.           DTSBE444
02162      MOVE MDST-ITEM-NO              TO CREDIT-ITEM-NO.            DTSBE444
02163                                                                   DTSBE444
02164      MOVE MDST-ESTB-DATE            TO L001-FED-8-DATE-9.         DTSBE444
02165      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBE444
02166      MOVE L001-SLASH-8-DATE         TO CREDIT-PROC-DATE.          DTSBE444
02167                                                                   DTSBE444
02168      MOVE MDST-AMT (MDST-ACCT-IDX)   TO CREDIT-AMT,               DTSBE444
02169                                                                   DTSBE444
02170      WRITE CREDIT-REC  FROM WRK-CREDIT-REC.                       DTSBE444
02171      ADD +1              TO WRK-CREDIT-CNT.                       DTSBE444
02172                                                                   DTSBE444
02173                                                                   DTSBE444
02174  P5111-EXIT.                                                      DTSBE444
02175      EXIT.                                                        DTSBE444
02176                                                                   DTSBE444
02177  T0000-TERMINATE.                                                 DTSBE444
02178      PERFORM T1000-WRITE-R442      THRU T1000-EXIT.               DTSBE444
02179                                                                   DTSBE444
02180      CLOSE AUDIT-FILE                                             DTSBE444
02181            AGING-REPORT                                           DTSBE444
02182            QTR-FILE                                               DTSBE444
02183            PAY-FILE                                               DTSBE444
02184            CREDIT-FILE.                                           DTSBE444
02185                                                                   DTSBE444
02186  T0000-EXIT.                                                      DTSBE444
02187      EXIT.                                                        DTSBE444
02188                                                                   DTSBE444
02189  T1000-WRITE-R442.                                                DTSBE444
02190      MOVE WRK-TOTAL-RATED-TAX  TO DISPLAY-TAX.                    DTSBE444
02191      DISPLAY '***    RATED TOTAL:  ' DISPLAY-TAX.                 DTSBE444
02192      DISPLAY SPACE.                                               DTSBE444
02193      DISPLAY '***    RATED PAYMENTS    ***'.                      DTSBE444
02194      MOVE WRK-MTH-RATED-TAX-PAY  TO DISPLAY-TAX.                  DTSBE444
02195      MOVE WRK-MTH-RATED-PEN-PAY  TO DISPLAY-PEN.                  DTSBE444
02196      MOVE WRK-MTH-RATED-INT-PAY  TO DISPLAY-INT.                  DTSBE444
02197      DISPLAY '   TAX PAY ' DISPLAY-TAX.                           DTSBE444
02198      DISPLAY '   PEN PAY ' DISPLAY-PEN.                           DTSBE444
02199      DISPLAY '   INT PAY ' DISPLAY-INT.                           DTSBE444
02200      DISPLAY SPACE.                                               DTSBE444
02201                                                                   DTSBE444
02202      MOVE WRK-TOT-SI-TAX  TO DISPLAY-TAX.                         DTSBE444
02203      DISPLAY '***    SI TOTAL:  ' DISPLAY-TAX.                    DTSBE444
02204      DISPLAY SPACE.                                               DTSBE444
02205      DISPLAY '***    SELF-INSURED PAYMENTS    ***'.               DTSBE444
02206      MOVE WRK-MTH-SI-TAX-PAY  TO DISPLAY-TAX.                     DTSBE444
02207      MOVE WRK-MTH-SI-PEN-PAY  TO DISPLAY-PEN.                     DTSBE444
02208      MOVE WRK-MTH-SI-INT-PAY  TO DISPLAY-INT.                     DTSBE444
02209      DISPLAY '   TAX PAY ' DISPLAY-TAX.                           DTSBE444
02210      DISPLAY '   PEN PAY ' DISPLAY-PEN.                           DTSBE444
02211      DISPLAY '   INT PAY ' DISPLAY-INT.                           DTSBE444
02212      DISPLAY SPACE.                                               DTSBE444
02213                                                                   DTSBE444
02214      DISPLAY '***    UNKNOWN PAYMENTS    ***'.                    DTSBE444
02215      MOVE WRK-MTH-UNK-TAX-PAY  TO DISPLAY-TAX.                    DTSBE444
02216      MOVE WRK-MTH-UNK-PEN-PAY  TO DISPLAY-PEN.                    DTSBE444
02217      MOVE WRK-MTH-UNK-INT-PAY  TO DISPLAY-INT.                    DTSBE444
02218      DISPLAY '   TAX PAY ' DISPLAY-TAX.                           DTSBE444
02219      DISPLAY '   PEN PAY ' DISPLAY-PEN.                           DTSBE444
02220      DISPLAY '   INT PAY ' DISPLAY-INT.                           DTSBE444
02221      DISPLAY SPACE.                                               DTSBE444
02222                                                                   DTSBE444
02223 ********************************************************          DTSBE444
02224 *  CREDITS                                                        DTSBE444
02225 ********************************************************          DTSBE444
02226      ADD WRK-CREDIT-WRITEOFF-RATED  TO WRK-CREDIT-PAID-RATED.     DTSBE444
02227      ADD WRK-CREDIT-TOL-RATED       TO WRK-CREDIT-PAID-RATED.     DTSBE444
02228      COMPUTE WRK-CREDIT-WRITEOFF-RATED =                          DTSBE444
02229         (WRK-CREDIT-WRITEOFF-RATED * -1).                         DTSBE444
02230      COMPUTE WRK-CREDIT-TOL-RATED =                               DTSBE444
02231         (WRK-CREDIT-TOL-RATED * -1).                              DTSBE444
02232      COMPUTE WRK-CREDIT-AMT = (0 -                                DTSBE444
02233         WRK-CREDIT-PAID-RATED - WRK-CREDIT-WRITEOFF-RATED         DTSBE444
02234         - WRK-CREDIT-TOL-RATED).                                  DTSBE444
02235                                                                   DTSBE444
02236      DISPLAY '***    RATED CREDITS     ***'.                      DTSBE444
02237      MOVE WRK-CREDIT-AMT  TO DISPLAY-TAX.                         DTSBE444
02238      DISPLAY '   CREDIT ' DISPLAY-TAX.                            DTSBE444
02239      MOVE WRK-MTH-RATED-CRED-PAY  TO DISPLAY-TAX.                 DTSBE444
02240      DISPLAY '   CREDIT PAID ' DISPLAY-TAX.                       DTSBE444
02241      DISPLAY SPACE.                                               DTSBE444
02242                                                                   DTSBE444
02243      ADD WRK-CREDIT-WRITEOFF-SI     TO WRK-CREDIT-PAID-SI.        DTSBE444
02244      ADD WRK-CREDIT-TOL-SI          TO WRK-CREDIT-PAID-SI.        DTSBE444
02245      COMPUTE WRK-CREDIT-WRITEOFF-SI    =                          DTSBE444
02246         (WRK-CREDIT-WRITEOFF-SI    * -1).                         DTSBE444
02247      COMPUTE WRK-CREDIT-TOL-SI    =                               DTSBE444
02248         (WRK-CREDIT-TOL-SI    * -1).                              DTSBE444
02249      COMPUTE WRK-CREDIT-AMT = (0 -                                DTSBE444
02250         WRK-CREDIT-PAID-SI - WRK-CREDIT-WRITEOFF-SI               DTSBE444
02251         - WRK-CREDIT-TOL-SI).                                     DTSBE444
02252                                                                   DTSBE444
02253      DISPLAY '***    SELF-INSURED CREDITS     ***'.               DTSBE444
02254      MOVE WRK-CREDIT-AMT       TO DISPLAY-TAX.                    DTSBE444
02255      DISPLAY '   CREDIT ' DISPLAY-TAX.                            DTSBE444
02256      MOVE WRK-MTH-SI-CRED-PAY  TO DISPLAY-TAX.                    DTSBE444
02257      DISPLAY '   CREDIT PAID ' DISPLAY-TAX.                       DTSBE444
02258      DISPLAY SPACE.                                               DTSBE444
02259                                                                   DTSBE444
02260      ADD WRK-CREDIT-WRITEOFF-UNK    TO WRK-CREDIT-PAID-UNK.       DTSBE444
02261      ADD WRK-CREDIT-TOL-UNK         TO WRK-CREDIT-PAID-UNK.       DTSBE444
02262      COMPUTE WRK-CREDIT-WRITEOFF-UNK   =                          DTSBE444
02263         (WRK-CREDIT-WRITEOFF-UNK   * -1).                         DTSBE444
02264      COMPUTE WRK-CREDIT-TOL-UNK   =                               DTSBE444
02265         (WRK-CREDIT-TOL-UNK   * -1).                              DTSBE444
02266      COMPUTE WRK-CREDIT-AMT = (0 -                                DTSBE444
02267         WRK-CREDIT-PAID-UNK - WRK-CREDIT-WRITEOFF-UNK             DTSBE444
02268         - WRK-CREDIT-TOL-UNK).                                    DTSBE444
02269                                                                   DTSBE444
02270      DISPLAY '***    UNKNOWN CREDITS     ***'.                    DTSBE444
02271      MOVE WRK-CREDIT-AMT        TO DISPLAY-TAX.                   DTSBE444
02272      DISPLAY '   CREDIT ' DISPLAY-TAX.                            DTSBE444
02273      MOVE WRK-MTH-UNK-CRED-PAY  TO DISPLAY-TAX.                   DTSBE444
02274      DISPLAY '   CREDIT PAID ' DISPLAY-TAX.                       DTSBE444
02275      DISPLAY SPACE.                                               DTSBE444
02276                                                                   DTSBE444
02277      DISPLAY '***    AGING OF EMPLOYER ACCOUNTS RECEIVABLE   ***'.DTSBE444
02278      DISPLAY SPACE.                                               DTSBE444
02279      DISPLAY '***  RATED  ***'.                                   DTSBE444
02280      MOVE 'RATED '    TO X442-EMPL-TYPE.                          DTSBE444
02281                                                                   DTSBE444
02282      MOVE WRK-QTR-YRQ (1)       TO R442-YRQ (1) L004-QTR-5-9.     DTSBE444
02283      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02284      IF L004-INVALID-QTR                                          DTSBE444
02285           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02286           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02287      ELSE                                                         DTSBE444
02288          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02289      END-IF.                                                      DTSBE444
02290                                                                   DTSBE444
02291      MOVE WRK-QTR-RATED-TAX (1) TO DISPLAY-TAX R442-TAX-AMT (1)   DTSBE444
02292                                    X442-TAX.                      DTSBE444
02293      MOVE WRK-QTR-RATED-PEN (1) TO DISPLAY-PEN R442-PEN-AMT (1)   DTSBE444
02294                                    X442-PENALTY.                  DTSBE444
02295      MOVE WRK-QTR-RATED-INT (1) TO DISPLAY-INT R442-INT-AMT (1)   DTSBE444
02296                                    X442-INTEREST.                 DTSBE444
02297      DISPLAY WRK-QTR-YRQ (1)                                      DTSBE444
02298         '  TAX ' DISPLAY-TAX                                      DTSBE444
02299         '  PEN ' DISPLAY-PEN                                      DTSBE444
02300         '  INT ' DISPLAY-INT.                                     DTSBE444
02301                                                                   DTSBE444
02302 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02303 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02304                                                                   DTSBE444
02305      MOVE WRK-QTR-YRQ (2)       TO R442-YRQ (2) L004-QTR-5-9.     DTSBE444
02306      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02307      IF L004-INVALID-QTR                                          DTSBE444
02308           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02309           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02310      ELSE                                                         DTSBE444
02311          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02312      END-IF.                                                      DTSBE444
02313                                                                   DTSBE444
02314      MOVE WRK-QTR-RATED-TAX (2) TO DISPLAY-TAX R442-TAX-AMT (2)   DTSBE444
02315                                    X442-TAX.                      DTSBE444
02316      MOVE WRK-QTR-RATED-PEN (2) TO DISPLAY-PEN R442-PEN-AMT (2)   DTSBE444
02317                                    X442-PENALTY.                  DTSBE444
02318      MOVE WRK-QTR-RATED-INT (2) TO DISPLAY-INT R442-INT-AMT (2)   DTSBE444
02319                                    X442-INTEREST.                 DTSBE444
02320      DISPLAY WRK-QTR-YRQ (2)                                      DTSBE444
02321         '  TAX ' DISPLAY-TAX                                      DTSBE444
02322         '  PEN ' DISPLAY-PEN                                      DTSBE444
02323         '  INT ' DISPLAY-INT.                                     DTSBE444
02324                                                                   DTSBE444
02325 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02326 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02327                                                                   DTSBE444
02328      MOVE WRK-QTR-YRQ (3)       TO R442-YRQ (3) L004-QTR-5-9.     DTSBE444
02329      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02330      IF L004-INVALID-QTR                                          DTSBE444
02331           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02332           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02333      ELSE                                                         DTSBE444
02334          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02335      END-IF.                                                      DTSBE444
02336                                                                   DTSBE444
02337      MOVE WRK-QTR-RATED-TAX (3) TO DISPLAY-TAX R442-TAX-AMT (3)   DTSBE444
02338                                    X442-TAX.                      DTSBE444
02339      MOVE WRK-QTR-RATED-PEN (3) TO DISPLAY-PEN R442-PEN-AMT (3)   DTSBE444
02340                                    X442-PENALTY.                  DTSBE444
02341      MOVE WRK-QTR-RATED-INT (3) TO DISPLAY-INT R442-INT-AMT (3)   DTSBE444
02342                                    X442-INTEREST.                 DTSBE444
02343      DISPLAY WRK-QTR-YRQ (3)                                      DTSBE444
02344         '  TAX ' DISPLAY-TAX                                      DTSBE444
02345         '  PEN ' DISPLAY-PEN                                      DTSBE444
02346         '  INT ' DISPLAY-INT.                                     DTSBE444
02347                                                                   DTSBE444
02348 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02349 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02350                                                                   DTSBE444
02351      MOVE WRK-QTR-YRQ (4)       TO R442-YRQ (4) L004-QTR-5-9.     DTSBE444
02352      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02353      IF L004-INVALID-QTR                                          DTSBE444
02354           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02355           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02356      ELSE                                                         DTSBE444
02357          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02358      END-IF.                                                      DTSBE444
02359                                                                   DTSBE444
02360      MOVE WRK-QTR-RATED-TAX (4) TO DISPLAY-TAX R442-TAX-AMT (4)   DTSBE444
02361                                    X442-TAX.                      DTSBE444
02362      MOVE WRK-QTR-RATED-PEN (4) TO DISPLAY-PEN R442-PEN-AMT (4)   DTSBE444
02363                                    X442-PENALTY.                  DTSBE444
02364      MOVE WRK-QTR-RATED-INT (4) TO DISPLAY-INT R442-INT-AMT (4)   DTSBE444
02365                                    X442-INTEREST.                 DTSBE444
02366      DISPLAY WRK-QTR-YRQ (4)                                      DTSBE444
02367         '  TAX ' DISPLAY-TAX                                      DTSBE444
02368         '  PEN ' DISPLAY-PEN                                      DTSBE444
02369         '  INT ' DISPLAY-INT.                                     DTSBE444
02370                                                                   DTSBE444
02371 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02372 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02373                                                                   DTSBE444
02374      MOVE WRK-QTR-YRQ (5)       TO R442-YRQ (5) L004-QTR-5-9.     DTSBE444
02375      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02376      IF L004-INVALID-QTR                                          DTSBE444
02377           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02378           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02379      ELSE                                                         DTSBE444
02380          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02381      END-IF.                                                      DTSBE444
02382                                                                   DTSBE444
02383      MOVE WRK-QTR-RATED-TAX (5) TO DISPLAY-TAX R442-TAX-AMT (5)   DTSBE444
02384                                    X442-TAX.                      DTSBE444
02385      MOVE WRK-QTR-RATED-PEN (5) TO DISPLAY-PEN R442-PEN-AMT (5)   DTSBE444
02386                                    X442-PENALTY.                  DTSBE444
02387      MOVE WRK-QTR-RATED-INT (5) TO DISPLAY-INT R442-INT-AMT (5)   DTSBE444
02388                                    X442-INTEREST.                 DTSBE444
02389      DISPLAY WRK-QTR-YRQ (5)                                      DTSBE444
02390         '  TAX ' DISPLAY-TAX                                      DTSBE444
02391         '  PEN ' DISPLAY-PEN                                      DTSBE444
02392         '  INT ' DISPLAY-INT.                                     DTSBE444
02393                                                                   DTSBE444
02394 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02395 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02396                                                                   DTSBE444
02397      MOVE WRK-QTR-YRQ (6)       TO R442-YRQ (6) L004-QTR-5-9.     DTSBE444
02398      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02399      IF L004-INVALID-QTR                                          DTSBE444
02400           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02401           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02402      ELSE                                                         DTSBE444
02403          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02404      END-IF.                                                      DTSBE444
02405                                                                   DTSBE444
02406      MOVE WRK-QTR-RATED-TAX (6) TO DISPLAY-TAX R442-TAX-AMT (6)   DTSBE444
02407                                    X442-TAX.                      DTSBE444
02408      MOVE WRK-QTR-RATED-PEN (6) TO DISPLAY-PEN R442-PEN-AMT (6)   DTSBE444
02409                                    X442-PENALTY.                  DTSBE444
02410      MOVE WRK-QTR-RATED-INT (6) TO DISPLAY-INT R442-INT-AMT (6)   DTSBE444
02411                                    X442-INTEREST.                 DTSBE444
02412      DISPLAY WRK-QTR-YRQ (6)                                      DTSBE444
02413         '  TAX ' DISPLAY-TAX                                      DTSBE444
02414         '  PEN ' DISPLAY-PEN                                      DTSBE444
02415         '  INT ' DISPLAY-INT.                                     DTSBE444
02416                                                                   DTSBE444
02417 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02418 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02419                                                                   DTSBE444
02420      MOVE WRK-QTR-YRQ (7)       TO R442-YRQ (7) L004-QTR-5-9.     DTSBE444
02421      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02422      IF L004-INVALID-QTR                                          DTSBE444
02423           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02424           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02425      ELSE                                                         DTSBE444
02426          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02427      END-IF.                                                      DTSBE444
02428                                                                   DTSBE444
02429      MOVE WRK-QTR-RATED-TAX (7) TO DISPLAY-TAX R442-TAX-AMT (7)   DTSBE444
02430                                    X442-TAX.                      DTSBE444
02431      MOVE WRK-QTR-RATED-PEN (7) TO DISPLAY-PEN R442-PEN-AMT (7)   DTSBE444
02432                                    X442-PENALTY.                  DTSBE444
02433      MOVE WRK-QTR-RATED-INT (7) TO DISPLAY-INT R442-INT-AMT (7)   DTSBE444
02434                                    X442-INTEREST.                 DTSBE444
02435      DISPLAY WRK-QTR-YRQ (7) ' AND PRIOR'                         DTSBE444
02436      DISPLAY '      TAX ' DISPLAY-TAX                             DTSBE444
02437         '  PEN ' DISPLAY-PEN                                      DTSBE444
02438         '  INT ' DISPLAY-INT.                                     DTSBE444
02439                                                                   DTSBE444
02440 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02441 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02442                                                                   DTSBE444
02443      COMPUTE WRK-TOT-RATED-PEN =                                  DTSBE444
02444         WRK-QTR-RATED-PEN (1) +                                   DTSBE444
02445         WRK-QTR-RATED-PEN (2) +                                   DTSBE444
02446         WRK-QTR-RATED-PEN (3) +                                   DTSBE444
02447         WRK-QTR-RATED-PEN (4) +                                   DTSBE444
02448         WRK-QTR-RATED-PEN (5) +                                   DTSBE444
02449         WRK-QTR-RATED-PEN (6) +                                   DTSBE444
02450         WRK-QTR-RATED-PEN (7).                                    DTSBE444
02451      COMPUTE WRK-TOT-RATED-TAX =                                  DTSBE444
02452         WRK-QTR-RATED-TAX (1) +                                   DTSBE444
02453         WRK-QTR-RATED-TAX (2) +                                   DTSBE444
02454         WRK-QTR-RATED-TAX (3) +                                   DTSBE444
02455         WRK-QTR-RATED-TAX (4) +                                   DTSBE444
02456         WRK-QTR-RATED-TAX (5) +                                   DTSBE444
02457         WRK-QTR-RATED-TAX (6) +                                   DTSBE444
02458         WRK-QTR-RATED-TAX (7).                                    DTSBE444
02459      COMPUTE WRK-TOT-RATED-INT =                                  DTSBE444
02460         WRK-QTR-RATED-INT (1) +                                   DTSBE444
02461         WRK-QTR-RATED-INT (2) +                                   DTSBE444
02462         WRK-QTR-RATED-INT (3) +                                   DTSBE444
02463         WRK-QTR-RATED-INT (4) +                                   DTSBE444
02464         WRK-QTR-RATED-INT (5) +                                   DTSBE444
02465         WRK-QTR-RATED-INT (6) +                                   DTSBE444
02466         WRK-QTR-RATED-INT (7).                                    DTSBE444
02467                                                                   DTSBE444
02468      MOVE 'GRAND TOTAL'         TO X442-DESCRIPTION.              DTSBE444
02469                                                                   DTSBE444
02470      MOVE WRK-TOT-RATED-TAX     TO DISPLAY-TAX X442-TAX.          DTSBE444
02471      MOVE WRK-TOT-RATED-PEN     TO DISPLAY-PEN X442-PENALTY.      DTSBE444
02472      MOVE WRK-TOT-RATED-INT     TO DISPLAY-INT X442-INTEREST.     DTSBE444
02473      DISPLAY SPACE.                                               DTSBE444
02474      DISPLAY 'TOTAL'                                              DTSBE444
02475         '  TAX ' DISPLAY-TAX                                      DTSBE444
02476         '  PEN ' DISPLAY-PEN                                      DTSBE444
02477         '  INT ' DISPLAY-INT.                                     DTSBE444
02478                                                                   DTSBE444
02479 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02480 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02481                                                                   DTSBE444
02482      MOVE '3 YEARS OR MORE'      TO X442-DESCRIPTION.             DTSBE444
02483      DISPLAY SPACE.                                               DTSBE444
02484      DISPLAY '3 YEARS OR MORE '                                   DTSBE444
02485      MOVE WRK-3-YR-RATED-TAX     TO DISPLAY-TAX X442-TAX          DTSBE444
02486                                     R442-3-YR-MORE-TAX-AMT.       DTSBE444
02487      MOVE WRK-3-YR-RATED-PEN     TO DISPLAY-PEN X442-PENALTY      DTSBE444
02488                                     R442-3-YR-MORE-PEN-AMT.       DTSBE444
02489      MOVE WRK-3-YR-RATED-INT     TO DISPLAY-INT X442-INTEREST     DTSBE444
02490                                     R442-3-YR-MORE-INT-AMT.       DTSBE444
02491      DISPLAY '     '                                              DTSBE444
02492         '  TAX ' DISPLAY-TAX                                      DTSBE444
02493         '  PEN ' DISPLAY-PEN                                      DTSBE444
02494         '  INT ' DISPLAY-INT.                                     DTSBE444
02495                                                                   DTSBE444
02496 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02497 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02498                                                                   DTSBE444
02499      DISPLAY SPACE.                                               DTSBE444
02500      DISPLAY 'SINCE 1999/4 '                                      DTSBE444
02501      MOVE WRK-19994-RATED-TAX    TO DISPLAY-TAX.                  DTSBE444
02502      MOVE WRK-19994-RATED-PEN    TO DISPLAY-PEN.                  DTSBE444
02503      MOVE WRK-19994-RATED-INT    TO DISPLAY-INT.                  DTSBE444
02504      DISPLAY '     '                                              DTSBE444
02505         '  TAX ' DISPLAY-TAX                                      DTSBE444
02506         '  PEN ' DISPLAY-PEN                                      DTSBE444
02507         '  INT ' DISPLAY-INT.                                     DTSBE444
02508                                                                   DTSBE444
02509      MOVE 'ACTIVE         '      TO X442-DESCRIPTION.             DTSBE444
02510      DISPLAY SPACE.                                               DTSBE444
02511      MOVE WRK-ACTIVE-RATED-TAX TO DISPLAY-TAX X442-TAX            DTSBE444
02512                                   R442-ACTIVE-TAX-AMT.            DTSBE444
02513      MOVE WRK-ACTIVE-RATED-PEN TO DISPLAY-PEN X442-PENALTY        DTSBE444
02514                                   R442-ACTIVE-PEN-AMT.            DTSBE444
02515      MOVE WRK-ACTIVE-RATED-INT TO DISPLAY-INT X442-INTEREST       DTSBE444
02516                                   R442-ACTIVE-INT-AMT.            DTSBE444
02517      DISPLAY 'ACTIVE'                                             DTSBE444
02518         '  TAX ' DISPLAY-TAX                                      DTSBE444
02519         '  PEN ' DISPLAY-PEN                                      DTSBE444
02520         '  INT ' DISPLAY-INT.                                     DTSBE444
02521                                                                   DTSBE444
02522 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02523 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02524                                                                   DTSBE444
02525      MOVE 'INACTIVE       '      TO X442-DESCRIPTION.             DTSBE444
02526      MOVE WRK-INACT-RATED-TAX TO DISPLAY-TAX X442-TAX             DTSBE444
02527                                  R442-INACTIVE-TAX-AMT.           DTSBE444
02528      MOVE WRK-INACT-RATED-PEN TO DISPLAY-PEN X442-PENALTY         DTSBE444
02529                                  R442-INACTIVE-PEN-AMT.           DTSBE444
02530      MOVE WRK-INACT-RATED-INT TO DISPLAY-INT X442-INTEREST        DTSBE444
02531                                  R442-INACTIVE-INT-AMT.           DTSBE444
02532      DISPLAY 'INACTIVE'                                           DTSBE444
02533         '  TAX ' DISPLAY-TAX                                      DTSBE444
02534         '  PEN ' DISPLAY-PEN                                      DTSBE444
02535         '  INT ' DISPLAY-INT.                                     DTSBE444
02536                                                                   DTSBE444
02537 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02538 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02539                                                                   DTSBE444
02540      MOVE 'INACTIVE 3 YEAR'      TO X442-DESCRIPTION.             DTSBE444
02541      MOVE WRK-INACT-3YR-RATED-TAX TO DISPLAY-TAX X442-TAX         DTSBE444
02542                                      R442-INACT-3-YR-TAX-AMT.     DTSBE444
02543      MOVE WRK-INACT-3YR-RATED-PEN TO DISPLAY-PEN X442-PENALTY     DTSBE444
02544                                      R442-INACT-3-YR-PEN-AMT.     DTSBE444
02545      MOVE WRK-INACT-3YR-RATED-INT TO DISPLAY-INT X442-INTEREST    DTSBE444
02546                                      R442-INACT-3-YR-INT-AMT.     DTSBE444
02547      DISPLAY 'INACTIVE 3 YEARS'                                   DTSBE444
02548         '  TAX ' DISPLAY-TAX                                      DTSBE444
02549         '  PEN ' DISPLAY-PEN                                      DTSBE444
02550         '  INT ' DISPLAY-INT.                                     DTSBE444
02551      DISPLAY SPACE.                                               DTSBE444
02552                                                                   DTSBE444
02553 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02554 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02555                                                                   DTSBE444
02556      MOVE 'TOT IN CHAPTER 7 '    TO X442-DESCRIPTION.             DTSBE444
02557      MOVE WRK-CHAPTER-7-RATED-TAX TO DISPLAY-TAX X442-TAX         DTSBE444
02558                                      R442-TOT-CHPT-7-TAX-AMT.     DTSBE444
02559      MOVE WRK-CHAPTER-7-RATED-PEN TO DISPLAY-PEN X442-PENALTY     DTSBE444
02560                                      R442-TOT-CHPT-7-PEN-AMT.     DTSBE444
02561      MOVE WRK-CHAPTER-7-RATED-INT TO DISPLAY-INT X442-INTEREST    DTSBE444
02562                                      R442-TOT-CHPT-7-INT-AMT.     DTSBE444
02563      DISPLAY 'TOTAL IN CHAPTER 7 '                                DTSBE444
02564         '  TAX ' DISPLAY-TAX                                      DTSBE444
02565         '  PEN ' DISPLAY-PEN                                      DTSBE444
02566         '  INT ' DISPLAY-INT.                                     DTSBE444
02567                                                                   DTSBE444
02568 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02569 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02570                                                                   DTSBE444
02571      MOVE 'TOT IN CHAPTER 11'    TO X442-DESCRIPTION.             DTSBE444
02572      MOVE WRK-CHAPTER-11-RATED-TAX TO DISPLAY-TAX X442-TAX        DTSBE444
02573                                       R442-TOT-CHPT-11-TAX-AMT.   DTSBE444
02574      MOVE WRK-CHAPTER-11-RATED-PEN TO DISPLAY-PEN X442-PENALTY    DTSBE444
02575                                       R442-TOT-CHPT-11-PEN-AMT.   DTSBE444
02576      MOVE WRK-CHAPTER-11-RATED-INT TO DISPLAY-INT X442-INTEREST   DTSBE444
02577                                       R442-TOT-CHPT-11-INT-AMT.   DTSBE444
02578      DISPLAY 'TOTAL IN CHAPTER 11 '                               DTSBE444
02579         '  TAX ' DISPLAY-TAX                                      DTSBE444
02580         '  PEN ' DISPLAY-PEN                                      DTSBE444
02581         '  INT ' DISPLAY-INT.                                     DTSBE444
02582                                                                   DTSBE444
02583 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02584 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02585                                                                   DTSBE444
02586      SET R442-SORT-CLASS-R-88 TO TRUE.                            DTSBE444
02587      PERFORM S946-WRITE-R442      THRU S946-EXIT.                 DTSBE444
02588                                                                   DTSBE444
02589      DISPLAY '***  SELF-INS  ***'.                                DTSBE444
02590      MOVE 'SELF INS'  TO X442-EMPL-TYPE.                          DTSBE444
02591      MOVE WRK-QTR-YRQ (1)          TO R442-YRQ (1)                DTSBE444
02592                                       L004-QTR-5-9.               DTSBE444
02593      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02594      IF L004-INVALID-QTR                                          DTSBE444
02595           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02596           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02597      ELSE                                                         DTSBE444
02598          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02599      END-IF.                                                      DTSBE444
02600                                                                   DTSBE444
02601      MOVE WRK-QTR-SELF-INS-TAX (1) TO DISPLAY-TAX X442-TAX        DTSBE444
02602                                       R442-TAX-AMT (1).           DTSBE444
02603      MOVE WRK-QTR-SELF-INS-PEN (1) TO DISPLAY-PEN X442-PENALTY    DTSBE444
02604                                       R442-PEN-AMT (1).           DTSBE444
02605      MOVE WRK-QTR-SELF-INS-INT (1) TO DISPLAY-INT X442-INTEREST   DTSBE444
02606                                       R442-INT-AMT (1).           DTSBE444
02607      DISPLAY WRK-QTR-YRQ (1)                                      DTSBE444
02608         '  TAX ' DISPLAY-TAX                                      DTSBE444
02609         '  PEN ' DISPLAY-PEN                                      DTSBE444
02610         '  INT ' DISPLAY-INT.                                     DTSBE444
02611                                                                   DTSBE444
02612 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02613 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02614                                                                   DTSBE444
02615      MOVE WRK-QTR-YRQ (2)          TO R442-YRQ (2)                DTSBE444
02616                                       L004-QTR-5-9.               DTSBE444
02617      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02618      IF L004-INVALID-QTR                                          DTSBE444
02619           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02620           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02621      ELSE                                                         DTSBE444
02622          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02623      END-IF.                                                      DTSBE444
02624                                                                   DTSBE444
02625      MOVE WRK-QTR-SELF-INS-TAX (2) TO DISPLAY-TAX X442-TAX        DTSBE444
02626                                       R442-TAX-AMT (2).           DTSBE444
02627      MOVE WRK-QTR-SELF-INS-PEN (2) TO DISPLAY-PEN X442-PENALTY    DTSBE444
02628                                       R442-PEN-AMT (2).           DTSBE444
02629      MOVE WRK-QTR-SELF-INS-INT (2) TO DISPLAY-INT X442-INTEREST   DTSBE444
02630                                       R442-INT-AMT (2).           DTSBE444
02631      DISPLAY WRK-QTR-YRQ (2)                                      DTSBE444
02632         '  TAX ' DISPLAY-TAX                                      DTSBE444
02633         '  PEN ' DISPLAY-PEN                                      DTSBE444
02634         '  INT ' DISPLAY-INT.                                     DTSBE444
02635                                                                   DTSBE444
02636 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02637 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02638                                                                   DTSBE444
02639      MOVE WRK-QTR-YRQ (3)          TO R442-YRQ (3)                DTSBE444
02640                                       L004-QTR-5-9.               DTSBE444
02641      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02642      IF L004-INVALID-QTR                                          DTSBE444
02643           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02644           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02645      ELSE                                                         DTSBE444
02646          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02647      END-IF.                                                      DTSBE444
02648                                                                   DTSBE444
02649      MOVE WRK-QTR-SELF-INS-TAX (3) TO DISPLAY-TAX X442-TAX        DTSBE444
02650                                       R442-TAX-AMT (3).           DTSBE444
02651      MOVE WRK-QTR-SELF-INS-PEN (3) TO DISPLAY-PEN X442-PENALTY    DTSBE444
02652                                       R442-PEN-AMT (3).           DTSBE444
02653      MOVE WRK-QTR-SELF-INS-INT (3) TO DISPLAY-INT X442-INTEREST   DTSBE444
02654                                       R442-INT-AMT (3).           DTSBE444
02655      DISPLAY WRK-QTR-YRQ (3)                                      DTSBE444
02656         '  TAX ' DISPLAY-TAX                                      DTSBE444
02657         '  PEN ' DISPLAY-PEN                                      DTSBE444
02658         '  INT ' DISPLAY-INT.                                     DTSBE444
02659                                                                   DTSBE444
02660 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02661 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02662                                                                   DTSBE444
02663      MOVE WRK-QTR-YRQ (4)          TO R442-YRQ (4)                DTSBE444
02664                                       L004-QTR-5-9.               DTSBE444
02665      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02666      IF L004-INVALID-QTR                                          DTSBE444
02667           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02668           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02669      ELSE                                                         DTSBE444
02670          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02671      END-IF.                                                      DTSBE444
02672                                                                   DTSBE444
02673      MOVE WRK-QTR-SELF-INS-TAX (4) TO DISPLAY-TAX X442-TAX        DTSBE444
02674                                       R442-TAX-AMT (4).           DTSBE444
02675      MOVE WRK-QTR-SELF-INS-PEN (4) TO DISPLAY-PEN X442-PENALTY    DTSBE444
02676                                       R442-PEN-AMT (4).           DTSBE444
02677      MOVE WRK-QTR-SELF-INS-INT (4) TO DISPLAY-INT X442-INTEREST   DTSBE444
02678                                       R442-INT-AMT (4).           DTSBE444
02679      DISPLAY WRK-QTR-YRQ (4)                                      DTSBE444
02680         '  TAX ' DISPLAY-TAX                                      DTSBE444
02681         '  PEN ' DISPLAY-PEN                                      DTSBE444
02682         '  INT ' DISPLAY-INT.                                     DTSBE444
02683                                                                   DTSBE444
02684 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02685 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02686                                                                   DTSBE444
02687      MOVE WRK-QTR-YRQ (5)          TO R442-YRQ (5)                DTSBE444
02688                                       L004-QTR-5-9.               DTSBE444
02689      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02690      IF L004-INVALID-QTR                                          DTSBE444
02691           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02692           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02693      ELSE                                                         DTSBE444
02694          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02695      END-IF.                                                      DTSBE444
02696                                                                   DTSBE444
02697      MOVE WRK-QTR-SELF-INS-TAX (5) TO DISPLAY-TAX X442-TAX        DTSBE444
02698                                       R442-TAX-AMT (5).           DTSBE444
02699      MOVE WRK-QTR-SELF-INS-PEN (5) TO DISPLAY-PEN X442-PENALTY    DTSBE444
02700                                       R442-PEN-AMT (5).           DTSBE444
02701      MOVE WRK-QTR-SELF-INS-INT (5) TO DISPLAY-INT X442-INTEREST   DTSBE444
02702                                       R442-INT-AMT (5).           DTSBE444
02703      DISPLAY WRK-QTR-YRQ (5)                                      DTSBE444
02704         '  TAX ' DISPLAY-TAX                                      DTSBE444
02705         '  PEN ' DISPLAY-PEN                                      DTSBE444
02706         '  INT ' DISPLAY-INT.                                     DTSBE444
02707                                                                   DTSBE444
02708 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02709 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02710                                                                   DTSBE444
02711      MOVE WRK-QTR-YRQ (6)          TO R442-YRQ (6)                DTSBE444
02712                                       L004-QTR-5-9.               DTSBE444
02713      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02714      IF L004-INVALID-QTR                                          DTSBE444
02715           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02716           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02717      ELSE                                                         DTSBE444
02718          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02719      END-IF.                                                      DTSBE444
02720                                                                   DTSBE444
02721      MOVE WRK-QTR-SELF-INS-TAX (6) TO DISPLAY-TAX X442-TAX        DTSBE444
02722                                       R442-TAX-AMT (6).           DTSBE444
02723      MOVE WRK-QTR-SELF-INS-PEN (6) TO DISPLAY-PEN X442-PENALTY    DTSBE444
02724                                       R442-PEN-AMT (6).           DTSBE444
02725      MOVE WRK-QTR-SELF-INS-INT (6) TO DISPLAY-INT X442-INTEREST   DTSBE444
02726                                       R442-INT-AMT (6).           DTSBE444
02727      DISPLAY WRK-QTR-YRQ (6)                                      DTSBE444
02728         '  TAX ' DISPLAY-TAX                                      DTSBE444
02729         '  PEN ' DISPLAY-PEN                                      DTSBE444
02730         '  INT ' DISPLAY-INT.                                     DTSBE444
02731                                                                   DTSBE444
02732 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02733 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02734                                                                   DTSBE444
02735      MOVE WRK-QTR-YRQ (7)          TO R442-YRQ (7)                DTSBE444
02736                                       L004-QTR-5-9.               DTSBE444
02737      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBE444
02738      IF L004-INVALID-QTR                                          DTSBE444
02739           MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG               DTSBE444
02740           PERFORM S999-ABEND THRU S999-EXIT                       DTSBE444
02741      ELSE                                                         DTSBE444
02742          MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION                DTSBE444
02743      END-IF.                                                      DTSBE444
02744                                                                   DTSBE444
02745      MOVE WRK-QTR-SELF-INS-TAX (7) TO DISPLAY-TAX X442-TAX        DTSBE444
02746                                       R442-TAX-AMT (7).           DTSBE444
02747      MOVE WRK-QTR-SELF-INS-PEN (7) TO DISPLAY-PEN X442-PENALTY    DTSBE444
02748                                       R442-PEN-AMT (7).           DTSBE444
02749      MOVE WRK-QTR-SELF-INS-INT (7) TO DISPLAY-INT X442-INTEREST   DTSBE444
02750                                       R442-INT-AMT (7).           DTSBE444
02751      DISPLAY WRK-QTR-YRQ (7) ' AND PRIOR'                         DTSBE444
02752      DISPLAY '      TAX ' DISPLAY-TAX                             DTSBE444
02753         '  PEN ' DISPLAY-PEN                                      DTSBE444
02754         '  INT ' DISPLAY-INT.                                     DTSBE444
02755                                                                   DTSBE444
02756 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02757 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02758                                                                   DTSBE444
02759      COMPUTE WRK-TOT-SELF-INS-PEN =                               DTSBE444
02760         WRK-QTR-SELF-INS-PEN (1) +                                DTSBE444
02761         WRK-QTR-SELF-INS-PEN (2) +                                DTSBE444
02762         WRK-QTR-SELF-INS-PEN (3) +                                DTSBE444
02763         WRK-QTR-SELF-INS-PEN (4) +                                DTSBE444
02764         WRK-QTR-SELF-INS-PEN (5) +                                DTSBE444
02765         WRK-QTR-SELF-INS-PEN (6) +                                DTSBE444
02766         WRK-QTR-SELF-INS-PEN (7).                                 DTSBE444
02767      COMPUTE WRK-TOT-SELF-INS-TAX =                               DTSBE444
02768         WRK-QTR-SELF-INS-TAX (1) +                                DTSBE444
02769         WRK-QTR-SELF-INS-TAX (2) +                                DTSBE444
02770         WRK-QTR-SELF-INS-TAX (3) +                                DTSBE444
02771         WRK-QTR-SELF-INS-TAX (4) +                                DTSBE444
02772         WRK-QTR-SELF-INS-TAX (5) +                                DTSBE444
02773         WRK-QTR-SELF-INS-TAX (6) +                                DTSBE444
02774         WRK-QTR-SELF-INS-TAX (7).                                 DTSBE444
02775      COMPUTE WRK-TOT-SELF-INS-INT =                               DTSBE444
02776         WRK-QTR-SELF-INS-INT (1) +                                DTSBE444
02777         WRK-QTR-SELF-INS-INT (2) +                                DTSBE444
02778         WRK-QTR-SELF-INS-INT (3) +                                DTSBE444
02779         WRK-QTR-SELF-INS-INT (4) +                                DTSBE444
02780         WRK-QTR-SELF-INS-INT (5) +                                DTSBE444
02781         WRK-QTR-SELF-INS-INT (6) +                                DTSBE444
02782         WRK-QTR-SELF-INS-INT (7).                                 DTSBE444
02783                                                                   DTSBE444
02784      MOVE 'GRAND TOTAL'         TO X442-DESCRIPTION.              DTSBE444
02785      MOVE WRK-TOT-SELF-INS-TAX  TO DISPLAY-TAX X442-TAX.          DTSBE444
02786      MOVE WRK-TOT-SELF-INS-PEN  TO DISPLAY-PEN X442-PENALTY.      DTSBE444
02787      MOVE WRK-TOT-SELF-INS-INT  TO DISPLAY-INT X442-INTEREST.     DTSBE444
02788      DISPLAY SPACE.                                               DTSBE444
02789      DISPLAY 'TOTAL'                                              DTSBE444
02790         '  TAX ' DISPLAY-TAX                                      DTSBE444
02791         '  PEN ' DISPLAY-PEN                                      DTSBE444
02792         '  INT ' DISPLAY-INT.                                     DTSBE444
02793                                                                   DTSBE444
02794 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02795 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02796                                                                   DTSBE444
02797      MOVE '3 YEARS OR MORE '    TO X442-DESCRIPTION.              DTSBE444
02798      DISPLAY SPACE.                                               DTSBE444
02799      DISPLAY '3 YEARS OR MORE '                                   DTSBE444
02800      MOVE WRK-3-YR-SELF-INS-TAX  TO DISPLAY-TAX X442-TAX          DTSBE444
02801                                     R442-3-YR-MORE-TAX-AMT.       DTSBE444
02802      MOVE WRK-3-YR-SELF-INS-PEN  TO DISPLAY-PEN X442-PENALTY      DTSBE444
02803                                     R442-3-YR-MORE-PEN-AMT.       DTSBE444
02804      MOVE WRK-3-YR-SELF-INS-INT  TO DISPLAY-INT X442-INTEREST     DTSBE444
02805                                     R442-3-YR-MORE-INT-AMT.       DTSBE444
02806      DISPLAY '     '                                              DTSBE444
02807         '  TAX ' DISPLAY-TAX                                      DTSBE444
02808         '  PEN ' DISPLAY-PEN                                      DTSBE444
02809         '  INT ' DISPLAY-INT.                                     DTSBE444
02810                                                                   DTSBE444
02811 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02812 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02813                                                                   DTSBE444
02814      DISPLAY SPACE.                                               DTSBE444
02815      DISPLAY 'SINCE 1999/4 '                                      DTSBE444
02816      MOVE WRK-19994-SELF-INS-TAX TO DISPLAY-TAX.                  DTSBE444
02817      MOVE WRK-19994-SELF-INS-PEN TO DISPLAY-PEN.                  DTSBE444
02818      MOVE WRK-19994-SELF-INS-INT TO DISPLAY-INT.                  DTSBE444
02819      DISPLAY '     '                                              DTSBE444
02820         '  TAX ' DISPLAY-TAX                                      DTSBE444
02821         '  PEN ' DISPLAY-PEN                                      DTSBE444
02822         '  INT ' DISPLAY-INT.                                     DTSBE444
02823                                                                   DTSBE444
02824      MOVE 'ACTIVE          '    TO X442-DESCRIPTION.              DTSBE444
02825      DISPLAY SPACE.                                               DTSBE444
02826      MOVE WRK-ACTIVE-SELF-INS-TAX TO DISPLAY-TAX X442-TAX         DTSBE444
02827                                      R442-ACTIVE-TAX-AMT.         DTSBE444
02828      MOVE WRK-ACTIVE-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY     DTSBE444
02829                                      R442-ACTIVE-PEN-AMT.         DTSBE444
02830      MOVE WRK-ACTIVE-SELF-INS-INT TO DISPLAY-INT X442-INTEREST    DTSBE444
02831                                      R442-ACTIVE-INT-AMT.         DTSBE444
02832      DISPLAY 'ACTIVE'                                             DTSBE444
02833         '  TAX ' DISPLAY-TAX                                      DTSBE444
02834         '  PEN ' DISPLAY-PEN                                      DTSBE444
02835         '  INT ' DISPLAY-INT.                                     DTSBE444
02836                                                                   DTSBE444
02837 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02838 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02839                                                                   DTSBE444
02840      MOVE 'INACTIVE        '    TO X442-DESCRIPTION.              DTSBE444
02841      MOVE WRK-INACT-SELF-INS-TAX TO DISPLAY-TAX X442-TAX          DTSBE444
02842                                     R442-INACTIVE-TAX-AMT.        DTSBE444
02843      MOVE WRK-INACT-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY      DTSBE444
02844                                     R442-INACTIVE-PEN-AMT.        DTSBE444
02845      MOVE WRK-INACT-SELF-INS-INT TO DISPLAY-INT X442-INTEREST     DTSBE444
02846                                     R442-INACTIVE-INT-AMT.        DTSBE444
02847      DISPLAY 'INACTIVE'                                           DTSBE444
02848         '  TAX ' DISPLAY-TAX                                      DTSBE444
02849         '  PEN ' DISPLAY-PEN                                      DTSBE444
02850         '  INT ' DISPLAY-INT.                                     DTSBE444
02851                                                                   DTSBE444
02852 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02853 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02854                                                                   DTSBE444
02855      MOVE 'INACTIVE 3 YEARS'    TO X442-DESCRIPTION.              DTSBE444
02856      MOVE WRK-INACT-3YR-SELF-INS-TAX TO DISPLAY-TAX X442-TAX      DTSBE444
02857                                         R442-INACT-3-YR-TAX-AMT.  DTSBE444
02858      MOVE WRK-INACT-3YR-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY  DTSBE444
02859                                         R442-INACT-3-YR-PEN-AMT.  DTSBE444
02860      MOVE WRK-INACT-3YR-SELF-INS-INT TO DISPLAY-INT X442-INTEREST DTSBE444
02861                                         R442-INACT-3-YR-INT-AMT.  DTSBE444
02862      DISPLAY 'INACTIVE 3 YEARS'                                   DTSBE444
02863         '  TAX ' DISPLAY-TAX                                      DTSBE444
02864         '  PEN ' DISPLAY-PEN                                      DTSBE444
02865         '  INT ' DISPLAY-INT.                                     DTSBE444
02866                                                                   DTSBE444
02867 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02868 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02869                                                                   DTSBE444
02870      MOVE 'TOT IN CHAPTER 7 '   TO X442-DESCRIPTION.              DTSBE444
02871      DISPLAY SPACE.                                               DTSBE444
02872      MOVE WRK-CHAPTER-7-SELF-INS-TAX TO DISPLAY-TAX X442-TAX      DTSBE444
02873                                         R442-TOT-CHPT-7-TAX-AMT.  DTSBE444
02874      MOVE WRK-CHAPTER-7-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY  DTSBE444
02875                                         R442-TOT-CHPT-7-PEN-AMT.  DTSBE444
02876      MOVE WRK-CHAPTER-7-SELF-INS-INT TO DISPLAY-INT X442-INTEREST DTSBE444
02877                                         R442-TOT-CHPT-7-INT-AMT.  DTSBE444
02878      DISPLAY 'TOTAL IN CHAPTER 7 '                                DTSBE444
02879         '  TAX ' DISPLAY-TAX                                      DTSBE444
02880         '  PEN ' DISPLAY-PEN                                      DTSBE444
02881         '  INT ' DISPLAY-INT.                                     DTSBE444
02882                                                                   DTSBE444
02883 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02884 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02885                                                                   DTSBE444
02886      MOVE 'TOT IN CHAPTER 11'   TO X442-DESCRIPTION.              DTSBE444
02887      DISPLAY SPACE.                                               DTSBE444
02888      MOVE WRK-CHAPTER-11-SELF-INS-TAX TO DISPLAY-TAX X442-TAX     DTSBE444
02889                                          R442-TOT-CHPT-11-TAX-AMT.DTSBE444
02890      MOVE WRK-CHAPTER-11-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444
02891                                          R442-TOT-CHPT-11-PEN-AMT.DTSBE444
02892      MOVE WRK-CHAPTER-11-SELF-INS-INT TO DISPLAY-INT X442-INTERESTDTSBE444
02893                                          R442-TOT-CHPT-11-INT-AMT.DTSBE444
02894      DISPLAY 'TOTAL IN CHAPTER 11 '                               DTSBE444
02895         '  TAX ' DISPLAY-TAX                                      DTSBE444
02896         '  PEN ' DISPLAY-PEN                                      DTSBE444
02897         '  INT ' DISPLAY-INT.                                     DTSBE444
02898                                                                   DTSBE444
02899 *    WRITE AGING-REC  FROM X442-REC.                              DTSBE444
02900 *    ADD +1          TO WRK-AGING-CNT.                            DTSBE444
02901                                                                   DTSBE444
02902      SET R442-SORT-CLASS-S-88 TO TRUE.                            DTSBE444
02903      PERFORM S946-WRITE-R442      THRU S946-EXIT.                 DTSBE444
02904                                                                   DTSBE444
02905      PERFORM T1100-TEXT-REPORT   THRU T1100-EXIT.                 DTSBE444
02906                                                                   DTSBE444
02907  T1000-EXIT.                                                      DTSBE444
02908      EXIT.                                                        DTSBE444
02909                                                                   DTSBE444
02910                                                                   DTSBE444
02911  T1100-TEXT-REPORT.                                               DTSBE444
02912      MOVE 'RATED'              TO WRK-RPT-EMP-CLASS.              DTSBE444
02913      WRITE AGING-REC           FROM WRK-RPT-HEADER1.              DTSBE444
02914      WRITE AGING-REC           FROM WRK-RPT-HEADER2.              DTSBE444
02915      WRITE AGING-REC           FROM WRK-RPT-HEADER3.              DTSBE444
02916      WRITE AGING-REC           FROM WRK-RPT-HEADER4.              DTSBE444
02917      MOVE SPACES               TO AGING-REC.                      DTSBE444
02918      WRITE AGING-REC.                                             DTSBE444
02919                                                                   DTSBE444
02920      PERFORM                                                      DTSBE444
02921        VARYING SUB FROM +1 BY +1                                  DTSBE444
02922        UNTIL SUB > +6                                             DTSBE444
02923          MOVE WRK-QTR-YRQ (SUB)    TO L004-QTR-5-9                DTSBE444
02924          PERFORM S004-FROM-5       THRU S004-EXIT                 DTSBE444
02925          IF L004-INVALID-QTR                                      DTSBE444
02926             MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG             DTSBE444
02927             PERFORM S999-ABEND THRU S999-EXIT                     DTSBE444
02928          ELSE                                                     DTSBE444
02929             MOVE L004-SLASH-5-QTR TO WRK-RPT-DESCRIPTION          DTSBE444
02930          END-IF                                                   DTSBE444
02931          MOVE WRK-QTR-RATED-TAX (SUB) TO WRK-RPT-TAX              DTSBE444
02932          MOVE WRK-QTR-RATED-PEN (SUB) TO WRK-RPT-PEN              DTSBE444
02933          MOVE WRK-QTR-RATED-INT (SUB) TO WRK-RPT-INT              DTSBE444
02934          WRITE AGING-REC            FROM WRK-RPT-DATA-LINE        DTSBE444
02935      END-PERFORM.                                                 DTSBE444
02936                                                                   DTSBE444
02937      MOVE WRK-QTR-YRQ (7)      TO L004-QTR-5-9                    DTSBE444
02938      PERFORM S004-FROM-5       THRU S004-EXIT                     DTSBE444
02939      IF L004-INVALID-QTR                                          DTSBE444
02940         MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG                 DTSBE444
02941         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE444
02942      ELSE                                                         DTSBE444
02943         STRING                                                    DTSBE444
02944            L004-SLASH-5-QTR ' AND PRIOR'                          DTSBE444
02945            DELIMITED BY SIZE                                      DTSBE444
02946            INTO WRK-RPT-DESCRIPTION                               DTSBE444
02947         END-STRING                                                DTSBE444
02948      END-IF                                                       DTSBE444
02949      MOVE WRK-QTR-RATED-TAX (7) TO WRK-RPT-TAX                    DTSBE444
02950      MOVE WRK-QTR-RATED-PEN (7) TO WRK-RPT-PEN                    DTSBE444
02951      MOVE WRK-QTR-RATED-INT (7) TO WRK-RPT-INT                    DTSBE444
02952      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
02953                                                                   DTSBE444
02954      MOVE SPACES                TO AGING-REC.                     DTSBE444
02955      WRITE AGING-REC.                                             DTSBE444
02956                                                                   DTSBE444
02957      MOVE 'GRAND TOTAL'         TO WRK-RPT-DESCRIPTION.           DTSBE444
02958      MOVE WRK-TOT-RATED-TAX     TO WRK-RPT-TAX.                   DTSBE444
02959      MOVE WRK-TOT-RATED-PEN     TO WRK-RPT-PEN.                   DTSBE444
02960      MOVE WRK-TOT-RATED-INT     TO WRK-RPT-INT.                   DTSBE444
02961      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
02962                                                                   DTSBE444
02963      MOVE SPACES                TO AGING-REC.                     DTSBE444
02964      WRITE AGING-REC.                                             DTSBE444
02965                                                                   DTSBE444
02966      MOVE '3 YEARS OR MORE'      TO WRK-RPT-DESCRIPTION.          DTSBE444
02967      MOVE WRK-3-YR-RATED-TAX     TO WRK-RPT-TAX.                  DTSBE444
02968      MOVE WRK-3-YR-RATED-PEN     TO WRK-RPT-PEN.                  DTSBE444
02969      MOVE WRK-3-YR-RATED-INT     TO WRK-RPT-INT.                  DTSBE444
02970      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
02971                                                                   DTSBE444
02972      MOVE 'ACTIVE         '      TO WRK-RPT-DESCRIPTION.          DTSBE444
02973      MOVE WRK-ACTIVE-RATED-TAX TO WRK-RPT-TAX.                    DTSBE444
02974      MOVE WRK-ACTIVE-RATED-PEN TO WRK-RPT-PEN.                    DTSBE444
02975      MOVE WRK-ACTIVE-RATED-INT TO WRK-RPT-INT.                    DTSBE444
02976      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
02977                                                                   DTSBE444
02978      MOVE 'INACTIVE       '      TO WRK-RPT-DESCRIPTION.          DTSBE444
02979      MOVE WRK-INACT-RATED-TAX TO WRK-RPT-TAX.                     DTSBE444
02980      MOVE WRK-INACT-RATED-PEN TO WRK-RPT-PEN.                     DTSBE444
02981      MOVE WRK-INACT-RATED-INT TO WRK-RPT-INT.                     DTSBE444
02982      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
02983                                                                   DTSBE444
02984      MOVE 'INACTIVE 3 YEAR'      TO WRK-RPT-DESCRIPTION.          DTSBE444
02985      MOVE WRK-INACT-3YR-RATED-TAX TO WRK-RPT-TAX.                 DTSBE444
02986      MOVE WRK-INACT-3YR-RATED-PEN TO WRK-RPT-PEN.                 DTSBE444
02987      MOVE WRK-INACT-3YR-RATED-INT TO WRK-RPT-INT.                 DTSBE444
02988      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
02989                                                                   DTSBE444
02990      MOVE 'TOT IN CHAPTER 7 '    TO WRK-RPT-DESCRIPTION.          DTSBE444
02991      MOVE WRK-CHAPTER-7-RATED-TAX TO WRK-RPT-TAX.                 DTSBE444
02992      MOVE WRK-CHAPTER-7-RATED-PEN TO WRK-RPT-PEN.                 DTSBE444
02993      MOVE WRK-CHAPTER-7-RATED-INT TO WRK-RPT-INT.                 DTSBE444
02994      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
02995                                                                   DTSBE444
02996      MOVE 'TOT IN CHAPTER 11 '    TO WRK-RPT-DESCRIPTION.         DTSBE444
02997      MOVE WRK-CHAPTER-11-RATED-TAX TO WRK-RPT-TAX.                DTSBE444
02998      MOVE WRK-CHAPTER-11-RATED-PEN TO WRK-RPT-PEN.                DTSBE444
02999      MOVE WRK-CHAPTER-11-RATED-INT TO WRK-RPT-INT.                DTSBE444
03000      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
03001                                                                   DTSBE444
03002      MOVE SPACES               TO AGING-REC.                      DTSBE444
03003      WRITE AGING-REC.                                             DTSBE444
03004      MOVE SPACES               TO AGING-REC.                      DTSBE444
03005      WRITE AGING-REC.                                             DTSBE444
03006      MOVE SPACES               TO AGING-REC.                      DTSBE444
03007      WRITE AGING-REC.                                             DTSBE444
03008                                                                   DTSBE444
03009      MOVE 'SELF-INSURED'       TO WRK-RPT-EMP-CLASS.              DTSBE444
03010      WRITE AGING-REC           FROM WRK-RPT-HEADER1.              DTSBE444
03011      WRITE AGING-REC           FROM WRK-RPT-HEADER2.              DTSBE444
03012      WRITE AGING-REC           FROM WRK-RPT-HEADER3.              DTSBE444
03013      MOVE SPACES               TO AGING-REC.                      DTSBE444
03014      WRITE AGING-REC.                                             DTSBE444
03015                                                                   DTSBE444
03016      PERFORM                                                      DTSBE444
03017        VARYING SUB FROM +1 BY +1                                  DTSBE444
03018        UNTIL SUB > +6                                             DTSBE444
03019          MOVE WRK-QTR-YRQ (SUB)    TO L004-QTR-5-9                DTSBE444
03020          PERFORM S004-FROM-5       THRU S004-EXIT                 DTSBE444
03021          IF L004-INVALID-QTR                                      DTSBE444
03022             MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG             DTSBE444
03023             PERFORM S999-ABEND THRU S999-EXIT                     DTSBE444
03024          ELSE                                                     DTSBE444
03025             MOVE L004-SLASH-5-QTR TO WRK-RPT-DESCRIPTION          DTSBE444
03026          END-IF                                                   DTSBE444
03027          MOVE WRK-QTR-SELF-INS-TAX (SUB) TO WRK-RPT-TAX           DTSBE444
03028          MOVE WRK-QTR-SELF-INS-PEN (SUB) TO WRK-RPT-PEN           DTSBE444
03029          MOVE WRK-QTR-SELF-INS-INT (SUB) TO WRK-RPT-INT           DTSBE444
03030          WRITE AGING-REC            FROM WRK-RPT-DATA-LINE        DTSBE444
03031      END-PERFORM.                                                 DTSBE444
03032                                                                   DTSBE444
03033      MOVE WRK-QTR-YRQ (7)      TO L004-QTR-5-9                    DTSBE444
03034      PERFORM S004-FROM-5       THRU S004-EXIT                     DTSBE444
03035      IF L004-INVALID-QTR                                          DTSBE444
03036         MOVE 'INVALID YEAR/QTR ' TO     ABEND-MSG                 DTSBE444
03037         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE444
03038      ELSE                                                         DTSBE444
03039         STRING                                                    DTSBE444
03040            L004-SLASH-5-QTR ' AND PRIOR'                          DTSBE444
03041            DELIMITED BY SIZE                                      DTSBE444
03042            INTO WRK-RPT-DESCRIPTION                               DTSBE444
03043         END-STRING                                                DTSBE444
03044      END-IF                                                       DTSBE444
03045      MOVE WRK-QTR-SELF-INS-TAX (7) TO WRK-RPT-TAX                 DTSBE444
03046      MOVE WRK-QTR-SELF-INS-PEN (7) TO WRK-RPT-PEN                 DTSBE444
03047      MOVE WRK-QTR-SELF-INS-INT (7) TO WRK-RPT-INT                 DTSBE444
03048      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
03049                                                                   DTSBE444
03050      MOVE SPACES               TO AGING-REC.                      DTSBE444
03051      WRITE AGING-REC.                                             DTSBE444
03052                                                                   DTSBE444
03053      MOVE 'GRAND TOTAL'         TO WRK-RPT-DESCRIPTION.           DTSBE444
03054      MOVE WRK-TOT-SELF-INS-TAX  TO WRK-RPT-TAX.                   DTSBE444
03055      MOVE WRK-TOT-SELF-INS-PEN  TO WRK-RPT-PEN.                   DTSBE444
03056      MOVE WRK-TOT-SELF-INS-INT  TO WRK-RPT-INT.                   DTSBE444
03057      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
03058                                                                   DTSBE444
03059      MOVE SPACES               TO AGING-REC.                      DTSBE444
03060      WRITE AGING-REC.                                             DTSBE444
03061                                                                   DTSBE444
03062      MOVE '3 YEARS OR MORE'      TO WRK-RPT-DESCRIPTION.          DTSBE444
03063      MOVE WRK-3-YR-SELF-INS-TAX  TO WRK-RPT-TAX.                  DTSBE444
03064      MOVE WRK-3-YR-SELF-INS-PEN  TO WRK-RPT-PEN.                  DTSBE444
03065      MOVE WRK-3-YR-SELF-INS-INT  TO WRK-RPT-INT.                  DTSBE444
03066      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
03067                                                                   DTSBE444
03068      MOVE 'ACTIVE         '      TO WRK-RPT-DESCRIPTION.          DTSBE444
03069      MOVE WRK-ACTIVE-SELF-INS-TAX TO WRK-RPT-TAX.                 DTSBE444
03070      MOVE WRK-ACTIVE-SELF-INS-PEN TO WRK-RPT-PEN.                 DTSBE444
03071      MOVE WRK-ACTIVE-SELF-INS-INT TO WRK-RPT-INT.                 DTSBE444
03072      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
03073                                                                   DTSBE444
03074      MOVE 'INACTIVE       '      TO WRK-RPT-DESCRIPTION.          DTSBE444
03075      MOVE WRK-INACT-SELF-INS-TAX TO WRK-RPT-TAX.                  DTSBE444
03076      MOVE WRK-INACT-SELF-INS-PEN TO WRK-RPT-PEN.                  DTSBE444
03077      MOVE WRK-INACT-SELF-INS-INT TO WRK-RPT-INT.                  DTSBE444
03078      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
03079                                                                   DTSBE444
03080      MOVE 'INACTIVE 3 YEAR'      TO WRK-RPT-DESCRIPTION.          DTSBE444
03081      MOVE WRK-INACT-3YR-SELF-INS-TAX TO WRK-RPT-TAX.              DTSBE444
03082      MOVE WRK-INACT-3YR-SELF-INS-PEN TO WRK-RPT-PEN.              DTSBE444
03083      MOVE WRK-INACT-3YR-SELF-INS-INT TO WRK-RPT-INT.              DTSBE444
03084      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
03085                                                                   DTSBE444
03086      MOVE 'TOT IN CHAPTER 7 '    TO WRK-RPT-DESCRIPTION.          DTSBE444
03087      MOVE WRK-CHAPTER-7-SELF-INS-TAX TO WRK-RPT-TAX.              DTSBE444
03088      MOVE WRK-CHAPTER-7-SELF-INS-PEN TO WRK-RPT-PEN.              DTSBE444
03089      MOVE WRK-CHAPTER-7-SELF-INS-INT TO WRK-RPT-INT.              DTSBE444
03090      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE            DTSBE444
03091                                                                   DTSBE444
03092      MOVE 'TOT IN CHAPTER 11 '    TO WRK-RPT-DESCRIPTION.         DTSBE444
03093      MOVE WRK-CHAPTER-11-SELF-INS-TAX TO WRK-RPT-TAX.             DTSBE444
03094      MOVE WRK-CHAPTER-11-SELF-INS-PEN TO WRK-RPT-PEN.             DTSBE444
03095      MOVE WRK-CHAPTER-11-SELF-INS-INT TO WRK-RPT-INT.             DTSBE444
03096      WRITE AGING-REC            FROM WRK-RPT-DATA-LINE.           DTSBE444
03097                                                                   DTSBE444
03098                                                                   DTSBE444
03099  T1100-EXIT.                                                      DTSBE444
03100      EXIT.                                                        DTSBE444
03101  S101-PER-MONTH-NO.                                                  CL*49
03102       SET L101-PER-MONTH-NO-88 TO TRUE.                              CL*44
03103       GO TO S101-INT-PEN-COMP.                                       CL*44
03104                                                                      CL*44
03105  S101-PER-MONTH-YES.                                                 CL*49
03106       SET L101-PER-MONTH-YES-88 TO TRUE.                             CL*44
03107       GO TO S101-INT-PEN-COMP.                                       CL*44
03108                                                                      CL*44
03109  S101-INT-PEN-COMP.                                                  CL*49
03110      CALL 'DTSBU101' USING L101-LINK-AREA.                           CL*44
03111  S101-EXIT.                                                          CL*49
03112       EXIT.                                                          CL*44
03113                                                                   DTSBE444
03114  S001-FROM-FED-8.                                                 DTSBE444
03115      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE444
03116      GO TO S001-DATE.                                             DTSBE444
03117                                                                   DTSBE444
03118  S001-FROM-ABS-DAY.                                               DTSBE444
03119      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE444
03120      GO TO S001-DATE.                                             DTSBE444
03121                                                                   DTSBE444
03122  S001-FROM-CAL-6.                                                 DTSBE444
03123      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE444
03124      GO TO S001-DATE.                                             DTSBE444
03125                                                                   DTSBE444
03126  S001-DATE.                                                       DTSBE444
03127      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE444
03128  S001-EXIT.                                                       DTSBE444
03129      EXIT.                                                        DTSBE444
03130      SKIP3                                                        DTSBE444
03131  S004-FROM-5.                                                     DTSBE444
03132      SET L004-FROM-5 TO TRUE.                                     DTSBE444
03133      GO TO S004-QTR.                                              DTSBE444
03134                                                                   DTSBE444
03135  S004-FROM-ABS.                                                   DTSBE444
03136      SET L004-FROM-ABS TO TRUE.                                   DTSBE444
03137      GO TO S004-QTR.                                              DTSBE444
03138                                                                   DTSBE444
03139  S004-FROM-3.                                                     DTSBE444
03140      SET L004-FROM-3 TO TRUE.                                     DTSBE444
03141      GO TO S004-QTR.                                              DTSBE444
03142                                                                   DTSBE444
03143  S004-FROM-DATE.                                                  DTSBE444
03144      SET L004-FROM-DATE TO TRUE.                                  DTSBE444
03145      GO TO S004-QTR.                                              DTSBE444
03146                                                                   DTSBE444
03147  S004-QTR.                                                        DTSBE444
03148                                                                   DTSBE444
03149      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBE444
03150                                                                   DTSBE444
03151  S004-EXIT.                                                       DTSBE444
03152      EXIT.                                                        DTSBE444
03153      SKIP3                                                        DTSBE444
03154  S005-FROM-ABSTIME.                                               DTSBE444
03155      SET L005-FROM-ABSTIME TO TRUE.                               DTSBE444
03156      GO TO S005-ABSTIME.                                          DTSBE444
03157                                                                   DTSBE444
03158  S005-FROM-DATE-TIME.                                             DTSBE444
03159      SET L005-FROM-DATE-TIME TO TRUE.                             DTSBE444
03160      GO TO S005-ABSTIME.                                          DTSBE444
03161                                                                   DTSBE444
03162  S005-ABSTIME.                                                    DTSBE444
03163      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBE444
03164  S005-EXIT.                                                       DTSBE444
03165      EXIT.                                                        DTSBE444
03166      SKIP3                                                        DTSBE444
03167  S910-READ.                                                       DTSBE444
03168      SET L910-READ-88 TO TRUE.                                    DTSBE444
03169      GO TO S910-MSTR-IO.                                          DTSBE444
03170                                                                   DTSBE444
03171  S910-START-BROWSE.                                               DTSBE444
03172      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE444
03173      GO TO S910-MSTR-IO.                                          DTSBE444
03174                                                                   DTSBE444
03175  S910-READ-NEXT.                                                  DTSBE444
03176      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE444
03177      GO TO S910-MSTR-IO.                                          DTSBE444
03178                                                                   DTSBE444
03179 *S910-COUNT.                                                      DTSBE444
03180 *****SET L910-COUNT-88 TO TRUE.                                   DTSBE444
03181 *****GO TO S910-MSTR-IO.                                          DTSBE444
03182                                                                   DTSBE444
03183                                                                   DTSBE444
03184  S910-MSTR-IO.                                                    DTSBE444
03185      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE444
03186                            MSKL-REC.                              DTSBE444
03187  S910-EXIT.                                                       DTSBE444
03188      EXIT.                                                        DTSBE444
03189      SKIP3                                                        DTSBE444
03190  S946-WRITE-R442.                                                 DTSBE444
03191      CALL 'DTSBU946' USING R442-REC.                              DTSBE444
03192      GO TO S946-EXIT.                                             DTSBE444
03193                                                                   DTSBE444
03194  S946-EXIT.                                                       DTSBE444
03195      EXIT.                                                        DTSBE444
03196      SKIP3                                                        DTSBE444
03197  S999-ABEND.                                                      DTSBE444
03198      DISPLAY '*** DTSBE442 ABENDING.  '                           DTSBE444
03199              ABEND-MSG.                                           DTSBE444
03200                                                                   DTSBE444
03201      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE444
03202  S999-EXIT.                                                       DTSBE444
03203      EXIT.                                                        DTSBE444
