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