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