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