00001  IDENTIFICATION DIVISION.                                         06/08/10
00002  PROGRAM-ID.             DTSBD383.                                DTSBD383
00003  AUTHOR.                 NORTHROP GRUMMAN.                           LV007
00004  DATE-WRITTEN.           JUNE 2005.                               DTSBD383
00005  DATE-COMPILED.                                                   DTSBD383
00006                                                                   DTSBD383
00007 *****                                                             DTSBD383
00008 *                                                                 DTSBD383
00009 *    FUNCTION:  UPDATE EMPLOYER ADDRESS, TELEPHONE                DTSBD383
00010 *               NUMBER, FAX NUMBER, AND EMAIL ADDRESS.            DTSBD383
00011 *                                                                 DTSBD383
00012 *    MODIFICATION LOG:                                            DTSBD383
00013 *                                                                 DTSBD383
00014 *    06/01/2005  INITIAL DEVELOPMENT.                             DTSBD383
00015 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD383
00016 *                                                                 DTSBD383
00017 *    11/20/2006  MODIFIED FOR NEW VERSION OF T002 TRANS RECORD.   DTSBD383
00018 *                WORK ORDER:                      PROGRAMMER: ZL1 DTSBD383
00019 *                                                                 DTSBD383
00020 *    09/25/2009  MOVE T002-OPID TO L331-OP-ID TO DISTINGUISH      DTSBD383
00021 *                MODIFICATIONS MADE ON THE WEB FROM THOSE         DTSBD383
00022 *                MADE BY STAFF.                                   DTSBD383
00023 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD383
00024 *                                                                 DTSBD383
00025 *    04/21/2010  MODIFIED TO ADD A DC WORKSITE ADDRESS AS AN      DTSBD383
00026 *                MTAD ADDRESS (MTAD-ID-TAX-RECORDS-ADDR-88) IF    DTSBD383
00027 *                THE BUSINESS OFFICE ADDRESS IS NOT IN DC.        DTSBD383
00028 *                PREVIOUSLY, ONLY THE BUSINESS OFFICE ADDRESSS    DTSBD383
00029 *                WOULD BE ADDED AS AN MTAD.                       DTSBD383
00030 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD383
00031 *                                                                 DTSBD383
00032 *    MM/DD/CCYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD383
00033 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD383
00034 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBD383
00035 *                                                                 DTSBD383
00036 *                                                                 DTSBD383
00037 *  DESCRIPTION:                                                   DTSBD383
00038 *                                                                 DTSBD383
00039 *                                                                 DTSBD383
00040 *                                                                 DTSBD383
00041 *      MASTER FILE RECORDS READ:                                  DTSBD383
00042 *                                                                 DTSBD383
00043 *        MPRF AND MTAD                                            DTSBD383
00044 *                                                                 DTSBD383
00045 *                                                                 DTSBD383
00046 *      MASTER FILE RECORDS UPDATED:                               DTSBD383
00047 *                                                                 DTSBD383
00048 *        MPRF AND MTAD                                            DTSBD383
00049 *                                                                 DTSBD383
00050 *                                                                 DTSBD383
00051 *      REPORT RECORDS WRITTEN:                                    DTSBD383
00052 *                                                                 DTSBD383
00053 *        NONE                                                     DTSBD383
00054 *                                                                 DTSBD383
00055 *                                                                 DTSBD383
00056 *      MODULES CALLED:                                            DTSBD383
00057 *                                                                 DTSBD383
00058 *        DTSBU111 LOOKUP ADDRESS.                                 DTSBD383
00059 *        DTSBU112 FORMAT ADDRESS.                                 DTSBD383
00060 *        DTSBU331 FORMAT AND WRITE MLOG RECORD OCCURRENCE.        DTSBD383
00061 *        DTSBU910 MASTER FILE I/O DRIVER.                         DTSBD383
00062 *        DTSBU927 BTC FILE OUTPUT.                                DTSBD383
00063 *        DTSBU941 VARIABLE LENGTH RECORD INPUT 1.                 DTSBD383
00064 *        DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.     DTSBD383
00065 *        DTSBU947 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 2.     DTSBD383
00066 *                                                                 DTSBD383
00067 *****                                                             DTSBD383
00068      SKIP3                                                        DTSBD383
00069  ENVIRONMENT DIVISION.                                            DTSBD383
00070      SKIP3                                                        DTSBD383
00071  DATA DIVISION.                                                   DTSBD383
00072      EJECT                                                        DTSBD383
00073  WORKING-STORAGE SECTION.                                         DTSBD383
000735 77  PAN-VALET PICTURE X(24) VALUE '007DTSBD383  06/08/10'.       DTSBD383
00074      SKIP3                                                        DTSBD383
00075  01  WRK-AREA.                                                    DTSBD383
00076      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +383.DTSBD383
00077      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD383'.DTSBD383
00078      05  WRK-ABEND-MSG               PIC  X(60).                  DTSBD383
00079      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBD383
00080      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSBD383
00081      05  WRK-ID-NO                   PIC S9(03)  COMP-3.          DTSBD383
00082      05  WRK-TRACE-IND               PIC  X(01)  VALUE SPACES.    DTSBD383
00083      05  WRK-REC-OCC-ID              PIC  X(20)  VALUE SPACES.    DTSBD383
00084          88  WRK-REC-OCC-MAIL-88      VALUE 'MAILING ADDRESS'.    DTSBD383
00085          88  WRK-REC-OCC-RECS-88      VALUE 'OFFICE ADDRESS'.     DTSBD383
00086          88  WRK-REC-OCC-WORK-88      VALUE 'WORKSITE ADDRESS'.   DTSBD383
00087                                                                   DTSBD383
00088      05  WRK-REWRITE-MTAD-CNT        PIC S9(07)  COMP-3 VALUE 0.  DTSBD383
00089      05  WRK-REWRITE-MPRF-CNT        PIC S9(07)  COMP-3 VALUE 0.  DTSBD383
00090      05  WRK-R907-REC-CNT            PIC S9(07)  COMP-3 VALUE 0.  DTSBD383
00091                                                                   DTSBD383
00092      05  WRK-MTAD-ZIP-AREA.                                       DTSBD383
00093          10  WRK-TAD-ZIP-5           PIC X(05).                   DTSBD383
00094          10  WRK-TAD-DASH            PIC X(01)  VALUE '-'.        DTSBD383
00095          10  WRK-TAD-ZIP-PLUS4       PIC X(04).                   DTSBD383
00096                                                                   DTSBD383
00097      05  WRK-MAIL-ADDR-AREA.                                      DTSBD383
00098          10  WRK-MAIL-DELV2      PIC  X(40).                      DTSBD383
00099          10  WRK-MAIL-CITY       PIC  X(25).                      DTSBD383
00100                                                                   DTSBD383
00101      05  WRK-OFFICE-STATE-ZIP.                                    DTSBD383
00102          10  WRK-OFFICE-STATE    PIC  X(02).                      DTSBD383
00103          10  WRK-OFFICE-ZIP      PIC  X(10).                      DTSBD383
00104                                                                   DTSBD383
00105      05  WRK-DUP-MAIL-IND        PIC  X(01).                      DTSBD383
00106          88  WRK-DUP-MAIL-YES-88      VALUE 'Y'.                  DTSBD383
00107          88  WRK-DUP-MAIL-NO-88       VALUE 'N'.                  DTSBD383
00108                                                                   DTSBD383
00109      05  WRK-DUP-WORKSITE-IND    PIC  X(01).                      DTSBD383
00110          88  WRK-DUP-WORKSITE-YES-88  VALUE 'Y'.                  DTSBD383
00111          88  WRK-DUP-WORKSITE-NO-88   VALUE 'N'.                  DTSBD383
00112                                                                   DTSBD383
00113      05  WRK-DC-ADDR-ADDED-IND   PIC  X(01).                      DTSBD383
00114          88  WRK-DC-ADDR-ADDED-YES-88  VALUE 'Y'.                 DTSBD383
00115          88  WRK-DC-ADDR-ADDED-NO-88   VALUE 'N'.                 DTSBD383
00116                                                                   DTSBD383
00117      05  DISP-DATE                   PIC  X(10)  VALUE SPACES.    DTSBD383
00118      05  DISP-TIME                   PIC  X(08)  VALUE SPACES.    DTSBD383
00119      05  DISP-ABSTIME                PIC  X(16)  VALUE SPACES.    DTSBD383
00120                                                                   DTSBD383
00121      05  WRK-CURR-TIME               PIC  S9(07) COMP-3 VALUE +0. DTSBD383
00122      05  WRK-CURR-DATE               PIC  S9(09) COMP-3 VALUE +0. DTSBD383
00123      05  WRK-CURR-YR                 PIC  9(04)  VALUE ZEROS.     DTSBD383
00124      05  WRK-ABSTIME                 PIC  S9(15) COMP-3 VALUE +0. DTSBD383
00125                                                                   DTSBD383
00126      05  WRK-MSG-TEXT.                                            DTSBD383
00127          10 WRK-MSG-LINE             PIC  X(50).                  DTSBD383
00128                                                                   DTSBD383
00129  01  MSG-TABLE.                                                   DTSBD383
00130      05  MSG1-ADDRESS-MISSING.                                    DTSBD383
00131          10  MSG1-ID         PIC  X(11)  VALUE 'DTSBD383909'.     DTSBD383
00132          10  MSG1-SHORT-TEXT PIC  X(20)  VALUE 'NAME & ADDR CHG'. DTSBD383
00133          10  MSG1-LONG-TEXT.                                      DTSBD383
00134              15  FILLER      PIC  X(30)                           DTSBD383
00135                    VALUE 'TRANSACTION FAILED - EXPECTED '.        DTSBD383
00136              15  FILLER      PIC  X(30)                           DTSBD383
00137                    VALUE 'NAME OR ADDRESS NOT FOUND     '.        DTSBD383
00138      EJECT                                                        DTSBD383
00139  01  Y110-REC.                                                    DTSBD383
00140  ++INCLUDE DTSIY110                                               DTSBD383
00141      EJECT                                                        DTSBD383
00142  01  L331-LINK-AREA.                                              DTSBD383
00143  ++INCLUDE DTSIL331                                               DTSBD383
00144      EJECT                                                        DTSBD383
00145  01  L910-LINK-AREA.                                              DTSBD383
00146  ++INCLUDE DTSIL910                                               DTSBD383
00147      EJECT                                                        DTSBD383
00148  01  MSKL-REC.                                                    DTSBD383
00149  ++INCLUDE DTSIMSKL                                               DTSBD383
00150      EJECT                                                        DTSBD383
00151  01  MTAD-REC.                                                    DTSBD383
00152  ++INCLUDE DTSIMTAD                                               DTSBD383
00153                                                                   DTSBD383
00154  01  MTAA-REC.                                                    DTSBD383
00155  ++INCLUDE DTSIMTAA                                               DTSBD383
00156                                                                   DTSBD383
00157  01  MEVL-REC.                                                    DTSBD383
00158  ++INCLUDE DTSIMEVL                                               DTSBD383
00159      EJECT                                                        DTSBD383
00160  01  R907-REC.                                                    DTSBD383
00161  ++INCLUDE DTSIR907                                               DTSBD383
00162      EJECT                                                        DTSBD383
00163                                                                   DTSBD383
00164  LINKAGE SECTION.                                                 DTSBD383
00165      SKIP3                                                        DTSBD383
00166  01  LBCM-LINK-AREA.                                              DTSBD383
00167  ++INCLUDE DTSILBCM                                               DTSBD383
00168      EJECT                                                        DTSBD383
00169  01  MPRF-REC.                                                    DTSBD383
00170  ++INCLUDE DTSIMPRF                                               DTSBD383
00171      EJECT                                                        DTSBD383
00172  01  T002-REC.                                                    DTSBD383
00173  ++INCLUDE DTSIT002                                               DTSBD383
00174      EJECT                                                        DTSBD383
00175  PROCEDURE DIVISION USING LBCM-LINK-AREA                          DTSBD383
00176                           MPRF-REC                                DTSBD383
00177                           T002-REC.                               DTSBD383
00178                                                                   DTSBD383
00179 *&                                                                DTSBD383
00180      DISPLAY 'DTSBD383 ' MPRF-EMP-NO '  ' T002-TRN-CD             DTSBD383
00181         '  WRK ' WRK-EMP-NO.                                      DTSBD383
00182 *&                                                                DTSBD383
00183      IF FIRST-TIME-IND = 'Y'                                      DTSBD383
00184          PERFORM I0000-INITIATE THRU I0000-EXIT                   DTSBD383
00185          MOVE 'N' TO FIRST-TIME-IND                               DTSBD383
00186      END-IF.                                                      DTSBD383
00187                                                                   DTSBD383
00188      IF MPRF-EMP-NO  NOT =  WRK-EMP-NO                            DTSBD383
00189          MOVE SPACES        TO WRK-MAIL-ADDR-AREA                 DTSBD383
00190                                WRK-OFFICE-STATE-ZIP               DTSBD383
00191          MOVE MPRF-EMP-NO   TO WRK-EMP-NO                         DTSBD383
00192      END-IF.                                                      DTSBD383
00193                                                                   DTSBD383
00194      PERFORM P0000-PROCESS THRU P0000-EXIT                        DTSBD383
00195                                                                   DTSBD383
00196      GOBACK.                                                      DTSBD383
00197                                                                   DTSBD383
00198  I0000-INITIATE.                                                  DTSBD383
00199                                                                   DTSBD383
00200      MOVE +0                  TO WRK-EMP-NO.                      DTSBD383
00201      MOVE LENGTH OF R907-REC  TO R907-LENGTH.                     DTSBD383
00202      MOVE SPACES              TO WRK-MAIL-ADDR-AREA               DTSBD383
00203                                WRK-OFFICE-STATE-ZIP.              DTSBD383
00204                                                                   DTSBD383
00205  I0000-EXIT.                                                      DTSBD383
00206      EXIT.                                                        DTSBD383
00207                                                                   DTSBD383
00208  P0000-PROCESS.                                                   DTSBD383
00209      SET WRK-DC-ADDR-ADDED-NO-88       TO TRUE.                   DTSBD383
00210                                                                   DTSBD383
00211      IF T002-EMP-ADDR-88                                          DTSBD383
00212         MOVE T002-DATA-AREA            TO Y110-REC                DTSBD383
00213      ELSE                                                         DTSBD383
00214         GO TO P0000-EXIT                                          DTSBD383
00215      END-IF.                                                      DTSBD383
00216                                                                   DTSBD383
00217      DISPLAY 'BD383 P0000 ' MPRF-EMP-NO '  ' WRK-OFFICE-ZIP       DTSBD383
00218         '  ' WRK-OFFICE-STATE                                     DTSBD383
00219         '  TYPE ' Y110-EMP-ADDR-TYPE.                             DTSBD383
00220                                                                   DTSBD383
00221      EVALUATE TRUE                                                DTSBD383
00222        WHEN Y110-EMP-ADDR-TYPE-MAIL-88                            DTSBD383
00223          PERFORM P1000-MAIL-ADDR      THRU P1000-EXIT             DTSBD383
00224                                                                   DTSBD383
00225        WHEN Y110-EMP-ADDR-TYPE-RECS-88                            DTSBD383
00226          PERFORM P2000-OFFICE-ADDR    THRU P2000-EXIT             DTSBD383
00227                                                                   DTSBD383
00228        WHEN Y110-EMP-ADDR-TYPE-WRK-88                             DTSBD383
00229          PERFORM P3000-WORKSITE-ADDR  THRU P3000-EXIT             DTSBD383
00230                                                                   DTSBD383
00231      END-EVALUATE.                                                DTSBD383
00232  P0000-EXIT.                                                      DTSBD383
00233      EXIT.                                                        DTSBD383
00234                                                                   DTSBD383
00235  P1000-MAIL-ADDR.                                                 DTSBD383
00236 *&                                                                DTSBD383
00237      DISPLAY 'BD383 P1000 ' MPRF-EMP-NO                           DTSBD383
00238         '  ' WRK-OFFICE-ZIP                                       DTSBD383
00239         '  ' WRK-OFFICE-STATE.                                    DTSBD383
00240 *&                                                                DTSBD383
00241      MOVE LOW-VALUES  TO MTAD-REC.                                DTSBD383
00242      MOVE SPACES      TO MTAD-DATA-AREA.                          DTSBD383
00243                                                                   DTSBD383
00244      MOVE Y110-EMP-DELV2    TO WRK-MAIL-DELV2.                    DTSBD383
00245      MOVE Y110-EMP-CITY     TO WRK-MAIL-CITY.                     DTSBD383
00246                                                                   DTSBD383
00247      MOVE T002-EMP-NO TO MTAD-EMP-NO.                             DTSBD383
00248      SET MTAD-TAD-88  TO TRUE.                                    DTSBD383
00249                                                                   DTSBD383
00250      SET MTAD-ID-TAX-MAILING-ADDR-88  TO TRUE.                    DTSBD383
00251                                                                   DTSBD383
00252      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD383
00253                                                                   DTSBD383
00254      PERFORM S910-READ         THRU S910-EXIT.                    DTSBD383
00255      IF L910-OK-88                                                DTSBD383
00256         MOVE MSKL-REC TO MTAD-REC                                 DTSBD383
00257      END-IF.                                                      DTSBD383
00258                                                                   DTSBD383
00259      PERFORM S330-INIT-MLOG            THRU S330-EXIT.            DTSBD383
00260                                                                   DTSBD383
00261      SET WRK-REC-OCC-MAIL-88           TO TRUE.                   DTSBD383
00262      PERFORM P5000-UPDATE-ADDR         THRU P5000-EXIT.           DTSBD383
00263                                                                   DTSBD383
00264      IF L910-OK-88                                                DTSBD383
00265         MOVE LBCM-CURR-RUN-DATE             TO MTAD-CHNG-DATE     DTSBD383
00266         MOVE MTAD-REC                       TO MSKL-REC           DTSBD383
00267         PERFORM S910-REWRITE                THRU S910-EXIT        DTSBD383
00268      ELSE                                                         DTSBD383
00269         SET MTAD-UC223-YES-88               TO TRUE               DTSBD383
00270         SET MTAD-MISSING-RPT-LTRS-YES-88    TO TRUE               DTSBD383
00271         IF (MTAD-DELIV-LINE-2 (1:6) = 'PO BOX'                    DTSBD383
00272         OR  MTAD-DELIV-LINE-1 (1:6) = 'PO BOX')                   DTSBD383
00273            SET MTAD-PHYSICAL-ADDRESS-NO-88  TO TRUE               DTSBD383
00274         ELSE                                                      DTSBD383
00275            SET MTAD-PHYSICAL-ADDRESS-YES-88 TO TRUE               DTSBD383
00276         END-IF                                                    DTSBD383
00277         SET MTAD-NOT-CONVERTED-88           TO TRUE               DTSBD383
00278         MOVE LBCM-CURR-RUN-DATE             TO MTAD-ESTB-DATE     DTSBD383
00279                                                MTAD-CHNG-DATE     DTSBD383
00280         MOVE MTAD-REC                       TO MSKL-REC           DTSBD383
00281         PERFORM S910-WRITE                  THRU S910-EXIT        DTSBD383
00282      END-IF.                                                      DTSBD383
00283                                                                   DTSBD383
00284      PERFORM P9000-FIELD-ZIP                THRU P9000-EXIT.      DTSBD383
00285                                                                   DTSBD383
00286  P1000-EXIT.                                                      DTSBD383
00287      EXIT.                                                        DTSBD383
00288                                                                   DTSBD383
00289  P2000-OFFICE-ADDR.                                               DTSBD383
00290      DISPLAY 'BD383 P2000 ' MPRF-EMP-NO                           DTSBD383
00291         '  ' WRK-OFFICE-ZIP                                       DTSBD383
00292         '  ' WRK-OFFICE-STATE.                                    DTSBD383
00293 ***  MOVE T002-EMP-NO TO MTAD-EMP-NO.                             DTSBD383
00294 *    SET MTAD-TAD-88  TO TRUE.                                    DTSBD383
00295 *                                                                 DTSBD383
00296 *    SET MTAD-ID-TAX-MAILING-ADDR-88   TO TRUE.                   DTSBD383
00297 *                                                                 DTSBD383
00298 *    MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD383
00299 *                                                                 DTSBD383
00300 *    PERFORM S910-READ         THRU S910-EXIT.                    DTSBD383
00301 *                                                                 DTSBD383
00302 *    IF L910-OK-88                                                DTSBD383
00303 *       MOVE MSKL-REC          TO MTAD-REC                        DTSBD383
00304 *       MOVE MTAD-DELIV-LINE-2 TO WRK-MAIL-DELV2                  DTSBD383
00305 *       MOVE MTAD-CITY         TO WRK-MAIL-CITY                   DTSBD383
00306 *    ELSE                                                         DTSBD383
00307 *       MOVE SPACES            TO WRK-MAIL-DELV2                  DTSBD383
00308 *                                 WRK-MAIL-CITY                   DTSBD383
00309 *    END-IF.                                                      DTSBD383
00310 *                                                                 DTSBD383
00311 *    IF Y110-EMP-DELV2 = WRK-MAIL-DELV2                           DTSBD383
00312 *    AND Y110-EMP-CITY = WRK-MAIL-CITY                            DTSBD383
00313 *       DISPLAY 'BD383 OFFICE ADDR = MAIL ADDR ' MPRF-EMP-NO      DTSBD383
00314 *       GO TO P2000-EXIT                                          DTSBD383
00315 ***  END-IF.                                                      DTSBD383
00316                                                                   DTSBD383
00317      IF Y110-EMP-STATE NOT =   'DC'                               DTSBD383
00318         DISPLAY 'BD383 OFFICE ADDR NOT DC ' MPRF-EMP-NO           DTSBD383
00319           '  ' Y110-EMP-STATE                                     DTSBD383
00320         PERFORM P3000-WORKSITE-ADDR  THRU P3000-EXIT              DTSBD383
00321         GO TO P2000-EXIT                                          DTSBD383
00322      ELSE                                                         DTSBD383
00323         SET WRK-DC-ADDR-ADDED-YES-88      TO TRUE                 DTSBD383
00324      END-IF.                                                      DTSBD383
00325                                                                   DTSBD383
00326      MOVE LOW-VALUES  TO MTAD-REC.                                DTSBD383
00327      MOVE SPACES      TO MTAD-DATA-AREA.                          DTSBD383
00328                                                                   DTSBD383
00329      MOVE T002-EMP-NO TO MTAD-EMP-NO.                             DTSBD383
00330      SET MTAD-TAD-88  TO TRUE.                                    DTSBD383
00331                                                                   DTSBD383
00332      SET MTAD-ID-TAX-RECORDS-ADDR-88  TO TRUE,                    DTSBD383
00333                                                                   DTSBD383
00334      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD383
00335                                                                   DTSBD383
00336      PERFORM S910-READ         THRU S910-EXIT.                    DTSBD383
00337      IF L910-OK-88                                                DTSBD383
00338         MOVE MSKL-REC TO MTAD-REC                                 DTSBD383
00339      END-IF.                                                      DTSBD383
00340                                                                   DTSBD383
00341      PERFORM S330-INIT-MLOG            THRU S330-EXIT.            DTSBD383
00342                                                                   DTSBD383
00343      SET WRK-REC-OCC-RECS-88           TO TRUE.                   DTSBD383
00344      PERFORM P5000-UPDATE-ADDR         THRU P5000-EXIT.           DTSBD383
00345                                                                   DTSBD383
00346      MOVE MTAD-ZIP                         TO WRK-OFFICE-ZIP.     DTSBD383
00347      MOVE MTAD-ST                          TO WRK-OFFICE-STATE.   DTSBD383
00348                                                                   DTSBD383
00349      IF L910-OK-88                                                DTSBD383
00350         MOVE LBCM-CURR-RUN-DATE             TO MTAD-CHNG-DATE     DTSBD383
00351         MOVE MTAD-REC                       TO MSKL-REC           DTSBD383
00352         PERFORM S910-REWRITE                THRU S910-EXIT        DTSBD383
00353      ELSE                                                         DTSBD383
00354         SET MTAD-UC223-NO-88                TO TRUE               DTSBD383
00355         SET MTAD-MISSING-RPT-LTRS-NO-88     TO TRUE               DTSBD383
00356         IF (MTAD-DELIV-LINE-2 (1:6) = 'PO BOX'                    DTSBD383
00357         OR  MTAD-DELIV-LINE-1 (1:6) = 'PO BOX')                   DTSBD383
00358            SET MTAD-PHYSICAL-ADDRESS-NO-88  TO TRUE               DTSBD383
00359         ELSE                                                      DTSBD383
00360            SET MTAD-PHYSICAL-ADDRESS-YES-88 TO TRUE               DTSBD383
00361         END-IF                                                    DTSBD383
00362         SET MTAD-NOT-CONVERTED-88           TO TRUE               DTSBD383
00363         MOVE LBCM-CURR-RUN-DATE             TO MTAD-ESTB-DATE     DTSBD383
00364                                                MTAD-CHNG-DATE     DTSBD383
00365         MOVE MTAD-REC                       TO MSKL-REC           DTSBD383
00366         PERFORM S910-WRITE                  THRU S910-EXIT        DTSBD383
00367      END-IF.                                                      DTSBD383
00368                                                                   DTSBD383
00369      PERFORM P9000-FIELD-ZIP                THRU P9000-EXIT.      DTSBD383
00370                                                                   DTSBD383
00371  P2000-EXIT.                                                      DTSBD383
00372      EXIT.                                                        DTSBD383
00373                                                                   DTSBD383
00374  P3000-WORKSITE-ADDR.                                             DTSBD383
00375      DISPLAY 'BD383 P3000 ' MPRF-EMP-NO                           DTSBD383
00376         '  ' Y110-EMP-DELV1 '  ' Y110-EMP-DELV2.                  DTSBD383
00377                                                                   DTSBD383
00378 *&   PERFORM P3100-VALIDATE-ADDR      THRU P3100-EXIT.            DTSBD383
00379 *    IF L072-ADDRESS-NOT-VALID-88                                 DTSBD383
00380 *       PERFORM P3200-ADDR-ERROR      THRU P3200-EXIT             DTSBD383
00381 *       GO TO P3000-EXIT                                          DTSBD383
00382 *&   END-IF.                                                      DTSBD383
00383                                                                   DTSBD383
00384      MOVE T002-EMP-NO TO MTAD-EMP-NO.                             DTSBD383
00385      SET MTAD-TAD-88  TO TRUE.                                    DTSBD383
00386                                                                   DTSBD383
00387      SET MTAD-ID-TAX-MAILING-ADDR-88  TO TRUE.                    DTSBD383
00388                                                                   DTSBD383
00389      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD383
00390                                                                   DTSBD383
00391      PERFORM S910-READ         THRU S910-EXIT.                    DTSBD383
00392      IF L910-OK-88                                                DTSBD383
00393         MOVE MSKL-REC          TO MTAD-REC                        DTSBD383
00394         PERFORM P3010-DUP-MAIL   THROUGH P3010-EXIT               DTSBD383
00395         IF WRK-DUP-MAIL-YES-88                                    DTSBD383
00396            DISPLAY 'BD383 WORKSITE ADDR = MAIL ADDR '             DTSBD383
00397                MPRF-EMP-NO                                        DTSBD383
00398            GO TO P3000-EXIT                                       DTSBD383
00399         END-IF                                                    DTSBD383
00400      END-IF.                                                      DTSBD383
00401                                                                   DTSBD383
00402      IF Y110-EMP-STATE = 'DC'                                     DTSBD383
00403      AND WRK-DC-ADDR-ADDED-NO-88                                  DTSBD383
00404          PERFORM P2000-OFFICE-ADDR    THRU P2000-EXIT             DTSBD383
00405          GO TO P3000-EXIT                                         DTSBD383
00406      END-IF.                                                      DTSBD383
00407                                                                   DTSBD383
00408      MOVE +0                       TO WRK-ID-NO.                  DTSBD383
00409      MOVE LOW-VALUES  TO MTAA-REC.                                DTSBD383
00410      MOVE T002-EMP-NO TO MTAA-EMP-NO.                             DTSBD383
00411      SET MTAA-TAA-88  TO TRUE.                                    DTSBD383
00412                                                                   DTSBD383
00413      MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD383
00414                                                                   DTSBD383
00415      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD383
00416      PERFORM                                                      DTSBD383
00417        UNTIL L910-NO-REC-88                                       DTSBD383
00418           MOVE MSKL-REC                TO MTAA-REC                DTSBD383
00419           MOVE MTAA-ID-NO              TO WRK-ID-NO               DTSBD383
00420           PERFORM P3020-DUP-WORKSITE   THRU P3020-EXIT            DTSBD383
00421           IF WRK-DUP-WORKSITE-YES-88                              DTSBD383
00422              DISPLAY 'BD383 DUP WORKSITE ' MPRF-EMP-NO            DTSBD383
00423                 '  ' Y110-EMP-DELV1 ' ' Y110-EMP-CITY             DTSBD383
00424              GO TO P3000-EXIT                                     DTSBD383
00425           ELSE                                                    DTSBD383
00426              PERFORM S910-READ-NEXT    THRU S910-EXIT             DTSBD383
00427           END-IF                                                  DTSBD383
00428      END-PERFORM.                                                 DTSBD383
00429                                                                   DTSBD383
00430      PERFORM S330-INIT-MLOG            THRU S330-EXIT.            DTSBD383
00431                                                                   DTSBD383
00432      SET WRK-REC-OCC-RECS-88           TO TRUE.                   DTSBD383
00433      PERFORM P3200-ADD-WORKSITE        THRU P3200-EXIT.           DTSBD383
00434                                                                   DTSBD383
00435      ADD +1                              TO WRK-ID-NO.            DTSBD383
00436      MOVE WRK-ID-NO                      TO MTAA-ID-NO.           DTSBD383
00437      SET MTAA-UC223-NO-88                TO TRUE.                 DTSBD383
00438      SET MTAA-MISSING-RPT-LTRS-NO-88     TO TRUE.                 DTSBD383
00439      IF MTAA-DELIV-LINE-2 (1:6) = 'PO BOX'                        DTSBD383
00440      OR MTAA-DELIV-LINE-1 (1:6) = 'PO BOX'                        DTSBD383
00441         SET MTAA-PHYSICAL-ADDRESS-NO-88  TO TRUE                  DTSBD383
00442      ELSE                                                         DTSBD383
00443         SET MTAA-PHYSICAL-ADDRESS-YES-88 TO TRUE                  DTSBD383
00444      END-IF.                                                      DTSBD383
00445      SET MTAA-NOT-CONVERTED-88           TO TRUE.                 DTSBD383
00446      MOVE LBCM-ABSTIME                   TO MTAA-ESTB-ABSTIME     DTSBD383
00447      MOVE LBCM-CURR-RUN-DATE             TO MTAA-ESTB-DATE        DTSBD383
00448                                             MTAA-CHNG-DATE.       DTSBD383
00449      MOVE MTAA-REC                       TO MSKL-REC.             DTSBD383
00450      PERFORM S910-WRITE                  THRU S910-EXIT.          DTSBD383
00451                                                                   DTSBD383
00452      DISPLAY 'BD383 WORKSITE ADDED ' MPRF-EMP-NO                  DTSBD383
00453         '  ' MTAA-DELIV-LINE-2.                                   DTSBD383
00454  P3000-EXIT.                                                      DTSBD383
00455      EXIT.                                                        DTSBD383
00456                                                                   DTSBD383
00457  P3010-DUP-MAIL.                                                  DTSBD383
00458      SET WRK-DUP-MAIL-NO-88              TO TRUE.                 DTSBD383
00459                                                                   DTSBD383
00460      IF Y110-EMP-DELV2 > SPACES                                   DTSBD383
00461         IF ((Y110-EMP-DELV2 = MTAA-DELIV-LINE-2                   DTSBD383
00462         OR  Y110-EMP-DELV2 = MTAA-DELIV-LINE-1)                   DTSBD383
00463         AND Y110-EMP-CITY = MTAA-CITY)                            DTSBD383
00464            SET WRK-DUP-MAIL-YES-88             TO TRUE            DTSBD383
00465            GO TO P3010-EXIT                                       DTSBD383
00466         END-IF                                                    DTSBD383
00467      END-IF.                                                      DTSBD383
00468                                                                   DTSBD383
00469      IF Y110-EMP-DELV1 > SPACES                                   DTSBD383
00470         IF ((Y110-EMP-DELV1 = MTAA-DELIV-LINE-2                   DTSBD383
00471         OR  Y110-EMP-DELV1 = MTAA-DELIV-LINE-1)                   DTSBD383
00472         AND Y110-EMP-CITY = MTAA-CITY)                            DTSBD383
00473            SET WRK-DUP-MAIL-YES-88             TO TRUE            DTSBD383
00474         END-IF                                                    DTSBD383
00475      END-IF.                                                      DTSBD383
00476                                                                   DTSBD383
00477  P3010-EXIT.                                                      DTSBD383
00478      EXIT.                                                        DTSBD383
00479                                                                   DTSBD383
00480  P3020-DUP-WORKSITE.                                              DTSBD383
00481      SET WRK-DUP-WORKSITE-NO-88      TO TRUE.                     DTSBD383
00482                                                                   DTSBD383
00483      IF Y110-EMP-DELV2 > SPACES                                   DTSBD383
00484         IF ((Y110-EMP-DELV2 = MTAD-DELIV-LINE-2                   DTSBD383
00485         OR  Y110-EMP-DELV2 = MTAD-DELIV-LINE-1)                   DTSBD383
00486         AND Y110-EMP-CITY = MTAD-CITY)                            DTSBD383
00487            SET WRK-DUP-WORKSITE-YES-88     TO TRUE                DTSBD383
00488            GO TO P3020-EXIT                                       DTSBD383
00489         END-IF                                                    DTSBD383
00490      END-IF.                                                      DTSBD383
00491                                                                   DTSBD383
00492      IF Y110-EMP-DELV1 > SPACES                                   DTSBD383
00493         IF ((Y110-EMP-DELV1 = MTAD-DELIV-LINE-2                   DTSBD383
00494         OR  Y110-EMP-DELV1 = MTAD-DELIV-LINE-1)                   DTSBD383
00495         AND Y110-EMP-CITY = MTAD-CITY)                            DTSBD383
00496            SET WRK-DUP-WORKSITE-YES-88     TO TRUE                DTSBD383
00497         END-IF                                                    DTSBD383
00498      END-IF.                                                      DTSBD383
00499                                                                   DTSBD383
00500  P3020-EXIT.                                                      DTSBD383
00501      EXIT.                                                        DTSBD383
00502                                                                   DTSBD383
00503 *P3100-VALIDATE-ADDR.                                             DTSBD383
00504 *    SET L072-CASS-EDITS-88     TO TRUE.                          DTSBD383
00505 *    SET L072-MTAA-88           TO TRUE.                          DTSBD383
00506 *    MOVE MPRF-PRIMARY-NAME     TO L072-NAME.                     DTSBD383
00507 *                                                                 DTSBD383
00508 *    MOVE SPACES                TO L072-ADDRESS.                  DTSBD383
00509 *    MOVE E-STREET              TO L072-DELIV-LINE-2.             DTSBD383
00510 *    MOVE E-CITY                TO L072-CITY.                     DTSBD383
00511 *    MOVE E-STATE               TO L072-ST.                       DTSBD383
00512 *    MOVE E-ZIP-CODE            TO L072-ZIP.                      DTSBD383
00513 *                                                                 DTSBD383
00514 *    PERFORM S072-ADDRESS       THRU S072-EXIT.                   DTSBD383
00515 *P3100-EXIT.                                                      DTSBD383
00516 *    EXIT.                                                        DTSBD383
00517                                                                   DTSBD383
00518  P3200-ADD-WORKSITE.                                              DTSBD383
00519      IF Y110-EMP-ATTN NOT =   MTAA-ATTN-LINE                      DTSBD383
00520         MOVE 'MTAA-ATTN-LINE'          TO L331-FIELD-NAME         DTSBD383
00521         MOVE MTAA-ATTN-LINE            TO L331-FROM-VALUE         DTSBD383
00522         MOVE Y110-EMP-ATTN             TO L331-TO-VALUE           DTSBD383
00523         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00524         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00525         MOVE Y110-EMP-ATTN             TO MTAA-ATTN-LINE          DTSBD383
00526      END-IF.                                                      DTSBD383
00527                                                                   DTSBD383
00528      IF Y110-EMP-DELV1 NOT =   MTAA-DELIV-LINE-1                  DTSBD383
00529         MOVE 'MTAA-DELIV-LINE-1'       TO L331-FIELD-NAME         DTSBD383
00530         MOVE MTAA-DELIV-LINE-1         TO L331-FROM-VALUE         DTSBD383
00531         MOVE Y110-EMP-DELV1            TO L331-TO-VALUE           DTSBD383
00532         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00533         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00534         MOVE Y110-EMP-DELV1            TO MTAA-DELIV-LINE-1       DTSBD383
00535      END-IF.                                                      DTSBD383
00536                                                                   DTSBD383
00537 *&                                                                DTSBD383
00538      DISPLAY 'BD383 P5000 ' MPRF-EMP-NO                           DTSBD383
00539         '  DELV2 ' Y110-EMP-DELV2                                 DTSBD383
00540         '  MTAA ' MTAA-DELIV-LINE-2.                              DTSBD383
00541 *&                                                                DTSBD383
00542      IF Y110-EMP-DELV2 NOT =   MTAA-DELIV-LINE-2                  DTSBD383
00543         MOVE 'MTAA-DELIV-LINE-2'       TO L331-FIELD-NAME         DTSBD383
00544         MOVE MTAA-DELIV-LINE-2         TO L331-FROM-VALUE         DTSBD383
00545         MOVE Y110-EMP-DELV2            TO L331-TO-VALUE           DTSBD383
00546         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00547         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00548         MOVE Y110-EMP-DELV2            TO MTAA-DELIV-LINE-2       DTSBD383
00549      END-IF.                                                      DTSBD383
00550                                                                   DTSBD383
00551      IF Y110-EMP-CITY   NOT = MTAA-CITY                           DTSBD383
00552         MOVE 'MTAA-CITY'               TO L331-FIELD-NAME         DTSBD383
00553         MOVE MTAA-CITY                 TO L331-FROM-VALUE         DTSBD383
00554         MOVE Y110-EMP-CITY             TO L331-TO-VALUE           DTSBD383
00555         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00556         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00557         MOVE Y110-EMP-CITY             TO MTAA-CITY               DTSBD383
00558      END-IF.                                                      DTSBD383
00559                                                                   DTSBD383
00560      IF Y110-EMP-STATE NOT =   MTAA-ST                            DTSBD383
00561         MOVE 'MTAA-ST'                 TO L331-FIELD-NAME         DTSBD383
00562         MOVE MTAA-ST                   TO L331-FROM-VALUE         DTSBD383
00563         MOVE Y110-EMP-STATE            TO L331-TO-VALUE           DTSBD383
00564         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00565         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00566         MOVE Y110-EMP-STATE            TO MTAA-ST                 DTSBD383
00567      END-IF.                                                      DTSBD383
00568                                                                   DTSBD383
00569      IF Y110-EMP-ZIP NOT =   MTAA-ZIP                             DTSBD383
00570         MOVE 'MTAA-ZIP'                TO L331-FIELD-NAME         DTSBD383
00571         MOVE MTAA-ZIP                  TO L331-FROM-VALUE         DTSBD383
00572         MOVE Y110-EMP-ZIP              TO L331-TO-VALUE           DTSBD383
00573         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00574         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00575         MOVE Y110-EMP-ZIP              TO MTAA-ZIP                DTSBD383
00576      END-IF.                                                      DTSBD383
00577                                                                   DTSBD383
00578      IF Y110-EMP-VOICE NOT = MTAA-VOICE-1                         DTSBD383
00579         MOVE 'MTAA-VOICE-1'            TO L331-FIELD-NAME         DTSBD383
00580         MOVE MTAA-VOICE-1              TO L331-FROM-VALUE         DTSBD383
00581         MOVE Y110-EMP-VOICE            TO L331-TO-VALUE           DTSBD383
00582         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00583         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00584         MOVE Y110-EMP-VOICE            TO MTAA-VOICE-1            DTSBD383
00585      END-IF.                                                      DTSBD383
00586                                                                   DTSBD383
00587      IF Y110-EMP-FAX        NOT =  MTAA-FAX                       DTSBD383
00588         MOVE 'MTAA-FAX'                TO L331-FIELD-NAME         DTSBD383
00589         MOVE MTAA-FAX                  TO L331-FROM-VALUE         DTSBD383
00590         MOVE Y110-EMP-FAX              TO L331-TO-VALUE           DTSBD383
00591         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00592         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00593         MOVE Y110-EMP-FAX              TO MTAA-FAX                DTSBD383
00594      END-IF.                                                      DTSBD383
00595                                                                   DTSBD383
00596      IF Y110-EMP-EMAIL NOT =       MTAA-EMAIL-ADDRESS             DTSBD383
00597         MOVE 'MTAA-EMAIL-ADDRESS'      TO L331-FIELD-NAME         DTSBD383
00598         MOVE MTAA-EMAIL-ADDRESS        TO L331-FROM-VALUE         DTSBD383
00599         MOVE Y110-EMP-EMAIL            TO L331-TO-VALUE           DTSBD383
00600         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00601         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00602         MOVE Y110-EMP-EMAIL            TO MTAA-EMAIL-ADDRESS      DTSBD383
00603      END-IF.                                                      DTSBD383
00604                                                                   DTSBD383
00605  P3200-EXIT.                                                      DTSBD383
00606      EXIT.                                                        DTSBD383
00607                                                                   DTSBD383
00608  P5000-UPDATE-ADDR.                                               DTSBD383
00609      IF Y110-EMP-ATTN NOT =   MTAD-ATTN-LINE                      DTSBD383
00610         MOVE 'MTAD-ATTN-LINE'          TO L331-FIELD-NAME         DTSBD383
00611         MOVE MTAD-ATTN-LINE            TO L331-FROM-VALUE         DTSBD383
00612         MOVE Y110-EMP-ATTN             TO L331-TO-VALUE           DTSBD383
00613         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00614         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00615         MOVE Y110-EMP-ATTN             TO MTAD-ATTN-LINE          DTSBD383
00616      END-IF.                                                      DTSBD383
00617                                                                   DTSBD383
00618      IF Y110-EMP-DELV1 NOT =   MTAD-DELIV-LINE-1                  DTSBD383
00619         MOVE 'MTAD-DELIV-LINE-1'       TO L331-FIELD-NAME         DTSBD383
00620         MOVE MTAD-DELIV-LINE-1         TO L331-FROM-VALUE         DTSBD383
00621         MOVE Y110-EMP-DELV1            TO L331-TO-VALUE           DTSBD383
00622         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00623         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00624         MOVE Y110-EMP-DELV1            TO MTAD-DELIV-LINE-1       DTSBD383
00625      END-IF.                                                      DTSBD383
00626                                                                   DTSBD383
00627 *&                                                                DTSBD383
00628      DISPLAY 'BD383 P5000 ' MPRF-EMP-NO                           DTSBD383
00629         '  DELV2 ' Y110-EMP-DELV2                                 DTSBD383
00630         '  MTAD ' MTAD-DELIV-LINE-2.                              DTSBD383
00631 *&                                                                DTSBD383
00632      IF Y110-EMP-DELV2 NOT =   MTAD-DELIV-LINE-2                  DTSBD383
00633         MOVE 'MTAD-DELIV-LINE-2'       TO L331-FIELD-NAME         DTSBD383
00634         MOVE MTAD-DELIV-LINE-2         TO L331-FROM-VALUE         DTSBD383
00635         MOVE Y110-EMP-DELV2            TO L331-TO-VALUE           DTSBD383
00636         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00637         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00638         MOVE Y110-EMP-DELV2            TO MTAD-DELIV-LINE-2       DTSBD383
00639      END-IF.                                                      DTSBD383
00640                                                                   DTSBD383
00641      IF Y110-EMP-CITY   NOT = MTAD-CITY                           DTSBD383
00642         MOVE 'MTAD-CITY'               TO L331-FIELD-NAME         DTSBD383
00643         MOVE MTAD-CITY                 TO L331-FROM-VALUE         DTSBD383
00644         MOVE Y110-EMP-CITY             TO L331-TO-VALUE           DTSBD383
00645         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00646         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00647         MOVE Y110-EMP-CITY             TO MTAD-CITY               DTSBD383
00648      END-IF.                                                      DTSBD383
00649                                                                   DTSBD383
00650      IF Y110-EMP-STATE NOT =   MTAD-ST                            DTSBD383
00651         MOVE 'MTAD-ST'                 TO L331-FIELD-NAME         DTSBD383
00652         MOVE MTAD-ST                   TO L331-FROM-VALUE         DTSBD383
00653         MOVE Y110-EMP-STATE            TO L331-TO-VALUE           DTSBD383
00654         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00655         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00656         MOVE Y110-EMP-STATE            TO MTAD-ST                 DTSBD383
00657      END-IF.                                                      DTSBD383
00658                                                                   DTSBD383
00659      IF Y110-EMP-ZIP NOT =   MTAD-ZIP                             DTSBD383
00660         MOVE 'MTAD-ZIP'                TO L331-FIELD-NAME         DTSBD383
00661         MOVE MTAD-ZIP                  TO L331-FROM-VALUE         DTSBD383
00662         MOVE Y110-EMP-ZIP              TO L331-TO-VALUE           DTSBD383
00663         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00664         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00665         MOVE Y110-EMP-ZIP              TO MTAD-ZIP                DTSBD383
00666      END-IF.                                                      DTSBD383
00667                                                                   DTSBD383
00668      IF Y110-EMP-VOICE NOT = MTAD-VOICE-1                         DTSBD383
00669         MOVE 'MTAD-VOICE-1'            TO L331-FIELD-NAME         DTSBD383
00670         MOVE MTAD-VOICE-1              TO L331-FROM-VALUE         DTSBD383
00671         MOVE Y110-EMP-VOICE            TO L331-TO-VALUE           DTSBD383
00672         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00673         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00674         MOVE Y110-EMP-VOICE            TO MTAD-VOICE-1            DTSBD383
00675      END-IF.                                                      DTSBD383
00676                                                                   DTSBD383
00677      IF Y110-EMP-FAX        NOT =  MTAD-FAX                       DTSBD383
00678         MOVE 'MTAD-FAX'                TO L331-FIELD-NAME         DTSBD383
00679         MOVE MTAD-FAX                  TO L331-FROM-VALUE         DTSBD383
00680         MOVE Y110-EMP-FAX              TO L331-TO-VALUE           DTSBD383
00681         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00682         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00683         MOVE Y110-EMP-FAX              TO MTAD-FAX                DTSBD383
00684      END-IF.                                                      DTSBD383
00685                                                                   DTSBD383
00686      IF Y110-EMP-EMAIL NOT =       MTAD-EMAIL-ADDRESS             DTSBD383
00687         MOVE 'MTAD-EMAIL-ADDRESS'      TO L331-FIELD-NAME         DTSBD383
00688         MOVE MTAD-EMAIL-ADDRESS        TO L331-FROM-VALUE         DTSBD383
00689         MOVE Y110-EMP-EMAIL            TO L331-TO-VALUE           DTSBD383
00690         MOVE WRK-REC-OCC-ID            TO L331-REC-OCC-ID         DTSBD383
00691         PERFORM S331-WRITE-MLOG        THRU S331-EXIT             DTSBD383
00692         MOVE Y110-EMP-EMAIL            TO MTAD-EMAIL-ADDRESS      DTSBD383
00693      END-IF.                                                      DTSBD383
00694                                                                   DTSBD383
00695  P5000-EXIT.                                                      DTSBD383
00696      EXIT.                                                        DTSBD383
00697                                                                   DTSBD383
00698  P9000-FIELD-ZIP.                                                 DTSBD383
00699      DISPLAY 'BD383 FIELD ZIP ' MPRF-EMP-NO                       DTSBD383
00700         '  ' Y110-EMP-ADDR-TYPE.                                  DTSBD383
00701      IF Y110-EMP-ADDR-TYPE-RECS-88                                DTSBD383
00702         MOVE WRK-OFFICE-ZIP     TO MPRF-FLD-ZIP                   DTSBD383
00703         MOVE WRK-OFFICE-STATE   TO MPRF-FLD-ST                    DTSBD383
00704      ELSE                                                         DTSBD383
00705         IF WRK-OFFICE-STATE = SPACES                              DTSBD383
00706            MOVE MTAD-ZIP        TO MPRF-FLD-ZIP                   DTSBD383
00707            MOVE MTAD-ST         TO MPRF-FLD-ST                    DTSBD383
00708         END-IF                                                    DTSBD383
00709      END-IF.                                                      DTSBD383
00710                                                                   DTSBD383
00711      DISPLAY '   ' MPRF-FLD-ZIP '  ' MPRF-FLD-ST.                 DTSBD383
00712  P9000-EXIT.                                                      DTSBD383
00713      EXIT.                                                        DTSBD383
00714                                                                   DTSBD383
00715  S330-INIT-MLOG.                                                  DTSBD383
00716      MOVE T002-EMP-NO            TO L331-EMP-NO.                  DTSBD383
00717      MOVE LBCM-CURR-RUN-DATE     TO L331-CURR-RUN-DATE.           DTSBD383
00718      ADD  +1000                  TO LBCM-EMP-ABSTIME.             DTSBD383
00719      MOVE LBCM-EMP-ABSTIME       TO L331-UPDATE-ABSTIME.          DTSBD383
00720      MOVE T002-OP-ID             TO L331-OP-ID.                   DTSBD383
00721                                                                   DTSBD383
00722  S330-EXIT.                                                       DTSBD383
00723      EXIT.                                                        DTSBD383
00724                                                                   DTSBD383
00725  S331-WRITE-MLOG.                                                 DTSBD383
00726      CALL 'DTSBU331' USING L331-LINK-AREA.                        DTSBD383
00727      SET LBCM-EMP-UPDATE-YES-88  TO TRUE.                         DTSBD383
00728                                                                   DTSBD383
00729  S331-EXIT.                                                       DTSBD383
00730      EXIT.                                                        DTSBD383
00731                                                                   DTSBD383
00732  S910-OPEN-READ.                                                  DTSBD383
00733      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD383
00734      GO TO S910-MSTR-IO.                                          DTSBD383
00735                                                                   DTSBD383
00736  S910-OPEN-UPDATE.                                                DTSBD383
00737      SET L910-OPEN-UPDATE-88 TO TRUE.                             DTSBD383
00738      GO TO S910-MSTR-IO.                                          DTSBD383
00739                                                                   DTSBD383
00740  S910-OPEN-UPDATE-NO-AIX.                                         DTSBD383
00741      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSBD383
00742      GO TO S910-MSTR-IO.                                          DTSBD383
00743                                                                   DTSBD383
00744  S910-READ.                                                       DTSBD383
00745      SET L910-READ-88 TO TRUE.                                    DTSBD383
00746      GO TO S910-MSTR-IO.                                          DTSBD383
00747                                                                   DTSBD383
00748  S910-START-BROWSE.                                               DTSBD383
00749      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD383
00750      GO TO S910-MSTR-IO.                                          DTSBD383
00751                                                                   DTSBD383
00752  S910-READ-NEXT.                                                  DTSBD383
00753      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD383
00754      GO TO S910-MSTR-IO.                                          DTSBD383
00755                                                                   DTSBD383
00756  S910-COUNT.                                                      DTSBD383
00757      SET L910-COUNT-88 TO TRUE.                                   DTSBD383
00758      GO TO S910-MSTR-IO.                                          DTSBD383
00759                                                                   DTSBD383
00760  S910-WRITE.                                                      DTSBD383
00761      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBD383
00762      SET L910-WRITE-88 TO TRUE.                                   DTSBD383
00763      GO TO S910-MSTR-IO.                                          DTSBD383
00764                                                                   DTSBD383
00765  S910-REWRITE.                                                    DTSBD383
00766      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBD383
00767      SET L910-REWRITE-88 TO TRUE.                                 DTSBD383
00768      GO TO S910-MSTR-IO.                                          DTSBD383
00769                                                                   DTSBD383
00770  S910-DELETE.                                                     DTSBD383
00771      SET L910-DELETE-88 TO TRUE.                                  DTSBD383
00772      GO TO S910-MSTR-IO.                                          DTSBD383
00773                                                                   DTSBD383
00774  S910-CLOSE.                                                      DTSBD383
00775      SET L910-CLOSE-88     TO TRUE.                               DTSBD383
00776      GO TO S910-MSTR-IO.                                          DTSBD383
00777                                                                   DTSBD383
00778  S910-MSTR-IO.                                                    DTSBD383
00779      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD383
00780                            MSKL-REC.                              DTSBD383
00781  S910-EXIT.                                                       DTSBD383
00782      EXIT.                                                        DTSBD383
00783                                                                   DTSBD383
00784  S947-WRITE-R907.                                                 DTSBD383
00785      CALL 'DTSBU947' USING R907-REC.                              DTSBD383
00786                                                                   DTSBD383
00787  S947-EXIT.                                                       DTSBD383
00788      EXIT.                                                        DTSBD383
00789                                                                   DTSBD383
00790  S999-ABEND.                                                      DTSBD383
00791      DISPLAY '*** DTSBD383 ABENDING : '                           DTSBD383
00792              WRK-ABEND-MSG.                                       DTSBD383
00793                                                                   DTSBD383
00794      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD383
00795  S999-EXIT.                                                       DTSBD383
00796      EXIT.                                                        DTSBD383
00797                                                                   DTSBD383
