621 lines
49 KiB
COBOL
621 lines
49 KiB
COBOL
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
|