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