DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
620
Batch/DTSBD384.cob
Normal file
620
Batch/DTSBD384.cob
Normal file
@ -0,0 +1,620 @@
|
||||
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
|
||||
Reference in New Issue
Block a user