640 lines
50 KiB
COBOL
640 lines
50 KiB
COBOL
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
|