00001  IDENTIFICATION DIVISION.                                         02/27/20
00002  PROGRAM-ID.             DTSBX427.                                DTSBX427
00003  AUTHOR.                 NORTHROP GRUMMAN.                           LV094
00004  DATE-WRITTEN.           SEPT 2014.                                  CL**2
00005  DATE-COMPILED.                                                   DTSBX427
00006      SKIP3                                                        DTSBX427
00007 *****                                                             DTSBX427
00008 *                                                                 DTSBX427
00009 *    FUNCTION:  UPDATE MAILING AND BUSINESS ADDRESS FROM ESSP.       CL**2
00010 *                                                                 DTSBX427
00011 *    MODIFICATION LOG:                                            DTSBX427
00012 *                                                                 DTSBX427
00013 *    09/15/2014  INITIAL DEVELOPMENT.                                CL**2
00014 *                WORK ORDER: ESSP               PROGRAMMER: ZL1      CL**2
00015 *                                                                 DTSBX427
00016 *                                                                    CL*48
00017 *    02/15/2017  MODIFIED TO CONVERT ADDRESS FIELDS INTO UPPER       CL*48
00018 *                CASE                           PROGRAMMER: ZL1      CL*48
00019 *                                                                    CL*48
00020 *                                                                    CL*50
00021 *                                                                    CL*50
00022 *    04/06/2017  MODIFIED TO UPDATE THE RETURN MAIL FLAG WHEN        CL*50
00023 *                ADDRESS UPDATES COMPLETED      PROGRAMMER: ZL1      CL*50
00024 *                                                                    CL*50
00025 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX427
00026 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX427
00027 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBX427
00028 *                                                                 DTSBX427
00029 *  DESCRIPTION:                                                   DTSBX427
00030 *                                                                 DTSBX427
00031 *      UPDATE ADDRESSES AND THE MPRF MASTER FILE.                 DTSBX427
00032 *                                                                 DTSBX427
00033 *      DTSBX427 IS THE MAILING ADDRESS UPDATE PROCESS FROM A         CL**2
00034 *               ESSP ADDRESS FILE.                                   CL**2
00035 *                                                                 DTSBX427
00036 *      REPORT RECORDS INPUT:                                      DTSBX427
00037 *        NONE                                                     DTSBX427
00038 *                                                                 DTSBX427
00039 *      TAPES INPUT:                                               DTSBX427
00040 *        NONE.                                                    DTSBX427
00041 *                                                                 DTSBX427
00042 *      MASTER FILE RECORDS READ:                                  DTSBX427
00043 *        MHDR                                                     DTSBX427
00044 *        MPRF                                                     DTSBX427
00045 *        MTAD                                                     DTSBX427
00046 *                                                                 DTSBX427
00047 *      MASTER FILE RECORDS UPDATED:                               DTSBX427
00048 *        MPRF (REWRITE).                                          DTSBX427
00049 *        MTAD (REWRITE).                                          DTSBX427
00050 *        MELOG(WRITTEN).                                          DTSBX427
00051 *                                                                 DTSBX427
00052 *      RECORDS READ:                                              DTSBX427
00053 *        ESSP ADDRESS FILE (X110).                                   CL**2
00054 *                                                                 DTSBX427
00055 *      MODULES CALLED:                                            DTSBX427
00056 *        DTSBU203  FIELD ZIP AND JS ZIP DETERMINATION.            DTSBX427
00057 *        DTSBU910  MASTER FILE I/O.                               DTSBX427
00058 *        DTSBU921  ALTERNATE INDEX I/O.                           DTSBX427
00059 *                                                                 DTSBX427
00060 *****                                                             DTSBX427
00061      SKIP3                                                        DTSBX427
00062  ENVIRONMENT DIVISION.                                            DTSBX427
00063  CONFIGURATION SECTION.                                              CL*82
00064  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                                  CL*82
00065      SKIP2                                                           CL*82
00066                                                                      CL*82
00067  INPUT-OUTPUT SECTION.                                            DTSBX427
00068                                                                   DTSBX427
00069  FILE-CONTROL.                                                    DTSBX427
00070      SELECT REPT-PAID-FILE    ASSIGN TO X427RPT1                     CL*75
00071         FILE STATUS IS REPT-STATUS.                                  CL*75
00072                                                                      CL*75
00073      SELECT REPT-PEND-FILE    ASSIGN TO X427RPT2                     CL*75
00074         FILE STATUS IS REPT-STATUS.                                  CL*75
00075                                                                      CL*75
00076      SELECT ESSP-X110-FILE  ASSIGN TO DTSFX110.                      CL**2
00077  DATA DIVISION.                                                   DTSBX427
00078                                                                   DTSBX427
00079  FILE SECTION.                                                    DTSBX427
00080                                                                   DTSBX427
00081  FD  ESSP-X110-FILE                                                  CL**2
00082      LABEL RECORDS ARE STANDARD                                   DTSBX427
00083      RECORDING MODE IS F                                          DTSBX427
00084      BLOCK CONTAINS 0 RECORDS.                                    DTSBX427
00085                                                                   DTSBX427
00086  01  ESSP-X110-REC                PIC X(512).                        CL*67
00087                                                                      CL*75
00088  FD  REPT-PAID-FILE                                                  CL*75
00089      RECORDING MODE IS F                                             CL*75
00090      BLOCK CONTAINS 0 RECORDS                                        CL*75
00091      LABEL RECORDS ARE OMITTED.                                      CL*75
00092                                                                      CL*75
00093  01  REPT-PAID-REC           PIC X(200).                             CL*75
00094                                                                      CL*75
00095                                                                      CL*75
00096  FD  REPT-PEND-FILE                                                  CL*75
00097      RECORDING MODE IS F                                             CL*75
00098      BLOCK CONTAINS 0 RECORDS                                        CL*75
00099      LABEL RECORDS ARE OMITTED.                                      CL*75
00100                                                                      CL*75
00101  01  REPT-PEND-REC           PIC X(133).                             CL*75
00102                                                                      CL*75
00103                                                                      CL*75
00104      EJECT                                                        DTSBX427
00105                                                                   DTSBX427
00106  WORKING-STORAGE SECTION.                                         DTSBX427
001065 77  PAN-VALET PICTURE X(24) VALUE '094DTSBX427  02/27/20'.       DTSBX427
00107  77  PAN-VALET PICTURE X(24) VALUE '062DTSBX427  03/06/07'.       DTSBX427
00108      SKIP3                                                        DTSBX427
00109  01  WRK-AREA.                                                    DTSBX427
00110      05  WRK-ABEND-CD                PIC S9(04)  COMP VALUE +427.    CL**2
00111      05  ABEND-MSG                   PIC  X(60).                  DTSBX427
00112      05  WRK-SYS-ABSTIME             PIC S9(15)  COMP-3 VALUE +0. DTSBX427
00113      05  WRK-ABSTIME           PIC S9(15)  COMP-3 VALUE +1000.       CL*29
00114      05  W-EMP-NO                PIC S9(07)  COMP-3 VALUE +0.        CL*77
00115                                                                      CL*77
00116      05  UPD-MTAD-IND                 PIC  9(01) VALUE 0.            CL**7
00117      05  WRK-MPRF-MAIL-UPD-CNT        PIC   9 VALUE 0.               CL*55
00118      05  WRK-MTAD-MAIL-UPD-CNT        PIC   9 VALUE 0.               CL*55
00119      05  WRK-MTAD-MAIL-ADD-CNT        PIC   9 VALUE 0.               CL*55
00120      05  X110-EOF-IND                 PIC  X(01).                    CL**7
00121      05  WRK-MPRF-ADD-CNT            PIC S9(07)  COMP-3.             CL*18
00122      05  WRK-MPRF-UPD-CNT            PIC S9(07)  COMP-3.             CL*18
00123      05  WRK-MPRF-NOT-CNT            PIC S9(07)  COMP-3.             CL*19
00124      05  WRK-MTAD-ADD-CNT            PIC S9(07)  COMP-3.             CL*18
00125      05  WRK-MTAD-UPD-CNT            PIC S9(07)  COMP-3.             CL*18
00126      05  WRK-MDCD-ADD-CNT            PIC S9(07)  COMP-3.             CL*18
00127      05  WRK-MDCD-UPD-CNT            PIC S9(07)  COMP-3.             CL*18
00128      05  WRK-MLOG-REC-CNT            PIC S9(07)  COMP-3.          DTSBX427
00129      05  WRK-X110-REC-CNT             PIC S9(07)  COMP-3.            CL**5
00130      05  W-T002-ADDR-CNT              PIC S9(07)  COMP-3.            CL*13
00131      05  REPT-STATUS         PIC  X(02).                             CL*76
00132          88 REPT-STATUS-OK-88     VALUE '00'.                        CL*76
00133          88 REPT-STATUS-EOF-88    VALUE '10'.                        CL*76
00134                                                                      CL*76
00135                                                                      CL*21
00136      05  W-ERROR-IND                 PIC  X(01) VALUE 'N'.           CL*21
00137          88 W-ERROR-YES-88            VALUE 'Y'.                     CL*21
00138          88 W-ERROR-NO-88             VALUE 'N'.                     CL*21
00139                                                                      CL*21
00140      05  W-FATAL-ERROR-IND           PIC  X(01) VALUE 'N'.           CL*21
00141          88 W-FATAL-ERROR-YES-88      VALUE 'Y'.                     CL*21
00142          88 W-FATAL-ERROR-NO-88       VALUE 'N'.                     CL*21
00143                                                                      CL*21
00144      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSBX427
00145      05  WRK-TAD-EMP-NO              PIC S9(07)  COMP-3.          DTSBX427
00146      05  WRK-MTAD-ZIP-UPDATED-IND    PIC  X(01).                  DTSBX427
00147                                                                   DTSBX427
00148      05  WRK-ID-NO-9                 PIC  9(03).                  DTSBX427
00149      05  WRK-ID-NO-X REDEFINES WRK-ID-NO-9                        DTSBX427
00150                                      PIC  X(03).                  DTSBX427
00151      05  WRK-ZIP.                                                    CL**3
00152          10  WRK-ZIP-5           PIC X(05).                          CL**3
00153          10  WRK-DASH            PIC X(01)  VALUE '-'.               CL**3
00154          10  WRK-ZIP-PLUS4       PIC X(04).                          CL**3
00155  01  HEADER-3.                                                       CL*75
00156      05  FILLER                   PIC X(01) VALUE SPACES.            CL*75
00157      05  FILLER                   PIC X(38) VALUE                    CL*75
00158          '  TAX STATUS STAFF'.                                       CL*84
00159      05  HDR3-LITERAL             PIC X(43) VALUE                    CL*75
00160          '  ESSP DAILY ADDRESS UPDATES             '.                CL*84
00161      05  FILLER                   PIC X(28) VALUE SPACES.            CL*75
00162 *    05  FILLER                   PIC X(06) VALUE 'PAGE:'.           CL*75
00163 *    05  HDR3-PAGE                PIC ZZ,ZZ9.                        CL*75
00164  01  HEADER-43.                                                      CL*75
00165      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*75
00166      05  FILLER                   PIC X(52)  VALUE                   CL*80
00167          'EMP NO   TYPE  QAS  ATTN                       LINE1'.     CL*80
00168      05  FILLER                   PIC X(27)  VALUE                   CL*80
00169          '                      LINE2'.                              CL*80
00170      05  FILLER                   PIC X(22)  VALUE SPACES.           CL*85
00171      05  FILLER                   PIC X(44)  VALUE                   CL*85
00172             '              CITY                  ST  '.              CL*94
00173      05  HDR5-NAME                PIC X(31)  VALUE                   CL*75
00174               'ZIP              EMAIL      '.                        CL*93
00175                                                                   DTSBX427
00176                                                                      CL*66
00177  01  BLANK-LINE                     PIC X(200) VALUE SPACES.         CL*85
00178  01  DETAIL-LINE-1.                                                  CL*85
00179      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00180      15  X427-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL*75
00181      15  FILLER                     PIC  X(03) VALUE SPACES.         CL*80
00182      15  X427-TYPE                  PIC  X(02).                      CL*79
00183      15  FILLER                     PIC  X(04) VALUE SPACES.         CL*80
00184      15  X427-QAS                   PIC  X(01).                      CL*75
00185      15  FILLER                     PIC  X(03) VALUE SPACES.         CL*84
00186      15  X427-ATTN                  PIC  X(20).                      CL*75
00187      15  FILLER                     PIC  X(07) VALUE SPACES.         CL*80
00188      15  X427-LINE1                 PIC  X(25).                      CL*75
00189      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00190      15  X427-LINE2                 PIC  X(40).                      CL*92
00191      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00192      15  X427-CITY                  PIC  X(20).                      CL*92
00193      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00194      15  X427-STATE                 PIC  X(02).                      CL*75
00195      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00196      15  X427-ZIP                   PIC  X(10).                      CL*75
00197      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00198      15  X427-EMAIL                 PIC  X(30).                      CL*75
00199      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00200      15  X427-MESSAGE               PIC  X(10) VALUE SPACES.         CL*79
00201                                                                      CL*75
00202  01  DETAIL-PEND-1.                                                  CL*75
00203      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00204      15  P427-EMP-NO                PIC  999B999 BLANK WHEN ZERO.    CL*75
00205      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00206      15  P427-TYPE                  PIC  X(01).                      CL*75
00207      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00208      15  P427-ATTN                  PIC  X(20).                      CL*75
00209      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00210      15  P427-LINE1                 PIC  X(25).                      CL*75
00211      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00212      15  P427-LINE2                 PIC  X(25).                      CL*75
00213      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00214      15  P427-CITY                  PIC  X(15).                      CL*75
00215      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00216      15  P427-STATE                 PIC  X(02).                      CL*75
00217      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00218      15  P427-ZIP                   PIC  X(10).                      CL*75
00219      15  FILLER                     PIC  X(02) VALUE SPACES.         CL*75
00220      15  P427-MESSAGE               PIC  X(10).                      CL*75
00221                                                                      CL*75
00222  01  FOOTING-LINE-51.                                                CL*75
00223      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*75
00224      05  WS-X110-PEN-CNT           PIC  ZZ,ZZ9.                      CL*75
00225      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*75
00226      05  FILLER                   PIC  X(40) VALUE                   CL*75
00227                       '# OF ADDRESSES RECEIVED FROM ESSP    '.       CL*75
00228      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*75
00229                                                                      CL*75
00230  01  FOOTING-LINE-6.                                                 CL*75
00231      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*75
00232      05  WS-X102-RED-CNT           PIC  ZZ,ZZ9.                      CL*75
00233      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*75
00234      05  FILLER                   PIC  X(45) VALUE                   CL*75
00235                       '# OF ADDRESSES DUTAS PASSED        '.         CL*89
00236      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*75
00237  01  FOOTING-LINE-7.                                                 CL*75
00238      05  FILLER                   PIC  X(25)  VALUE SPACES.          CL*75
00239      05  WS-X102-ERR-CNT           PIC  ZZ,ZZ9.                      CL*75
00240      05  FILLER                   PIC  X(02)  VALUE SPACES.          CL*75
00241      05  FILLER                   PIC  X(40) VALUE                   CL*75
00242          '# OF ADDRESSES DUTAS FAILED    '.                          CL*75
00243      05  FILLER                   PIC  X(32)  VALUE SPACES.          CL*75
00244                                                                      CL*75
00245  01  X110-REC.                                                       CL*75
00246  ++INCLUDE DTSUX110                                                  CL*66
00247      EJECT                                                           CL*66
00248                                                                      CL*66
00249                                                                      CL*18
00250  01  R140-REC.                                                       CL*18
00251  ++INCLUDE DTSIR140                                                  CL*18
00252      EJECT                                                        DTSBX427
00253                                                                      CL*47
00254  01  L009-LINK-AREA.                                                 CL*47
00255  ++INCLUDE DTSIL009                                                  CL*47
00256      EJECT                                                           CL*47
00257  01  L005-LINK-AREA.                                              DTSBX427
00258  ++INCLUDE DTSIL005                                               DTSBX427
00259      EJECT                                                        DTSBX427
00260  01  L203-LINK-AREA.                                              DTSBX427
00261  ++INCLUDE DTSIL203                                               DTSBX427
00262      EJECT                                                        DTSBX427
00263  01  L331-LINK-AREA.                                              DTSBX427
00264  ++INCLUDE DTSIL331                                               DTSBX427
00265      EJECT                                                        DTSBX427
00266  01  L910-LINK-AREA.                                              DTSBX427
00267  ++INCLUDE DTSIL910                                               DTSBX427
00268      EJECT                                                        DTSBX427
00269  01  MSKL-REC.                                                    DTSBX427
00270  ++INCLUDE DTSIMSKL                                               DTSBX427
00271      EJECT                                                        DTSBX427
00272  01  MHDR-REC.                                                    DTSBX427
00273  ++INCLUDE DTSIMHDR                                               DTSBX427
00274      EJECT                                                        DTSBX427
00275  01  MPRF-REC.                                                    DTSBX427
00276  ++INCLUDE DTSIMPRF                                               DTSBX427
00277      EJECT                                                        DTSBX427
00278                                                                      CL*12
00279  01  T002-REC.                                                       CL*12
00280  ++INCLUDE DTSIT002                                                  CL*12
00281                                                                      CL*12
00282 *  ADDRESS                                                           CL*12
00283  01  Y110-REC.                                                       CL*12
00284  ++INCLUDE DTSIY110                                                  CL*12
00285                                                                      CL*12
00286  01  MTAD-REC.                                                    DTSBX427
00287  ++INCLUDE DTSIMTAD                                               DTSBX427
00288      EJECT                                                        DTSBX427
00289  01  L921-LINK-AREA.                                              DTSBX427
00290  ++INCLUDE DTSIL921                                               DTSBX427
00291                                                                      CL*12
00292  01  L927-LINK-AREA.                                                 CL*12
00293  ++INCLUDE DTSIL927                                                  CL*12
00294                                                                      CL*12
00295  01  TSKL-REC.                                                       CL*12
00296  ++INCLUDE DTSITSKL                                                  CL*12
00297                                                                      CL*12
00298      EJECT                                                        DTSBX427
00299  01  ISKL-REC.                                                    DTSBX427
00300  ++INCLUDE DTSIISKL                                               DTSBX427
00301      EJECT                                                        DTSBX427
00302  PROCEDURE DIVISION.                                              DTSBX427
00303                                                                   DTSBX427
00304      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBX427
00305                                                                   DTSBX427
00306      MOVE 'N' TO X110-EOF-IND.                                       CL**5
00307                                                                   DTSBX427
00308      MOVE +0    TO WRK-EMP-NO WRK-TAD-EMP-NO.                     DTSBX427
00309                                                                   DTSBX427
00310      MOVE 'N' TO WRK-MTAD-ZIP-UPDATED-IND.                        DTSBX427
00311                                                                   DTSBX427
00312      PERFORM P0000-PROCESS THRU P0000-EXIT                        DTSBX427
00313          UNTIL X110-EOF-IND = 'Y'.                                   CL**3
00314                                                                   DTSBX427
00315      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBX427
00316      IF W-ERROR-YES-88                                               CL*18
00317         MOVE 02 TO RETURN-CODE.                                      CL*36
00318                                                                   DTSBX427
00319      GOBACK.                                                      DTSBX427
00320      EJECT                                                        DTSBX427
00321                                                                   DTSBX427
00322  I0000-INITIATE.                                                  DTSBX427
00323      PERFORM S910-OPEN-UPDATE THRU S910-EXIT.                     DTSBX427
00324                                                                   DTSBX427
00325      PERFORM S921-OPEN-UPDATE THRU S921-EXIT.                     DTSBX427
00326                                                                   DTSBX427
00327      PERFORM S927A-OPEN-UPDATE THRU S927A-EXIT.                      CL*19
00328                                                                      CL*16
00329      OPEN INPUT ESSP-X110-FILE.                                      CL**6
00330      OPEN OUTPUT REPT-PAID-FILE REPT-PEND-FILE.                      CL*75
00331                                                                   DTSBX427
00332      WRITE REPT-PAID-REC FROM HEADER-3                               CL*82
00333            AFTER ADVANCING TOP-OF-PAGE                               CL*82
00334                                                                      CL*82
00335      WRITE REPT-PAID-REC FROM HEADER-43                              CL*83
00336            AFTER ADVANCING 2 LINE.                                   CL*85
00337      WRITE REPT-PAID-REC FROM BLANK-LINE                             CL*85
00338            AFTER ADVANCING 1 LINE.                                   CL*85
00339      MOVE +0 TO WRK-MPRF-UPD-CNT                                     CL*19
00340                 W-T002-ADDR-CNT                                      CL*30
00341                 WRK-MTAD-UPD-CNT                                     CL*19
00342                 WRK-MPRF-NOT-CNT                                     CL*20
00343                 WRK-MPRF-ADD-CNT                                     CL*19
00344                 WRK-MTAD-ADD-CNT                                     CL*19
00345                 WRK-MDCD-ADD-CNT                                     CL*26
00346                 WRK-MDCD-UPD-CNT                                     CL*26
00347                 WRK-MLOG-REC-CNT                                     CL*26
00348                 WRK-X110-REC-CNT.                                    CL**5
00349                                                                   DTSBX427
00350      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBX427
00351                                                                   DTSBX427
00352      MOVE +0 TO MSKL-EMP-NO.                                      DTSBX427
00353                                                                   DTSBX427
00354      SET MSKL-HDR-88 TO TRUE.                                     DTSBX427
00355                                                                   DTSBX427
00356      PERFORM S910-READ THRU S910-EXIT.                            DTSBX427
00357                                                                   DTSBX427
00358      IF L910-NO-REC-88                                            DTSBX427
00359          MOVE 'MHDR RECORD NOT FOUND' TO ABEND-MSG                DTSBX427
00360          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBX427
00361                                                                   DTSBX427
00362      MOVE MSKL-REC TO MHDR-REC.                                   DTSBX427
00363                                                                   DTSBX427
00364      PERFORM S005-FROM-SYS THRU S005-EXIT.                        DTSBX427
00365      MOVE L005-ABSTIME TO WRK-SYS-ABSTIME.                        DTSBX427
00366      MOVE LENGTH OF R140-REC           TO R140-LENGTH.               CL*18
00367      MOVE '140'                        TO R140-REC-TYPE.             CL*18
00368                                                                   DTSBX427
00369  I0000-EXIT.                                                      DTSBX427
00370      EXIT.                                                        DTSBX427
00371                                                                   DTSBX427
00372  P0000-PROCESS.                                                   DTSBX427
00373      READ ESSP-X110-FILE INTO X110-REC                               CL*66
00374        AT END                                                     DTSBX427
00375          MOVE 'Y' TO X110-EOF-IND                                    CL**3
00376          PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT               DTSBX427
00377          GO TO P0000-EXIT.                                        DTSBX427
00378                                                                   DTSBX427
00379      ADD +1 TO WRK-X110-REC-CNT.                                     CL**3
00380                                                                   DTSBX427
00381                                                                   DTSBX427
00382 *    IF X110-EMP-NO = WRK-EMP-NO OR                                  CL*68
00383 *       WRK-X110-REC-CNT = 1                                         CL*68
00384 *        NEXT SENTENCE                                               CL*68
00385 *    ELSE                                                            CL*68
00386 *        PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT                  CL*68
00387 *      IF L910-NO-REC-88                                             CL*68
00388 *          DISPLAY ' EMPL NOT FOUND IN DUTAS ADDR NOT ADDED> '       CL*68
00389 *            X110-EMP-NO                                             CL*68
00390 *         GO TO P0000-EXIT.                                          CL*68
00391      IF X110-STREET-2 = SPACES                                       CL*72
00392         MOVE X110-STREET-1 TO X110-STREET-2                          CL*72
00393         MOVE SPACES        TO X110-STREET-1.                         CL*72
00394                                                                      CL*62
00395      MOVE X110-EMP-NO TO WRK-EMP-NO                                  CL*62
00396      MOVE 'N' TO WRK-MTAD-ZIP-UPDATED-IND                            CL*62
00397      MOVE X110-EMP-NO TO L331-EMP-NO                                 CL*62
00398      MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE                   CL*62
00399      MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME                     CL*62
00400      MOVE 'WEBESSP ' TO L331-OP-ID.                                  CL*62
00401                                                                   DTSBX427
00402      MOVE LOW-VALUES TO MTAD-KEY-AREA.                               CL**4
00403      IF X110-ADDR-TYPE-MAIL-88                                       CL**3
00404         SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE                      CL**3
00405      ELSE                                                            CL**3
00406      IF X110-ADDR-TYPE-RECS-88                                       CL**3
00407         SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE                      CL**3
00408      ELSE                                                            CL**3
00409         SET W-ERROR-YES-88    TO TRUE                                CL*18
00410         MOVE SPACES TO R140-MESSAGE                                  CL*18
00411         MOVE WRK-EMP-NO TO R140-EMP-NO                               CL*19
00412         STRING                                                       CL*18
00413            'X427  INV ADDR CODE ON X110 ADDR REC  ' X110-ADDR-TYPE   CL*19
00414              DELIMITED BY SIZE                                       CL*18
00415              INTO R140-MESSAGE                                       CL*18
00416         END-STRING                                                   CL*18
00417         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*18
00418       GO TO P0000-EXIT.                                              CL**3
00419                                                                      CL**3
00420       IF MTAD-ID-TAX-RECORDS-ADDR-88 AND X110-STATE NOT = 'DC'       CL*42
00421         SET W-ERROR-YES-88    TO TRUE                                CL*34
00422         MOVE SPACES TO R140-MESSAGE                                  CL*34
00423         MOVE WRK-EMP-NO TO R140-EMP-NO                               CL*34
00424         STRING                                                       CL*34
00425            'X427  STATE NOT DC FOR DC ADDRESS     ' X110-STATE       CL*34
00426              DELIMITED BY SIZE                                       CL*34
00427              INTO R140-MESSAGE                                       CL*34
00428         END-STRING                                                   CL*34
00429         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*34
00430       GO TO P0000-EXIT.                                              CL*34
00431                                                                      CL*34
00432      MOVE ZEROS TO UPD-MTAD-IND                                      CL**5
00433                                                                      CL**5
00434      DISPLAY '+++++++ CHECKING FOR ADDRESS UPDATES: ' X110-EMP-NO.   CL*57
00435      PERFORM P1000-MTAD-UPDATE              THRU P1000-EXIT.         CL**3
00436                                                                      CL*78
00437      MOVE X110-EMP-NO               TO X427-EMP-NO.                  CL*78
00438      MOVE X110-ADDR-TYPE            TO X427-TYPE                     CL*78
00439      MOVE X110-ATTENTION            TO X427-ATTN                     CL*78
00440      MOVE X110-STREET-1             TO X427-LINE1                    CL*78
00441      MOVE X110-STREET-2             TO X427-LINE2                    CL*78
00442      MOVE X110-CITY                 TO X427-CITY                     CL*78
00443      MOVE X110-STATE                TO X427-STATE.                   CL*78
00444      MOVE X110-ZIP                  TO X427-ZIP.                     CL*78
00445      MOVE X110-EMAIL                TO X427-EMAIL.                   CL*78
00446      MOVE X110-QAS-FLAG             TO X427-QAS.                     CL*78
00447      WRITE REPT-PAID-REC            FROM DETAIL-LINE-1.              CL*78
00448                                                                      CL**3
00449  P0000-EXIT.                                                      DTSBX427
00450      EXIT.                                                        DTSBX427
00451                                                                   DTSBX427
00452  P1000-MTAD-UPDATE.                                               DTSBX427
00453                                                                   DTSBX427
00454 *    MOVE LOW-VALUES  TO MTAD-KEY-AREA.                              CL*43
00455      MOVE X110-EMP-NO TO WRK-TAD-EMP-NO WRK-EMP-NO.                  CL*44
00456                                                                   DTSBX427
00457      MOVE WRK-TAD-EMP-NO TO MTAD-EMP-NO.                          DTSBX427
00458      SET MTAD-TAD-88 TO TRUE.                                     DTSBX427
00459                                                                      CL**3
00460      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSBX427
00461                                                                   DTSBX427
00462      PERFORM S910-READ THRU S910-EXIT.                            DTSBX427
00463                                                                   DTSBX427
00464      IF L910-NO-REC-88                                            DTSBX427
00465 *       DISPLAY 'MTAD NOT FOUND ' MTAD-KEY-AREA                      CL*57
00466         MOVE SPACES TO R140-MESSAGE                                  CL*18
00467         MOVE WRK-EMP-NO TO R140-EMP-NO                               CL*19
00468       IF X110-ADDR-TYPE-MAIL-88                                      CL*37
00469        DISPLAY  '------ X427  MAIL ADDR NOT IN DUTAS  -ADDED '       CL*57
00470              X110-EMP-NO                                             CL*45
00471         STRING                                                       CL*18
00472            'X427  MAIL ADDR NOT IN DUTAS  -ADDED '                   CL*37
00473              X110-EMP-NO                                             CL*37
00474              DELIMITED BY SIZE                                       CL*18
00475              INTO R140-MESSAGE                                       CL*18
00476         END-STRING                                                   CL*18
00477         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*18
00478         PERFORM P1050-MTAD-ADD  THRU P1050-EXIT                      CL*18
00479        PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT                    CL*68
00480         GO TO P1000-EXIT                                             CL*37
00481       ELSE                                                           CL*38
00482        DISPLAY    '----- X427  DC ADDR NOT IN DUTAS  -ADDED '        CL*57
00483              X110-EMP-NO                                             CL*45
00484         STRING                                                       CL*37
00485            'X427  DC ADDR NOT IN DUTAS  -ADDED '                     CL*37
00486              X110-EMP-NO                                             CL*37
00487              DELIMITED BY SIZE                                       CL*37
00488              INTO R140-MESSAGE                                       CL*37
00489         END-STRING                                                   CL*37
00490         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*37
00491         PERFORM P1050-MTAD-ADD  THRU P1050-EXIT                      CL*37
00492         GO TO P1000-EXIT.                                            CL*37
00493                                                                      CL*18
00494      MOVE MSKL-REC TO MTAD-REC.                                   DTSBX427
00495                                                                   DTSBX427
00496      MOVE X110-ZIP        TO WRK-ZIP.                                CL**3
00497                                                                   DTSBX427
00498      IF WRK-ZIP = MTAD-ZIP                                           CL**3
00499          MOVE 'N' TO WRK-MTAD-ZIP-UPDATED-IND                        CL**3
00500      ELSE                                                         DTSBX427
00501          MOVE 'Y' TO WRK-MTAD-ZIP-UPDATED-IND.                    DTSBX427
00502                                                                   DTSBX427
00503      MOVE ZEROS TO UPD-MTAD-IND.                                     CL*32
00504                                                                      CL*32
00505      PERFORM P1100-CHECK-FOR-MLOG THRU P1100-EXIT.                DTSBX427
00506                                                                   DTSBX427
00507                                                                   DTSBX427
00508      IF UPD-MTAD-IND = 1                                             CL**5
00509        DISPLAY '===== DUTAS ADDRESS UPDATED ' X110-EMP-NO            CL*56
00510        MOVE MHDR-CURR-RUN-DATE      TO MTAD-CHNG-DATE                CL**5
00511        MOVE MTAD-REC TO MSKL-REC                                     CL**5
00512        PERFORM S910-REWRITE THRU S910-EXIT                           CL*68
00513        PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT.                   CL*68
00514                                                                   DTSBX427
00515  P1000-EXIT.                                                      DTSBX427
00516      EXIT.                                                        DTSBX427
00517                                                                   DTSBX427
00518  P1050-MTAD-ADD.                                                     CL*11
00519        MOVE +0 TO WRK-MTAD-MAIL-ADD-CNT.                             CL*51
00520        IF X110-ADDR-TYPE-MAIL-88                                     CL*35
00521         ADD +1 TO WRK-MTAD-ADD-CNT                                   CL*18
00522        MOVE +1 TO WRK-MTAD-MAIL-ADD-CNT                              CL*51
00523 *       DISPLAY '<<< X427--ADDIN T002 MAIL ADDR ' WRK-EMP-NO         CL*57
00524        ELSE                                                          CL*18
00525 *       DISPLAY '<<< X427--ADDIN T002 DC   ADDR ' WRK-EMP-NO         CL*57
00526         ADD +1 TO WRK-MDCD-ADD-CNT.                                  CL*18
00527                                                                      CL*18
00528      PERFORM S005-FROM-SYS             THRU S005-EXIT.               CL*13
00529      MOVE LOW-VALUES                TO T002-REC.                     CL*11
00530                                                                      CL*11
00531      SET T002-LENGTH-EMP-ADDR-88    TO TRUE.                         CL*11
00532      MOVE '002'                     TO T002-REC-TYPE.                CL*11
00533      MOVE X110-EMP-NO               TO T002-EMP-NO.                  CL*13
00534      MOVE 'WEB ESSP  '              TO T002-ORIGIN.                  CL*12
00535      MOVE L005-DATE                 TO T002-SYS-DATE.                CL*13
00536      MOVE L005-TIME                 TO T002-SYS-TIME.                CL*13
00537                                                                      CL*11
00538      MOVE X110-ADDR-TYPE            TO Y110-EMP-ADDR-TYPE.           CL*11
00539                                                                      CL*47
00540      IF  X110-ATTENTION > SPACES                                     CL*47
00541         MOVE X110-ATTENTION    TO L009-DATA                          CL*47
00542         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*47
00543         MOVE L009-DATA        TO Y110-EMP-ATTN                       CL*49
00544      ELSE                                                            CL*47
00545      MOVE X110-ATTENTION            TO Y110-EMP-ATTN.                CL*11
00546                                                                      CL*47
00547      IF  X110-STREET-1  > SPACES                                     CL*47
00548         MOVE X110-STREET-1     TO L009-DATA                          CL*47
00549         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*47
00550         MOVE L009-DATA        TO Y110-EMP-DELV1                      CL*47
00551      ELSE                                                            CL*47
00552      MOVE X110-STREET-1             TO Y110-EMP-DELV1.               CL*11
00553                                                                      CL*47
00554      IF  X110-STREET-2  > SPACES                                     CL*47
00555         MOVE X110-STREET-2     TO L009-DATA                          CL*47
00556         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*47
00557         MOVE L009-DATA        TO Y110-EMP-DELV2                      CL*47
00558      ELSE                                                            CL*47
00559      MOVE X110-STREET-2             TO Y110-EMP-DELV2.               CL*11
00560                                                                      CL*47
00561      IF  X110-CITY  > SPACES                                         CL*47
00562         MOVE X110-CITY         TO L009-DATA                          CL*47
00563         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*47
00564         MOVE L009-DATA        TO Y110-EMP-CITY                       CL*47
00565      ELSE                                                            CL*47
00566      MOVE X110-CITY                 TO Y110-EMP-CITY.                CL*11
00567                                                                      CL*47
00568      IF  X110-STATE > SPACES                                         CL*47
00569         MOVE X110-STATE        TO L009-DATA                          CL*47
00570         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*47
00571         MOVE L009-DATA        TO Y110-EMP-STATE                      CL*47
00572      ELSE                                                            CL*47
00573      MOVE X110-STATE                TO Y110-EMP-STATE.               CL*11
00574 *    MOVE X110-STATE                TO Y110-EMP-STATE.               CL*51
00575      MOVE X110-ZIP                  TO Y110-EMP-ZIP.                 CL*11
00576      MOVE X110-PHONE                TO Y110-EMP-VOICE.               CL*11
00577      MOVE X110-FAX                  TO Y110-EMP-FAX.                 CL*11
00578      MOVE X110-EMAIL                TO Y110-EMP-EMAIL.               CL*11
00579      MOVE Y110-REC                  TO T002-DATA-AREA.               CL*11
00580      SET T002-EMP-ADDR-88           TO TRUE.                         CL*11
00581      MOVE T002-REC                  TO TSKL-REC.                     CL*11
00582      PERFORM S927B-WRITE            THRU S927B-EXIT.                 CL*11
00583      ADD +1                         TO W-T002-ADDR-CNT.              CL*11
00584                                                                      CL*11
00585  P1050-EXIT.                                                         CL*11
00586      EXIT.                                                           CL*11
00587                                                                      CL*11
00588  P1100-CHECK-FOR-MLOG.                                            DTSBX427
00589                                                                   DTSBX427
00590      MOVE 0 TO WRK-MTAD-MAIL-UPD-CNT.                                CL*55
00591      ADD  +100            TO WRK-ABSTIME                             CL*29
00592      PERFORM S005-FROM-SYS THRU S005-EXIT.                           CL*27
00593      MOVE L005-ABSTIME TO WRK-SYS-ABSTIME.                           CL*27
00594      MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO                      CL*44
00595      MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE                   CL*27
00596      ADD  WRK-ABSTIME TO WRK-SYS-ABSTIME.                            CL*29
00597      MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME                     CL*27
00598      MOVE 'WEBESSP ' TO L331-OP-ID.                                  CL*41
00599                                                                      CL*24
00600      IF MTAD-ID-TAX-MAILING-ADDR-88                               DTSBX427
00601          MOVE 'MAILING ADDRESS' TO L331-REC-OCC-ID                DTSBX427
00602 *       ADD +1 TO WRK-MTAD-ADD-CNT                                   CL*46
00603      ELSE                                                         DTSBX427
00604         IF MTAD-ID-TAX-RECORDS-ADDR-88                            DTSBX427
00605            MOVE 'RECORDS ADDRESS' TO L331-REC-OCC-ID              DTSBX427
00606 *       ADD +1 TO WRK-MDCD-ADD-CNT                                   CL*46
00607         ELSE                                                      DTSBX427
00608            MOVE MTAD-ID-NO TO WRK-ID-NO-9                         DTSBX427
00609            MOVE WRK-ID-NO-X TO L331-REC-OCC-ID.                   DTSBX427
00610                                                                   DTSBX427
00611         MOVE X110-ATTENTION    TO L009-DATA                          CL*69
00612         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*69
00613         MOVE L009-DATA        TO X110-ATTENTION                      CL*69
00614      IF X110-ATTENTION  = MTAD-ATTN-LINE                             CL**5
00615          NEXT SENTENCE                                            DTSBX427
00616      ELSE                                                         DTSBX427
00617          MOVE 'MTAD-ATTENTION   ' TO L331-FIELD-NAME                 CL**3
00618          MOVE MTAD-ATTN-LINE    TO L331-FROM-VALUE                   CL**5
00619          DISPLAY  'MTAD-ATTENTION B ' MTAD-ATTN-LINE                 CL**7
00620          MOVE X110-ATTENTION    TO L331-TO-VALUE                     CL**4
00621          MOVE X110-ATTENTION    TO MTAD-ATTN-LINE                    CL**5
00622          DISPLAY  'MTAD-ATTENTION A ' X110-ATTENTION                 CL**7
00623          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL*14
00624          MOVE 1 TO UPD-MTAD-IND                                      CL**5
00625          ADD +1 TO WRK-MLOG-REC-CNT.                              DTSBX427
00626                                                                   DTSBX427
00627                                                                      CL**3
00628         MOVE X110-STREET-1     TO L009-DATA                          CL*69
00629         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*69
00630         MOVE L009-DATA        TO X110-STREET-1                       CL*69
00631      IF X110-STREET-1     = MTAD-DELIV-LINE-1                        CL**6
00632          NEXT SENTENCE                                               CL**3
00633      ELSE                                                            CL**3
00634          MOVE 'MTAD-DELIV-LINE-1' TO L331-FIELD-NAME                 CL**4
00635          MOVE MTAD-DELIV-LINE-1 TO L331-FROM-VALUE                   CL**4
00636          DISPLAY  'MTAD-DELV LIN1 B ' MTAD-DELIV-LINE-1              CL**7
00637          MOVE X110-STREET-1           TO MTAD-DELIV-LINE-1           CL**6
00638          MOVE X110-STREET-1           TO L331-TO-VALUE               CL*52
00639          DISPLAY  'MTAD-DELV LIN1 A ' X110-STREET-1                  CL**7
00640          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL*14
00641          MOVE 1 TO UPD-MTAD-IND                                      CL**5
00642          ADD +1 TO WRK-MLOG-REC-CNT.                                 CL**3
00643                                                                      CL**3
00644         MOVE X110-STREET-2     TO L009-DATA                          CL*69
00645         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*69
00646         MOVE L009-DATA        TO X110-STREET-2                       CL*69
00647                                                                      CL**4
00648      IF X110-STREET-2     = MTAD-DELIV-LINE-2                        CL**6
00649          NEXT SENTENCE                                               CL**4
00650      ELSE                                                            CL**4
00651          MOVE 'MTAD-DELIV-LINE-2' TO L331-FIELD-NAME                 CL**4
00652          MOVE MTAD-DELIV-LINE-2 TO L331-FROM-VALUE                   CL**4
00653          DISPLAY  'MTAD-DELV LIN2 B ' MTAD-DELIV-LINE-2              CL**7
00654          MOVE X110-STREET-2     TO L331-TO-VALUE                     CL**6
00655          MOVE X110-STREET-2     TO MTAD-DELIV-LINE-2                 CL**6
00656          DISPLAY  'MTAD-DELV LIN3 A ' X110-STREET-2                  CL**7
00657          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL*14
00658          MOVE 1 TO UPD-MTAD-IND                                      CL**5
00659          ADD +1 TO WRK-MLOG-REC-CNT.                                 CL**4
00660                                                                      CL**4
00661         MOVE X110-CITY         TO L009-DATA                          CL*69
00662         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*69
00663         MOVE L009-DATA        TO X110-CITY                           CL*69
00664      IF X110-CITY      = MTAD-CITY                                   CL**4
00665          NEXT SENTENCE                                            DTSBX427
00666      ELSE                                                         DTSBX427
00667          MOVE 'MTAD-CITY' TO L331-FIELD-NAME                      DTSBX427
00668          MOVE MTAD-CITY TO L331-FROM-VALUE                        DTSBX427
00669          DISPLAY  'MTAD-CITY      B ' MTAD-CITY                      CL**7
00670          MOVE X110-CITY TO L331-TO-VALUE                             CL**6
00671          MOVE X110-CITY TO MTAD-CITY                                 CL**6
00672          DISPLAY  'MTAD-CITY      A ' X110-CITY                      CL**7
00673          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL*14
00674          MOVE 1 TO UPD-MTAD-IND                                      CL**5
00675          ADD +1 TO WRK-MLOG-REC-CNT.                              DTSBX427
00676                                                                   DTSBX427
00677         MOVE X110-STATE        TO L009-DATA                          CL*69
00678         PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT                  CL*69
00679         MOVE L009-DATA        TO X110-STATE                          CL*69
00680      IF X110-STATE     = MTAD-ST                                     CL**4
00681          NEXT SENTENCE                                            DTSBX427
00682      ELSE                                                         DTSBX427
00683          MOVE 'MTAD-ST' TO L331-FIELD-NAME                        DTSBX427
00684          MOVE MTAD-ST TO L331-FROM-VALUE                          DTSBX427
00685          DISPLAY  'MTAD-STATE     B ' MTAD-ST                        CL**7
00686          MOVE X110-STATE TO L331-TO-VALUE                            CL**4
00687          MOVE X110-STATE TO MTAD-ST                                  CL**5
00688          DISPLAY  'MTAD-STATE     A ' X110-STATE                     CL**7
00689          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL*14
00690          MOVE 1 TO UPD-MTAD-IND                                      CL**5
00691          ADD +1 TO WRK-MLOG-REC-CNT.                              DTSBX427
00692                                                                   DTSBX427
00693      IF WRK-ZIP = MTAD-ZIP                                           CL**4
00694          NEXT SENTENCE                                            DTSBX427
00695      ELSE                                                         DTSBX427
00696          MOVE 'MTAD-ZIP' TO L331-FIELD-NAME                       DTSBX427
00697          MOVE MTAD-ZIP TO L331-FROM-VALUE                         DTSBX427
00698          DISPLAY  'MTAD-ZIP       B ' MTAD-ZIP                       CL**7
00699          MOVE WRK-ZIP TO L331-TO-VALUE                               CL**4
00700          MOVE WRK-ZIP TO MTAD-ZIP                                    CL**6
00701          DISPLAY  'MTAD-ZIP       A ' MTAD-ZIP                       CL*38
00702          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL*14
00703          MOVE 1 TO UPD-MTAD-IND                                      CL**6
00704          ADD +1 TO WRK-MLOG-REC-CNT.                              DTSBX427
00705                                                                   DTSBX427
00706  P1100-CHECK-EMAIL.                                                  CL*91
00707      IF X110-EMAIL  = SPACES                                         CL*91
00708         GO TO P1100-CHECK-PHONE.                                     CL*91
00709                                                                      CL*91
00710      IF X110-EMAIL  = MTAD-EMAIL-ADDRESS                             CL*91
00711          NEXT SENTENCE                                               CL**4
00712      ELSE                                                            CL**4
00713          MOVE 'MTAD-EMAIL ADDR' TO L331-FIELD-NAME                   CL**4
00714          MOVE MTAD-EMAIL-ADDRESS  TO L331-FROM-VALUE                 CL**4
00715          DISPLAY  'MTAD-EMAIL     B ' MTAD-EMAIL-ADDRESS             CL**7
00716          MOVE X110-EMAIL  TO L331-TO-VALUE                           CL**4
00717          MOVE X110-EMAIL  TO MTAD-EMAIL-ADDRESS                      CL**5
00718          DISPLAY  'MTAD-EMAIL     A ' X110-EMAIL                     CL**7
00719          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL*14
00720          MOVE 1 TO UPD-MTAD-IND                                      CL**5
00721          ADD +1 TO WRK-MLOG-REC-CNT.                                 CL**4
00722                                                                      CL*38
00723  P1100-CHECK-PHONE.                                                  CL*91
00724      IF X110-PHONE  = SPACES                                         CL*91
00725         GO TO P1100-CHECK-MTAD.                                      CL*91
00726                                                                      CL*91
00727      IF X110-PHONE  = MTAD-VOICE-1                                   CL*90
00728          NEXT SENTENCE                                               CL*90
00729      ELSE                                                            CL*90
00730          MOVE 'MTAD-PHONE     ' TO L331-FIELD-NAME                   CL*90
00731          MOVE MTAD-VOICE-1        TO L331-FROM-VALUE                 CL*90
00732          DISPLAY  'MTAD-PHONE     B ' MTAD-VOICE-1                   CL*90
00733          MOVE X110-PHONE  TO L331-TO-VALUE                           CL*90
00734          MOVE X110-PHONE  TO MTAD-VOICE-1                            CL*90
00735          DISPLAY  'MTAD-PHONE     A ' X110-PHONE                     CL*90
00736          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL*90
00737          MOVE 1 TO UPD-MTAD-IND                                      CL*90
00738          ADD +1 TO WRK-MLOG-REC-CNT.                                 CL*90
00739                                                                      CL*90
00740  P1100-CHECK-MTAD.                                                   CL*91
00741       IF UPD-MTAD-IND = 0                                            CL*38
00742          GO TO P1100-EXIT.                                           CL*39
00743                                                                      CL*38
00744       IF X110-ADDR-TYPE-MAIL-88                                      CL*38
00745        MOVE +1 TO WRK-MTAD-MAIL-UPD-CNT                              CL*51
00746        DISPLAY '<<<< ---X427 DUTAS MAILING ADDR <UPD> ' WRK-EMP-NO   CL*55
00747         STRING                                                       CL*38
00748            'X427  DUTAS MAILING ADDRESS <UPDATED> '                  CL*38
00749              X110-EMP-NO                                             CL*38
00750              DELIMITED BY SIZE                                       CL*38
00751              INTO R140-MESSAGE                                       CL*38
00752         END-STRING                                                   CL*38
00753         MOVE WRK-EMP-NO TO R140-EMP-NO                               CL*44
00754         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*38
00755         ADD +1 TO WRK-MTAD-UPD-CNT                                   CL*46
00756       ELSE                                                           CL*38
00757        DISPLAY '<<<< ---X427 DUTAS DC WORK ADDR <UPD> ' WRK-EMP-NO   CL*55
00758         STRING                                                       CL*38
00759            'X427  DUTAS DC ADDRESS  <UPDATED > '                     CL*38
00760              X110-EMP-NO                                             CL*38
00761              DELIMITED BY SIZE                                       CL*38
00762              INTO R140-MESSAGE                                       CL*38
00763         END-STRING                                                   CL*38
00764         MOVE WRK-EMP-NO TO R140-EMP-NO                               CL*44
00765         ADD +1 TO WRK-MDCD-UPD-CNT                                   CL*46
00766         PERFORM S946-WRITE-R140 THRU S946-EXIT.                      CL*38
00767                                                                      CL**4
00768  P1100-EXIT.                                                      DTSBX427
00769      EXIT.                                                        DTSBX427
00770                                                                   DTSBX427
00771  P2000-EMP-NO-BREAK.                                              DTSBX427
00772                                                                      CL*33
00773      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBX427
00774                                                                   DTSBX427
00775      DISPLAY 'OLDE ' WRK-EMP-NO '  NEWE ' X110-EMP-NO.               CL*65
00776      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                                 CL*65
00777                                                                   DTSBX427
00778      SET MSKL-PRF-88 TO TRUE.                                     DTSBX427
00779                                                                   DTSBX427
00780      PERFORM S910-READ THRU S910-EXIT.                            DTSBX427
00781                                                                   DTSBX427
00782      IF L910-NO-REC-88                                            DTSBX427
00783         MOVE SPACES TO R140-MESSAGE                                  CL*18
00784         MOVE X110-EMP-NO TO R140-EMP-NO                              CL*32
00785         STRING                                                       CL*18
00786            'X427  NO EMPLOYER PROFILE FOUND IN DUTAS    >>>>  '      CL*37
00787              X110-EMP-NO                                             CL*37
00788              DELIMITED BY SIZE                                       CL*18
00789              INTO R140-MESSAGE                                       CL*18
00790         END-STRING                                                   CL*18
00791         PERFORM S946-WRITE-R140 THRU S946-EXIT                       CL*18
00792         ADD +1 TO WRK-MPRF-NOT-CNT                                   CL*18
00793         GO TO P2000-EXIT.                                            CL*31
00794                                                                      CL*18
00795      MOVE MSKL-REC TO MPRF-REC.                                   DTSBX427
00796      MOVE 0 TO WRK-MPRF-MAIL-UPD-CNT.                                CL*55
00797                                                                      CL*54
00798      DISPLAY ' MPRF: ' WRK-EMP-NO                                    CL*65
00799              ' MUPD: ' WRK-MTAD-MAIL-UPD-CNT                         CL*56
00800              ' MADD: ' WRK-MTAD-MAIL-ADD-CNT                         CL*55
00801              ' MIND: ' MPRF-RETURN-MAIL-IND.                         CL*55
00802                                                                      CL*51
00803 *      IF MPRF-RETURN-MAIL-IND  = 'N'                                CL*74
00804 *         GO TO P2000-EMP-CONTINUE.                                  CL*74
00805                                                                      CL*70
00806        IF WRK-MTAD-MAIL-UPD-CNT = 1 OR                               CL*70
00807           WRK-MTAD-MAIL-ADD-CNT = 1                                  CL*59
00808          ADD  +100            TO WRK-ABSTIME                         CL*51
00809          PERFORM S005-FROM-SYS THRU S005-EXIT                        CL*51
00810          MOVE L005-ABSTIME TO WRK-SYS-ABSTIME                        CL*51
00811          MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO                  CL*51
00812          MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE               CL*51
00813          ADD  WRK-ABSTIME TO WRK-SYS-ABSTIME                         CL*51
00814          MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME                 CL*51
00815          MOVE 'WEBESSP ' TO L331-OP-ID                               CL*51
00816          MOVE 'RETURN MAIL IND' TO L331-FIELD-NAME                   CL*51
00817          MOVE MPRF-RETURN-MAIL-IND  TO L331-FROM-VALUE               CL*51
00818          MOVE 'N'         TO L331-TO-VALUE                           CL*52
00819          MOVE 'N'         TO MPRF-RETURN-MAIL-IND                    CL*52
00820          MOVE +1 TO WRK-MPRF-MAIL-UPD-CNT                            CL*51
00821          DISPLAY ' RETURN MAIL UPDATED: ' WRK-EMP-NO                 CL*52
00822          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                     CL*51
00823                                                                      CL*51
00824        IF MTAD-UC223-IND = 'N'                                       CL*70
00825          ADD  +100            TO WRK-ABSTIME                         CL*70
00826          PERFORM S005-FROM-SYS THRU S005-EXIT                        CL*70
00827          MOVE L005-ABSTIME TO WRK-SYS-ABSTIME                        CL*70
00828          MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO                  CL*70
00829          MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE               CL*70
00830          ADD  WRK-ABSTIME TO WRK-SYS-ABSTIME                         CL*70
00831          MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME                 CL*70
00832          MOVE 'WEBESSP ' TO L331-OP-ID                               CL*70
00833          MOVE 'DEBIT MEMO IND ' TO L331-FIELD-NAME                   CL*70
00834          MOVE MTAD-UC223-IND  TO L331-FROM-VALUE                     CL*70
00835          MOVE 'Y'         TO L331-TO-VALUE                           CL*70
00836          MOVE 'Y'         TO MTAD-UC223-IND                          CL*71
00837          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                     CL*70
00838                                                                      CL*70
00839        IF MTAD-MISSING-RPT-LETTERS-IND = 'N'                         CL*71
00840          ADD  +100            TO WRK-ABSTIME                         CL*70
00841          PERFORM S005-FROM-SYS THRU S005-EXIT                        CL*70
00842          MOVE L005-ABSTIME TO WRK-SYS-ABSTIME                        CL*70
00843          MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO                  CL*70
00844          MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE               CL*70
00845          ADD  WRK-ABSTIME TO WRK-SYS-ABSTIME                         CL*70
00846          MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME                 CL*70
00847          MOVE 'WEBESSP ' TO L331-OP-ID                               CL*70
00848          MOVE 'MISS RPT LETTER' TO L331-FIELD-NAME                   CL*70
00849          MOVE MTAD-MISSING-RPT-LETTERS-IND TO L331-FROM-VALUE        CL*73
00850          MOVE 'Y'         TO L331-TO-VALUE                           CL*70
00851          MOVE 'Y'         TO MTAD-MISSING-RPT-LETTERS-IND            CL*71
00852          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                     CL*70
00853                                                                      CL*70
00854                                                                   DTSBX427
00855  P2000-EMP-CONTINUE.                                                 CL*70
00856      MOVE MPRF-EMP-NO TO L203-EMP-NO.                             DTSBX427
00857                                                                   DTSBX427
00858      MOVE MPRF-TAX-REC-ADDR-EXISTS-IND                            DTSBX427
00859        TO L203-TAX-REC-ADDR-EXISTS-IND.                           DTSBX427
00860                                                                   DTSBX427
00861      PERFORM S203-FIELD-ZIP-CODE THRU S203-EXIT.                  DTSBX427
00862                                                                   DTSBX427
00863 *    IF L203-OK-88                                                   CL*56
00864 *        NEXT SENTENCE                                               CL*56
00865 *    ELSE                                                            CL*56
00866 *        GO TO P2000-EXIT.                                           CL*56
00867                                                                   DTSBX427
00868      DISPLAY 'Z203: ' L203-FLD-ZIP  ' ' L203-FLD-STATE               CL*61
00869              ' MPRF: ' MPRF-FLD-ZIP  ' ' MPRF-FLD-ST                 CL*60
00870              ' MAIL: ' WRK-MPRF-MAIL-UPD-CNT.                        CL*60
00871      IF ((L203-FLD-ZIP = MPRF-FLD-ZIP) AND                           CL*60
00872         (L203-FLD-STATE = MPRF-FLD-ST) AND                           CL*56
00873          (WRK-MPRF-MAIL-UPD-CNT = 0))                                CL*60
00874          GO TO P2000-EXIT                                            CL*56
00875      ELSE                                                            CL*56
00876      MOVE L203-FLD-ZIP TO MPRF-FLD-ZIP                               CL*56
00877      MOVE L203-FLD-STATE TO MPRF-FLD-ST.                          DTSBX427
00878                                                                   DTSBX427
00879      MOVE MHDR-CURR-RUN-DATE TO MPRF-CHNG-DATE.                   DTSBX427
00880                                                                   DTSBX427
00881      MOVE MPRF-REC TO MSKL-REC.                                   DTSBX427
00882                                                                   DTSBX427
00883      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBX427
00884      ADD +1 TO WRK-MPRF-UPD-CNT.                                     CL*18
00885                                                                   DTSBX427
00886  P2000-EXIT.                                                      DTSBX427
00887      EXIT.                                                        DTSBX427
00888                                                                   DTSBX427
00889                                                                      CL**3
00890  T0000-TERMINATE.                                                 DTSBX427
00891      DISPLAY                                                      DTSBX427
00892       '***  DTSBX427 TERMINATION STATISTICS'.                        CL**2
00893                                                                   DTSBX427
00894      DISPLAY ' '.                                                 DTSBX427
00895                                                                   DTSBX427
00896      DISPLAY                                                      DTSBX427
00897       '***  NUMBER OF X110 FILE RECORDS READ  : '                    CL**5
00898       WRK-X110-REC-CNT.                                              CL**5
00899       MOVE WRK-X110-REC-CNT TO   WS-X110-PEN-CNT.                    CL*87
00900                                                                   DTSBX427
00901      DISPLAY ' '.                                                 DTSBX427
00902                                                                   DTSBX427
00903      DISPLAY                                                      DTSBX427
00904       '*** NUMBER OF PROFILE RECORDS NOT FOUND  : '                  CL*40
00905       WRK-MPRF-NOT-CNT.                                              CL*18
00906                                                                   DTSBX427
00907      DISPLAY                                                         CL*18
00908       '*** NUMBER OF PROFILE RECORDS UPDATED    : '                  CL*40
00909       WRK-MPRF-UPD-CNT.                                              CL*18
00910                                                                      CL*18
00911      DISPLAY                                                      DTSBX427
00912       '***  NUMBER OF MAIL RECORDS ADDED      : '                    CL*18
00913       WRK-MTAD-ADD-CNT.                                              CL*18
00914                                                                   DTSBX427
00915      DISPLAY                                                         CL*20
00916       '***  NUMBER OF MAIL RECORDS UPDATED    : '                    CL*18
00917       WRK-MTAD-UPD-CNT.                                              CL*18
00918                                                                      CL*18
00919      DISPLAY                                                         CL*18
00920       '***  NUMBER OF DC   RECORDS ADDED      : '                    CL*18
00921       WRK-MDCD-ADD-CNT.                                              CL*18
00922                                                                      CL*18
00923      DISPLAY                                                         CL*20
00924       '***  NUMBER OF DC   RECORDS UPDATED    : '                    CL*18
00925       WRK-MDCD-UPD-CNT.                                              CL*18
00926                                                                      CL*18
00927      DISPLAY                                                      DTSBX427
00928       '***  NUMBER OF MLOG RECORDS WRITTEN    : '                 DTSBX427
00929       WRK-MLOG-REC-CNT.                                           DTSBX427
00930                                                                   DTSBX427
00931                                                                   DTSBX427
00932      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSBX427
00933                                                                   DTSBX427
00934      PERFORM S921-CLOSE THRU S921-EXIT.                           DTSBX427
00935      PERFORM S927C-CLOSE THRU S927C-EXIT.                            CL*20
00936                                                                   DTSBX427
00937      WRITE REPT-PAID-REC FROM FOOTING-LINE-51 AFTER ADVANCING 3.     CL*87
00938      WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER ADVANCING 2.      CL*87
00939      WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER ADVANCING 2.      CL*87
00940      CLOSE ESSP-X110-FILE REPT-PAID-FILE REPT-PEND-FILE.             CL*75
00941  T0000-EXIT.                                                      DTSBX427
00942      EXIT.                                                        DTSBX427
00943      EJECT                                                        DTSBX427
00944  S005-FROM-SYS.                                                   DTSBX427
00945      SET L005-FROM-SYS TO TRUE.                                   DTSBX427
00946      GO TO S005-ABSTIME.                                          DTSBX427
00947                                                                   DTSBX427
00948  S005-FROM-ABSTIME.                                               DTSBX427
00949      SET L005-FROM-ABSTIME TO TRUE.                               DTSBX427
00950      GO TO S005-ABSTIME.                                          DTSBX427
00951                                                                   DTSBX427
00952  S005-ABSTIME.                                                    DTSBX427
00953      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBX427
00954  S005-EXIT.                                                       DTSBX427
00955      EXIT.                                                        DTSBX427
00956      SKIP3                                                        DTSBX427
00957  S203-FIELD-ZIP-CODE.                                             DTSBX427
00958      CALL 'DTSBU203' USING L203-LINK-AREA.                        DTSBX427
00959  S203-EXIT.                                                       DTSBX427
00960      EXIT.                                                        DTSBX427
00961      SKIP3                                                        DTSBX427
00962  S009-CONVERT-TO-CAPS.                                               CL*47
00963      CALL 'DTSBU009' USING L009-LINK-AREA.                           CL*47
00964  S009-EXIT.                                                          CL*47
00965      EXIT.                                                           CL*47
00966      SKIP3                                                           CL*47
00967  S331-WRITE-MLOG.                                                 DTSBX427
00968      CALL 'DTSBU331' USING L331-LINK-AREA.                        DTSBX427
00969  S331-EXIT.                                                       DTSBX427
00970      EXIT.                                                        DTSBX427
00971      SKIP3                                                        DTSBX427
00972  S910-OPEN-UPDATE.                                                DTSBX427
00973      SET L910-OPEN-UPDATE-88 TO TRUE.                             DTSBX427
00974      GO TO S910-MSTR-CALL.                                        DTSBX427
00975                                                                   DTSBX427
00976  S910-READ.                                                       DTSBX427
00977      SET L910-READ-88 TO TRUE.                                    DTSBX427
00978      GO TO S910-MSTR-CALL.                                        DTSBX427
00979                                                                   DTSBX427
00980  S910-START-BROWSE.                                               DTSBX427
00981      SET L910-START-BROWSE-88 TO TRUE.                            DTSBX427
00982      GO TO S910-MSTR-CALL.                                        DTSBX427
00983                                                                   DTSBX427
00984  S910-READ-NEXT.                                                  DTSBX427
00985      SET L910-READ-NEXT-88 TO TRUE.                               DTSBX427
00986      GO TO S910-MSTR-CALL.                                        DTSBX427
00987                                                                   DTSBX427
00988 *S910-COUNT.                                                      DTSBX427
00989 *****SET L910-COUNT-88 TO TRUE.                                   DTSBX427
00990 *****GO TO S910-MSTR-CALL.                                        DTSBX427
00991                                                                   DTSBX427
00992  S910-REWRITE.                                                    DTSBX427
00993      SET L910-REWRITE-88 TO TRUE.                                 DTSBX427
00994      GO TO S910-MSTR-CALL.                                        DTSBX427
00995                                                                   DTSBX427
00996  S910-CLOSE.                                                      DTSBX427
00997      SET L910-CLOSE-88 TO TRUE.                                   DTSBX427
00998      GO TO S910-MSTR-CALL.                                        DTSBX427
00999                                                                   DTSBX427
01000  S910-MSTR-CALL.                                                  DTSBX427
01001      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBX427
01002                            MSKL-REC.                              DTSBX427
01003  S910-EXIT.                                                       DTSBX427
01004      EXIT.                                                        DTSBX427
01005      SKIP3                                                        DTSBX427
01006  S921-OPEN-UPDATE.                                                DTSBX427
01007      SET L921-OPEN-UPDATE-88 TO TRUE.                             DTSBX427
01008      GO TO S921-AIX-IO.                                           DTSBX427
01009                                                                   DTSBX427
01010  S921-CLOSE.                                                      DTSBX427
01011      SET L921-CLOSE-88 TO TRUE.                                   DTSBX427
01012      GO TO S921-AIX-IO.                                           DTSBX427
01013                                                                   DTSBX427
01014  S921-AIX-IO.                                                     DTSBX427
01015      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBX427
01016                            ISKL-REC.                              DTSBX427
01017  S921-EXIT.                                                       DTSBX427
01018      EXIT.                                                        DTSBX427
01019      SKIP3                                                        DTSBX427
01020  S927A-OPEN-UPDATE.                                                  CL*19
01021      SET L927-OPEN-UPDATE-88 TO TRUE.                                CL*19
01022      PERFORM S927Z-IO   THRU S927Z-EXIT.                             CL*19
01023  S927A-EXIT.                                                         CL*19
01024      EXIT.                                                           CL*19
01025                                                                      CL*19
01026  S927B-WRITE.                                                        CL*12
01027      SET L927-WRITE-88 TO TRUE.                                      CL*12
01028      PERFORM S927Z-IO   THRU S927Z-EXIT.                             CL*12
01029                                                                      CL*12
01030  S927B-EXIT.                                                         CL*12
01031      EXIT.                                                           CL*12
01032                                                                      CL*12
01033  S927C-CLOSE.                                                        CL*16
01034      SET L927-CLOSE-88        TO TRUE.                               CL*16
01035      PERFORM S927Z-IO   THRU S927Z-EXIT.                             CL*16
01036                                                                      CL*16
01037  S927C-EXIT.                                                         CL*16
01038      EXIT.                                                           CL*16
01039                                                                      CL*12
01040  S927Z-IO.                                                           CL*12
01041      CALL 'DTSBU927' USING L927-LINK-AREA                            CL*12
01042                            TSKL-REC.                                 CL*12
01043  S927Z-EXIT.                                                         CL*12
01044      EXIT.                                                           CL*12
01045  S946-WRITE-R140.                                                    CL*18
01046                                                                      CL*18
01047      CALL 'DTSBU946' USING R140-REC.                                 CL*18
01048                                                                      CL*18
01049  S946-EXIT.                                                          CL*18
01050      EXIT.                                                           CL*18
01051  S999-ABEND.                                                      DTSBX427
01052      DISPLAY '*** DTSBX427 ABENDING.  '                              CL**2
01053              ABEND-MSG.                                           DTSBX427
01054      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBX427
01055  S999-EXIT.                                                       DTSBX427
01056      EXIT.                                                        DTSBX427
01057      EJECT                                                        DTSBX427
