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