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