00001 IDENTIFICATION DIVISION. 02/13/99 00002 PROGRAM-ID. DTSBD560. DTSBD560 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002 00004 DATE-WRITTEN. DECEMBER 1997. DTSBD560 00005 DATE-COMPILED. DTSBD560 00006 SKIP3 DTSBD560 00007 ***** DTSBD560 00008 * DTSBD560 00009 * FUNCTION: BATCH ADDRESS UPDATE ADDRESS EXTRACT. DTSBD560 00010 * DTSBD560 00011 * DTSBD560 00012 * MODIFICATION LOG: DTSBD560 00013 * DTSBD560 00014 * 12/27/97 INITIAL DEVELOPMENT. DTSBD560 00015 * WORK ORDER: TCL 214 PROGRAMMER: EHH DTSBD560 00016 * DTSBD560 00017 * 02/13/1999 REVIEWED AND MODIFIED FOR DC. CL**2 00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2 00019 * CL**2 00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**2 00023 * DTSBD560 00024 * DTSBD560 00025 * DESCRIPTION: DTSBD560 00026 * DTSBD560 00027 * EXTRACT ADDRESSES FROM TAX MASTER FILE. DTSBD560 00028 * DTSBD560 00029 * DTSBD560 IS THE FIRST STEP IN THE THREE STEP BATCH CL**2 00030 * ADDRESS UPDATE PROCESS. DTSBD560 00031 * DTSBD560 00032 * DTSBD560 00033 * REPORT RECORDS INPUT: DTSBD560 00034 * DTSBD560 00035 * NONE DTSBD560 00036 * DTSBD560 00037 * DTSBD560 00038 * TAPES INPUT: DTSBD560 00039 * DTSBD560 00040 * NONE. DTSBD560 00041 * DTSBD560 00042 * DTSBD560 00043 * MASTER FILE RECORDS READ: DTSBD560 00044 * DTSBD560 00045 * MPRF DTSBD560 00046 * MTAD DTSBD560 00047 * MOPO DTSBD560 00048 * MTAA DTSBD560 00049 * MBAA DTSBD560 00050 * MELF DTSBD560 00051 * DTSBD560 00052 * MASTER FILE RECORDS UPDATED: DTSBD560 00053 * DTSBD560 00054 * NONE. DTSBD560 00055 * DTSBD560 00056 * DTSBD560 00057 * RECORDS WRITTEN: DTSBD560 00058 * DTSBD560 00059 * XLPC INTERFACE TO FINALIST MODULE. DTSBD560 00060 * DTSBD560 00061 * DTSBD560 00062 * MODULES CALLED: DTSBD560 00063 * DTSBD560 00064 * DTSBU910 MASTER FILE I/O. CL**2 00065 * DTSBD560 00066 * DTSBD560 00067 ***** DTSBD560 00068 SKIP3 DTSBD560 00069 ENVIRONMENT DIVISION. DTSBD560 00070 SKIP3 DTSBD560 00071 INPUT-OUTPUT SECTION. DTSBD560 00072 SKIP2 DTSBD560 00073 FILE-CONTROL. DTSBD560 00074 SELECT LPC-FILE ASSIGN TO DTSLPCO. CL**2 00075 DATA DIVISION. DTSBD560 00076 SKIP3 DTSBD560 00077 FILE SECTION. DTSBD560 00078 SKIP3 DTSBD560 00079 FD LPC-FILE DTSBD560 00080 LABEL RECORDS ARE STANDARD DTSBD560 00081 RECORDING MODE IS F DTSBD560 00082 BLOCK CONTAINS 0 RECORDS. DTSBD560 00083 SKIP2 DTSBD560 00084 01 LPC-REC. DTSBD560 00085 ++INCLUDE DTSIXLPC CL**2 00086 EJECT DTSBD560 00087 WORKING-STORAGE SECTION. DTSBD560 000875 77 PAN-VALET PICTURE X(24) VALUE '002DTSBD560 02/13/99'. DTSBD560 00088 SKIP3 DTSBD560 00089 01 WRK-AREA. DTSBD560 00090 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +560. DTSBD560 00091 DTSBD560 00092 05 ABEND-MSG PIC X(60). DTSBD560 00093 DTSBD560 00094 05 WRK-MPRF-REC-CNT PIC S9(07) COMP-3. DTSBD560 00095 DTSBD560 00096 05 WRK-MTAD-REC-CNT PIC S9(07) COMP-3. DTSBD560 00097 DTSBD560 00098 05 WRK-MOPO-REC-CNT PIC S9(07) COMP-3. DTSBD560 00099 DTSBD560 00100 05 WRK-MTAA-REC-CNT PIC S9(07) COMP-3. DTSBD560 00101 DTSBD560 00102 05 WRK-MBAA-REC-CNT PIC S9(07) COMP-3. DTSBD560 00103 DTSBD560 00104 05 WRK-MELF-REC-CNT PIC S9(07) COMP-3. DTSBD560 00105 DTSBD560 00106 05 WRK-LPC-REC-CNT PIC S9(07) COMP-3. DTSBD560 00107 DTSBD560 00108 05 WRK-MASTER-UPDATE-IND PIC X(01). DTSBD560 00109 88 WRK-MASTER-UPDATE-NO-88 VALUE 'N'. DTSBD560 00110 88 WRK-MASTER-UPDATE-YES-88 VALUE 'Y'. DTSBD560 00111 EJECT DTSBD560 00112 01 C072-LITERALS. DTSBD560 00113 ++INCLUDE DTSIC072 CL**2 00114 EJECT DTSBD560 00115 01 L910-LINK-AREA. DTSBD560 00116 ++INCLUDE DTSIL910 CL**2 00117 EJECT DTSBD560 00118 01 MSKL-REC. DTSBD560 00119 ++INCLUDE DTSIMSKL CL**2 00120 EJECT DTSBD560 00121 01 MPRF-REC. DTSBD560 00122 ++INCLUDE DTSIMPRF CL**2 00123 EJECT DTSBD560 00124 01 MTAD-REC. DTSBD560 00125 ++INCLUDE DTSIMTAD CL**2 00126 EJECT DTSBD560 00127 01 MOPO-REC. DTSBD560 00128 ++INCLUDE DTSIMOPO CL**2 00129 EJECT DTSBD560 00130 01 MTAA-REC. DTSBD560 00131 ++INCLUDE DTSIMTAA CL**2 00132 EJECT DTSBD560 00133 01 MBAA-REC. DTSBD560 00134 ++INCLUDE DTSIMBAA CL**2 00135 EJECT DTSBD560 00136 01 MELF-REC. DTSBD560 00137 ++INCLUDE DTSIMELF CL**2 00138 EJECT DTSBD560 00139 LINKAGE SECTION. DTSBD560 00140 DTSBD560 00141 01 PARM-AREA. DTSBD560 00142 05 PARM-LENGTH PIC S9(04) COMP. DTSBD560 00143 05 PARM-DATA. DTSBD560 00144 10 PARM-MASTER-UPDATE-IND PIC X(01). DTSBD560 00145 88 PARM-MASTER-UPDATE-NO-88 VALUE 'N'. DTSBD560 00146 88 PARM-MASTER-UPDATE-YES-88 VALUE 'Y'. DTSBD560 00147 EJECT DTSBD560 00148 PROCEDURE DIVISION USING PARM-AREA. DTSBD560 00149 DTSBD560 00150 DTSBD560 00151 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD560 00152 DTSBD560 00153 CL**2 00154 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD560 00155 DTSBD560 00156 CL**2 00157 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD560 00158 DTSBD560 00159 DTSBD560 00160 GOBACK. DTSBD560 00161 EJECT DTSBD560 00162 I0000-INITIATE. DTSBD560 00163 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD560 00164 DTSBD560 00165 CL**2 00166 OPEN OUTPUT LPC-FILE. DTSBD560 00167 DTSBD560 00168 DTSBD560 00169 MOVE +0 TO WRK-MPRF-REC-CNT DTSBD560 00170 WRK-MTAD-REC-CNT DTSBD560 00171 WRK-MOPO-REC-CNT DTSBD560 00172 WRK-MTAA-REC-CNT DTSBD560 00173 WRK-MBAA-REC-CNT DTSBD560 00174 WRK-MELF-REC-CNT DTSBD560 00175 WRK-LPC-REC-CNT. DTSBD560 00176 DTSBD560 00177 DTSBD560 00178 IF PARM-LENGTH = +0 DTSBD560 00179 SET WRK-MASTER-UPDATE-NO-88 TO TRUE DTSBD560 00180 GO TO I0000-EXIT. DTSBD560 00181 DTSBD560 00182 CL**2 00183 IF PARM-LENGTH = +1 DTSBD560 00184 IF PARM-MASTER-UPDATE-NO-88 DTSBD560 00185 OR DTSBD560 00186 PARM-MASTER-UPDATE-YES-88 DTSBD560 00187 MOVE PARM-MASTER-UPDATE-IND TO WRK-MASTER-UPDATE-IND DTSBD560 00188 ELSE DTSBD560 00189 MOVE 'INVALID PARM-MASTER-UPDATE-IND VALUE ENCOUNTERED' DTSBD560 00190 TO ABEND-MSG DTSBD560 00191 PERFORM S999-ABEND THRU S999-EXIT DTSBD560 00192 ELSE DTSBD560 00193 MOVE 'INVALID PARM-LENGTH VALUE ENCOUNTERED' DTSBD560 00194 TO ABEND-MSG DTSBD560 00195 PERFORM S999-ABEND THRU S999-EXIT. DTSBD560 00196 I0000-EXIT. DTSBD560 00197 EXIT. DTSBD560 00198 EJECT DTSBD560 00199 P0000-PROCESS. DTSBD560 00200 MOVE LOW-VALUES TO MSKL-REC. DTSBD560 00201 DTSBD560 00202 MOVE +0 TO MSKL-EMP-NO. DTSBD560 00203 DTSBD560 00204 SET MSKL-PRF-88 TO TRUE. DTSBD560 00205 DTSBD560 00206 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD560 00207 DTSBD560 00208 DTSBD560 00209 PERFORM P1000-MPRF-SCAN THRU P1000-EXIT DTSBD560 00210 UNTIL L910-NO-REC-88. DTSBD560 00211 P0000-EXIT. DTSBD560 00212 EXIT. DTSBD560 00213 EJECT DTSBD560 00214 P1000-MPRF-SCAN. DTSBD560 00215 MOVE MSKL-REC TO MPRF-REC. DTSBD560 00216 DTSBD560 00217 ADD +1 TO WRK-MPRF-REC-CNT. DTSBD560 00218 DTSBD560 00219 DTSBD560 00220 IF MPRF-CLASS-CHG-ONLY-88 DTSBD560 00221 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD560 00222 GO TO P1000-EXIT. DTSBD560 00223 DTSBD560 00224 DTSBD560 00225 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD560 00226 DTSBD560 00227 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD560 00228 DTSBD560 00229 SET MSKL-TAD-88 TO TRUE. DTSBD560 00230 DTSBD560 00231 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD560 00232 DTSBD560 00233 PERFORM P1100-MTAD-SCAN THRU P1100-EXIT DTSBD560 00234 UNTIL L910-NO-REC-88. DTSBD560 00235 DTSBD560 00236 DTSBD560 00237 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD560 00238 DTSBD560 00239 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD560 00240 DTSBD560 00241 SET MSKL-OPO-88 TO TRUE. DTSBD560 00242 DTSBD560 00243 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD560 00244 DTSBD560 00245 PERFORM P1200-MOPO-SCAN THRU P1200-EXIT DTSBD560 00246 UNTIL L910-NO-REC-88. DTSBD560 00247 DTSBD560 00248 DTSBD560 00249 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD560 00250 DTSBD560 00251 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD560 00252 DTSBD560 00253 SET MSKL-TAA-88 TO TRUE. DTSBD560 00254 DTSBD560 00255 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD560 00256 DTSBD560 00257 PERFORM P1300-MTAA-SCAN THRU P1300-EXIT DTSBD560 00258 UNTIL L910-NO-REC-88. DTSBD560 00259 DTSBD560 00260 DTSBD560 00261 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD560 00262 DTSBD560 00263 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD560 00264 DTSBD560 00265 SET MSKL-BAA-88 TO TRUE. DTSBD560 00266 DTSBD560 00267 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD560 00268 DTSBD560 00269 PERFORM P1400-MBAA-SCAN THRU P1400-EXIT DTSBD560 00270 UNTIL L910-NO-REC-88. DTSBD560 00271 DTSBD560 00272 DTSBD560 00273 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD560 00274 DTSBD560 00275 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD560 00276 DTSBD560 00277 SET MSKL-ELF-88 TO TRUE. DTSBD560 00278 DTSBD560 00279 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD560 00280 DTSBD560 00281 PERFORM P1500-MELF-SCAN THRU P1500-EXIT DTSBD560 00282 UNTIL L910-NO-REC-88. DTSBD560 00283 DTSBD560 00284 DTSBD560 00285 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD560 00286 DTSBD560 00287 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD560 00288 P1000-EXIT. DTSBD560 00289 EXIT. DTSBD560 00290 EJECT DTSBD560 00291 P1100-MTAD-SCAN. DTSBD560 00292 MOVE MSKL-REC TO MTAD-REC. DTSBD560 00293 DTSBD560 00294 ADD +1 TO WRK-MTAD-REC-CNT. DTSBD560 00295 DTSBD560 00296 DTSBD560 00297 MOVE MTAD-ST TO C072-ST. DTSBD560 00298 DTSBD560 00299 IF (MTAD-ADDRESS = SPACES OR LOW-VALUES) DTSBD560 00300 OR DTSBD560 00301 (C072-CANADA-88 OR C072-FOREIGN-88) DTSBD560 00302 ***********OR DTSBD560 00303 ********(MTAD-MAIL-NOT-DELIV-88) DTSBD560 00304 CONTINUE DTSBD560 00305 ELSE DTSBD560 00306 PERFORM P1110-MTAD-EXTRACT THRU P1110-EXIT. DTSBD560 00307 DTSBD560 00308 DTSBD560 00309 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD560 00310 P1100-EXIT. DTSBD560 00311 EXIT. DTSBD560 00312 SKIP3 DTSBD560 00313 P1110-MTAD-EXTRACT. DTSBD560 00314 MOVE MTAD-ZIP TO XLPC-KEY-ZIP. DTSBD560 00315 DTSBD560 00316 MOVE MPRF-EMP-NO TO XLPC-KEY-EMP-NO. DTSBD560 00317 DTSBD560 00318 SET XLPC-KEY-TAD-88 TO TRUE. DTSBD560 00319 DTSBD560 00320 MOVE MTAD-ID-NO TO XLPC-KEY-ADDR-ID-NO. DTSBD560 00321 DTSBD560 00322 DTSBD560 00323 MOVE SPACES TO XLPC-PARM-AREA. DTSBD560 00324 DTSBD560 00325 MOVE WRK-MASTER-UPDATE-IND TO XLPC-MASTER-UPDATE-IND. DTSBD560 00326 DTSBD560 00327 DTSBD560 00328 MOVE SPACES TO XLPC-DATA-AREA. DTSBD560 00329 DTSBD560 00330 MOVE MPRF-PRIMARY-NAME TO XLPC-PRIMARY-NAME. CL**2 00331 DTSBD560 00332 SET XLPC-ADDR-TAD-88 TO TRUE. DTSBD560 00333 DTSBD560 00334 MOVE MTAD-ADDRESS TO XLPC-PRE-ADDRESS DTSBD560 00335 XLPC-POST-ADDRESS. DTSBD560 00336 DTSBD560 00337 WRITE LPC-REC. DTSBD560 00338 DTSBD560 00339 ADD +1 TO WRK-LPC-REC-CNT. DTSBD560 00340 DTSBD560 00341 P1110-EXIT. DTSBD560 00342 EXIT. DTSBD560 00343 EJECT DTSBD560 00344 P1200-MOPO-SCAN. DTSBD560 00345 MOVE MSKL-REC TO MOPO-REC. DTSBD560 00346 DTSBD560 00347 ADD +1 TO WRK-MOPO-REC-CNT. DTSBD560 00348 DTSBD560 00349 DTSBD560 00350 MOVE MOPO-ST TO C072-ST. DTSBD560 00351 DTSBD560 00352 IF (MOPO-ADDRESS = SPACES OR LOW-VALUES) DTSBD560 00353 OR DTSBD560 00354 (C072-CANADA-88 OR C072-FOREIGN-88) DTSBD560 00355 ***********OR DTSBD560 00356 ********(MOPO-MAIL-NOT-DELIV-88) DTSBD560 00357 CONTINUE DTSBD560 00358 ELSE DTSBD560 00359 PERFORM P1210-MOPO-EXTRACT THRU P1210-EXIT. DTSBD560 00360 DTSBD560 00361 DTSBD560 00362 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD560 00363 P1200-EXIT. DTSBD560 00364 EXIT. DTSBD560 00365 SKIP3 DTSBD560 00366 P1210-MOPO-EXTRACT. DTSBD560 00367 MOVE MOPO-ZIP TO XLPC-KEY-ZIP. DTSBD560 00368 DTSBD560 00369 MOVE MPRF-EMP-NO TO XLPC-KEY-EMP-NO. DTSBD560 00370 DTSBD560 00371 SET XLPC-KEY-OPO-88 TO TRUE. DTSBD560 00372 DTSBD560 00373 MOVE MOPO-ID-NO TO XLPC-KEY-ADDR-ID-NO. DTSBD560 00374 DTSBD560 00375 DTSBD560 00376 MOVE SPACES TO XLPC-PARM-AREA. DTSBD560 00377 DTSBD560 00378 MOVE WRK-MASTER-UPDATE-IND TO XLPC-MASTER-UPDATE-IND. DTSBD560 00379 DTSBD560 00380 DTSBD560 00381 MOVE SPACES TO XLPC-DATA-AREA. DTSBD560 00382 DTSBD560 00383 MOVE MPRF-PRIMARY-NAME TO XLPC-PRIMARY-NAME. CL**2 00384 DTSBD560 00385 SET XLPC-ADDR-OPO-88 TO TRUE. DTSBD560 00386 DTSBD560 00387 MOVE MOPO-ADDRESS TO XLPC-PRE-ADDRESS DTSBD560 00388 XLPC-POST-ADDRESS. DTSBD560 00389 DTSBD560 00390 WRITE LPC-REC. DTSBD560 00391 DTSBD560 00392 ADD +1 TO WRK-LPC-REC-CNT. DTSBD560 00393 DTSBD560 00394 P1210-EXIT. DTSBD560 00395 EXIT. DTSBD560 00396 EJECT DTSBD560 00397 P1300-MTAA-SCAN. DTSBD560 00398 MOVE MSKL-REC TO MTAA-REC. DTSBD560 00399 DTSBD560 00400 ADD +1 TO WRK-MTAA-REC-CNT. DTSBD560 00401 DTSBD560 00402 DTSBD560 00403 MOVE MTAA-ST TO C072-ST. DTSBD560 00404 DTSBD560 00405 IF (MTAA-ADDRESS = SPACES OR LOW-VALUES) DTSBD560 00406 OR DTSBD560 00407 (C072-CANADA-88 OR C072-FOREIGN-88) DTSBD560 00408 ***********OR DTSBD560 00409 ********(MTAA-MAIL-NOT-DELIV-88) DTSBD560 00410 CONTINUE DTSBD560 00411 ELSE DTSBD560 00412 PERFORM P1310-MTAA-EXTRACT THRU P1310-EXIT. DTSBD560 00413 DTSBD560 00414 DTSBD560 00415 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD560 00416 P1300-EXIT. DTSBD560 00417 EXIT. DTSBD560 00418 SKIP3 DTSBD560 00419 P1310-MTAA-EXTRACT. DTSBD560 00420 MOVE MTAA-ZIP TO XLPC-KEY-ZIP. DTSBD560 00421 DTSBD560 00422 MOVE MPRF-EMP-NO TO XLPC-KEY-EMP-NO. DTSBD560 00423 DTSBD560 00424 SET XLPC-KEY-TAA-88 TO TRUE. DTSBD560 00425 DTSBD560 00426 MOVE MTAA-ID-NO TO XLPC-KEY-ADDR-ID-NO. DTSBD560 00427 DTSBD560 00428 DTSBD560 00429 MOVE SPACES TO XLPC-PARM-AREA. DTSBD560 00430 DTSBD560 00431 MOVE WRK-MASTER-UPDATE-IND TO XLPC-MASTER-UPDATE-IND. DTSBD560 00432 DTSBD560 00433 DTSBD560 00434 MOVE SPACES TO XLPC-DATA-AREA. DTSBD560 00435 DTSBD560 00436 MOVE MPRF-PRIMARY-NAME TO XLPC-PRIMARY-NAME. CL**2 00437 DTSBD560 00438 SET XLPC-ADDR-TAA-88 TO TRUE. DTSBD560 00439 DTSBD560 00440 MOVE MTAA-ADDRESS TO XLPC-PRE-ADDRESS DTSBD560 00441 XLPC-POST-ADDRESS. DTSBD560 00442 DTSBD560 00443 WRITE LPC-REC. DTSBD560 00444 DTSBD560 00445 ADD +1 TO WRK-LPC-REC-CNT. DTSBD560 00446 DTSBD560 00447 P1310-EXIT. DTSBD560 00448 EXIT. DTSBD560 00449 EJECT DTSBD560 00450 P1400-MBAA-SCAN. DTSBD560 00451 MOVE MSKL-REC TO MBAA-REC. DTSBD560 00452 DTSBD560 00453 ADD +1 TO WRK-MBAA-REC-CNT. DTSBD560 00454 DTSBD560 00455 DTSBD560 00456 MOVE MBAA-ST TO C072-ST. DTSBD560 00457 DTSBD560 00458 IF (MBAA-ADDRESS = SPACES OR LOW-VALUES) DTSBD560 00459 OR DTSBD560 00460 (C072-CANADA-88 OR C072-FOREIGN-88) DTSBD560 00461 ***********OR DTSBD560 00462 ********(MBAA-MAIL-NOT-DELIV-88) DTSBD560 00463 CONTINUE DTSBD560 00464 ELSE DTSBD560 00465 PERFORM P1410-MBAA-EXTRACT THRU P1410-EXIT. DTSBD560 00466 DTSBD560 00467 DTSBD560 00468 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD560 00469 P1400-EXIT. DTSBD560 00470 EXIT. DTSBD560 00471 SKIP3 DTSBD560 00472 P1410-MBAA-EXTRACT. DTSBD560 00473 MOVE MBAA-ZIP TO XLPC-KEY-ZIP. DTSBD560 00474 DTSBD560 00475 MOVE MPRF-EMP-NO TO XLPC-KEY-EMP-NO. DTSBD560 00476 DTSBD560 00477 SET XLPC-KEY-BAA-88 TO TRUE. DTSBD560 00478 DTSBD560 00479 MOVE MBAA-ID-NO TO XLPC-KEY-ADDR-ID-NO. DTSBD560 00480 DTSBD560 00481 DTSBD560 00482 MOVE SPACES TO XLPC-PARM-AREA. DTSBD560 00483 DTSBD560 00484 MOVE WRK-MASTER-UPDATE-IND TO XLPC-MASTER-UPDATE-IND. DTSBD560 00485 DTSBD560 00486 DTSBD560 00487 MOVE SPACES TO XLPC-DATA-AREA. DTSBD560 00488 DTSBD560 00489 MOVE MPRF-PRIMARY-NAME TO XLPC-PRIMARY-NAME. CL**2 00490 DTSBD560 00491 SET XLPC-ADDR-BAA-88 TO TRUE. DTSBD560 00492 DTSBD560 00493 MOVE MBAA-ADDRESS TO XLPC-PRE-ADDRESS DTSBD560 00494 XLPC-POST-ADDRESS. DTSBD560 00495 DTSBD560 00496 WRITE LPC-REC. DTSBD560 00497 DTSBD560 00498 ADD +1 TO WRK-LPC-REC-CNT. DTSBD560 00499 DTSBD560 00500 P1410-EXIT. DTSBD560 00501 EXIT. DTSBD560 00502 EJECT DTSBD560 00503 P1500-MELF-SCAN. DTSBD560 00504 MOVE MSKL-REC TO MELF-REC. DTSBD560 00505 DTSBD560 00506 ADD +1 TO WRK-MELF-REC-CNT. DTSBD560 00507 DTSBD560 00508 DTSBD560 00509 MOVE MELF-ST TO C072-ST. DTSBD560 00510 DTSBD560 00511 IF (MELF-ADDRESS = SPACES OR LOW-VALUES) DTSBD560 00512 OR DTSBD560 00513 (C072-CANADA-88 OR C072-FOREIGN-88) DTSBD560 00514 ***********OR DTSBD560 00515 ********(MELF-MAIL-NOT-DELIV-88) DTSBD560 00516 CONTINUE DTSBD560 00517 ELSE DTSBD560 00518 PERFORM P1510-MELF-EXTRACT THRU P1510-EXIT. DTSBD560 00519 DTSBD560 00520 DTSBD560 00521 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD560 00522 P1500-EXIT. DTSBD560 00523 EXIT. DTSBD560 00524 SKIP3 DTSBD560 00525 P1510-MELF-EXTRACT. DTSBD560 00526 MOVE MELF-ZIP TO XLPC-KEY-ZIP. DTSBD560 00527 DTSBD560 00528 MOVE MPRF-EMP-NO TO XLPC-KEY-EMP-NO. DTSBD560 00529 DTSBD560 00530 SET XLPC-KEY-ELF-88 TO TRUE. DTSBD560 00531 DTSBD560 00532 MOVE +0 TO XLPC-KEY-ADDR-ID-NO. DTSBD560 00533 DTSBD560 00534 DTSBD560 00535 MOVE SPACES TO XLPC-PARM-AREA. DTSBD560 00536 DTSBD560 00537 MOVE WRK-MASTER-UPDATE-IND TO XLPC-MASTER-UPDATE-IND. DTSBD560 00538 DTSBD560 00539 DTSBD560 00540 MOVE SPACES TO XLPC-DATA-AREA. DTSBD560 00541 DTSBD560 00542 MOVE MPRF-PRIMARY-NAME TO XLPC-PRIMARY-NAME. CL**2 00543 DTSBD560 00544 SET XLPC-ADDR-ELF-88 TO TRUE. DTSBD560 00545 DTSBD560 00546 MOVE MELF-ADDRESS TO XLPC-PRE-ADDRESS DTSBD560 00547 XLPC-POST-ADDRESS. DTSBD560 00548 DTSBD560 00549 WRITE LPC-REC. DTSBD560 00550 DTSBD560 00551 ADD +1 TO WRK-LPC-REC-CNT. DTSBD560 00552 DTSBD560 00553 P1510-EXIT. DTSBD560 00554 EXIT. DTSBD560 00555 EJECT DTSBD560 00556 T0000-TERMINATE. DTSBD560 00557 DISPLAY DTSBD560 00558 '*** DTSBD560 TERMINATION STATISTICS'. CL**2 00559 DTSBD560 00560 DISPLAY ' '. DTSBD560 00561 DTSBD560 00562 DISPLAY DTSBD560 00563 '*** MASTER FILE UPDATE INDICATOR: ' DTSBD560 00564 WRK-MASTER-UPDATE-IND. DTSBD560 00565 DTSBD560 00566 DISPLAY DTSBD560 00567 '*** NUMBER OF MPRF RECORDS PROCESSED: ' DTSBD560 00568 WRK-MPRF-REC-CNT. DTSBD560 00569 DTSBD560 00570 DISPLAY DTSBD560 00571 '*** NUMBER OF MTAD RECORDS PROCESSED: ' DTSBD560 00572 WRK-MTAD-REC-CNT. DTSBD560 00573 DTSBD560 00574 DISPLAY DTSBD560 00575 '*** NUMBER OF MOPO RECORDS PROCESSED: ' DTSBD560 00576 WRK-MOPO-REC-CNT. DTSBD560 00577 DTSBD560 00578 DISPLAY DTSBD560 00579 '*** NUMBER OF MTAA RECORDS PROCESSED: ' DTSBD560 00580 WRK-MTAA-REC-CNT. DTSBD560 00581 DTSBD560 00582 DISPLAY DTSBD560 00583 '*** NUMBER OF MBAA RECORDS PROCESSED: ' DTSBD560 00584 WRK-MBAA-REC-CNT. DTSBD560 00585 DTSBD560 00586 DISPLAY DTSBD560 00587 '*** NUMBER OF MELF RECORDS PROCESSED: ' DTSBD560 00588 WRK-MELF-REC-CNT. DTSBD560 00589 DTSBD560 00590 DISPLAY DTSBD560 00591 '*** NUMBER OF XLPC RECORDS CREATED: ' DTSBD560 00592 WRK-LPC-REC-CNT. DTSBD560 00593 DTSBD560 00594 DTSBD560 00595 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD560 00596 DTSBD560 00597 CLOSE LPC-FILE. DTSBD560 00598 T0000-EXIT. DTSBD560 00599 EXIT. DTSBD560 00600 EJECT DTSBD560 00601 S910-OPEN-READ. DTSBD560 00602 SET L910-OPEN-READ-88 TO TRUE. DTSBD560 00603 GO TO S910-MSTR-CALL. DTSBD560 00604 DTSBD560 00605 S910-READ. DTSBD560 00606 SET L910-READ-88 TO TRUE. DTSBD560 00607 GO TO S910-MSTR-CALL. DTSBD560 00608 DTSBD560 00609 S910-START-BROWSE. DTSBD560 00610 SET L910-START-BROWSE-88 TO TRUE. DTSBD560 00611 GO TO S910-MSTR-CALL. DTSBD560 00612 DTSBD560 00613 S910-READ-NEXT. DTSBD560 00614 SET L910-READ-NEXT-88 TO TRUE. DTSBD560 00615 GO TO S910-MSTR-CALL. DTSBD560 00616 DTSBD560 00617 *S910-COUNT. DTSBD560 00618 *****SET L910-COUNT-88 TO TRUE. DTSBD560 00619 *****GO TO S910-MSTR-CALL. DTSBD560 00620 DTSBD560 00621 S910-CLOSE. DTSBD560 00622 SET L910-CLOSE-88 TO TRUE. DTSBD560 00623 GO TO S910-MSTR-CALL. DTSBD560 00624 DTSBD560 00625 S910-MSTR-CALL. DTSBD560 00626 CALL 'DTSBU910' USING L910-LINK-AREA CL**2 00627 MSKL-REC. DTSBD560 00628 S910-EXIT. DTSBD560 00629 EXIT. DTSBD560 00630 SKIP3 DTSBD560 00631 S999-ABEND. DTSBD560 00632 DISPLAY '*** DTSBD560 ABENDING. ' CL**2 00633 ABEND-MSG. DTSBD560 00634 CL**2 00635 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2 00636 S999-EXIT. DTSBD560 00637 EXIT. DTSBD560 00638 EJECT DTSBD560