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