00001  IDENTIFICATION DIVISION.                                         10/02/09
00002  PROGRAM-ID.             DTSBD384.                                DTSBD384
00003  AUTHOR.                 NORTHROP GRUMMAN.                           LV011
00004  DATE-WRITTEN.           AUGUST 2003.                             DTSBD384
00005  DATE-COMPILED.                                                   DTSBD384
00006      SKIP3                                                        DTSBD384
00007 *****                                                             DTSBD384
00008 *                                                                 DTSBD384
00009 *    FUNCTION:  UPDATE EMPLOYER CONTACT NAME, TITLE, TELEPHONE    DTSBD384
00010 *               NUMBER, FAX NUMBER, AND E-MAIL ADDRESS. FOR ANY   DTSBD384
00011 *               STATUS CHANGE IT WILL WRITE A MLOG RECORD FOR     DTSBD384
00012 *               THE ON-LINE AUDIT TRAIL.                          DTSBD384
00013 *                                                                 DTSBD384
00014 *    MODIFICATION LOG:                                            DTSBD384
00015 *                                                                 DTSBD384
00016 *    08/05/1003  INITIAL DEVELOPMENT.                             DTSBD384
00017 *                WORK ORDER:                      PROGRAMMER: RW1 DTSBD384
00018 *                                                                 DTSBD384
00019 *    02/09/2005  CORRECTED ERRORS.                                DTSBD384
00020 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD384
00021 *                                                                 DTSBD384
00022 *    04/05/2005  ADDED CODE TO INITIALIZE UC223-IND AND           DTSBD384
00023 *                MISSING-RPT-LETTERS-IND.                         DTSBD384
00024 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD384
00025 *                                                                 DTSBD384
00026 *    11/20/2006  RECOMPILED FOR NEW VERSION OF T002 RECORD        DTSBD384
00027 *                WORK ORDER:                      PROGRAMMER: ZL1 DTSBD384
00028 *                                                                 DTSBD384
00029 *    09/25/2009  MODIFIED S1000 TO SET L331-OP-ID FROM T002-OP-ID DTSBD384
00030 *                TO DISTINGUISH MODIFICATIONS FROM THE WEB FROM   DTSBD384
00031 *                THOSE MADE BY STAFF.                             DTSBD384
00032 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD384
00033 *                                                                 DTSBD384
00034 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD384
00035 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD384
00036 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBD384
00037 *                                                                 DTSBD384
00038 *                                                                 DTSBD384
00039 *  DESCRIPTION:                                                   DTSBD384
00040 *                                                                 DTSBD384
00041 *                                                                 DTSBD384
00042 *                                                                 DTSBD384
00043 *      MASTER FILE RECORDS READ:                                  DTSBD384
00044 *                                                                 DTSBD384
00045 *        MPRF                                                     DTSBD384
00046 *                                                                 DTSBD384
00047 *                                                                 DTSBD384
00048 *      MASTER FILE RECORDS UPDATED:                               DTSBD384
00049 *                                                                 DTSBD384
00050 *        MOPO                                                     DTSBD384
00051 *                                                                 DTSBD384
00052 *                                                                 DTSBD384
00053 *      REPORT RECORDS WRITTEN:                                    DTSBD384
00054 *                                                                 DTSBD384
00055 *        R907 ERRORS REPORT                                       DTSBD384
00056 *                                                                 DTSBD384
00057 *                                                                 DTSBD384
00058 *      MODULES CALLED:                                            DTSBD384
00059 *                                                                 DTSBD384
00060 *        DTSBU111 LOOKUP ADDRESS.                                 DTSBD384
00061 *        DTSBU112 FORMAT ADDRESS.                                 DTSBD384
00062 *        DTSBU331 FORMAT AND WRITE MLOG OCCURRENCE.               DTSBD384
00063 *        DTSBU910 MASTER FILE I/O DRIVER.                         DTSBD384
00064 *        DTSBU941 VARIABLE LENGTH RECORD INPUT 1.                 DTSBD384
00065 *        DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.     DTSBD384
00066 *                                                                 DTSBD384
00067 *****                                                             DTSBD384
00068      SKIP3                                                        DTSBD384
00069  ENVIRONMENT DIVISION.                                            DTSBD384
00070      SKIP3                                                        DTSBD384
00071  DATA DIVISION.                                                   DTSBD384
00072      EJECT                                                        DTSBD384
00073  WORKING-STORAGE SECTION.                                         DTSBD384
000735 77  PAN-VALET PICTURE X(24) VALUE '011DTSBD384  10/02/09'.       DTSBD384
00074      SKIP3                                                        DTSBD384
00075  01  WRK-AREA.                                                    DTSBD384
00076      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +384.DTSBD384
00077      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD384'.DTSBD384
00078      05  WRK-ABEND-MSG               PIC  X(60).                  DTSBD384
00079      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBD384
00080      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSBD384
00081      05  WRK-ID-NO                   PIC S9(03)  COMP-3.          DTSBD384
00082      05  WRK-REWRITE-ID-NO           PIC S9(03)  COMP-3.          DTSBD384
00083      05  WRK-TRACE-IND               PIC  X(01)  VALUE SPACES.    DTSBD384
00084                                                                   DTSBD384
00085      05  WRK-WRITE-MOPO-CNT          PIC S9(07)  COMP-3 VALUE 0.  DTSBD384
00086      05  WRK-REWRITE-MOPO-CNT        PIC S9(07)  COMP-3 VALUE 0.  DTSBD384
00087      05  WRK-R907-REC-CNT            PIC S9(07)  COMP-3 VALUE 0.  DTSBD384
00088                                                                   DTSBD384
00089      05  WRK-MOPO-FOUND-IND          PIC  X(01).                  DTSBD384
00090          88 WRK-MOPO-FOUND-YES-88       VALUE 'Y'.                DTSBD384
00091          88 WRK-MOPO-FOUND-NO-88        VALUE 'N'.                DTSBD384
00092                                                                   DTSBD384
00093      05  WRK-REWRITE-MOPO-IND        PIC  X(01).                  DTSBD384
00094          88 WRK-REWRITE-MOPO-YES-88     VALUE 'Y'.                DTSBD384
00095          88 WRK-REWRITE-MOPO-NO-88      VALUE 'N'.                DTSBD384
00096                                                                   DTSBD384
00097      05  DISP-DATE                   PIC  X(10)  VALUE SPACES.    DTSBD384
00098      05  DISP-TIME                   PIC  X(08)  VALUE SPACES.    DTSBD384
00099      05  DISP-ABSTIME                PIC  X(16)  VALUE SPACES.    DTSBD384
00100                                                                   DTSBD384
00101      05  WRK-CURR-TIME               PIC  S9(07) COMP-3 VALUE +0. DTSBD384
00102      05  WRK-CURR-DATE               PIC  S9(09) COMP-3 VALUE +0. DTSBD384
00103      05  WRK-CURR-YR                 PIC  9(04)  VALUE ZEROS.     DTSBD384
00104      05  WRK-ABSTIME                 PIC  S9(15) COMP-3 VALUE +0. DTSBD384
00105                                                                   DTSBD384
00106                                                                   DTSBD384
00107  01  MSG-TABLE.                                                   DTSBD384
00108      05  MSG1-REC-ID-OVERFLOW.                                    DTSBD384
00109          10  MSG1-ID         PIC  X(11)  VALUE 'DTSBD384001'.     DTSBD384
00110          10  MSG1-SHORT-TEXT PIC  X(20)  VALUE 'OVER 999 OPOS  '. DTSBD384
00111          10  MSG1-LONG-TEXT.                                      DTSBD384
00112              15  FILLER              PIC  X(31)                   DTSBD384
00113                    VALUE 'MORE THAN 999 OPO RECORDS FOR: '.       DTSBD384
00114              15  MSG1-EMP-NO         PIC  9(06).                  DTSBD384
00115      05  MSG2-MOPO-NOT-FOUND.                                     DTSBD384
00116          10  MSG2-ID         PIC  X(11)  VALUE 'DTSBD384002'.     DTSBD384
00117          10  MSG2-SHORT-TEXT PIC  X(20)  VALUE 'MOPO NOT FOUND '. DTSBD384
00118          10  MSG2-LONG-TEXT.                                      DTSBD384
00119              15  FILLER              PIC  X(35)                   DTSBD384
00120                    VALUE 'MOPO RECORD NOT FOUND FOR REWRITE: '.   DTSBD384
00121              15  MSG2-EMP-NO         PIC  9(06).                  DTSBD384
00122                                                                   DTSBD384
00123      EJECT                                                        DTSBD384
00124  01  Y120-REC.                                                    DTSBD384
00125  ++INCLUDE DTSIY120                                               DTSBD384
00126      EJECT                                                        DTSBD384
00127  01  L005-COMM-AREA.                                              DTSBD384
00128  ++INCLUDE DTSIL005                                               DTSBD384
00129      EJECT                                                        DTSBD384
00130  01  L331-LINK-AREA.                                              DTSBD384
00131  ++INCLUDE DTSIL331                                               DTSBD384
00132      EJECT                                                        DTSBD384
00133  01  L910-LINK-AREA.                                              DTSBD384
00134  ++INCLUDE DTSIL910                                               DTSBD384
00135      EJECT                                                        DTSBD384
00136  01  MSKL-REC.                                                    DTSBD384
00137  ++INCLUDE DTSIMSKL                                               DTSBD384
00138      EJECT                                                        DTSBD384
00139  01  MOPO-REC.                                                    DTSBD384
00140  ++INCLUDE DTSIMOPO                                               DTSBD384
00141  01  MEVL-REC.                                                    DTSBD384
00142  ++INCLUDE DTSIMEVL                                               DTSBD384
00143      EJECT                                                        DTSBD384
00144  01  R907-REC.                                                    DTSBD384
00145  ++INCLUDE DTSIR907                                               DTSBD384
00146      EJECT                                                        DTSBD384
00147                                                                   DTSBD384
00148  LINKAGE SECTION.                                                 DTSBD384
00149      SKIP3                                                        DTSBD384
00150  01  LBCM-LINK-AREA.                                              DTSBD384
00151  ++INCLUDE DTSILBCM                                               DTSBD384
00152      EJECT                                                        DTSBD384
00153  01  MPRF-REC.                                                    DTSBD384
00154  ++INCLUDE DTSIMPRF                                               DTSBD384
00155      EJECT                                                        DTSBD384
00156  01  T002-REC.                                                    DTSBD384
00157  ++INCLUDE DTSIT002                                               DTSBD384
00158      EJECT                                                        DTSBD384
00159  PROCEDURE DIVISION USING LBCM-LINK-AREA                          DTSBD384
00160                           MPRF-REC                                DTSBD384
00161                           T002-REC.                               DTSBD384
00162                                                                   DTSBD384
00163      IF FIRST-TIME-IND = 'Y'                                      DTSBD384
00164          PERFORM I0000-INITIATE THRU I0000-EXIT                   DTSBD384
00165          MOVE 'N' TO FIRST-TIME-IND                               DTSBD384
00166      END-IF.                                                      DTSBD384
00167                                                                   DTSBD384
00168      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBD384
00169                                                                   DTSBD384
00170      GOBACK.                                                      DTSBD384
00171      SKIP3                                                        DTSBD384
00172  I0000-INITIATE.                                                  DTSBD384
00173      MOVE LENGTH OF R907-REC  TO R907-LENGTH.                     DTSBD384
00174      MOVE WRK-MOD-NAME  TO R907-MODULE-NAME.                      DTSBD384
00175                                                                   DTSBD384
00176  I0000-EXIT.                                                      DTSBD384
00177      EXIT.                                                        DTSBD384
00178                                                                   DTSBD384
00179  P0000-PROCESS.                                                   DTSBD384
00180      IF T002-CONTACT-88                                           DTSBD384
00181         MOVE T002-DATA-AREA             TO Y120-REC               DTSBD384
00182         PERFORM P1000-SCAN-MOPO         THRU P1000-EXIT           DTSBD384
00183         IF WRK-MOPO-FOUND-NO-88                                   DTSBD384
00184            PERFORM P2000-ADD-CONTACT    THRU P2000-EXIT           DTSBD384
00185         ELSE                                                      DTSBD384
00186            PERFORM P3000-UPDATE-CONTACT THRU P3000-EXIT           DTSBD384
00187         END-IF                                                    DTSBD384
00188      END-IF.                                                      DTSBD384
00189                                                                   DTSBD384
00190  P0000-EXIT.                                                      DTSBD384
00191      EXIT.                                                        DTSBD384
00192                                                                   DTSBD384
00193  P1000-SCAN-MOPO.                                                 DTSBD384
00194      SET WRK-MOPO-FOUND-NO-88  TO TRUE.                           DTSBD384
00195      MOVE ZERO                 TO WRK-ID-NO                       DTSBD384
00196                                   WRK-REWRITE-ID-NO.              DTSBD384
00197                                                                   DTSBD384
00198      MOVE LOW-VALUES  TO MOPO-KEY-AREA.                           DTSBD384
00199      MOVE MPRF-EMP-NO TO MOPO-EMP-NO.                             DTSBD384
00200      SET MOPO-OPO-88  TO TRUE.                                    DTSBD384
00201      MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD384
00202      PERFORM S910-START-BROWSE  THRU S910-EXIT.                   DTSBD384
00203      PERFORM                                                      DTSBD384
00204        UNTIL L910-NO-REC-88 OR WRK-REWRITE-ID-NO > 0              DTSBD384
00205          MOVE MSKL-REC             TO MOPO-REC                    DTSBD384
00206          MOVE MOPO-ID-NO           TO WRK-ID-NO                   DTSBD384
00207          PERFORM P1100-CHECK-DUP   THRU P1100-EXIT                DTSBD384
00208          PERFORM S910-READ-NEXT THRU S910-EXIT                    DTSBD384
00209      END-PERFORM.                                                 DTSBD384
00210  P1000-EXIT.                                                      DTSBD384
00211      EXIT.                                                        DTSBD384
00212                                                                   DTSBD384
00213  P1100-CHECK-DUP.                                                 DTSBD384
00214      IF  MOPO-TYPE-IND          = Y120-CONTACT-TYPE               DTSBD384
00215      AND Y120-CONTACT-NAME      = MOPO-NAME                       DTSBD384
00216      AND Y120-CONTACT-TITLE     = MOPO-TITLE                      DTSBD384
00217      AND ((Y120-CONTACT-DELV1    = MOPO-DELIV-LINE-1              DTSBD384
00218      OR   Y120-CONTACT-DELV1    = MOPO-DELIV-LINE-2)              DTSBD384
00219      OR   (Y120-CONTACT-DELV2    = MOPO-DELIV-LINE-1              DTSBD384
00220      OR   Y120-CONTACT-DELV2    = MOPO-DELIV-LINE-2))             DTSBD384
00221      AND Y120-CONTACT-CITY      = MOPO-CITY                       DTSBD384
00222      AND Y120-CONTACT-STATE     = MOPO-ST                         DTSBD384
00223          SET WRK-MOPO-FOUND-YES-88  TO TRUE                       DTSBD384
00224          MOVE MOPO-ID-NO        TO WRK-REWRITE-ID-NO              DTSBD384
00225      END-IF.                                                      DTSBD384
00226                                                                   DTSBD384
00227  P1100-EXIT.                                                      DTSBD384
00228      EXIT.                                                        DTSBD384
00229                                                                   DTSBD384
00230  P2000-ADD-CONTACT.                                               DTSBD384
00231 *&                                                                DTSBD384
00232 *    IF T002-EMP-NO = 010021                                      DTSBD384
00233         DISPLAY 'BD384 P2000 ADD ' T002-EMP-NO                    DTSBD384
00234            '  ' Y120-CONTACT-NAME '  ' Y120-CONTACT-VOICE.        DTSBD384
00235 *    END-IF.                                                      DTSBD384
00236 *&                                                                DTSBD384
00237      MOVE LOW-VALUES              TO MOPO-REC.                    DTSBD384
00238      MOVE T002-EMP-NO             TO MOPO-EMP-NO.                 DTSBD384
00239      SET MOPO-OPO-88              TO TRUE.                        DTSBD384
00240      IF WRK-ID-NO < +999                                          DTSBD384
00241         ADD +1                    TO WRK-ID-NO                    DTSBD384
00242         MOVE WRK-ID-NO            TO MOPO-ID-NO                   DTSBD384
00243      ELSE                                                         DTSBD384
00244         MOVE T002-EMP-NO          TO R907-EMP-NO                  DTSBD384
00245                                      MSG1-EMP-NO                  DTSBD384
00246         MOVE MSG1-REC-ID-OVERFLOW TO R907-MSG-TEXT                DTSBD384
00247         PERFORM S946-WRITE-R907   THRU S946-EXIT                  DTSBD384
00248         GO TO P2000-EXIT                                          DTSBD384
00249      END-IF.                                                      DTSBD384
00250      MOVE ZERO                    TO MOPO-PURGE-DATE.             DTSBD384
00251      MOVE SPACES                  TO MOPO-ATTN-LINE               DTSBD384
00252                                      MOPO-ADVANCED-BARCODE.       DTSBD384
00253                                                                   DTSBD384
00254      MOVE Y120-CONTACT-TYPE       TO MOPO-TYPE-IND.               DTSBD384
00255      SET MOPO-UC223-NO-88         TO TRUE.                        DTSBD384
00256      SET MOPO-MISSING-RPT-LTRS-NO-88                              DTSBD384
00257                                   TO TRUE.                        DTSBD384
00258      SET MOPO-NOT-CONVERTED-88    TO TRUE.                        DTSBD384
00259      MOVE LBCM-CURR-RUN-DATE      TO MOPO-CHNG-DATE.              DTSBD384
00260      MOVE LBCM-CURR-RUN-DATE      TO MOPO-ESTB-DATE.              DTSBD384
00261                                                                   DTSBD384
00262      PERFORM S1000-INIT-MLOG      THRU S1000-EXIT.                DTSBD384
00263      MOVE LBCM-EMP-ABSTIME        TO MOPO-ESTB-ABSTIME.           DTSBD384
00264                                                                   DTSBD384
00265      IF Y120-CONTACT-SSN > SPACES                                 DTSBD384
00266         MOVE 'MOPO-SSN'           TO L331-FIELD-NAME              DTSBD384
00267         MOVE SPACES               TO L331-FROM-VALUE              DTSBD384
00268         MOVE Y120-CONTACT-SSN     TO L331-TO-VALUE                DTSBD384
00269         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00270         MOVE Y120-CONTACT-SSN     TO MOPO-SSN                     DTSBD384
00271      ELSE                                                         DTSBD384
00272         MOVE ZERO                 TO MOPO-SSN                     DTSBD384
00273      END-IF.                                                      DTSBD384
00274                                                                   DTSBD384
00275      IF Y120-CONTACT-NAME > SPACES                                DTSBD384
00276         MOVE 'MOPO-NAME'          TO L331-FIELD-NAME              DTSBD384
00277         MOVE SPACES               TO L331-FROM-VALUE              DTSBD384
00278         MOVE Y120-CONTACT-NAME    TO L331-TO-VALUE                DTSBD384
00279         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00280         MOVE Y120-CONTACT-NAME    TO MOPO-NAME                    DTSBD384
00281      ELSE                                                         DTSBD384
00282         MOVE SPACES               TO MOPO-NAME                    DTSBD384
00283      END-IF.                                                      DTSBD384
00284                                                                   DTSBD384
00285      IF Y120-CONTACT-TITLE  > SPACES                              DTSBD384
00286         MOVE 'MOPO-TITLE'         TO L331-FIELD-NAME              DTSBD384
00287         MOVE SPACES               TO L331-FROM-VALUE              DTSBD384
00288         MOVE Y120-CONTACT-TITLE   TO L331-TO-VALUE                DTSBD384
00289         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00290         MOVE Y120-CONTACT-TITLE   TO MOPO-TITLE                   DTSBD384
00291      ELSE                                                         DTSBD384
00292         MOVE SPACES               TO MOPO-TITLE                   DTSBD384
00293      END-IF.                                                      DTSBD384
00294                                                                   DTSBD384
00295      IF Y120-CONTACT-DELV1  > SPACES                              DTSBD384
00296         MOVE 'MOPO-DELIV-LINE-1'  TO L331-FIELD-NAME              DTSBD384
00297         MOVE SPACES               TO L331-FROM-VALUE              DTSBD384
00298         MOVE Y120-CONTACT-DELV1   TO L331-TO-VALUE                DTSBD384
00299         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00300         MOVE Y120-CONTACT-DELV1   TO MOPO-DELIV-LINE-1            DTSBD384
00301      ELSE                                                         DTSBD384
00302         MOVE SPACES               TO MOPO-DELIV-LINE-1            DTSBD384
00303      END-IF.                                                      DTSBD384
00304                                                                   DTSBD384
00305      IF Y120-CONTACT-DELV2  > SPACES                              DTSBD384
00306         MOVE 'MOPO-DELIV-LINE-2'  TO L331-FIELD-NAME              DTSBD384
00307         MOVE SPACES               TO L331-FROM-VALUE              DTSBD384
00308         MOVE Y120-CONTACT-DELV2   TO L331-TO-VALUE                DTSBD384
00309         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00310         MOVE Y120-CONTACT-DELV2   TO MOPO-DELIV-LINE-2            DTSBD384
00311      ELSE                                                         DTSBD384
00312         MOVE SPACES               TO MOPO-DELIV-LINE-2            DTSBD384
00313      END-IF.                                                      DTSBD384
00314                                                                   DTSBD384
00315      IF Y120-CONTACT-CITY   > SPACES                              DTSBD384
00316         MOVE 'MOPO-CITY'          TO L331-FIELD-NAME              DTSBD384
00317         MOVE SPACES               TO L331-FROM-VALUE              DTSBD384
00318         MOVE Y120-CONTACT-CITY    TO L331-TO-VALUE                DTSBD384
00319         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00320         MOVE Y120-CONTACT-CITY    TO MOPO-CITY                    DTSBD384
00321      ELSE                                                         DTSBD384
00322         MOVE SPACES               TO MOPO-CITY                    DTSBD384
00323      END-IF.                                                      DTSBD384
00324                                                                   DTSBD384
00325      IF Y120-CONTACT-STATE  > SPACES                              DTSBD384
00326         MOVE 'MOPO-ST'            TO L331-FIELD-NAME              DTSBD384
00327         MOVE SPACES               TO L331-FROM-VALUE              DTSBD384
00328         MOVE Y120-CONTACT-STATE   TO L331-TO-VALUE                DTSBD384
00329         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00330         MOVE Y120-CONTACT-STATE   TO MOPO-ST                      DTSBD384
00331      ELSE                                                         DTSBD384
00332         MOVE SPACES               TO MOPO-ST                      DTSBD384
00333      END-IF.                                                      DTSBD384
00334                                                                   DTSBD384
00335      IF Y120-CONTACT-ZIP    > SPACES                              DTSBD384
00336         MOVE 'MOPO-ZIP'           TO L331-FIELD-NAME              DTSBD384
00337         MOVE SPACES               TO L331-FROM-VALUE              DTSBD384
00338         MOVE Y120-CONTACT-ZIP     TO L331-TO-VALUE                DTSBD384
00339         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00340         MOVE Y120-CONTACT-ZIP     TO MOPO-ZIP                     DTSBD384
00341      ELSE                                                         DTSBD384
00342         MOVE SPACES               TO MOPO-ZIP                     DTSBD384
00343      END-IF.                                                      DTSBD384
00344                                                                   DTSBD384
00345      IF Y120-CONTACT-VOICE > SPACES                               DTSBD384
00346         MOVE 'MOPO-VOICE-1'       TO L331-FIELD-NAME              DTSBD384
00347         MOVE SPACES               TO L331-FROM-VALUE              DTSBD384
00348         MOVE Y120-CONTACT-VOICE   TO L331-TO-VALUE                DTSBD384
00349         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00350         MOVE Y120-CONTACT-VOICE   TO MOPO-VOICE-1                 DTSBD384
00351      ELSE                                                         DTSBD384
00352         MOVE SPACES               TO MOPO-VOICE-1                 DTSBD384
00353      END-IF.                                                      DTSBD384
00354                                                                   DTSBD384
00355      MOVE SPACES                  TO MOPO-VOICE-2.                DTSBD384
00356                                                                   DTSBD384
00357      IF Y120-CONTACT-FAX    > SPACES                              DTSBD384
00358         MOVE 'MOPO-FAX'           TO L331-FIELD-NAME              DTSBD384
00359         MOVE SPACES               TO L331-FROM-VALUE              DTSBD384
00360         MOVE Y120-CONTACT-FAX     TO L331-TO-VALUE                DTSBD384
00361         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00362         MOVE Y120-CONTACT-FAX     TO MOPO-FAX                     DTSBD384
00363      ELSE                                                         DTSBD384
00364         MOVE SPACES               TO MOPO-FAX                     DTSBD384
00365      END-IF.                                                      DTSBD384
00366                                                                   DTSBD384
00367      IF Y120-CONTACT-EMAIL > SPACES                               DTSBD384
00368         MOVE 'MOPO-EMAIL-ADDRESS' TO L331-FIELD-NAME              DTSBD384
00369         MOVE SPACES               TO L331-FROM-VALUE              DTSBD384
00370         MOVE Y120-CONTACT-EMAIL   TO L331-TO-VALUE                DTSBD384
00371         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00372         MOVE Y120-CONTACT-EMAIL   TO MOPO-EMAIL-ADDRESS           DTSBD384
00373      ELSE                                                         DTSBD384
00374         MOVE SPACES               TO MOPO-EMAIL-ADDRESS           DTSBD384
00375      END-IF.                                                      DTSBD384
00376                                                                   DTSBD384
00377      MOVE MOPO-REC                TO MSKL-REC.                    DTSBD384
00378      PERFORM S910-WRITE           THRU S910-EXIT.                 DTSBD384
00379                                                                   DTSBD384
00380 *&                                                                DTSBD384
00381      DISPLAY 'BD384 P2000 - 2 ' MPRF-EMP-NO                       DTSBD384
00382         '  ' MOPO-ID-NO '  ' MOPO-TYPE-IND                        DTSBD384
00383         '  ' MOPO-NAME '  ' MOPO-VOICE-1 '  ' MOPO-FAX.           DTSBD384
00384      DISPLAY '   Y120 ' Y120-CONTACT-NAME                         DTSBD384
00385              '  ' Y120-CONTACT-VOICE.                             DTSBD384
00386 *&                                                                DTSBD384
00387  P2000-EXIT.                                                      DTSBD384
00388      EXIT.                                                        DTSBD384
00389                                                                   DTSBD384
00390  P3000-UPDATE-CONTACT.                                            DTSBD384
00391 *&                                                                DTSBD384
00392      DISPLAY 'BD384 P3000 UPD ' MPRF-EMP-NO                       DTSBD384
00393         '  ' Y120-CONTACT-NAME                                    DTSBD384
00394         '  ' Y120-CONTACT-VOICE.                                  DTSBD384
00395 *&                                                                DTSBD384
00396      SET WRK-REWRITE-MOPO-NO-88   TO TRUE.                        DTSBD384
00397      MOVE LOW-VALUES  TO MOPO-KEY-AREA.                           DTSBD384
00398      MOVE MPRF-EMP-NO TO MOPO-EMP-NO.                             DTSBD384
00399      SET MOPO-OPO-88  TO TRUE.                                    DTSBD384
00400      MOVE WRK-REWRITE-ID-NO TO MOPO-ID-NO.                        DTSBD384
00401      MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD384
00402      PERFORM S910-READ          THRU S910-EXIT.                   DTSBD384
00403      IF NOT L910-OK-88                                            DTSBD384
00404         MOVE T002-EMP-NO          TO R907-EMP-NO                  DTSBD384
00405                                      MSG2-EMP-NO                  DTSBD384
00406         MOVE MSG2-MOPO-NOT-FOUND  TO R907-MSG-TEXT                DTSBD384
00407         PERFORM S946-WRITE-R907   THRU S946-EXIT                  DTSBD384
00408         GO TO P3000-EXIT                                          DTSBD384
00409      ELSE                                                         DTSBD384
00410         MOVE MSKL-REC             TO MOPO-REC                     DTSBD384
00411      END-IF.                                                      DTSBD384
00412                                                                   DTSBD384
00413      PERFORM S1000-INIT-MLOG      THRU S1000-EXIT.                DTSBD384
00414                                                                   DTSBD384
00415 *&                                                                DTSBD384
00416      DISPLAY 'BD384 P3000 - 1 ' MPRF-EMP-NO                       DTSBD384
00417         '  ' MOPO-ID-NO '  ' MOPO-TYPE-IND                        DTSBD384
00418         '  ' MOPO-NAME '  ' MOPO-VOICE-1                          DTSBD384
00419         '  ' MOPO-FAX.                                            DTSBD384
00420 *&                                                                DTSBD384
00421      IF Y120-CONTACT-NAME NOT = MOPO-NAME                         DTSBD384
00422         SET WRK-REWRITE-MOPO-YES-88   TO TRUE                     DTSBD384
00423         MOVE 'MOPO-NAME'          TO L331-FIELD-NAME              DTSBD384
00424         MOVE MOPO-NAME            TO L331-FROM-VALUE              DTSBD384
00425         MOVE Y120-CONTACT-NAME    TO L331-TO-VALUE                DTSBD384
00426         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00427         MOVE Y120-CONTACT-NAME    TO MOPO-NAME                    DTSBD384
00428      END-IF.                                                      DTSBD384
00429                                                                   DTSBD384
00430                                                                   DTSBD384
00431      IF Y120-CONTACT-TITLE NOT = MOPO-TITLE                       DTSBD384
00432         SET WRK-REWRITE-MOPO-YES-88   TO TRUE                     DTSBD384
00433         MOVE 'MOPO-TITLE'         TO L331-FIELD-NAME              DTSBD384
00434         MOVE MOPO-TITLE           TO L331-FROM-VALUE              DTSBD384
00435         MOVE Y120-CONTACT-TITLE   TO L331-TO-VALUE                DTSBD384
00436         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00437         MOVE Y120-CONTACT-TITLE   TO MOPO-TITLE                   DTSBD384
00438      END-IF.                                                      DTSBD384
00439                                                                   DTSBD384
00440      IF Y120-CONTACT-DELV1 NOT = MOPO-DELIV-LINE-1                DTSBD384
00441         SET WRK-REWRITE-MOPO-YES-88   TO TRUE                     DTSBD384
00442         MOVE 'MOPO-DELIV-LINE-1'  TO L331-FIELD-NAME              DTSBD384
00443         MOVE MOPO-DELIV-LINE-1    TO L331-FROM-VALUE              DTSBD384
00444         MOVE Y120-CONTACT-DELV1   TO L331-TO-VALUE                DTSBD384
00445         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00446         MOVE Y120-CONTACT-DELV1   TO MOPO-DELIV-LINE-1            DTSBD384
00447      END-IF.                                                      DTSBD384
00448                                                                   DTSBD384
00449      IF Y120-CONTACT-DELV2 NOT = MOPO-DELIV-LINE-2                DTSBD384
00450         SET WRK-REWRITE-MOPO-YES-88   TO TRUE                     DTSBD384
00451         MOVE 'MOPO-DELIV-LINE-2'  TO L331-FIELD-NAME              DTSBD384
00452         MOVE MOPO-DELIV-LINE-2    TO L331-FROM-VALUE              DTSBD384
00453         MOVE Y120-CONTACT-DELV2   TO L331-TO-VALUE                DTSBD384
00454         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00455         MOVE Y120-CONTACT-DELV2   TO MOPO-DELIV-LINE-2            DTSBD384
00456      END-IF.                                                      DTSBD384
00457                                                                   DTSBD384
00458      IF Y120-CONTACT-CITY NOT = MOPO-CITY                         DTSBD384
00459         SET WRK-REWRITE-MOPO-YES-88   TO TRUE                     DTSBD384
00460         MOVE 'MOPO-CITY'          TO L331-FIELD-NAME              DTSBD384
00461         MOVE MOPO-CITY            TO L331-FROM-VALUE              DTSBD384
00462         MOVE Y120-CONTACT-CITY    TO L331-TO-VALUE                DTSBD384
00463         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00464         MOVE Y120-CONTACT-CITY    TO MOPO-CITY                    DTSBD384
00465      END-IF.                                                      DTSBD384
00466                                                                   DTSBD384
00467      IF Y120-CONTACT-STATE NOT = MOPO-ST                          DTSBD384
00468         SET WRK-REWRITE-MOPO-YES-88   TO TRUE                     DTSBD384
00469         MOVE 'MOPO-ST'            TO L331-FIELD-NAME              DTSBD384
00470         MOVE MOPO-ST              TO L331-FROM-VALUE              DTSBD384
00471         MOVE Y120-CONTACT-STATE   TO L331-TO-VALUE                DTSBD384
00472         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00473         MOVE Y120-CONTACT-STATE   TO MOPO-ST                      DTSBD384
00474      END-IF.                                                      DTSBD384
00475                                                                   DTSBD384
00476      IF Y120-CONTACT-ZIP    > SPACES                              DTSBD384
00477         SET WRK-REWRITE-MOPO-YES-88   TO TRUE                     DTSBD384
00478         MOVE 'MOPO-ZIP'           TO L331-FIELD-NAME              DTSBD384
00479         MOVE MOPO-ZIP             TO L331-FROM-VALUE              DTSBD384
00480         MOVE Y120-CONTACT-ZIP     TO L331-TO-VALUE                DTSBD384
00481         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00482         MOVE Y120-CONTACT-ZIP     TO MOPO-ZIP                     DTSBD384
00483      END-IF.                                                      DTSBD384
00484                                                                   DTSBD384
00485      IF Y120-CONTACT-VOICE NOT = MOPO-VOICE-1                     DTSBD384
00486         SET WRK-REWRITE-MOPO-YES-88   TO TRUE                     DTSBD384
00487         MOVE 'MOPO-VOICE-1'       TO L331-FIELD-NAME              DTSBD384
00488         MOVE MOPO-VOICE-1         TO L331-FROM-VALUE              DTSBD384
00489         MOVE Y120-CONTACT-VOICE   TO L331-TO-VALUE                DTSBD384
00490         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00491         MOVE Y120-CONTACT-VOICE   TO MOPO-VOICE-1                 DTSBD384
00492      END-IF.                                                      DTSBD384
00493                                                                   DTSBD384
00494      IF Y120-CONTACT-FAX   NOT  =  MOPO-FAX                       DTSBD384
00495         SET WRK-REWRITE-MOPO-YES-88   TO TRUE                     DTSBD384
00496         MOVE 'MOPO-FAX'           TO L331-FIELD-NAME              DTSBD384
00497         MOVE MOPO-FAX             TO L331-FROM-VALUE              DTSBD384
00498         MOVE Y120-CONTACT-FAX     TO L331-TO-VALUE                DTSBD384
00499         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00500         MOVE Y120-CONTACT-FAX     TO MOPO-FAX                     DTSBD384
00501      END-IF.                                                      DTSBD384
00502                                                                   DTSBD384
00503      IF Y120-CONTACT-EMAIL  NOT = MOPO-EMAIL-ADDRESS              DTSBD384
00504         SET WRK-REWRITE-MOPO-YES-88   TO TRUE                     DTSBD384
00505         MOVE 'MOPO-EMAIL-ADDRESS' TO L331-FIELD-NAME              DTSBD384
00506         MOVE MOPO-EMAIL-ADDRESS   TO L331-FROM-VALUE              DTSBD384
00507         MOVE Y120-CONTACT-EMAIL   TO L331-TO-VALUE                DTSBD384
00508         PERFORM S331-WRITE-MLOG   THRU S331-EXIT                  DTSBD384
00509         MOVE Y120-CONTACT-EMAIL   TO MOPO-EMAIL-ADDRESS           DTSBD384
00510         END-IF.                                                   DTSBD384
00511                                                                   DTSBD384
00512      IF WRK-REWRITE-MOPO-YES-88                                   DTSBD384
00513         MOVE LBCM-CURR-RUN-DATE   TO MOPO-CHNG-DATE               DTSBD384
00514         MOVE MOPO-REC             TO MSKL-REC                     DTSBD384
00515         PERFORM S910-REWRITE      THRU S910-EXIT                  DTSBD384
00516 *&                                                                DTSBD384
00517      DISPLAY 'BD384 P3000 - 2 ' MPRF-EMP-NO                       DTSBD384
00518         '  ' MOPO-ID-NO '  ' MOPO-TYPE-IND                        DTSBD384
00519         '  ' MOPO-NAME '  ' MOPO-VOICE-1 '  ' MOPO-FAX            DTSBD384
00520 *&                                                                DTSBD384
00521      END-IF.                                                      DTSBD384
00522                                                                   DTSBD384
00523  P3000-EXIT.                                                      DTSBD384
00524      EXIT.                                                        DTSBD384
00525                                                                   DTSBD384
00526  S005-SYS-DATE.                                                   DTSBD384
00527      CALL 'DTSBU005' USING L005-COMM-AREA.                        DTSBD384
00528                                                                   DTSBD384
00529  S005-EXIT.                                                       DTSBD384
00530      EXIT.                                                        DTSBD384
00531                                                                   DTSBD384
00532  S331-WRITE-MLOG.                                                 DTSBD384
00533      CALL 'DTSBU331' USING L331-LINK-AREA.                        DTSBD384
00534                                                                   DTSBD384
00535  S331-EXIT.                                                       DTSBD384
00536      EXIT.                                                        DTSBD384
00537                                                                   DTSBD384
00538  S910-OPEN-READ.                                                  DTSBD384
00539      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD384
00540      GO TO S910-MSTR-IO.                                          DTSBD384
00541                                                                   DTSBD384
00542  S910-OPEN-UPDATE.                                                DTSBD384
00543      SET L910-OPEN-UPDATE-88 TO TRUE.                             DTSBD384
00544      GO TO S910-MSTR-IO.                                          DTSBD384
00545                                                                   DTSBD384
00546  S910-OPEN-UPDATE-NO-AIX.                                         DTSBD384
00547      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSBD384
00548      GO TO S910-MSTR-IO.                                          DTSBD384
00549                                                                   DTSBD384
00550  S910-READ.                                                       DTSBD384
00551      SET L910-READ-88 TO TRUE.                                    DTSBD384
00552      GO TO S910-MSTR-IO.                                          DTSBD384
00553                                                                   DTSBD384
00554  S910-START-BROWSE.                                               DTSBD384
00555      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD384
00556      GO TO S910-MSTR-IO.                                          DTSBD384
00557                                                                   DTSBD384
00558  S910-READ-NEXT.                                                  DTSBD384
00559      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD384
00560      GO TO S910-MSTR-IO.                                          DTSBD384
00561                                                                   DTSBD384
00562  S910-COUNT.                                                      DTSBD384
00563      SET L910-COUNT-88 TO TRUE.                                   DTSBD384
00564      GO TO S910-MSTR-IO.                                          DTSBD384
00565                                                                   DTSBD384
00566  S910-WRITE.                                                      DTSBD384
00567      SET LBCM-EMP-UPDATE-YES-88  TO TRUE.                         DTSBD384
00568      SET L910-WRITE-88 TO TRUE.                                   DTSBD384
00569      GO TO S910-MSTR-IO.                                          DTSBD384
00570                                                                   DTSBD384
00571  S910-REWRITE.                                                    DTSBD384
00572      SET LBCM-EMP-UPDATE-YES-88  TO TRUE.                         DTSBD384
00573      SET L910-REWRITE-88 TO TRUE.                                 DTSBD384
00574      GO TO S910-MSTR-IO.                                          DTSBD384
00575                                                                   DTSBD384
00576  S910-DELETE.                                                     DTSBD384
00577      SET L910-DELETE-88 TO TRUE.                                  DTSBD384
00578      GO TO S910-MSTR-IO.                                          DTSBD384
00579                                                                   DTSBD384
00580  S910-CLOSE.                                                      DTSBD384
00581      SET L910-CLOSE-88     TO TRUE.                               DTSBD384
00582      GO TO S910-MSTR-IO.                                          DTSBD384
00583                                                                   DTSBD384
00584  S910-MSTR-IO.                                                    DTSBD384
00585      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD384
00586                            MSKL-REC.                              DTSBD384
00587  S910-EXIT.                                                       DTSBD384
00588      EXIT.                                                        DTSBD384
00589                                                                   DTSBD384
00590  S946-WRITE-R907.                                                 DTSBD384
00591      CALL 'DTSBU946' USING R907-REC.                              DTSBD384
00592                                                                   DTSBD384
00593  S946-EXIT.                                                       DTSBD384
00594      EXIT.                                                        DTSBD384
00595                                                                   DTSBD384
00596  S1000-INIT-MLOG.                                                 DTSBD384
00597      MOVE T002-EMP-NO            TO L331-EMP-NO.                  DTSBD384
00598      MOVE LBCM-CURR-RUN-DATE     TO L331-CURR-RUN-DATE.           DTSBD384
00599      ADD  +1000                  TO LBCM-EMP-ABSTIME.             DTSBD384
00600      MOVE LBCM-EMP-ABSTIME       TO L331-UPDATE-ABSTIME.          DTSBD384
00601      MOVE T002-OP-ID             TO L331-OP-ID.                   DTSBD384
00602      SET L005-FROM-ABSTIME       TO TRUE.                         DTSBD384
00603      MOVE LBCM-EMP-ABSTIME       TO L005-ABSTIME.                 DTSBD384
00604      PERFORM S005-SYS-DATE       THRU S005-EXIT.                  DTSBD384
00605      MOVE L005-DATE-8-SLASH-TIME TO L331-REC-OCC-ID.              DTSBD384
00606                                                                   DTSBD384
00607      PERFORM S331-WRITE-MLOG     THRU S331-EXIT.                  DTSBD384
00608                                                                   DTSBD384
00609  S1000-EXIT.                                                      DTSBD384
00610      EXIT.                                                        DTSBD384
00611                                                                   DTSBD384
00612  S999-ABEND.                                                      DTSBD384
00613      DISPLAY '*** DTSBD384 ABENDING : '                           DTSBD384
00614              WRK-ABEND-MSG.                                       DTSBD384
00615                                                                   DTSBD384
00616      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD384
00617  S999-EXIT.                                                       DTSBD384
00618      EXIT.                                                        DTSBD384
00619                                                                   DTSBD384
