00001  IDENTIFICATION DIVISION.                                         10/31/19
00002  PROGRAM-ID.             DTSBX424.                                DTSBX424
00003  AUTHOR.                 NGC.                                        LV064
00004  DATE-WRITTEN.           APRIL 2005.                              DTSBX424
00005  DATE-COMPILED.                                                   DTSBX424
00006      SKIP3                                                        DTSBX424
00007 *****                                                             DTSBX424
00008 *                                                                 DTSBX424
00009 *    FUNCTION:  WEB IMPORT: PROFILE DATA.                         DTSBX424
00010 *               PROCESS ADDRESSES, NAMES (EXCEPT ENTITY AND FIRST DTSBX424
00011 *               TRADE NAME), OWNERS/OFFICERS/PARTNERS.            DTSBX424
00012 *                                                                 DTSBX424
00013 *    MODIFICATION HISTORY:                                        DTSBX424
00014 *                                                                 DTSBX424
00015 *    04-05-2005 INITIAL DEVELOPMENT                               DTSBX424
00016 *               REFERENCE RFP: WEB REGISTRATION                   DTSBX424
00017 *    02-20-2008 ADDED CALL TO DTSBU072 TO VERIFY ADDRESS          DTSBX424
00018 *               REFERENCE RFP: WEB REGISTRATION                   DTSBX424
00019 *                                                                 DTSBX424
00020 *    09-22-2009 ADDED EDIT IN P1510 TO CATCH SIMULTANEOUS         DTSBX424
00021 *               CHANGES ON WEB AND MAINFRAME.                     DTSBX424
00022 *               REFERENCE RFP: WEB REGISTRATION                   DTSBX424
00023 *                                                                 DTSBX424
00024 *                                                                    CL*23
00025 *    11-22-2014 DUE TO THE COMMAS IN ADDESS FIELDS, X110 AND 120     CL*23
00026 *               DOES NOT CALL BX205 INSTED IT USES THE IMPORT REC    CL*23
00027 *               FROM ESSP. ESSP PASSES A FIXED LENGTH RECORD         CL*23
00028 *               MODIFIED X120 FOR TO USE FIELDS FROM W120            CL*24
00029 *               REFERENCE RFP: WEB REGISTRATION               ZL1    CL*23
00030 *                                                                    CL*23
00031 *    11-24-2014 MODIFIED PROGRAM TO WWITE EMPLOYER ADDRES AND OPO    CL*26
00032 *               INFORMATION ON A SEPARATE BTC FILE.                  CL*26
00033 *               REFERENCE RFP: WEB REGISTRATION               ZL1    CL*26
00034 *                                                                    CL*26
00035 *                                                                    CL*26
00036 *****                                                             DTSBX424
00037      SKIP3                                                        DTSBX424
00038  ENVIRONMENT DIVISION.                                            DTSBX424
00039  CONFIGURATION SECTION.                                              CL*42
00040  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                                  CL*42
00041       SKIP2                                                          CL*42
00042      SKIP2                                                        DTSBX424
00043  INPUT-OUTPUT SECTION.                                            DTSBX424
00044                                                                   DTSBX424
00045  FILE-CONTROL.                                                    DTSBX424
00046                                                                      CL*25
00047      SELECT TEMP-BTC-FILE    ASSIGN TO X424BTC                       CL*25
00048         FILE STATUS IS TEMP-BTC-STATUS.                              CL*25
00049      SELECT REPT-PAID-FILE    ASSIGN TO X424RPT1                     CL*35
00050         FILE STATUS IS REPT-STATUS.                                  CL*35
00051                                                                      CL*35
00052      SELECT REPT-PEND-FILE    ASSIGN TO X424RPT2                     CL*35
00053         FILE STATUS IS REPT-STATUS.                                  CL*35
00054                                                                      CL*35
00055                                                                      CL*25
00056                                                                   DTSBX424
00057  DATA DIVISION.                                                   DTSBX424
00058                                                                      CL*25
00059  FILE SECTION.                                                       CL*25
00060  FD  TEMP-BTC-FILE                                                   CL*25
00061      RECORDING MODE IS V                                             CL*25
00062      BLOCK CONTAINS 0 RECORDS.                                       CL*25
00063                                                                      CL*25
00064  01  TEMP-BTC-REC.                                                   CL*25
00065  ++INCLUDE DTSIRVAR                                                  CL*25
00066                                                                      CL*25
00067  01  TSKL-REC.                                                       CL*25
00068  ++INCLUDE DTSITSKL                                                  CL*25
00069  FD  REPT-PAID-FILE                                                  CL*35
00070      RECORDING MODE IS F                                             CL*35
00071      BLOCK CONTAINS 0 RECORDS                                        CL*35
00072      LABEL RECORDS ARE OMITTED.                                      CL*35
00073                                                                      CL*35
00074  01  REPT-PAID-REC           PIC X(200).                             CL*41
00075                                                                      CL*35
00076                                                                      CL*35
00077  FD  REPT-PEND-FILE                                                  CL*35
00078      RECORDING MODE IS F                                             CL*35
00079      BLOCK CONTAINS 0 RECORDS                                        CL*35
00080      LABEL RECORDS ARE OMITTED.                                      CL*35
00081                                                                      CL*35
00082  01  REPT-PEND-REC           PIC X(133).                             CL*60
00083                                                                      CL*35
00084                                                                      CL*35
00085                                                                   DTSBX424
00086  WORKING-STORAGE SECTION.                                         DTSBX424
000865 77  PAN-VALET PICTURE X(24) VALUE '064DTSBX424  10/31/19'.       DTSBX424
00087  77  PAN-VALET PICTURE X(24) VALUE '011DTSBX424  10/07/14'.       DTSBX424
00088  77  PAN-VALET PICTURE X(24) VALUE '011DTSBX424  09/24/14'.       DTSBX424
00089      SKIP3                                                        DTSBX424
00090  01  WRK-AREA.                                                    DTSBX424
00091      05  W-ABEND-CD                  PIC S9(04)  COMP  VALUE 424. DTSBX424
00092      05  W-MOD-NAME                  PIC  X(08)  VALUE 'DTSBX424'.DTSBX424
00093      05  W-RUN-DATE              PIC  9(07) VALUE 0.                 CL*49
00094      05  Z-RUN-DATE REDEFINES W-RUN-DATE.                            CL*49
00095          10  Z-CC              PIC  9(01).                           CL*49
00096          10  Z-YY              PIC  9(02).                           CL*49
00097          10  Z-MM              PIC  9(02).                           CL*49
00098          10  Z-DD              PIC  9(02).                           CL*49
00099                                                                   DTSBX424
00100      05  W-EMP-NO                PIC S9(07)  COMP-3 VALUE +0.     DTSBX424
00101                                                                      CL*25
00102      05  TEMP-BTC-STATUS         PIC  X(02).                         CL*25
00103          88 TEMP-BTC-STATUS-OK-88     VALUE '00'.                    CL*25
00104          88 TEMP-BTC-STATUS-EOF-88    VALUE '10'.                    CL*25
00105                                                                      CL*25
00106      05  REPT-STATUS         PIC  X(02).                             CL*38
00107          88 REPT-STATUS-OK-88     VALUE '00'.                        CL*38
00108          88 REPT-STATUS-EOF-88    VALUE '10'.                        CL*38
00109                                                                      CL*38
00110                                                                   DTSBX424
00111      05  W-NEW-X110-EMP              PIC  9(01) VALUE 0.             CL**5
00112                                                                      CL**5
00113      05  W-ERROR-IND                 PIC  X(01) VALUE 'N'.           CL**4
00114          88 W-ERROR-YES-88            VALUE 'Y'.                  DTSBX424
00115          88 W-ERROR-NO-88             VALUE 'N'.                  DTSBX424
00116                                                                   DTSBX424
00117      05  W-FATAL-ERROR-IND           PIC  X(01) VALUE 'N'.        DTSBX424
00118          88 W-FATAL-ERROR-YES-88      VALUE 'Y'.                  DTSBX424
00119          88 W-FATAL-ERROR-NO-88       VALUE 'N'.                  DTSBX424
00120                                                                   DTSBX424
00121      05  W-MNTE-SUBJECT          PIC  X(40).                      DTSBX424
00122          88  W-MNTE-NOT-LIAB-88   VALUE                           DTSBX424
00123          'REASON FOR NOT-LIABLE DETERMINATION     '.              DTSBX424
00124          88  W-MNTE-KEY-WORD-88   VALUE                           DTSBX424
00125          'FR-500 INDUSTRY DESCRIPTION - KEY WORD  '.              DTSBX424
00126          88  W-MNTE-DATA-ENTRY-88 VALUE                           DTSBX424
00127          'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'.              DTSBX424
00128          88  W-MNTE-RELATIONSHIP-88 VALUE                         DTSBX424
00129          'WEB REGISTRATION RELATED EMPLOYER       '.              DTSBX424
00130                                                                   DTSBX424
00131      05  W-MNTE-COMPLETE-IND         PIC  X(01) VALUE 'N'.        DTSBX424
00132          88 W-MNTE-COMPLETE-YES-88    VALUE 'Y'.                  DTSBX424
00133          88 W-MNTE-COMPLETE-NO-88     VALUE 'N'.                  DTSBX424
00134                                                                   DTSBX424
00135      05  W-NAME-AREA                 PIC  X(40).                  DTSBX424
00136      05  TSUB1                   PIC S9(04) COMP.                 DTSBX424
00137      05  TSUB2                   PIC S9(04) COMP.                 DTSBX424
00138      05  W-LAST-SPACE            PIC S9(04) COMP.                 DTSBX424
00139                                                                   DTSBX424
00140      05  W-MNTE-LINE             PIC  X(72).                      DTSBX424
00141                                                                   DTSBX424
00142      05  W-SLASH-DATE            PIC  X(10).                      DTSBX424
00143      05  FILLER REDEFINES W-SLASH-DATE.                           DTSBX424
00144          10  W-SLASH-DT-MM       PIC  X(02).                      DTSBX424
00145          10  FILLER              PIC  X(01).                      DTSBX424
00146          10  W-SLASH-DT-DD       PIC  X(02).                      DTSBX424
00147          10  FILLER              PIC  X(01).                      DTSBX424
00148          10  W-SLASH-DT-CCYY     PIC  X(04).                      DTSBX424
00149                                                                   DTSBX424
00150      05  W-SLASH-QTR             PIC  X(06).                      DTSBX424
00151      05  FILLER REDEFINES W-SLASH-QTR.                            DTSBX424
00152          10  W-SLASH-QTR-CCYY    PIC  X(04).                      DTSBX424
00153          10  FILLER              PIC  X(01).                      DTSBX424
00154          10  W-SLASH-QTR-Q       PIC  X(01).                      DTSBX424
00155                                                                   DTSBX424
00156      05  WRK-PHONE                   PIC  X(15)  VALUE SPACES.    DTSBX424
00157      05  FILLER REDEFINES WRK-PHONE.                              DTSBX424
00158          10  WRK-AREA-CD             PIC  X(03).                  DTSBX424
00159          10  WRK-PREFIX              PIC  X(03).                  DTSBX424
00160          10  WRK-SUFFIX              PIC  X(04).                  DTSBX424
00161          10  WRK-EXT                 PIC  X(05).                  DTSBX424
00162      05  WRK-EXT-HYPHEN              PIC  X(01)  VALUE SPACES.    DTSBX424
00163      05  WRK-PHONE-TEXT1             PIC  X(72)  VALUE SPACES.    DTSBX424
00164      05  WRK-PHONE-TEXT2             PIC  X(72)  VALUE SPACES.    DTSBX424
00165                                                                   DTSBX424
00166 *  NAME                                                           DTSBX424
00167      05  W-X106-CNT              PIC S9(07)  COMP-3 VALUE +0.     DTSBX424
00168 *  ADDRESS                                                        DTSBX424
00169      05  W-X110-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*19
00170      05  W-X110-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*19
00171 *  OPO                                                            DTSBX424
00172      05  W-X120-RED-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*19
00173      05  W-X120-ERR-CNT          PIC S9(07)  COMP-3 VALUE +0.        CL*19
00174                                                                   DTSBX424
00175      05  W-T002-NAME-CNT         PIC S9(07)  COMP-3 VALUE +0.     DTSBX424
00176      05  W-T002-ADDR-CNT         PIC S9(07)  COMP-3 VALUE +0.     DTSBX424
00177      05  W-T002-OPO-CNT          PIC S9(07)  COMP-3 VALUE +0.     DTSBX424
00178      05  W-T002-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX424
00179                                                                   DTSBX424
00180      05  W-T003-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.     DTSBX424
00181                                                                   DTSBX424
00182                                                                   DTSBX424
00183      05  W-X106-LENGTH           PIC S9(04)  COMP.                DTSBX424
00184      05  W-X110-LENGTH           PIC S9(04)  COMP.                DTSBX424
00185      05  W-X120-LENGTH           PIC S9(04)  COMP.                   CL*28
00186      05  VAR-CHAR-CNT            PIC S9(04)  COMP.                   CL*27
00187                                                                   DTSBX424
00188      05  W-AMT-DISP1             PIC ----------9.99.              DTSBX424
00189      05  W-AMT-DISP2             PIC ----------9.99.              DTSBX424
00190                                                                   DTSBX424
00191      05  WRK-R140-CNT            PIC S9(07) COMP-3 VALUE +0.      DTSBX424
00192      05  DISPLAY-CNT             PIC  Z(06)9.                     DTSBX424
00193      05  WRK-MPRF-EXISTS-IND     PIC  X(01).                      DTSBX424
00194          88  WRK-MPRF-EXISTS-YES-88  VALUE 'Y'.                   DTSBX424
00195          88  WRK-MPRF-EXISTS-NO-88   VALUE 'N'.                   DTSBX424
00196                                                                   DTSBX424
00197  01  MESSAGE-AREA.                                                DTSBX424
00198      05  MSG1-TYPE.                                               DTSBX424
00199          10  FILLER                            PIC X(04)          DTSBX424
00200              VALUE 'RATE'.                                        DTSBX424
00201      05  MSG1-MESSAGE.                                            DTSBX424
00202          10  FILLER                            PIC X(30)          DTSBX424
00203              VALUE 'INVALID RATE: NO DECIMAL POINT'.              DTSBX424
00204  01  HEADER-1.                                                       CL*35
00205      05  FILLER                   PIC X(01) VALUE SPACES.            CL*35
00206      05  FILLER                   PIC X(49) VALUE 'X424R'.           CL*35
00207      05  FILLER                   PIC X(60) VALUE                    CL*35
00208          'DISTRICT OF COLUMBIA'.                                     CL*35
00209      05  FILLER                   PIC X(06) VALUE 'DATE:'.           CL*35
00210      05  HDR1-DATE.                                                  CL*35
00211          10  W-MM                 PIC  X(02).                        CL*35
00212          10  FILLER               PIC  X(01) VALUE '/'.              CL*35
00213          10  W-DD                 PIC  X(02).                        CL*35
00214          10  FILLER               PIC  X(01) VALUE '/'.              CL*35
00215          10  W-YY                 PIC  X(02).                        CL*35
00216  01  HEADER-2.                                                       CL*35
00217      05  FILLER                   PIC X(54) VALUE SPACES.            CL*35
00218      05  FILLER                   PIC X(56) VALUE                    CL*35
00219          'TAX DIVISION'.                                             CL*35
00220 *    05  FILLER                   PIC X(06) VALUE 'TIME:'.           CL*35
00221 *    05  HDR2-LRCM-SYS-TIME       PIC X(08).                         CL*35
00222  01  HEADER-3.                                                       CL*35
00223      05  FILLER                   PIC X(01) VALUE SPACES.            CL*35
00224      05  FILLER                   PIC X(38) VALUE                    CL*35
00225          '          ADDR SKIP        '.                              CL*48
00226      05  HDR3-LITERAL             PIC X(43) VALUE                    CL*35
00227          '  ESSP DAILY REGISTRATIONS ADDRESSES      '.               CL*35
00228      05  FILLER                   PIC X(28) VALUE SPACES.            CL*35
00229 *    05  FILLER                   PIC X(06) VALUE 'PAGE:'.           CL*35
00230 *    05  HDR3-PAGE                PIC ZZ,ZZ9.                        CL*35
00231  01  HEADER-43.                                                      CL*43
00232      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*43
00233      05  FILLER                   PIC X(52)  VALUE                   CL*43
00234          'EMP NO   TYPE  QAS  ATTN                       LINE1'.     CL*44
00235      05  FILLER                   PIC X(15)  VALUE SPACES.           CL*58
00236      05  FILLER                   PIC X(27)  VALUE                   CL*43
00237          '                      LINE2'.                              CL*43
00238      05  FILLER                   PIC X(27)  VALUE SPACES.           CL*59
00239      05  FILLER                   PIC X(44)  VALUE                   CL*43
00240             'CITY             ST  ZIP          EMAIL '.              CL*43
00241      05  HDR5-NAME                PIC X(31)  VALUE                   CL*43
00242               '                            '.                        CL*43
00243                                                                      CL*43
00244                                                                      CL*43
00245  01  BLANK-LINE                     PIC X(200) VALUE SPACES.         CL*43
00246  01  DETAIL-LINE-1.                                                  CL*35
00247      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00248      15  X424-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL*35
00249      15  FILLER                     PIC  X(03) VALUE SPACES.         CL*43
00250      15  X424-TYPE                  PIC  X(02).                      CL*43
00251      15  FILLER                     PIC  X(04) VALUE SPACES.         CL*43
00252      15  X424-QAS                   PIC  X(01).                      CL*38
00253      15  FILLER                     PIC  X(03) VALUE SPACES.         CL*43
00254      15  X424-ATTN                  PIC  X(20).                      CL*35
00255      15  FILLER                     PIC  X(07) VALUE SPACES.         CL*43
00256      15  X424-LINE1                 PIC  X(40).                      CL*54
00257      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00258      15  X424-LINE2                 PIC  X(30).                      CL*54
00259      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00260      15  X424-CITY                  PIC  X(15).                      CL*35
00261      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00262      15  X424-STATE                 PIC  X(02).                      CL*35
00263      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00264      15  X424-ZIP                   PIC  X(10).                      CL*35
00265      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00266      15  X424-EMAIL                 PIC  X(30).                      CL*36
00267      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*36
00268      15  X424-MESSAGE               PIC  X(01).                      CL*54
00269                                                                      CL*35
00270  01  DETAIL-PEND-1.                                                  CL*35
00271      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00272      15  P424-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL*35
00273      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00274      15  P424-TYPE                  PIC  X(02).                      CL*44
00275      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00276      15  P424-ATTN                  PIC  X(20).                      CL*35
00277      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00278      15  P424-LINE1                 PIC  X(25).                      CL*35
00279      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00280      15  P424-LINE2                 PIC  X(25).                      CL*35
00281      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00282      15  P424-CITY                  PIC  X(15).                      CL*35
00283      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00284      15  P424-STATE                 PIC  X(02).                      CL*35
00285      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00286      15  P424-ZIP                   PIC  X(10).                      CL*35
00287      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*35
00288      15  P424-MESSAGE               PIC  X(10).                      CL*44
00289                                                                      CL*35
00290  01  FOOTING-LINE-51.                                                CL*35
00291      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*35
00292      05  WS-X110-PEN-CNT           PIC  ZZ,ZZ9.                      CL*35
00293      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*35
00294      05  FILLER                   PIC  X(40) VALUE                   CL*35
00295                       '# OF ADDRESSES RECEIVED FROM ESSP    '.       CL*35
00296      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*35
00297                                                                      CL*35
00298  01  FOOTING-LINE-6.                                                 CL*35
00299      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*35
00300      05  WS-X102-RED-CNT           PIC  ZZ,ZZ9.                      CL*35
00301      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*35
00302      05  FILLER                   PIC  X(45) VALUE                   CL*35
00303                       '# OF ADDRESSES     DUTAS PASSED    '.         CL*35
00304      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*35
00305  01  FOOTING-LINE-7.                                                 CL*35
00306      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*35
00307      05  WS-X102-ERR-CNT           PIC  ZZ,ZZ9.                      CL*35
00308      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*35
00309      05  FILLER                   PIC  X(40) VALUE                   CL*35
00310          '# OF ADDRESSES DUTAS FAILED    '.                          CL*35
00311      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*35
00312                                                                      CL*35
00313  01  T002-REC.                                                    DTSBX424
00314  ++INCLUDE DTSIT002                                               DTSBX424
00315                                                                   DTSBX424
00316 *  ADDRESS                                                        DTSBX424
00317  01  Y110-REC.                                                    DTSBX424
00318  ++INCLUDE DTSIY110                                               DTSBX424
00319                                                                   DTSBX424
00320 *  OPO                                                            DTSBX424
00321  01  Y120-REC.                                                    DTSBX424
00322  ++INCLUDE DTSIY120                                               DTSBX424
00323                                                                   DTSBX424
00324  01  T003-REC.                                                    DTSBX424
00325  ++INCLUDE DTSIT003                                               DTSBX424
00326                                                                   DTSBX424
00327 *  NAME                                                           DTSBX424
00328  01  X106-REC.                                                    DTSBX424
00329  ++INCLUDE DTSIX106                                               DTSBX424
00330                                                                   DTSBX424
00331  01  Y106-REC.                                                    DTSBX424
00332  ++INCLUDE DTSIY106                                               DTSBX424
00333                                                                   DTSBX424
00334 *  ADDRESS                                                        DTSBX424
00335  01  X110-REC.                                                    DTSBX424
00336  ++INCLUDE DTSIX110                                               DTSBX424
00337                                                                   DTSBX424
00338 *  OPO                                                            DTSBX424
00339  01  X120-REC.                                                    DTSBX424
00340  ++INCLUDE DTSIX120                                               DTSBX424
00341                                                                   DTSBX424
00342 *  ERRORS                                                         DTSBX424
00343 *01  X907-REC.                                                    DTSBX424
00344 ***INCLUDE DTSIX907                                               DTSBX424
00345                                                                   DTSBX424
00346  01  L001-LINK-AREA.                                              DTSBX424
00347  ++INCLUDE DTSIL001                                               DTSBX424
00348                                                                   DTSBX424
00349  01  L003-LINK-AREA.                                              DTSBX424
00350  ++INCLUDE DTSIL003                                               DTSBX424
00351                                                                   DTSBX424
00352  01  L004-LINK-AREA.                                              DTSBX424
00353  ++INCLUDE DTSIL004                                               DTSBX424
00354                                                                      CL*52
00355  01  L009-LINK-AREA.                                                 CL*52
00356  ++INCLUDE DTSIL009                                                  CL*52
00357                                                                      CL*52
00358  01  L072-LINK-AREA.                                              DTSBX424
00359  ++INCLUDE DTSIL072                                               DTSBX424
00360                                                                   DTSBX424
00361  01  L516-LINK-AREA.                                              DTSBX424
00362  ++INCLUDE DTSIL516                                               DTSBX424
00363                                                                   DTSBX424
00364  01  L910-LINK-AREA.                                              DTSBX424
00365  ++INCLUDE DTSIL910                                               DTSBX424
00366  01  MSKL-REC.                                                    DTSBX424
00367  ++INCLUDE DTSIMSKL                                               DTSBX424
00368                                                                   DTSBX424
00369  01  MHDR-REC.                                                    DTSBX424
00370  ++INCLUDE DTSIMHDR                                               DTSBX424
00371                                                                   DTSBX424
00372  01  MPRF-REC.                                                    DTSBX424
00373  ++INCLUDE DTSIMPRF                                               DTSBX424
00374                                                                   DTSBX424
00375  01  MSOL-REC.                                                    DTSBX424
00376  ++INCLUDE DTSIMSOL                                               DTSBX424
00377                                                                   DTSBX424
00378  01  MQTR-REC.                                                    DTSBX424
00379  ++INCLUDE DTSIMQTR                                               DTSBX424
00380                                                                   DTSBX424
00381  01  MOPO-REC.                                                    DTSBX424
00382  ++INCLUDE DTSIMOPO                                               DTSBX424
00383                                                                   DTSBX424
00384  01  MTAD-REC.                                                    DTSBX424
00385  ++INCLUDE DTSIMTAD                                               DTSBX424
00386                                                                   DTSBX424
00387  01  MNTE-REC.                                                    DTSBX424
00388  ++INCLUDE DTSIMNTE                                               DTSBX424
00389                                                                   DTSBX424
00390  01  L921-LINK-AREA.                                              DTSBX424
00391  ++INCLUDE DTSIL921                                               DTSBX424
00392      SKIP3                                                        DTSBX424
00393  01  ISKL-REC.                                                    DTSBX424
00394  ++INCLUDE DTSIISKL                                               DTSBX424
00395      SKIP3                                                        DTSBX424
00396  01  IEIN-REC.                                                    DTSBX424
00397  ++INCLUDE DTSIIEIN                                               DTSBX424
00398                                                                   DTSBX424
00399  01  L927-LINK-AREA.                                              DTSBX424
00400  ++INCLUDE DTSIL927                                               DTSBX424
00401                                                                   DTSBX424
00402 *01  TSKL-REC.                                                       CL*27
00403 *++INCLUDE DTSITSKL                                                  CL*27
00404                                                                   DTSBX424
00405  01  L931-LINK-AREA.                                              DTSBX424
00406  ++INCLUDE DTSIL931                                               DTSBX424
00407                                                                   DTSBX424
00408  01  FSKL-REC.                                                    DTSBX424
00409  ++INCLUDE DTSIFSKL                                               DTSBX424
00410                                                                   DTSBX424
00411  01  R140-REC.                                                    DTSBX424
00412  ++INCLUDE DTSIR140                                               DTSBX424
00413                                                                   DTSBX424
00414  LINKAGE SECTION.                                                 DTSBX424
00415                                                                   DTSBX424
00416  01  LX42-LINK-AREA.                                              DTSBX424
00417  ++INCLUDE DTSILX42                                                  CL*21
00418                                                                   DTSBX424
00419  PROCEDURE DIVISION USING LX42-LINK-AREA.                         DTSBX424
00420                                                                   DTSBX424
00421  DTSBX424-MAIN.                                                   DTSBX424
00422      MOVE LX42-ERROR-IND                 TO W-ERROR-IND.          DTSBX424
00423      MOVE LX42-CURR-RUN-DATE TO W-RUN-DATE.                          CL*48
00424      DISPLAY 'RDATE ' W-RUN-DATE.                                    CL*48
00425      MOVE Z-YY               TO W-YY.                                CL*48
00426      MOVE Z-MM               TO W-MM.                                CL*48
00427      MOVE Z-DD               TO W-DD.                                CL*48
00428                                                                   DTSBX424
00429      EVALUATE TRUE                                                DTSBX424
00430         WHEN LX42-INITIALIZE-88                                   DTSBX424
00431            PERFORM I0000-INITIATE        THRU I0000-EXIT          DTSBX424
00432                                                                   DTSBX424
00433         WHEN LX42-NEW-EMPLOYER-88                                 DTSBX424
00434            PERFORM P3000-NEW-EMP         THRU P3000-EXIT          DTSBX424
00435                                                                   DTSBX424
00436         WHEN LX42-PROCESS-88                                      DTSBX424
00437            PERFORM P0000-PROCESS         THRU P0000-EXIT          DTSBX424
00438                                                                   DTSBX424
00439         WHEN LX42-TERMINATE-88                                    DTSBX424
00440            DISPLAY '424 - TERMINATE '                                CL*10
00441            PERFORM P3000-NEW-EMP         THRU P3000-EXIT          DTSBX424
00442            PERFORM T0000-TERMINATE       THRU T0000-EXIT          DTSBX424
00443                                                                   DTSBX424
00444      END-EVALUATE.                                                DTSBX424
00445                                                                   DTSBX424
00446 *    IF LX42-PROCESS-88                                              CL**8
00447 *       MOVE W-ERROR-IND               TO LX42-ERROR-IND             CL**8
00448 *    END-IF.                                                         CL**8
00449                                                                   DTSBX424
00450  DTSBX424-MAIN-EXIT.                                              DTSBX424
00451      GOBACK.                                                      DTSBX424
00452                                                                   DTSBX424
00453  I0000-INITIATE.                                                  DTSBX424
00454 ***  SET W-ERROR-NO-88                 TO TRUE.                   DTSBX424
00455      SET W-FATAL-ERROR-NO-88           TO TRUE.                   DTSBX424
00456      MOVE LENGTH OF X110-REC           TO W-X110-LENGTH.          DTSBX424
00457      MOVE LENGTH OF X120-REC           TO W-X120-LENGTH.          DTSBX424
00458                                                                   DTSBX424
00459 *RW1 FOR VARIABLE REPORT FILE.                                    DTSBX424
00460      MOVE LENGTH OF R140-REC           TO R140-LENGTH.            DTSBX424
00461      MOVE '140'                        TO R140-REC-TYPE.          DTSBX424
00462      PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT.                CL*25
00463      IF W-FATAL-ERROR-YES-88                                         CL*25
00464         DISPLAY 'CANNOT OPEN TEMP X424BTC FILE '                     CL*29
00465            TEMP-BTC-STATUS                                           CL*25
00466         PERFORM S999-ABEND THRU S999-EXIT                            CL*25
00467      END-IF.                                                         CL*25
00468                                                                   DTSBX424
00469      WRITE REPT-PAID-REC FROM HEADER-1                               CL*45
00470            AFTER ADVANCING TOP-OF-PAGE.                              CL*45
00471                                                                      CL*45
00472      WRITE REPT-PAID-REC FROM HEADER-2                               CL*45
00473            AFTER ADVANCING 2 LINES.                                  CL*45
00474                                                                      CL*45
00475      WRITE REPT-PAID-REC FROM HEADER-3                               CL*45
00476            AFTER ADVANCING 1 LINE.                                   CL*45
00477                                                                      CL*45
00478      WRITE REPT-PAID-REC FROM HEADER-43                              CL*45
00479            AFTER ADVANCING 1 LINE.                                   CL*45
00480                                                                      CL*45
00481      WRITE REPT-PAID-REC FROM BLANK-LINE                             CL*45
00482            AFTER ADVANCING 1 LINE.                                   CL*45
00483  I0000-EXIT.                                                      DTSBX424
00484      EXIT.                                                        DTSBX424
00485                                                                   DTSBX424
00486  P0000-PROCESS.                                                   DTSBX424
00487 *&                                                                DTSBX424
00488      DISPLAY SPACE.                                               DTSBX424
00489      DISPLAY 'BX424 P0000 ' W-EMP-NO '  ' LX42-REC-TYPE.          DTSBX424
00490 *&                                                                DTSBX424
00491      EVALUATE TRUE                                                DTSBX424
00492        WHEN LX42-REC-TYPE-ADDR-88                                 DTSBX424
00493          PERFORM P1500-ADDRESS            THRU P1500-EXIT         DTSBX424
00494                                                                   DTSBX424
00495        WHEN LX42-REC-TYPE-OPO-88                                  DTSBX424
00496 *        DISPLAY 'OPO REC ' LX42-EMP-NO                              CL*20
00497          PERFORM P1600-OPO                THRU P1600-EXIT         DTSBX424
00498                                                                   DTSBX424
00499      END-EVALUATE.                                                DTSBX424
00500  P0000-EXIT.                                                      DTSBX424
00501      EXIT.                                                        DTSBX424
00502                                                                   DTSBX424
00503  P1500-ADDRESS.                                                   DTSBX424
00504      MOVE LX42-DATA-AREA               TO X110-REC.                  CL*24
00505      DISPLAY ' P1500 X110 REC ' X110-REC.                            CL*61
00506 *&                                                                DTSBX424
00507 *    DISPLAY 'BX424 EMP ADDRESS ' W-EMP-NO ' ' X110-REC-TYPE ' '     CL*61
00508 *             ' ' X110-ADDR-TYPE.                                    CL*61
00509                                                                   DTSBX424
00510      ADD +1                            TO W-X110-RED-CNT.            CL*19
00511                                                                   DTSBX424
00512      MOVE SPACES                       TO LX42-X110-EMP-NO.          CL*50
00513                                                                      CL**2
00514      ADD 1 TO W-NEW-X110-EMP.                                        CL**2
00515                                                                      CL*43
00516      MOVE X110-EMP-NO               TO X424-EMP-NO.                  CL*43
00517      MOVE X110-ADDR-TYPE            TO X424-TYPE                     CL*43
00518      MOVE X110-ATTENTION            TO X424-ATTN                     CL*43
00519      MOVE X110-STREET-1             TO X424-LINE1                    CL*43
00520      MOVE X110-STREET-2             TO X424-LINE2                    CL*43
00521      MOVE X110-CITY                 TO X424-CITY                     CL*43
00522      MOVE X110-STATE                TO X424-STATE.                   CL*43
00523      MOVE X110-ZIP                  TO X424-ZIP.                     CL*43
00524      MOVE X110-EMAIL                TO X424-EMAIL.                   CL*43
00525      MOVE X110-QAS-FLAG             TO X424-QAS.                     CL*43
00526      MOVE SPACES                    TO X424-MESSAGE.                 CL*46
00527      WRITE REPT-PAID-REC            FROM DETAIL-LINE-1.              CL*43
00528                                                                      CL**2
00529      DISPLAY 'QAS ' X110-QAS-FLAG                                    CL*47
00530      PERFORM P1510-EDIT-ADDRESS        THRU P1510-EXIT.           DTSBX424
00531                                                                      CL**2
00532      IF W-ERROR-NO-88                                             DTSBX424
00533      DISPLAY 'X110  ADDRESS  OK - PASS EDITS ' W-EMP-NO              CL*12
00534         PERFORM P1520-SAVE-ADDRESS        THRU P1520-EXIT         DTSBX424
00535      ELSE                                                            CL**3
00536         SET W-ERROR-YES-88    TO TRUE                                CL**8
00537         MOVE SPACES TO R140-MESSAGE                                  CL**8
00538         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**8
00539         ADD +1     TO W-X110-ERR-CNT                                 CL*19
00540      DISPLAY 'X110  ADDRESS  HAS ERRORS      ' W-EMP-NO              CL*16
00541         STRING                                                       CL**8
00542            'X110  EMP ADDRESS HAS ERRORS - CANNOT ADD ADDR'          CL**8
00543              DELIMITED BY SIZE                                       CL**8
00544              INTO R140-MESSAGE                                       CL**8
00545         END-STRING                                                   CL**8
00546         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**8
00547         MOVE '999999'                     TO LX42-X110-EMP-NO        CL**3
00548      END-IF.                                                      DTSBX424
00549                                                                   DTSBX424
00550 ***  PERFORM P1530-CHECK-NAME          THRU P1530-EXIT.              CL**8
00551                                                                   DTSBX424
00552  P1500-EXIT.                                                      DTSBX424
00553      EXIT.                                                        DTSBX424
00554                                                                   DTSBX424
00555  P1510-EDIT-ADDRESS.                                              DTSBX424
00556                                                                      CL**2
00557 *    IF W-NEW-X110-EMP  = 1 AND LX42-X102-EMP-NO > SPACES            CL*14
00558 *     IF NOT X110-ADDR-TYPE-MAIL-88                                  CL*14
00559 *       MOVE SPACES TO R140-MESSAGE                                  CL*14
00560 *       MOVE W-EMP-NO TO R140-EMP-NO                                 CL*14
00561 *       STRING                                                       CL*14
00562 *        'X110- 1ST ADDR  NOT  MAILING ADDRESS '  X110-ADDR-TYPE     CL*14
00563 *          DELIMITED BY SIZE                                         CL*14
00564 *          INTO R140-MESSAGE                                         CL*14
00565 *          END-STRING                                                CL*14
00566 *          PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL*14
00567 *     END-IF                                                         CL*14
00568 *    END-IF.                                                         CL*14
00569                                                                      CL**2
00570                                                                      CL**2
00571       IF X110-ADDR-TYPE-RECS-88 AND X110-STATE NOT = 'DC'            CL**2
00572         SET W-ERROR-YES-88  TO TRUE                                  CL**2
00573         MOVE SPACES TO R140-MESSAGE                                  CL**2
00574         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**2
00575          DISPLAY 'X110- EMP DC ADDRESS NOT IN DC   '  X110-STATE     CL*17
00576         STRING                                                       CL**2
00577          'X110- EMPLOYER DC ADDRESS NOT IN DC   '  X110-STATE        CL**7
00578            DELIMITED BY SIZE                                         CL**2
00579            INTO R140-MESSAGE                                         CL**2
00580            END-STRING                                                CL**2
00581            PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL**2
00582       END-IF.                                                        CL**2
00583                                                                      CL**2
00584       IF  X110-STREET-1 = SPACES                                     CL**2
00585          DISPLAY 'X110- STREET 1   '  X110-STREET-1                  CL*17
00586         SET W-ERROR-YES-88  TO TRUE                                  CL**2
00587         MOVE SPACES TO R140-MESSAGE                                  CL**2
00588         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**2
00589         STRING                                                       CL**2
00590          'X110- EMPLOYER ADDR -STREET 1 IS BLANK '  X110-STREET-1    CL**7
00591            DELIMITED BY SIZE                                         CL**2
00592            INTO R140-MESSAGE                                         CL**2
00593            END-STRING                                                CL**2
00594            PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL**2
00595       END-IF.                                                        CL**2
00596                                                                      CL**2
00597       IF  X110-CITY = SPACES                                         CL*17
00598          DISPLAY 'X110- CITY       '  X110-CITY                      CL*17
00599         SET W-ERROR-YES-88  TO TRUE                                  CL**2
00600         MOVE SPACES TO R140-MESSAGE                                  CL**2
00601         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**2
00602         STRING                                                       CL**2
00603          'X110- EMPLOYER ADDRESS  -CITY IS BLANK '  X110-CITY        CL**7
00604            DELIMITED BY SIZE                                         CL**2
00605            INTO R140-MESSAGE                                         CL**2
00606            END-STRING                                                CL**2
00607            PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL**2
00608       END-IF.                                                        CL**2
00609                                                                      CL**2
00610       IF  X110-STATE = SPACES                                        CL*17
00611          DISPLAY 'X110- STATE      '  X110-STATE                     CL*17
00612         SET W-ERROR-YES-88  TO TRUE                                  CL**2
00613         MOVE SPACES TO R140-MESSAGE                                  CL**2
00614         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**2
00615         STRING                                                       CL**2
00616          'X110- EMPLOYER ADDRESS  -STATE IS BLANK '  X110-STATE      CL**7
00617            DELIMITED BY SIZE                                         CL**2
00618            INTO R140-MESSAGE                                         CL**2
00619            END-STRING                                                CL**2
00620            PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL**2
00621       END-IF.                                                        CL**2
00622                                                                      CL**2
00623       IF  X110-ZIP  = SPACES                                         CL*17
00624          DISPLAY 'X110- ZIP        '  X110-ZIP                       CL*17
00625         SET W-ERROR-YES-88  TO TRUE                                  CL**3
00626         MOVE SPACES TO R140-MESSAGE                                  CL**3
00627         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**3
00628         STRING                                                       CL**3
00629          'X110- EMPLOYER ADDRESS  -ZIP IS BLANK '  X110-ZIP          CL**7
00630            DELIMITED BY SIZE                                         CL**3
00631            INTO R140-MESSAGE                                         CL**3
00632            END-STRING                                                CL**3
00633            PERFORM S946-WRITE-R140 THRU S946-EXIT                    CL**3
00634       END-IF.                                                        CL**3
00635                                                                      CL**3
00636      IF X110-ADDR-TYPE-MAIL-88                                    DTSBX424
00637         SET MTAD-ID-TAX-MAILING-ADDR-88  TO TRUE                  DTSBX424
00638      ELSE                                                         DTSBX424
00639         IF X110-ADDR-TYPE-RECS-88                                 DTSBX424
00640            SET MTAD-ID-TAX-RECORDS-ADDR-88  TO TRUE               DTSBX424
00641         ELSE                                                      DTSBX424
00642            SET W-ERROR-YES-88  TO TRUE                               CL**3
00643            MOVE SPACES TO R140-MESSAGE                            DTSBX424
00644            MOVE W-EMP-NO TO R140-EMP-NO                           DTSBX424
00645            STRING                                                 DTSBX424
00646               'X110-ADDRESS TYPE INCORRECT ' X110-ADDR-TYPE       DTSBX424
00647                DELIMITED BY SIZE                                  DTSBX424
00648                INTO R140-MESSAGE                                  DTSBX424
00649            END-STRING                                             DTSBX424
00650            PERFORM S946-WRITE-R140 THRU S946-EXIT                 DTSBX424
00651            GO TO P1510-EXIT                                       DTSBX424
00652         END-IF                                                    DTSBX424
00653      END-IF.                                                      DTSBX424
00654                                                                      CL**3
00655      MOVE LOW-VALUES           TO MTAD-KEY-AREA.                     CL**3
00656      MOVE W-EMP-NO             TO MTAD-EMP-NO.                       CL**3
00657      SET MTAD-TAD-88           TO TRUE.                           DTSBX424
00658                                                                   DTSBX424
00659      MOVE MTAD-KEY-AREA        TO MSKL-KEY-AREA.                  DTSBX424
00660                                                                   DTSBX424
00661      PERFORM S910-READ         THRU S910-EXIT.                    DTSBX424
00662      IF L910-OK-88                                                DTSBX424
00663         MOVE MSKL-REC          TO MTAD-REC                        DTSBX424
00664 *          SET W-ERROR-YES-88  TO TRUE                               CL**8
00665            MOVE SPACES TO R140-MESSAGE                            DTSBX424
00666            MOVE W-EMP-NO TO R140-EMP-NO                           DTSBX424
00667            STRING                                                 DTSBX424
00668               'X110- ADDRESS EXIST IN DUTAS - UPDATE ADDR '          CL**8
00669                DELIMITED BY SIZE                                  DTSBX424
00670                INTO R140-MESSAGE                                  DTSBX424
00671            END-STRING                                             DTSBX424
00672            PERFORM S946-WRITE-R140 THRU S946-EXIT                 DTSBX424
00673      END-IF.                                                      DTSBX424
00674                                                                   DTSBX424
00675  P1510-EXIT.                                                      DTSBX424
00676      EXIT.                                                        DTSBX424
00677                                                                   DTSBX424
00678                                                                   DTSBX424
00679  P1520-SAVE-ADDRESS.                                              DTSBX424
00680      MOVE LOW-VALUES                TO T002-REC.                  DTSBX424
00681                                                                   DTSBX424
00682      SET T002-LENGTH-EMP-ADDR-88    TO TRUE.                      DTSBX424
00683      MOVE '002'                     TO T002-REC-TYPE.             DTSBX424
00684      MOVE W-EMP-NO                  TO T002-EMP-NO.               DTSBX424
00685      MOVE 'WEB REG   '              TO T002-ORIGIN.               DTSBX424
00686      MOVE LX42-SYS-DATE             TO T002-SYS-DATE.             DTSBX424
00687      MOVE LX42-SYS-TIME             TO T002-SYS-TIME.             DTSBX424
00688                                                                   DTSBX424
00689                                                                   DTSBX424
00690      MOVE X110-ADDR-TYPE            TO Y110-EMP-ADDR-TYPE.        DTSBX424
00691      IF X110-ATTENTION > SPACES                                      CL*51
00692         MOVE X110-ATTENTION         TO L009-DATA                     CL*51
00693         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*51
00694         MOVE L009-DATA              TO Y110-EMP-ATTN                 CL*51
00695      ELSE                                                            CL*51
00696         MOVE SPACES                    TO Y110-EMP-ATTN.             CL*51
00697                                                                      CL*53
00698      IF X110-STREET-2 = SPACES                                       CL*53
00699         MOVE X110-STREET-1 TO X110-STREET-2                          CL*53
00700         MOVE SPACES        TO X110-STREET-1.                         CL*53
00701                                                                      CL*53
00702      IF X110-STREET-1  > SPACES                                      CL*51
00703         MOVE X110-STREET-1          TO L009-DATA                     CL*51
00704         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*51
00705         MOVE L009-DATA              TO Y110-EMP-DELV1                CL*51
00706      ELSE                                                            CL*51
00707         MOVE SPACES                    TO Y110-EMP-DELV1.            CL*51
00708                                                                      CL*51
00709      IF X110-STREET-2  > SPACES                                      CL*51
00710         MOVE X110-STREET-2          TO L009-DATA                     CL*51
00711         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*51
00712         MOVE L009-DATA              TO Y110-EMP-DELV2                CL*51
00713      ELSE                                                            CL*51
00714         MOVE SPACES                    TO Y110-EMP-DELV2.            CL*51
00715                                                                      CL*51
00716      IF X110-CITY   > SPACES                                         CL*51
00717         MOVE X110-CITY              TO L009-DATA                     CL*51
00718         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*51
00719         MOVE L009-DATA              TO Y110-EMP-CITY                 CL*51
00720      ELSE                                                            CL*51
00721         MOVE SPACES                    TO Y110-EMP-CITY.             CL*51
00722      IF X110-STATE  > SPACES                                         CL*51
00723         MOVE X110-STATE             TO L009-DATA                     CL*51
00724         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*51
00725         MOVE L009-DATA              TO Y110-EMP-STATE                CL*51
00726      ELSE                                                            CL*51
00727         MOVE SPACES                    TO Y110-EMP-STATE.            CL*51
00728                                                                      CL*51
00729      MOVE X110-ZIP                  TO Y110-EMP-ZIP.              DTSBX424
00730      MOVE X110-PHONE                TO Y110-EMP-VOICE.            DTSBX424
00731      MOVE X110-FAX                  TO Y110-EMP-FAX.              DTSBX424
00732 **** MOVE X110-WEB-SITE             TO Y110-WEB-SITE.             DTSBX424
00733      MOVE X110-EMAIL                TO Y110-EMP-EMAIL.            DTSBX424
00734                                                                   DTSBX424
00735      MOVE Y110-REC                  TO T002-DATA-AREA.            DTSBX424
00736      SET T002-EMP-ADDR-88           TO TRUE.                      DTSBX424
00737                                                                      CL*26
00738 *    MOVE T002-REC                  TO TSKL-REC.                     CL*25
00739 *    PERFORM S927B-WRITE            THRU S927B-EXIT.                 CL*25
00740      ADD +1                         TO W-T002-ADDR-CNT.           DTSBX424
00741 *    PERFORM S927B-WRITE            THRU S927B-EXIT.                 CL*26
00742                                                                   DTSBX424
00743      MOVE T002-LENGTH               TO VAR-CHAR-CNT.                 CL*26
00744      PERFORM S1032-WRITE-TEMP-T002  THRU S1032-EXIT.                 CL*26
00745 *&                                                                DTSBX424
00746 *    DISPLAY 'BX424 ADDRESS ' W-EMP-NO '  ' X110-STREET-1.           CL*41
00747 *&                                                                DTSBX424
00748  P1520-EXIT.                                                      DTSBX424
00749      EXIT.                                                        DTSBX424
00750                                                                   DTSBX424
00751  P1530-CHECK-NAME.                                                DTSBX424
00752      DISPLAY 'BX424 P1530 NAME ' W-EMP-NO '  ' X110-EMP-NAME.     DTSBX424
00753      MOVE LOW-VALUE             TO MSKL-KEY-AREA.                 DTSBX424
00754      MOVE W-EMP-NO              TO MSKL-EMP-NO.                   DTSBX424
00755      SET MSKL-PRF-88            TO TRUE.                          DTSBX424
00756                                                                   DTSBX424
00757      PERFORM S910-READ          THRU S910-EXIT.                   DTSBX424
00758      IF L910-OK-88                                                DTSBX424
00759         NEXT SENTENCE                                             DTSBX424
00760      ELSE                                                         DTSBX424
00761         GO TO P1530-EXIT                                          DTSBX424
00762      END-IF.                                                      DTSBX424
00763                                                                   DTSBX424
00764      IF X110-EMP-NAME > SPACES                                    DTSBX424
00765         PERFORM P1535-SAVE-NAME        THRU P1535-EXIT            DTSBX424
00766      ELSE                                                         DTSBX424
00767         SET W-ERROR-YES-88  TO TRUE                               DTSBX424
00768         MOVE SPACES TO R140-MESSAGE                               DTSBX424
00769         MOVE W-EMP-NO TO R140-EMP-NO                              DTSBX424
00770         STRING                                                    DTSBX424
00771            'NAME       NAME IS BLANK '                            DTSBX424
00772             DELIMITED BY SIZE                                     DTSBX424
00773             INTO R140-MESSAGE                                     DTSBX424
00774         END-STRING                                                DTSBX424
00775         DISPLAY R140-MESSAGE                                      DTSBX424
00776         PERFORM S946-WRITE-R140 THRU S946-EXIT                    DTSBX424
00777      END-IF.                                                      DTSBX424
00778                                                                   DTSBX424
00779  P1530-EXIT.                                                      DTSBX424
00780      EXIT.                                                        DTSBX424
00781                                                                   DTSBX424
00782  P1535-SAVE-NAME.                                                 DTSBX424
00783      MOVE LOW-VALUES                TO T002-REC.                  DTSBX424
00784                                                                   DTSBX424
00785      SET T002-LENGTH-EMP-NAME-88    TO TRUE.                      DTSBX424
00786      MOVE '002'                     TO T002-REC-TYPE.             DTSBX424
00787      MOVE X110-EMP-NO               TO T002-EMP-NO.               DTSBX424
00788      MOVE 'WEB       '              TO T002-ORIGIN.               DTSBX424
00789      MOVE LX42-SYS-DATE             TO T002-SYS-DATE.             DTSBX424
00790      MOVE LX42-SYS-TIME             TO T002-SYS-TIME.             DTSBX424
00791                                                                   DTSBX424
00792      SET Y106-EMP-NAME-ENTITY-88    TO TRUE.                      DTSBX424
00793      MOVE X110-EMP-NAME             TO Y106-EMP-NAME.             DTSBX424
00794                                                                   DTSBX424
00795      MOVE Y106-REC                  TO T002-DATA-AREA.            DTSBX424
00796      SET T002-EMP-NAME-88           TO TRUE.                      DTSBX424
00797                                                                   DTSBX424
00798      MOVE T002-REC                  TO TSKL-REC.                  DTSBX424
00799      PERFORM S927B-WRITE            THRU S927B-EXIT.              DTSBX424
00800      ADD +1                         TO W-T002-NAME-CNT.           DTSBX424
00801                                                                   DTSBX424
00802 *&                                                                DTSBX424
00803 *    DISPLAY 'BX424 NAME '  X110-EMP-NO                              CL**3
00804 *       '  ' X110-EMP-NAME.                                          CL**3
00805 *&                                                                DTSBX424
00806  P1535-EXIT.                                                      DTSBX424
00807      EXIT.                                                        DTSBX424
00808                                                                   DTSBX424
00809  P1600-OPO.                                                       DTSBX424
00810      MOVE LX42-DATA-AREA               TO X120-REC.                  CL*24
00811                                                                   DTSBX424
00812      ADD +1                            TO W-X120-RED-CNT.            CL*19
00813      MOVE X120-EMP-NO                  TO LX42-X120-EMP-NO           CL**3
00814                                                                      CL**3
00815                                                                      CL**6
00816      PERFORM P1610-EDIT-OPO            THRU P1610-EXIT            DTSBX424
00817                                                                      CL**3
00818      IF W-ERROR-NO-88                                             DTSBX424
00819         DISPLAY ' X120 OPO PASS EDITS -OK' W-EMP-NO                  CL*12
00820         PERFORM P1620-SAVE-OPO         THRU P1620-EXIT            DTSBX424
00821      ELSE                                                            CL**3
00822         SET W-ERROR-YES-88    TO TRUE                                CL**9
00823         MOVE SPACES TO R140-MESSAGE                                  CL**9
00824         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**9
00825         ADD +1           TO W-X120-ERR-CNT                           CL*19
00826         STRING                                                       CL**9
00827            'X120  OPO RECORD HAS ERRORS - CANNOT ADD OPO '           CL**9
00828              DELIMITED BY SIZE                                       CL**9
00829              INTO R140-MESSAGE                                       CL**9
00830         END-STRING                                                   CL**9
00831         MOVE '999999'                     TO LX42-X120-EMP-NO        CL**9
00832         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**9
00833      END-IF.                                                      DTSBX424
00834                                                                   DTSBX424
00835  P1600-EXIT.                                                      DTSBX424
00836      EXIT.                                                        DTSBX424
00837                                                                   DTSBX424
00838  P1610-EDIT-OPO.                                                  DTSBX424
00839      IF X120-OPO-SSN = SPACES                                     DTSBX424
00840         MOVE ZEROS                 TO X120-OPO-SSN                DTSBX424
00841      END-IF.                                                      DTSBX424
00842                                                                      CL**3
00843      IF X120-OPO-TITLE = SPACES                                      CL**3
00844         SET W-ERROR-YES-88  TO TRUE                                  CL**3
00845         MOVE SPACES TO R140-MESSAGE                                  CL**3
00846         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**3
00847         STRING                                                       CL**3
00848            'X120-  EMP OPO TITLE IS BLANK '                          CL**8
00849             DELIMITED BY SIZE                                        CL**3
00850             INTO R140-MESSAGE                                        CL**3
00851         END-STRING                                                   CL**3
00852         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**3
00853      END-IF.                                                         CL**3
00854                                                                      CL**3
00855      IF X120-OPO-STREET-1 = SPACES                                   CL**3
00856         SET W-ERROR-YES-88  TO TRUE                                  CL**3
00857         MOVE SPACES TO R140-MESSAGE                                  CL**3
00858         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**3
00859         STRING                                                       CL**3
00860            'X120-  OPO ADDRESS STREET 1 IS BLANK '                   CL**7
00861             DELIMITED BY SIZE                                        CL**3
00862             INTO R140-MESSAGE                                        CL**3
00863         END-STRING                                                   CL**3
00864         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**3
00865      END-IF.                                                         CL**3
00866                                                                      CL**3
00867      DISPLAY 'CITY ' X120-OPO-CITY                                   CL*32
00868      IF X120-OPO-CITY = SPACES                                       CL*32
00869         SET W-ERROR-YES-88  TO TRUE                                  CL**3
00870         MOVE SPACES TO R140-MESSAGE                                  CL**3
00871         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**3
00872         STRING                                                       CL**3
00873            'X120-  OPO ADDRESS CITY  IS BLANK '                      CL**7
00874             DELIMITED BY SIZE                                        CL**3
00875             INTO R140-MESSAGE                                        CL**3
00876         END-STRING                                                   CL**3
00877         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**3
00878      END-IF.                                                         CL**3
00879                                                                      CL**3
00880      DISPLAY '  ST ' X120-OPO-STATE                                  CL*32
00881      IF X120-OPO-STATE = SPACES                                      CL**3
00882         SET W-ERROR-YES-88  TO TRUE                                  CL**3
00883         MOVE SPACES TO R140-MESSAGE                                  CL**3
00884         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**3
00885         STRING                                                       CL**3
00886            'X120-  OPO ADDRESS STATE IS BLANK '                      CL**7
00887             DELIMITED BY SIZE                                        CL**3
00888             INTO R140-MESSAGE                                        CL**3
00889         END-STRING                                                   CL**3
00890         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**3
00891      END-IF.                                                         CL**3
00892                                                                   DTSBX424
00893      DISPLAY ' ZIP ' X120-OPO-ZIP                                    CL*32
00894      IF X120-OPO-ZIP   = SPACES                                      CL**3
00895         SET W-ERROR-YES-88  TO TRUE                                  CL**3
00896         MOVE SPACES TO R140-MESSAGE                                  CL**3
00897         MOVE W-EMP-NO TO R140-EMP-NO                                 CL**3
00898         STRING                                                       CL**3
00899            'X120-  OPO ADDRESS ZIP IS BLANK '                        CL**7
00900             DELIMITED BY SIZE                                        CL**3
00901             INTO R140-MESSAGE                                        CL**3
00902         END-STRING                                                   CL**3
00903         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL**3
00904      END-IF.                                                         CL**3
00905                                                                      CL**3
00906  P1610-EXIT.                                                      DTSBX424
00907      EXIT.                                                        DTSBX424
00908                                                                   DTSBX424
00909  P1620-SAVE-OPO.                                                  DTSBX424
00910      MOVE LOW-VALUES                TO T002-REC.                  DTSBX424
00911                                                                   DTSBX424
00912      SET T002-LENGTH-CONTACT-88     TO TRUE.                      DTSBX424
00913      MOVE '002'                     TO T002-REC-TYPE.             DTSBX424
00914      MOVE W-EMP-NO                  TO T002-EMP-NO.               DTSBX424
00915      MOVE 'WEB REG   '              TO T002-ORIGIN.               DTSBX424
00916      MOVE LX42-SYS-DATE             TO T002-SYS-DATE.             DTSBX424
00917      MOVE LX42-SYS-TIME             TO T002-SYS-TIME.             DTSBX424
00918                                                                   DTSBX424
00919      MOVE SPACES                    TO Y120-REC.                     CL*63
00920      MOVE X120-TYPE-IND             TO Y120-CONTACT-TYPE.         DTSBX424
00921      MOVE X120-OPO-SSN              TO Y120-CONTACT-SSN.          DTSBX424
00922      IF X120-OPO-MEMBER-NAME > SPACES                             DTSBX424
00923         MOVE X120-OPO-MEMBER-NAME   TO Y120-CONTACT-NAME          DTSBX424
00924      ELSE                                                         DTSBX424
00925         PERFORM P1621-FORMAT-NAME   THRU P1621-EXIT               DTSBX424
00926      END-IF.                                                      DTSBX424
00927                                                                   DTSBX424
00928      MOVE X120-OPO-TITLE            TO Y120-CONTACT-TITLE.        DTSBX424
00929      MOVE X120-OPO-ATTENTION        TO Y120-CONTACT-ATTN.         DTSBX424
00930      MOVE X120-OPO-STREET-1         TO Y120-CONTACT-DELV1.        DTSBX424
00931      MOVE X120-OPO-STREET-2         TO Y120-CONTACT-DELV2.        DTSBX424
00932      MOVE X120-OPO-CITY             TO Y120-CONTACT-CITY.         DTSBX424
00933      DISPLAY 'CITY ' Y120-CONTACT-CITY                               CL*33
00934      MOVE X120-OPO-STATE            TO Y120-CONTACT-STATE.        DTSBX424
00935      DISPLAY '  ST ' Y120-CONTACT-STATE                              CL*33
00936      MOVE X120-OPO-ZIP              TO Y120-CONTACT-ZIP.          DTSBX424
00937      DISPLAY ' ZIP ' Y120-CONTACT-ZIP                                CL*33
00938      MOVE X120-OPO-PHONE            TO Y120-CONTACT-VOICE.        DTSBX424
00939      DISPLAY 'FONE ' Y120-CONTACT-VOICE                              CL*34
00940      MOVE X120-OPO-FAX              TO Y120-CONTACT-FAX.          DTSBX424
00941      DISPLAY ' FAX ' Y120-CONTACT-FAX                                CL*34
00942      MOVE X120-OPO-EMAIL            TO Y120-CONTACT-EMAIL.        DTSBX424
00943      DISPLAY 'MAIL ' Y120-CONTACT-EMAIL.                             CL*34
00944                                                                   DTSBX424
00945      MOVE Y120-REC                  TO T002-DATA-AREA.            DTSBX424
00946      SET T002-CONTACT-88            TO TRUE.                      DTSBX424
00947                                                                      CL*26
00948 *    MOVE T002-REC                  TO TSKL-REC.                     CL*26
00949 *    PERFORM S927B-WRITE            THRU S927B-EXIT.                 CL*26
00950      ADD +1                         TO W-T002-OPO-CNT.            DTSBX424
00951                                                                   DTSBX424
00952      MOVE T002-LENGTH               TO VAR-CHAR-CNT.                 CL*26
00953      PERFORM S1032-WRITE-TEMP-T002  THRU S1032-EXIT.                 CL*26
00954 *&                                                                   CL*26
00955 *&                                                                DTSBX424
00956      DISPLAY 'BX424 P1620 ' X120-EMP-NO                              CL*30
00957         '  ' Y120-CONTACT-NAME.                                      CL*30
00958 *       '  ' Y120-CONTACT-DELV1.                                     CL**3
00959 *&                                                                DTSBX424
00960  P1620-EXIT.                                                      DTSBX424
00961      EXIT.                                                        DTSBX424
00962                                                                   DTSBX424
00963  P1621-FORMAT-NAME.                                               DTSBX424
00964      MOVE SPACES  TO W-NAME-AREA Y120-CONTACT-NAME.                  CL*64
00965      STRING                                                       DTSBX424
00966         X120-OPO-LAST-NAME  '/'                                   DTSBX424
00967         X120-OPO-FIRST-NAME (1:18) ' '                            DTSBX424
00968         X120-OPO-MID-INIT                                         DTSBX424
00969           DELIMITED BY SIZE                                       DTSBX424
00970           INTO W-NAME-AREA                                        DTSBX424
00971      END-STRING.                                                  DTSBX424
00972      DISPLAY 'BX424 P16 ' W-NAME-AREA.                               CL*64
00973                                                                   DTSBX424
00974      MOVE +0                     TO TSUB2                         DTSBX424
00975      PERFORM                                                      DTSBX424
00976        VARYING TSUB1 FROM +1 BY +1                                DTSBX424
00977        UNTIL TSUB1 > +40 OR TSUB2 > +31                           DTSBX424
00978          IF W-NAME-AREA (TSUB1:1) NOT = SPACE                     DTSBX424
00979            ADD +1 TO TSUB2                                        DTSBX424
00980            MOVE W-NAME-AREA (TSUB1:1) TO                          DTSBX424
00981               Y120-CONTACT-NAME (TSUB2:1)                         DTSBX424
00982          END-IF                                                   DTSBX424
00983      END-PERFORM.                                                 DTSBX424
00984      DISPLAY 'BX424 P16 ' Y120-CONTACT-NAME.                         CL*64
00985                                                                   DTSBX424
00986  P1621-EXIT.                                                      DTSBX424
00987      EXIT.                                                        DTSBX424
00988                                                                   DTSBX424
00989 *P1800-IND-DESC.                                                  DTSBX424
00990 *    INITIALIZE X132-REC.                                         DTSBX424
00991 *    MOVE +4                           TO W-LAST-FIELD.           DTSBX424
00992 *    MOVE +500                         TO W-LAST-FIELD-LEN.       DTSBX424
00993 *    PERFORM S2000-PARSE-INPUT         THRU S2000-EXIT.           DTSBX424
00994 *&                                                                DTSBX424
00995 *    DISPLAY 'INDUSTRY DESCRIPTION'.                              DTSBX424
00996 *&                                                                DTSBX424
00997 *                                                                 DTSBX424
00998 *    SET W-PREV-REC-IND-88             TO TRUE.                   DTSBX424
00999 *    ADD +1                            TO W-X132-CNT.             DTSBX424
01000 *    PERFORM P1820-SAVE-IND            THRU P1820-EXIT.           DTSBX424
01001 *                                                                 DTSBX424
01002 *P1800-EXIT.                                                      DTSBX424
01003 *    EXIT.                                                        DTSBX424
01004 *                                                                 DTSBX424
01005 *P1820-SAVE-IND.                                                  DTSBX424
01006 *    MOVE LOW-VALUES              TO MNTE-KEY-AREA.               DTSBX424
01007 *    MOVE W-EMP-NO                TO MNTE-EMP-NO.                 DTSBX424
01008 *    SET MNTE-NTE-88              TO TRUE.                        DTSBX424
01009 *    MOVE +0                      TO MNTE-PURGE-DATE.             DTSBX424
01010 *    SET MNTE-NOT-CONVERTED-88    TO TRUE.                        DTSBX424
01011 *                                                                 DTSBX424
01012 *    MOVE LX42-SYS-DATE           TO MNTE-ESTB-DATE               DTSBX424
01013 *                                    MNTE-CHNG-DATE.              DTSBX424
01014 *    MOVE ZERO                    TO MNTE-KEY-ESTB-ABSTIME        DTSBX424
01015 *                                    MNTE-DATA-ESTB-ABSTIME       DTSBX424
01016 *                                    MNTE-CHNG-ABSTIME.           DTSBX424
01017 *    MOVE 'WEB REG '              TO MNTE-ESTB-OP-ID              DTSBX424
01018 *                                    MNTE-CHNG-OP-ID.             DTSBX424
01019 *    MOVE +0                      TO MNTE-TEXT-CNT.               DTSBX424
01020 *    MOVE SPACES                  TO MNTE-TEXT-AREA.              DTSBX424
01021 *                                                                 DTSBX424
01022 *    IF X132-SOURCE-KEY-WORD-88                                   DTSBX424
01023 *       SET W-MNTE-KEY-WORD-88     TO TRUE                        DTSBX424
01024 *       MOVE W-MNTE-SUBJECT        TO MNTE-SUBJECT                DTSBX424
01025 *    ELSE                                                         DTSBX424
01026 *       SET W-MNTE-DATA-ENTRY-88   TO TRUE                        DTSBX424
01027 *       MOVE W-MNTE-SUBJECT        TO MNTE-SUBJECT                DTSBX424
01028 *    END-IF.                                                      DTSBX424
01029 *                                                                 DTSBX424
01030 *    PERFORM P1821-MOVE-TEXT        THRU P1821-EXIT.              DTSBX424
01031 *                                                                 DTSBX424
01032 *    MOVE LENGTH OF T003-REC        TO T003-LENGTH                DTSBX424
01033 *    MOVE '003'                     TO T003-REC-TYPE.             DTSBX424
01034 *    MOVE W-EMP-NO                  TO T003-EMP-NO.               DTSBX424
01035 *    MOVE 'WEB REG   '              TO T003-ORIGIN.               DTSBX424
01036 *    MOVE LX42-SYS-DATE             TO T003-SYS-DATE.             DTSBX424
01037 *    MOVE LX42-SYS-TIME             TO T003-SYS-TIME.             DTSBX424
01038 *    SET T003-ADD-MNTE-88           TO TRUE.                      DTSBX424
01039 *    MOVE MNTE-REC                  TO T003-MNTE-REC.             DTSBX424
01040 *                                                                 DTSBX424
01041 *    PERFORM S1031-WRITE-TEMP-T003  THRU S1031-EXIT.              DTSBX424
01042 *                                                                 DTSBX424
01043 *P1820-EXIT.                                                      DTSBX424
01044 *    EXIT.                                                        DTSBX424
01045 *                                                                 DTSBX424
01046 *P1821-MOVE-TEXT.                                                 DTSBX424
01047 *    SET W-MNTE-COMPLETE-NO-88          TO TRUE.                  DTSBX424
01048 *    MOVE SPACES                        TO W-MNTE-LINE.           DTSBX424
01049 *    MOVE +0                            TO W-LAST-SPACE           DTSBX424
01050 *                                          TSUB1                  DTSBX424
01051 *                                          TSUB2.                 DTSBX424
01052 *                                                                 DTSBX424
01053 *    PERFORM                                                      DTSBX424
01054 *      UNTIL W-MNTE-COMPLETE-YES-88                               DTSBX424
01055 *        ADD +1                         TO TSUB1                  DTSBX424
01056 *        IF TSUB1 <= +500                                         DTSBX424
01057 *           PERFORM P1821A-MOVE-DATA    THRU P1821A-EXIT          DTSBX424
01058 *        ELSE                                                     DTSBX424
01059 *           SET W-MNTE-COMPLETE-YES-88  TO TRUE                   DTSBX424
01060 *        END-IF                                                   DTSBX424
01061 *    END-PERFORM.                                                 DTSBX424
01062 *                                                                 DTSBX424
01063 *P1821-EXIT.                                                      DTSBX424
01064 *    EXIT.                                                        DTSBX424
01065 *                                                                 DTSBX424
01066 *P1821A-MOVE-DATA.                                                DTSBX424
01067 *    IF TSUB2 < +72                                               DTSBX424
01068 *       ADD +1               TO TSUB2                             DTSBX424
01069 *       MOVE X132-IND-DESC (TSUB1:1)                              DTSBX424
01070 *                            TO W-MNTE-LINE (TSUB2:1)             DTSBX424
01071 *       IF X132-IND-DESC (TSUB1:1) = SPACE                        DTSBX424
01072 *          MOVE TSUB2        TO W-LAST-SPACE                      DTSBX424
01073 *       END-IF                                                    DTSBX424
01074 *    ELSE                                                         DTSBX424
01075 *       PERFORM P1821B-RESET THRU P1821B-EXIT                     DTSBX424
01076 *       ADD +1               TO MNTE-TEXT-CNT                     DTSBX424
01077 *       MOVE W-MNTE-LINE     TO MNTE-TEXT (MNTE-TEXT-CNT)         DTSBX424
01078 *       MOVE SPACES          TO W-MNTE-LINE                       DTSBX424
01079 *       MOVE +0              TO W-LAST-SPACE                      DTSBX424
01080 *                               TSUB2                             DTSBX424
01081 *    END-IF.                                                      DTSBX424
01082 *                                                                 DTSBX424
01083 ***  DISPLAY 'A ' TSUB1 '  ' TSUB2 '  ' W-MNTE-LINE.              DTSBX424
01084 *P1821A-EXIT.                                                     DTSBX424
01085 *    EXIT.                                                        DTSBX424
01086 *                                                                 DTSBX424
01087 *P1821B-RESET.                                                    DTSBX424
01088 ***  DISPLAY 'B1 ' W-LAST-SPACE '  ' TSUB1 '  ' TSUB2.            DTSBX424
01089 *************                                                     DTSBX424
01090 * EXIT IF THE LAST LETTER MOVED IS A SPACE, OR IF THE CURRENT     DTSBX424
01091 * LINE DOES NOT CONTAIN ANY SPACES.                               DTSBX424
01092 *************                                                     DTSBX424
01093 *    IF W-MNTE-LINE (72:1)   = SPACE                              DTSBX424
01094 *       SUBTRACT +1          FROM TSUB1                           DTSBX424
01095 *       GO TO P1821B-EXIT                                         DTSBX424
01096 *    END-IF.                                                      DTSBX424
01097 *                                                                 DTSBX424
01098 *    IF W-LAST-SPACE         = ZERO                               DTSBX424
01099 *       GO TO P1821B-EXIT                                         DTSBX424
01100 *    END-IF.                                                      DTSBX424
01101 *                                                                 DTSBX424
01102 *************                                                     DTSBX424
01103 * REPLACE THE LAST LETTERS WRITTEN (OCCURRING IN THE MIDDLE OF    DTSBX424
01104 * A WORD) WITH SPACES.                                            DTSBX424
01105 *************                                                     DTSBX424
01106 *    PERFORM                                                      DTSBX424
01107 *      VARYING TSUB2 FROM W-LAST-SPACE BY +1                      DTSBX424
01108 *      UNTIL TSUB2 > +72                                          DTSBX424
01109 *        MOVE SPACE          TO W-MNTE-LINE (TSUB2:1)             DTSBX424
01110 *    END-PERFORM.                                                 DTSBX424
01111 *                                                                 DTSBX424
01112 *************                                                     DTSBX424
01113 * RESET TSUB1 TO POINT TO THE FIRST LETTER OF THE INCOMPLETED     DTSBX424
01114 * WORD.                                                           DTSBX424
01115 *************                                                     DTSBX424
01116 *    COMPUTE TSUB1 = TSUB1 - (73 - W-LAST-SPACE).                 DTSBX424
01117 *                                                                 DTSBX424
01118 ***  DISPLAY 'B2 ' TSUB1 '  ' TSUB2 '  ' W-MNTE-LINE.             DTSBX424
01119 *P1821B-EXIT.                                                     DTSBX424
01120 *    EXIT.                                                        DTSBX424
01121                                                                   DTSBX424
01122  P3000-NEW-EMP.                                                   DTSBX424
01123 *&                                                                DTSBX424
01124      DISPLAY 'BX424 P3000 ' W-EMP-NO '  ' LX42-EMP-NO.               CL*16
01125 *&                                                                DTSBX424
01126      PERFORM P3400-INIT-NEW-EMP       THRU P3400-EXIT.            DTSBX424
01127                                                                   DTSBX424
01128  P3000-EXIT.                                                      DTSBX424
01129      EXIT.                                                        DTSBX424
01130                                                                   DTSBX424
01131  P3400-INIT-NEW-EMP.                                              DTSBX424
01132      MOVE LX42-EMP-NO        TO W-EMP-NO.                         DTSBX424
01133 ***  SET W-ERROR-NO-88       TO TRUE.                             DTSBX424
01134                                                                   DTSBX424
01135      MOVE ZEROS             TO W-NEW-X110-EMP.                       CL**2
01136      INITIALIZE              X110-REC                             DTSBX424
01137                              X120-REC.                            DTSBX424
01138                                                                   DTSBX424
01139  P3400-EXIT.                                                      DTSBX424
01140      EXIT.                                                        DTSBX424
01141                                                                   DTSBX424
01142                                                                   DTSBX424
01143  T0000-TERMINATE.                                                 DTSBX424
01144      DISPLAY ' '.                                                 DTSBX424
01145      CLOSE TEMP-BTC-FILE REPT-PAID-FILE REPT-PEND-FILE.              CL*35
01146      DISPLAY '***************************************'.              CL*19
01147      DISPLAY '*** DTSBX424 TERMINATION STATISTICS ***'.           DTSBX424
01148      DISPLAY '***   EMPLOYER/OPO ADDRESS          ***'.              CL*19
01149      DISPLAY '***************************************'.              CL*19
01150                                                                   DTSBX424
01151      DISPLAY ' '.                                                 DTSBX424
01152                                                                   DTSBX424
01153      PERFORM T2000-DISPLAY-TOTALS         THRU T2000-EXIT.        DTSBX424
01154                                                                   DTSBX424
01155  T0000-EXIT.                                                      DTSBX424
01156      EXIT.                                                        DTSBX424
01157                                                                   DTSBX424
01158  T2000-DISPLAY-TOTALS.                                            DTSBX424
01159      DISPLAY 'X110-ADDRESS RECORDS READ:     '                       CL*19
01160              W-X110-RED-CNT.                                         CL*19
01161                                                                      CL*19
01162      DISPLAY 'X110-ADDRESS RECORDS IN ERROR: '                       CL*19
01163              W-X110-ERR-CNT.                                         CL*19
01164                                                                   DTSBX424
01165      DISPLAY 'X110- ADDRESS RECORDS WRITTEN: '                       CL*19
01166              W-T002-ADDR-CNT.                                     DTSBX424
01167                                                                   DTSBX424
01168      DISPLAY 'X120 -OPO RECORDS READ:        '                       CL*19
01169              W-X120-RED-CNT.                                         CL*19
01170                                                                   DTSBX424
01171      DISPLAY 'X120 -OPO RECORDS IN ERROR:    '                       CL*19
01172              W-X120-ERR-CNT.                                         CL*19
01173                                                                      CL*19
01174                                                                      CL**8
01175      DISPLAY 'X120 -OPO RECORDS WRITTEN:     '                       CL*19
01176              W-T002-OPO-CNT.                                         CL**8
01177                                                                      CL**8
01178      DISPLAY '  '.                                                DTSBX424
01179                                                                   DTSBX424
01180  T2000-EXIT.                                                      DTSBX424
01181      EXIT.                                                        DTSBX424
01182                                                                   DTSBX424
01183  S001-FROM-FED-8.                                                 DTSBX424
01184      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX424
01185      GO TO S001-DATE.                                             DTSBX424
01186                                                                   DTSBX424
01187  S001-FROM-CAL-8.                                                 DTSBX424
01188      SET L001-FROM-CAL-8 TO TRUE.                                 DTSBX424
01189      GO TO S001-DATE.                                             DTSBX424
01190                                                                   DTSBX424
01191  S001-FROM-ABS-DAY.                                               DTSBX424
01192      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBX424
01193      GO TO S001-DATE.                                             DTSBX424
01194                                                                   DTSBX424
01195  S001-DATE.                                                       DTSBX424
01196      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX424
01197  S001-EXIT.                                                       DTSBX424
01198      EXIT.                                                        DTSBX424
01199                                                                   DTSBX424
01200  S003-AGENCY-DAY.                                                 DTSBX424
01201      SET L003-AGENCY-DAY TO TRUE.                                 DTSBX424
01202      GO TO S003-WORK-DAY.                                         DTSBX424
01203                                                                   DTSBX424
01204  S003-WORK-DAY.                                                   DTSBX424
01205      CALL 'DTSBU003' USING L003-LINK-AREA.                        DTSBX424
01206  S003-EXIT.                                                       DTSBX424
01207      EXIT.                                                        DTSBX424
01208                                                                   DTSBX424
01209  S004-FROM-5.                                                     DTSBX424
01210      SET L004-FROM-5        TO TRUE.                              DTSBX424
01211      GO TO S004-YRQ.                                              DTSBX424
01212                                                                   DTSBX424
01213  S004-FROM-DATE.                                                  DTSBX424
01214      SET L004-FROM-DATE     TO TRUE.                              DTSBX424
01215      GO TO S004-YRQ.                                              DTSBX424
01216                                                                   DTSBX424
01217  S004-FROM-ABS.                                                   DTSBX424
01218      SET L004-FROM-ABS      TO TRUE.                              DTSBX424
01219      GO TO S004-YRQ.                                              DTSBX424
01220                                                                   DTSBX424
01221  S004-YRQ.                                                        DTSBX424
01222      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX424
01223                                                                   DTSBX424
01224  S004-EXIT.                                                       DTSBX424
01225      EXIT.                                                        DTSBX424
01226                                                                      CL*51
01227  S009-CONVERT-TO-CAPS.                                               CL*51
01228      CALL 'DTSBU009' USING L009-LINK-AREA.                           CL*51
01229                                                                      CL*51
01230  S009-EXIT.                                                          CL*51
01231      EXIT.                                                           CL*51
01232                                                                   DTSBX424
01233  S072-ADDRESS.                                                    DTSBX424
01234      CALL 'DTSBU072' USING L072-LINK-AREA.                        DTSBX424
01235                                                                   DTSBX424
01236  S072-EXIT.                                                       DTSBX424
01237      EXIT.                                                        DTSBX424
01238                                                                   DTSBX424
01239  S516-LIABILITY-INFO.                                             DTSBX424
01240      CALL 'DTSBU516' USING L516-LINK-AREA                         DTSBX424
01241                            MPRF-REC.                              DTSBX424
01242  S516-EXIT.                                                       DTSBX424
01243      EXIT.                                                        DTSBX424
01244                                                                   DTSBX424
01245 *S910-OPEN-READ.                                                  DTSBX424
01246 *    SET L910-OPEN-READ-88 TO TRUE.                               DTSBX424
01247 *    GO TO S910-MSTR-IO.                                          DTSBX424
01248                                                                   DTSBX424
01249  S910-READ.                                                       DTSBX424
01250      SET L910-READ-88 TO TRUE.                                    DTSBX424
01251      GO TO S910-MSTR-IO.                                          DTSBX424
01252                                                                   DTSBX424
01253  S910-START-BROWSE.                                               DTSBX424
01254      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX424
01255      GO TO S910-MSTR-IO.                                          DTSBX424
01256                                                                   DTSBX424
01257  S910-READ-NEXT.                                                  DTSBX424
01258      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX424
01259      GO TO S910-MSTR-IO.                                          DTSBX424
01260                                                                   DTSBX424
01261 *S910-CLOSE.                                                      DTSBX424
01262 *    SET L910-CLOSE-88     TO TRUE.                               DTSBX424
01263 *    GO TO S910-MSTR-IO.                                          DTSBX424
01264                                                                   DTSBX424
01265  S910-MSTR-IO.                                                    DTSBX424
01266      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX424
01267                            MSKL-REC.                              DTSBX424
01268  S910-EXIT.                                                       DTSBX424
01269      EXIT.                                                        DTSBX424
01270                                                                   DTSBX424
01271  S921-OPEN-READ.                                                  DTSBX424
01272      SET L921-OPEN-READ-88 TO TRUE.                               DTSBX424
01273      GO TO S921-AIX-IO.                                           DTSBX424
01274                                                                   DTSBX424
01275  S921-READ.                                                       DTSBX424
01276      SET L921-READ-88 TO TRUE.                                    DTSBX424
01277      GO TO S921-AIX-IO.                                           DTSBX424
01278                                                                   DTSBX424
01279  S921-START-BROWSE.                                               DTSBX424
01280      SET L921-START-BROWSE-88 TO TRUE.                            DTSBX424
01281      GO TO S921-AIX-IO.                                           DTSBX424
01282                                                                   DTSBX424
01283  S921-READ-NEXT.                                                  DTSBX424
01284      SET L921-READ-NEXT-88 TO TRUE.                               DTSBX424
01285      GO TO S921-AIX-IO.                                           DTSBX424
01286                                                                   DTSBX424
01287  S921-CLOSE.                                                      DTSBX424
01288      SET L921-CLOSE-88 TO TRUE.                                   DTSBX424
01289      GO TO S921-AIX-IO.                                           DTSBX424
01290                                                                   DTSBX424
01291  S921-AIX-IO.                                                     DTSBX424
01292      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX424
01293                            ISKL-REC.                              DTSBX424
01294  S921-EXIT.                                                       DTSBX424
01295      EXIT.                                                        DTSBX424
01296                                                                   DTSBX424
01297 *S927A-OPEN.                                                      DTSBX424
01298 *    SET L927-OPEN-UPDATE-88  TO TRUE.                            DTSBX424
01299 *    PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBX424
01300 *                                                                 DTSBX424
01301 *S927A-EXIT.                                                      DTSBX424
01302 *    EXIT.                                                        DTSBX424
01303                                                                   DTSBX424
01304  S927B-WRITE.                                                     DTSBX424
01305      SET L927-WRITE-88 TO TRUE.                                   DTSBX424
01306      PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBX424
01307                                                                   DTSBX424
01308  S927B-EXIT.                                                      DTSBX424
01309      EXIT.                                                        DTSBX424
01310                                                                   DTSBX424
01311 *S927C-CLOSE.                                                     DTSBX424
01312 *    SET L927-CLOSE-88        TO TRUE.                            DTSBX424
01313 *    PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBX424
01314 *                                                                 DTSBX424
01315 *S927C-EXIT.                                                      DTSBX424
01316 *    EXIT.                                                        DTSBX424
01317                                                                   DTSBX424
01318  S927Z-IO.                                                        DTSBX424
01319      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSBX424
01320                            TSKL-REC.                              DTSBX424
01321  S927Z-EXIT.                                                      DTSBX424
01322      EXIT.                                                        DTSBX424
01323                                                                   DTSBX424
01324 *S931-OPEN-READ.                                                  DTSBX424
01325 *    SET L931-OPEN-READ-88 TO TRUE.                               DTSBX424
01326 *    GO TO S931-REF-IO.                                           DTSBX424
01327 *                                                                 DTSBX424
01328 *S931-CLOSE.                                                      DTSBX424
01329 *    SET L931-CLOSE-88 TO TRUE.                                   DTSBX424
01330 *    GO TO S931-REF-IO.                                           DTSBX424
01331 *                                                                 DTSBX424
01332 *S931-REF-IO.                                                     DTSBX424
01333 *    CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBX424
01334 *                          FSKL-REC.                              DTSBX424
01335 *S931-EXIT.                                                       DTSBX424
01336 *    EXIT.                                                        DTSBX424
01337                                                                   DTSBX424
01338  S946-WRITE-R140.                                                 DTSBX424
01339 *    MOVE SPACES TO R140-MESSAGE                                  DTSBX424
01340 *    MOVE W-EMP-NO TO R140-EMP-NO                                 DTSBX424
01341 *    STRING                                                       DTSBX424
01342 *       MSG1-TYPE ' - '                                           DTSBX424
01343 *       MSG1-MESSAGE ': '                                         DTSBX424
01344 *       X108-RATE-YEAR                                            DTSBX424
01345 *     DELIMITED BY SIZE                                           DTSBX424
01346 *     INTO R140-MESSAGE                                           DTSBX424
01347 *    END-STRING.                                                  DTSBX424
01348                                                                   DTSBX424
01349      CALL 'DTSBU946' USING R140-REC.                              DTSBX424
01350                                                                   DTSBX424
01351  S946-EXIT.                                                       DTSBX424
01352      EXIT.                                                        DTSBX424
01353                                                                      CL*25
01354  S1032-WRITE-TEMP-T002.                                              CL*25
01355      MOVE T002-REC        TO TEMP-BTC-REC.                           CL*25
01356      WRITE TEMP-BTC-REC.                                             CL*25
01357      IF TEMP-BTC-STATUS-OK-88                                        CL*25
01358         NEXT SENTENCE                                                CL*25
01359      ELSE                                                            CL*25
01360         DISPLAY 'CANNOT WRITE ADDRESS TEMP T002: '                   CL*27
01361            TEMP-BTC-STATUS                                           CL*25
01362      END-IF.                                                         CL*25
01363                                                                      CL*25
01364  S1032-EXIT.                                                         CL*25
01365      EXIT.                                                           CL*25
01366                                                                      CL*25
01367                                                                      CL*25
01368  S1040-OPEN-TEMP-BTC-OUT.                                            CL*25
01369      OPEN OUTPUT   TEMP-BTC-FILE                                     CL*35
01370                    REPT-PAID-FILE                                    CL*35
01371                    REPT-PEND-FILE.                                   CL*35
01372      IF TEMP-BTC-STATUS-OK-88                                        CL*25
01373         NEXT SENTENCE                                                CL*25
01374      ELSE                                                            CL*25
01375         SET W-FATAL-ERROR-YES-88 TO TRUE                             CL*25
01376         DISPLAY 'CANNOT OPEN ADDR BTC FILE BX424 : '                 CL*25
01377            TEMP-BTC-STATUS                                           CL*25
01378      END-IF.                                                         CL*25
01379                                                                      CL*25
01380  S1040-EXIT.                                                         CL*25
01381      EXIT.                                                           CL*25
01382  S3000-INIT-T003.                                                    CL*25
01383      MOVE LOW-VALUES              TO MNTE-KEY-AREA.                  CL*25
01384                                                                      CL*25
01385      MOVE W-EMP-NO                TO MNTE-EMP-NO.                 DTSBX424
01386      SET MNTE-NTE-88              TO TRUE.                        DTSBX424
01387      MOVE +0                      TO MNTE-PURGE-DATE.             DTSBX424
01388      SET MNTE-NOT-CONVERTED-88    TO TRUE.                        DTSBX424
01389                                                                   DTSBX424
01390      MOVE LX42-SYS-DATE           TO MNTE-ESTB-DATE               DTSBX424
01391                                      MNTE-CHNG-DATE.              DTSBX424
01392      MOVE ZERO                    TO MNTE-KEY-ESTB-ABSTIME        DTSBX424
01393                                      MNTE-DATA-ESTB-ABSTIME       DTSBX424
01394                                      MNTE-CHNG-ABSTIME.           DTSBX424
01395      MOVE 'WEB REG '              TO MNTE-ESTB-OP-ID              DTSBX424
01396                                      MNTE-CHNG-OP-ID.             DTSBX424
01397      MOVE +0                      TO MNTE-TEXT-CNT.               DTSBX424
01398      MOVE SPACES                  TO MNTE-TEXT-AREA.              DTSBX424
01399                                                                   DTSBX424
01400      MOVE LENGTH OF T003-REC        TO T003-LENGTH                DTSBX424
01401      MOVE '003'                     TO T003-REC-TYPE.             DTSBX424
01402      MOVE W-EMP-NO                  TO T003-EMP-NO.               DTSBX424
01403      MOVE 'WEB REG   '              TO T003-ORIGIN.               DTSBX424
01404      MOVE LX42-SYS-DATE             TO T003-SYS-DATE.             DTSBX424
01405      MOVE LX42-SYS-TIME             TO T003-SYS-TIME.             DTSBX424
01406      SET T003-ADD-MNTE-88           TO TRUE.                      DTSBX424
01407                                                                   DTSBX424
01408  S3000-EXIT.                                                      DTSBX424
01409      EXIT.                                                        DTSBX424
01410                                                                   DTSBX424
01411  S999-ABEND.                                                      DTSBX424
01412      CALL 'DTSBU999' USING W-ABEND-CD.                            DTSBX424
01413  S999-EXIT.                                                       DTSBX424
01414      EXIT.                                                        DTSBX424
01415                                                                   DTSBX424
