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