893 lines
71 KiB
COBOL
893 lines
71 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/21/99
|
|
00002 PROGRAM-ID. DTSBD580. DTSBD580
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005
|
|
00004 DATE-WRITTEN. DECEMBER 1997. DTSBD580
|
|
00005 DATE-COMPILED. DTSBD580
|
|
00006 SKIP3 DTSBD580
|
|
00007 ***** DTSBD580
|
|
00008 * DTSBD580
|
|
00009 * FUNCTION: BATCH ADDRESS UPDATE MASTER FILE UPDATE. DTSBD580
|
|
00010 * DTSBD580
|
|
00011 * DTSBD580
|
|
00012 * MODIFICATION LOG: DTSBD580
|
|
00013 * DTSBD580
|
|
00014 * 12/27/97 INITIAL DEVELOPMENT. DTSBD580
|
|
00015 * WORK ORDER: TCL 214 PROGRAMMER: EHH DTSBD580
|
|
00016 * DTSBD580
|
|
00017 * 02/13/1999 REVIEWED AND MODIFED FOR DC. CL**2
|
|
00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2
|
|
00019 * CL**2
|
|
00020 * 05/21/1999 ADD CODE TO UPDATE MODIFICATION LOG - VIA CALL CL**3
|
|
00021 * TO DTSBU331. OVER LOOKED DURING 02/13/1999 CL**3
|
|
00022 * MODIFICATION. CL**3
|
|
00023 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**3
|
|
00024 * CL**3
|
|
00025 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
|
00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
|
00027 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**3
|
|
00028 * DTSBD580
|
|
00029 * DTSBD580
|
|
00030 * DESCRIPTION: DTSBD580
|
|
00031 * DTSBD580
|
|
00032 * UPDATE ADDRESSES ON THE TAX MASTER FILE. DTSBD580
|
|
00033 * DTSBD580
|
|
00034 * DTSBD580 IS THE LAST STEP IN THE THREE STEP BATCH CL**2
|
|
00035 * ADDRESS UPDATE PROCESS. DTSBD580
|
|
00036 * DTSBD580
|
|
00037 * DTSBD580
|
|
00038 * REPORT RECORDS INPUT: DTSBD580
|
|
00039 * DTSBD580
|
|
00040 * NONE DTSBD580
|
|
00041 * DTSBD580
|
|
00042 * DTSBD580
|
|
00043 * TAPES INPUT: DTSBD580
|
|
00044 * DTSBD580
|
|
00045 * NONE. DTSBD580
|
|
00046 * DTSBD580
|
|
00047 * DTSBD580
|
|
00048 * MASTER FILE RECORDS READ: DTSBD580
|
|
00049 * DTSBD580
|
|
00050 * MHDR DTSBD580
|
|
00051 * MPRF DTSBD580
|
|
00052 * MTAD DTSBD580
|
|
00053 * MOPO DTSBD580
|
|
00054 * MTAA DTSBD580
|
|
00055 * MBAA DTSBD580
|
|
00056 * MELF DTSBD580
|
|
00057 * DTSBD580
|
|
00058 * DTSBD580
|
|
00059 * MASTER FILE RECORDS UPDATED: DTSBD580
|
|
00060 * DTSBD580
|
|
00061 * MPRF (REWRITE). DTSBD580
|
|
00062 * MTAD (REWRITE). DTSBD580
|
|
00063 * MOPO (REWRITE). DTSBD580
|
|
00064 * MTAA (REWRITE). DTSBD580
|
|
00065 * MBAA (REWRITE). DTSBD580
|
|
00066 * MELF (REWRITE). DTSBD580
|
|
00067 * DTSBD580
|
|
00068 * DTSBD580
|
|
00069 * RECORDS READ: DTSBD580
|
|
00070 * DTSBD580
|
|
00071 * XLPC INTERFACE TO FINALIST MODULE. DTSBD580
|
|
00072 * DTSBD580
|
|
00073 * DTSBD580
|
|
00074 * MODULES CALLED: DTSBD580
|
|
00075 * DTSBD580
|
|
00076 * DTSBU203 FIELD ZIP AND JS ZIP DETERMINATION. CL**2
|
|
00077 * DTSBU910 MASTER FILE I/O. CL**2
|
|
00078 * DTSBU921 ALTERNATE INDEX I/O. CL**2
|
|
00079 * DTSBD580
|
|
00080 * DTSBD580
|
|
00081 ***** DTSBD580
|
|
00082 SKIP3 DTSBD580
|
|
00083 ENVIRONMENT DIVISION. DTSBD580
|
|
00084 SKIP3 DTSBD580
|
|
00085 INPUT-OUTPUT SECTION. DTSBD580
|
|
00086 SKIP2 DTSBD580
|
|
00087 FILE-CONTROL. DTSBD580
|
|
00088 SELECT LPC-FILE ASSIGN TO DTSLPCI. CL**2
|
|
00089 DATA DIVISION. DTSBD580
|
|
00090 SKIP3 DTSBD580
|
|
00091 FILE SECTION. DTSBD580
|
|
00092 SKIP3 DTSBD580
|
|
00093 FD LPC-FILE DTSBD580
|
|
00094 LABEL RECORDS ARE STANDARD DTSBD580
|
|
00095 RECORDING MODE IS F DTSBD580
|
|
00096 BLOCK CONTAINS 0 RECORDS. DTSBD580
|
|
00097 SKIP2 DTSBD580
|
|
00098 01 LPC-REC. DTSBD580
|
|
00099 ++INCLUDE DTSIXLPC CL**2
|
|
00100 EJECT DTSBD580
|
|
00101 WORKING-STORAGE SECTION. DTSBD580
|
|
001015 77 PAN-VALET PICTURE X(24) VALUE '005DTSBD580 05/21/99'. DTSBD580
|
|
00102 SKIP3 DTSBD580
|
|
00103 01 WRK-AREA. DTSBD580
|
|
00104 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +580. DTSBD580
|
|
00105 DTSBD580
|
|
00106 05 ABEND-MSG PIC X(60). DTSBD580
|
|
00107 DTSBD580
|
|
00108 CL**3
|
|
00109 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3. CL**3
|
|
00110 CL**3
|
|
00111 CL**3
|
|
00112 05 LPC-EOF-IND PIC X(01). DTSBD580
|
|
00113 DTSBD580
|
|
00114 CL**3
|
|
00115 05 WRK-MPRF-REC-CNT PIC S9(07) COMP-3. DTSBD580
|
|
00116 DTSBD580
|
|
00117 05 WRK-MTAD-REC-CNT PIC S9(07) COMP-3. DTSBD580
|
|
00118 DTSBD580
|
|
00119 05 WRK-MOPO-REC-CNT PIC S9(07) COMP-3. DTSBD580
|
|
00120 DTSBD580
|
|
00121 05 WRK-MTAA-REC-CNT PIC S9(07) COMP-3. DTSBD580
|
|
00122 DTSBD580
|
|
00123 05 WRK-MBAA-REC-CNT PIC S9(07) COMP-3. DTSBD580
|
|
00124 DTSBD580
|
|
00125 05 WRK-MELF-REC-CNT PIC S9(07) COMP-3. DTSBD580
|
|
00126 DTSBD580
|
|
00127 05 WRK-LPC-REC-CNT PIC S9(07) COMP-3. DTSBD580
|
|
00128 DTSBD580
|
|
00129 DTSBD580
|
|
00130 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD580
|
|
00131 DTSBD580
|
|
00132 05 WRK-MTAD-ZIP-UPDATED-IND PIC X(01). DTSBD580
|
|
00133 CL**3
|
|
00134 CL**3
|
|
00135 05 WRK-ID-NO-9 PIC 9(03). CL**3
|
|
00136 05 WRK-ID-NO-X REDEFINES WRK-ID-NO-9 CL**3
|
|
00137 PIC X(03). CL**3
|
|
00138 EJECT DTSBD580
|
|
00139 01 L005-LINK-AREA. CL**3
|
|
00140 ++INCLUDE DTSIL005 CL**3
|
|
00141 EJECT DTSBD580
|
|
00142 01 L203-LINK-AREA. CL**3
|
|
00143 ++INCLUDE DTSIL203 CL**3
|
|
00144 EJECT CL**3
|
|
00145 01 L331-LINK-AREA. CL**3
|
|
00146 ++INCLUDE DTSIL331 CL**3
|
|
00147 EJECT CL**3
|
|
00148 01 L910-LINK-AREA. DTSBD580
|
|
00149 ++INCLUDE DTSIL910 CL**2
|
|
00150 EJECT DTSBD580
|
|
00151 01 MSKL-REC. DTSBD580
|
|
00152 ++INCLUDE DTSIMSKL CL**2
|
|
00153 EJECT DTSBD580
|
|
00154 01 MHDR-REC. DTSBD580
|
|
00155 ++INCLUDE DTSIMHDR CL**2
|
|
00156 EJECT DTSBD580
|
|
00157 01 MPRF-REC. DTSBD580
|
|
00158 ++INCLUDE DTSIMPRF CL**2
|
|
00159 EJECT DTSBD580
|
|
00160 01 MTAD-REC. DTSBD580
|
|
00161 ++INCLUDE DTSIMTAD CL**2
|
|
00162 EJECT DTSBD580
|
|
00163 01 MOPO-REC. DTSBD580
|
|
00164 ++INCLUDE DTSIMOPO CL**2
|
|
00165 EJECT DTSBD580
|
|
00166 01 MTAA-REC. DTSBD580
|
|
00167 ++INCLUDE DTSIMTAA CL**2
|
|
00168 EJECT DTSBD580
|
|
00169 01 MBAA-REC. DTSBD580
|
|
00170 ++INCLUDE DTSIMBAA CL**2
|
|
00171 EJECT DTSBD580
|
|
00172 01 MELF-REC. DTSBD580
|
|
00173 ++INCLUDE DTSIMELF CL**2
|
|
00174 EJECT DTSBD580
|
|
00175 01 L921-LINK-AREA. DTSBD580
|
|
00176 ++INCLUDE DTSIL921 CL**2
|
|
00177 EJECT DTSBD580
|
|
00178 01 ISKL-REC. DTSBD580
|
|
00179 ++INCLUDE DTSIISKL CL**2
|
|
00180 EJECT DTSBD580
|
|
00181 PROCEDURE DIVISION. DTSBD580
|
|
00182 DTSBD580
|
|
00183 DTSBD580
|
|
00184 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD580
|
|
00185 DTSBD580
|
|
00186 DTSBD580
|
|
00187 MOVE 'N' TO LPC-EOF-IND. DTSBD580
|
|
00188 DTSBD580
|
|
00189 MOVE +0 TO WRK-EMP-NO. DTSBD580
|
|
00190 DTSBD580
|
|
00191 MOVE 'N' TO WRK-MTAD-ZIP-UPDATED-IND. DTSBD580
|
|
00192 DTSBD580
|
|
00193 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD580
|
|
00194 UNTIL LPC-EOF-IND = 'Y'. DTSBD580
|
|
00195 DTSBD580
|
|
00196 DTSBD580
|
|
00197 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD580
|
|
00198 DTSBD580
|
|
00199 DTSBD580
|
|
00200 GOBACK. DTSBD580
|
|
00201 EJECT DTSBD580
|
|
00202 I0000-INITIATE. DTSBD580
|
|
00203 PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBD580
|
|
00204 DTSBD580
|
|
00205 PERFORM S921-OPEN-UPDATE THRU S921-EXIT. DTSBD580
|
|
00206 DTSBD580
|
|
00207 OPEN INPUT LPC-FILE. DTSBD580
|
|
00208 DTSBD580
|
|
00209 DTSBD580
|
|
00210 MOVE +0 TO WRK-MPRF-REC-CNT DTSBD580
|
|
00211 WRK-MTAD-REC-CNT DTSBD580
|
|
00212 WRK-MOPO-REC-CNT DTSBD580
|
|
00213 WRK-MTAA-REC-CNT DTSBD580
|
|
00214 WRK-MBAA-REC-CNT DTSBD580
|
|
00215 WRK-MELF-REC-CNT DTSBD580
|
|
00216 WRK-LPC-REC-CNT. DTSBD580
|
|
00217 DTSBD580
|
|
00218 DTSBD580
|
|
00219 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD580
|
|
00220 DTSBD580
|
|
00221 MOVE +0 TO MSKL-EMP-NO. DTSBD580
|
|
00222 DTSBD580
|
|
00223 SET MSKL-HDR-88 TO TRUE. DTSBD580
|
|
00224 DTSBD580
|
|
00225 PERFORM S910-READ THRU S910-EXIT. DTSBD580
|
|
00226 DTSBD580
|
|
00227 IF L910-NO-REC-88 DTSBD580
|
|
00228 MOVE 'MHDR RECORD NOT FOUND' TO ABEND-MSG DTSBD580
|
|
00229 PERFORM S999-ABEND THRU S999-EXIT. DTSBD580
|
|
00230 DTSBD580
|
|
00231 MOVE MSKL-REC TO MHDR-REC. DTSBD580
|
|
00232 CL**3
|
|
00233 CL**3
|
|
00234 PERFORM S005-FROM-SYS THRU S005-EXIT. CL**3
|
|
00235 CL**3
|
|
00236 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL**3
|
|
00237 I0000-EXIT. DTSBD580
|
|
00238 EXIT. DTSBD580
|
|
00239 EJECT DTSBD580
|
|
00240 P0000-PROCESS. DTSBD580
|
|
00241 READ LPC-FILE DTSBD580
|
|
00242 AT END DTSBD580
|
|
00243 MOVE 'Y' TO LPC-EOF-IND DTSBD580
|
|
00244 PERFORM P9000-EMP-NO-BREAK THRU P9000-EXIT DTSBD580
|
|
00245 GO TO P0000-EXIT. DTSBD580
|
|
00246 DTSBD580
|
|
00247 CL**2
|
|
00248 ADD +1 TO WRK-LPC-REC-CNT. DTSBD580
|
|
00249 DTSBD580
|
|
00250 DTSBD580
|
|
00251 IF XLPC-KEY-EMP-NO = WRK-EMP-NO DTSBD580
|
|
00252 NEXT SENTENCE DTSBD580
|
|
00253 ELSE DTSBD580
|
|
00254 PERFORM P9000-EMP-NO-BREAK THRU P9000-EXIT DTSBD580
|
|
00255 MOVE XLPC-KEY-EMP-NO TO WRK-EMP-NO DTSBD580
|
|
00256 MOVE 'N' TO WRK-MTAD-ZIP-UPDATED-IND CL**3
|
|
00257 MOVE XLPC-KEY-EMP-NO TO L331-EMP-NO CL**3
|
|
00258 MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE CL**3
|
|
00259 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL**3
|
|
00260 MOVE 'BATCH' TO L331-OP-ID. CL**5
|
|
00261 CL**3
|
|
00262 DTSBD580
|
|
00263 IF XLPC-KEY-TAD-88 DTSBD580
|
|
00264 PERFORM P1000-MTAD-UPDATE THRU P1000-EXIT DTSBD580
|
|
00265 ELSE DTSBD580
|
|
00266 IF XLPC-KEY-OPO-88 DTSBD580
|
|
00267 PERFORM P2000-MOPO-UPDATE THRU P2000-EXIT DTSBD580
|
|
00268 ELSE DTSBD580
|
|
00269 IF XLPC-KEY-TAA-88 DTSBD580
|
|
00270 PERFORM P3000-MTAA-UPDATE THRU P3000-EXIT DTSBD580
|
|
00271 ELSE DTSBD580
|
|
00272 IF XLPC-KEY-BAA-88 DTSBD580
|
|
00273 PERFORM P4000-MBAA-UPDATE THRU P4000-EXIT DTSBD580
|
|
00274 ELSE DTSBD580
|
|
00275 IF XLPC-KEY-ELF-88 DTSBD580
|
|
00276 PERFORM P5000-MELF-UPDATE THRU P5000-EXIT DTSBD580
|
|
00277 ELSE DTSBD580
|
|
00278 MOVE 'INVALID XLPC-KEY-REC-TYPE ENCOUNTERED' DTSBD580
|
|
00279 TO ABEND-MSG DTSBD580
|
|
00280 PERFORM S999-ABEND THRU S999-EXIT. DTSBD580
|
|
00281 P0000-EXIT. DTSBD580
|
|
00282 EXIT. DTSBD580
|
|
00283 EJECT DTSBD580
|
|
00284 P1000-MTAD-UPDATE. DTSBD580
|
|
00285 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBD580
|
|
00286 DTSBD580
|
|
00287 MOVE XLPC-KEY-EMP-NO TO MTAD-EMP-NO. DTSBD580
|
|
00288 DTSBD580
|
|
00289 SET MTAD-TAD-88 TO TRUE. DTSBD580
|
|
00290 DTSBD580
|
|
00291 MOVE XLPC-KEY-ADDR-ID-NO TO MTAD-ID-NO. DTSBD580
|
|
00292 DTSBD580
|
|
00293 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD580
|
|
00294 DTSBD580
|
|
00295 PERFORM S910-READ THRU S910-EXIT. DTSBD580
|
|
00296 DTSBD580
|
|
00297 IF L910-NO-REC-88 DTSBD580
|
|
00298 MOVE 'MTAD RECORD NOT FOUND' TO ABEND-MSG DTSBD580
|
|
00299 PERFORM S999-ABEND THRU S999-EXIT. DTSBD580
|
|
00300 DTSBD580
|
|
00301 DTSBD580
|
|
00302 MOVE MSKL-REC TO MTAD-REC. DTSBD580
|
|
00303 DTSBD580
|
|
00304 DTSBD580
|
|
00305 IF XLPC-POST-ZIP = MTAD-ZIP DTSBD580
|
|
00306 NEXT SENTENCE DTSBD580
|
|
00307 ELSE DTSBD580
|
|
00308 MOVE 'Y' TO WRK-MTAD-ZIP-UPDATED-IND. DTSBD580
|
|
00309 DTSBD580
|
|
00310 CL**3
|
|
00311 PERFORM P1100-CHECK-FOR-MLOG THRU P1100-EXIT. CL**3
|
|
00312 CL**3
|
|
00313 DTSBD580
|
|
00314 MOVE XLPC-POST-ADDRESS TO MTAD-ADDRESS. DTSBD580
|
|
00315 DTSBD580
|
|
00316 MOVE MHDR-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSBD580
|
|
00317 DTSBD580
|
|
00318 DTSBD580
|
|
00319 MOVE MTAD-REC TO MSKL-REC. DTSBD580
|
|
00320 DTSBD580
|
|
00321 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD580
|
|
00322 DTSBD580
|
|
00323 ADD +1 TO WRK-MTAD-REC-CNT. DTSBD580
|
|
00324 P1000-EXIT. DTSBD580
|
|
00325 EXIT. DTSBD580
|
|
00326 SKIP3 CL**4
|
|
00327 P1100-CHECK-FOR-MLOG. CL**4
|
|
00328 IF MTAD-ID-TAX-MAILING-ADDR-88 CL**4
|
|
00329 MOVE 'MAILING ADDRESS' TO L331-REC-OCC-ID CL**4
|
|
00330 ELSE CL**4
|
|
00331 IF MTAD-ID-TAX-RECORDS-ADDR-88 CL**4
|
|
00332 MOVE 'RECORDS ADDRESS' TO L331-REC-OCC-ID CL**4
|
|
00333 ELSE CL**4
|
|
00334 MOVE MTAD-ID-NO TO WRK-ID-NO-9 CL**4
|
|
00335 MOVE WRK-ID-NO-X TO L331-REC-OCC-ID. CL**4
|
|
00336 CL**4
|
|
00337 CL**4
|
|
00338 IF XLPC-POST-ATTN-LINE = MTAD-ATTN-LINE CL**4
|
|
00339 NEXT SENTENCE CL**4
|
|
00340 ELSE CL**4
|
|
00341 MOVE 'MTAD-ATTN-LINE' TO L331-FIELD-NAME CL**4
|
|
00342 MOVE MTAD-ATTN-LINE TO L331-FROM-VALUE CL**4
|
|
00343 MOVE XLPC-POST-ATTN-LINE TO L331-TO-VALUE CL**4
|
|
00344 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00345 CL**4
|
|
00346 IF XLPC-POST-DELIV-LINE-1 = MTAD-DELIV-LINE-1 CL**4
|
|
00347 NEXT SENTENCE CL**4
|
|
00348 ELSE CL**4
|
|
00349 MOVE 'MTAD-DELIV-LINE-1' TO L331-FIELD-NAME CL**4
|
|
00350 MOVE MTAD-DELIV-LINE-1 TO L331-FROM-VALUE CL**4
|
|
00351 MOVE XLPC-POST-DELIV-LINE-1 TO L331-TO-VALUE CL**4
|
|
00352 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00353 CL**4
|
|
00354 IF XLPC-POST-DELIV-LINE-2 = MTAD-DELIV-LINE-2 CL**4
|
|
00355 NEXT SENTENCE CL**4
|
|
00356 ELSE CL**4
|
|
00357 MOVE 'MTAD-DELIV-LINE-2' TO L331-FIELD-NAME CL**4
|
|
00358 MOVE MTAD-DELIV-LINE-2 TO L331-FROM-VALUE CL**4
|
|
00359 MOVE XLPC-POST-DELIV-LINE-2 TO L331-TO-VALUE CL**4
|
|
00360 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00361 CL**4
|
|
00362 IF XLPC-POST-CITY = MTAD-CITY CL**4
|
|
00363 NEXT SENTENCE CL**4
|
|
00364 ELSE CL**4
|
|
00365 MOVE 'MTAD-CITY' TO L331-FIELD-NAME CL**4
|
|
00366 MOVE MTAD-CITY TO L331-FROM-VALUE CL**4
|
|
00367 MOVE XLPC-POST-CITY TO L331-TO-VALUE CL**4
|
|
00368 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00369 CL**4
|
|
00370 IF XLPC-POST-ST = MTAD-ST CL**4
|
|
00371 NEXT SENTENCE CL**4
|
|
00372 ELSE CL**4
|
|
00373 MOVE 'MTAD-ST' TO L331-FIELD-NAME CL**4
|
|
00374 MOVE MTAD-ST TO L331-FROM-VALUE CL**4
|
|
00375 MOVE XLPC-POST-ST TO L331-TO-VALUE CL**4
|
|
00376 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00377 CL**4
|
|
00378 IF XLPC-POST-ZIP = MTAD-ZIP CL**4
|
|
00379 NEXT SENTENCE CL**4
|
|
00380 ELSE CL**4
|
|
00381 MOVE 'MTAD-ZIP' TO L331-FIELD-NAME CL**4
|
|
00382 MOVE MTAD-ZIP TO L331-FROM-VALUE CL**4
|
|
00383 MOVE XLPC-POST-ZIP TO L331-TO-VALUE CL**4
|
|
00384 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00385 P1100-EXIT. CL**4
|
|
00386 EXIT. CL**4
|
|
00387 EJECT DTSBD580
|
|
00388 P2000-MOPO-UPDATE. DTSBD580
|
|
00389 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSBD580
|
|
00390 DTSBD580
|
|
00391 MOVE XLPC-KEY-EMP-NO TO MOPO-EMP-NO. DTSBD580
|
|
00392 DTSBD580
|
|
00393 SET MOPO-OPO-88 TO TRUE. DTSBD580
|
|
00394 DTSBD580
|
|
00395 MOVE XLPC-KEY-ADDR-ID-NO TO MOPO-ID-NO. DTSBD580
|
|
00396 DTSBD580
|
|
00397 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBD580
|
|
00398 DTSBD580
|
|
00399 PERFORM S910-READ THRU S910-EXIT. DTSBD580
|
|
00400 DTSBD580
|
|
00401 IF L910-NO-REC-88 DTSBD580
|
|
00402 MOVE 'MOPO RECORD NOT FOUND' TO ABEND-MSG DTSBD580
|
|
00403 PERFORM S999-ABEND THRU S999-EXIT. DTSBD580
|
|
00404 DTSBD580
|
|
00405 DTSBD580
|
|
00406 MOVE MSKL-REC TO MOPO-REC. DTSBD580
|
|
00407 DTSBD580
|
|
00408 DTSBD580
|
|
00409 PERFORM P2100-CHECK-FOR-MLOG THRU P2100-EXIT. CL**4
|
|
00410 CL**4
|
|
00411 CL**4
|
|
00412 MOVE XLPC-POST-ADDRESS TO MOPO-ADDRESS. DTSBD580
|
|
00413 DTSBD580
|
|
00414 MOVE MHDR-CURR-RUN-DATE TO MOPO-CHNG-DATE. DTSBD580
|
|
00415 DTSBD580
|
|
00416 DTSBD580
|
|
00417 MOVE MOPO-REC TO MSKL-REC. DTSBD580
|
|
00418 DTSBD580
|
|
00419 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD580
|
|
00420 DTSBD580
|
|
00421 ADD +1 TO WRK-MOPO-REC-CNT. DTSBD580
|
|
00422 P2000-EXIT. DTSBD580
|
|
00423 EXIT. DTSBD580
|
|
00424 SKIP3 CL**4
|
|
00425 P2100-CHECK-FOR-MLOG. CL**4
|
|
00426 IF (MOPO-ESTB-ABSTIME NOT NUMERIC) CL**4
|
|
00427 OR CL**4
|
|
00428 (MOPO-ESTB-ABSTIME = +0) CL**4
|
|
00429 MOVE MOPO-ID-NO TO WRK-ID-NO-9 CL**4
|
|
00430 MOVE WRK-ID-NO-X TO L331-REC-OCC-ID CL**4
|
|
00431 ELSE CL**4
|
|
00432 MOVE MOPO-ESTB-ABSTIME TO L005-ABSTIME CL**4
|
|
00433 PERFORM S005-FROM-ABSTIME THRU S005-EXIT CL**4
|
|
00434 MOVE L005-DATE-8-SLASH-TIME TO L331-REC-OCC-ID. CL**4
|
|
00435 CL**4
|
|
00436 CL**4
|
|
00437 IF XLPC-POST-ATTN-LINE = MOPO-ATTN-LINE CL**4
|
|
00438 NEXT SENTENCE CL**4
|
|
00439 ELSE CL**4
|
|
00440 MOVE 'MOPO-ATTN-LINE' TO L331-FIELD-NAME CL**4
|
|
00441 MOVE MOPO-ATTN-LINE TO L331-FROM-VALUE CL**4
|
|
00442 MOVE XLPC-POST-ATTN-LINE TO L331-TO-VALUE CL**4
|
|
00443 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00444 CL**4
|
|
00445 IF XLPC-POST-DELIV-LINE-1 = MOPO-DELIV-LINE-1 CL**4
|
|
00446 NEXT SENTENCE CL**4
|
|
00447 ELSE CL**4
|
|
00448 MOVE 'MOPO-DELIV-LINE-1' TO L331-FIELD-NAME CL**4
|
|
00449 MOVE MOPO-DELIV-LINE-1 TO L331-FROM-VALUE CL**4
|
|
00450 MOVE XLPC-POST-DELIV-LINE-1 TO L331-TO-VALUE CL**4
|
|
00451 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00452 CL**4
|
|
00453 IF XLPC-POST-DELIV-LINE-2 = MOPO-DELIV-LINE-2 CL**4
|
|
00454 NEXT SENTENCE CL**4
|
|
00455 ELSE CL**4
|
|
00456 MOVE 'MOPO-DELIV-LINE-2' TO L331-FIELD-NAME CL**4
|
|
00457 MOVE MOPO-DELIV-LINE-2 TO L331-FROM-VALUE CL**4
|
|
00458 MOVE XLPC-POST-DELIV-LINE-2 TO L331-TO-VALUE CL**4
|
|
00459 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00460 CL**4
|
|
00461 IF XLPC-POST-CITY = MOPO-CITY CL**4
|
|
00462 NEXT SENTENCE CL**4
|
|
00463 ELSE CL**4
|
|
00464 MOVE 'MOPO-CITY' TO L331-FIELD-NAME CL**4
|
|
00465 MOVE MOPO-CITY TO L331-FROM-VALUE CL**4
|
|
00466 MOVE XLPC-POST-CITY TO L331-TO-VALUE CL**4
|
|
00467 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00468 CL**4
|
|
00469 IF XLPC-POST-ST = MOPO-ST CL**4
|
|
00470 NEXT SENTENCE CL**4
|
|
00471 ELSE CL**4
|
|
00472 MOVE 'MOPO-ST' TO L331-FIELD-NAME CL**4
|
|
00473 MOVE MOPO-ST TO L331-FROM-VALUE CL**4
|
|
00474 MOVE XLPC-POST-ST TO L331-TO-VALUE CL**4
|
|
00475 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00476 CL**4
|
|
00477 IF XLPC-POST-ZIP = MOPO-ZIP CL**4
|
|
00478 NEXT SENTENCE CL**4
|
|
00479 ELSE CL**4
|
|
00480 MOVE 'MOPO-ZIP' TO L331-FIELD-NAME CL**4
|
|
00481 MOVE MOPO-ZIP TO L331-FROM-VALUE CL**4
|
|
00482 MOVE XLPC-POST-ZIP TO L331-TO-VALUE CL**4
|
|
00483 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00484 P2100-EXIT. CL**4
|
|
00485 EXIT. CL**4
|
|
00486 EJECT DTSBD580
|
|
00487 P3000-MTAA-UPDATE. DTSBD580
|
|
00488 MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSBD580
|
|
00489 DTSBD580
|
|
00490 MOVE XLPC-KEY-EMP-NO TO MTAA-EMP-NO. DTSBD580
|
|
00491 DTSBD580
|
|
00492 SET MTAA-TAA-88 TO TRUE. DTSBD580
|
|
00493 DTSBD580
|
|
00494 MOVE XLPC-KEY-ADDR-ID-NO TO MTAA-ID-NO. DTSBD580
|
|
00495 DTSBD580
|
|
00496 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBD580
|
|
00497 DTSBD580
|
|
00498 PERFORM S910-READ THRU S910-EXIT. DTSBD580
|
|
00499 DTSBD580
|
|
00500 IF L910-NO-REC-88 DTSBD580
|
|
00501 MOVE 'MTAA RECORD NOT FOUND' TO ABEND-MSG DTSBD580
|
|
00502 PERFORM S999-ABEND THRU S999-EXIT. DTSBD580
|
|
00503 DTSBD580
|
|
00504 DTSBD580
|
|
00505 MOVE MSKL-REC TO MTAA-REC. DTSBD580
|
|
00506 DTSBD580
|
|
00507 CL**4
|
|
00508 PERFORM P3100-CHECK-FOR-MLOG THRU P3100-EXIT. CL**4
|
|
00509 CL**4
|
|
00510 DTSBD580
|
|
00511 MOVE XLPC-POST-ADDRESS TO MTAA-ADDRESS. DTSBD580
|
|
00512 DTSBD580
|
|
00513 MOVE MHDR-CURR-RUN-DATE TO MTAA-CHNG-DATE. DTSBD580
|
|
00514 DTSBD580
|
|
00515 DTSBD580
|
|
00516 MOVE MTAA-REC TO MSKL-REC. DTSBD580
|
|
00517 DTSBD580
|
|
00518 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD580
|
|
00519 DTSBD580
|
|
00520 ADD +1 TO WRK-MTAA-REC-CNT. DTSBD580
|
|
00521 P3000-EXIT. DTSBD580
|
|
00522 EXIT. DTSBD580
|
|
00523 SKIP3 CL**4
|
|
00524 P3100-CHECK-FOR-MLOG. CL**4
|
|
00525 IF (MTAA-ESTB-ABSTIME NOT NUMERIC) CL**4
|
|
00526 OR CL**4
|
|
00527 (MTAA-ESTB-ABSTIME = +0) CL**4
|
|
00528 MOVE MTAA-ID-NO TO WRK-ID-NO-9 CL**4
|
|
00529 MOVE WRK-ID-NO-X TO L331-REC-OCC-ID CL**4
|
|
00530 ELSE CL**4
|
|
00531 MOVE MTAA-ESTB-ABSTIME TO L005-ABSTIME CL**4
|
|
00532 PERFORM S005-FROM-ABSTIME THRU S005-EXIT CL**4
|
|
00533 MOVE L005-DATE-8-SLASH-TIME TO L331-REC-OCC-ID. CL**4
|
|
00534 CL**4
|
|
00535 CL**4
|
|
00536 IF XLPC-POST-ATTN-LINE = MTAA-ATTN-LINE CL**4
|
|
00537 NEXT SENTENCE CL**4
|
|
00538 ELSE CL**4
|
|
00539 MOVE 'MTAA-ATTN-LINE' TO L331-FIELD-NAME CL**4
|
|
00540 MOVE MTAA-ATTN-LINE TO L331-FROM-VALUE CL**4
|
|
00541 MOVE XLPC-POST-ATTN-LINE TO L331-TO-VALUE CL**4
|
|
00542 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00543 CL**4
|
|
00544 IF XLPC-POST-DELIV-LINE-1 = MTAA-DELIV-LINE-1 CL**4
|
|
00545 NEXT SENTENCE CL**4
|
|
00546 ELSE CL**4
|
|
00547 MOVE 'MTAA-DELIV-LINE-1' TO L331-FIELD-NAME CL**4
|
|
00548 MOVE MTAA-DELIV-LINE-1 TO L331-FROM-VALUE CL**4
|
|
00549 MOVE XLPC-POST-DELIV-LINE-1 TO L331-TO-VALUE CL**4
|
|
00550 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00551 CL**4
|
|
00552 IF XLPC-POST-DELIV-LINE-2 = MTAA-DELIV-LINE-2 CL**4
|
|
00553 NEXT SENTENCE CL**4
|
|
00554 ELSE CL**4
|
|
00555 MOVE 'MTAA-DELIV-LINE-2' TO L331-FIELD-NAME CL**4
|
|
00556 MOVE MTAA-DELIV-LINE-2 TO L331-FROM-VALUE CL**4
|
|
00557 MOVE XLPC-POST-DELIV-LINE-2 TO L331-TO-VALUE CL**4
|
|
00558 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00559 CL**4
|
|
00560 IF XLPC-POST-CITY = MTAA-CITY CL**4
|
|
00561 NEXT SENTENCE CL**4
|
|
00562 ELSE CL**4
|
|
00563 MOVE 'MTAA-CITY' TO L331-FIELD-NAME CL**4
|
|
00564 MOVE MTAA-CITY TO L331-FROM-VALUE CL**4
|
|
00565 MOVE XLPC-POST-CITY TO L331-TO-VALUE CL**4
|
|
00566 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00567 CL**4
|
|
00568 IF XLPC-POST-ST = MTAA-ST CL**4
|
|
00569 NEXT SENTENCE CL**4
|
|
00570 ELSE CL**4
|
|
00571 MOVE 'MTAA-ST' TO L331-FIELD-NAME CL**4
|
|
00572 MOVE MTAA-ST TO L331-FROM-VALUE CL**4
|
|
00573 MOVE XLPC-POST-ST TO L331-TO-VALUE CL**4
|
|
00574 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00575 CL**4
|
|
00576 IF XLPC-POST-ZIP = MTAA-ZIP CL**4
|
|
00577 NEXT SENTENCE CL**4
|
|
00578 ELSE CL**4
|
|
00579 MOVE 'MTAA-ZIP' TO L331-FIELD-NAME CL**4
|
|
00580 MOVE MTAA-ZIP TO L331-FROM-VALUE CL**4
|
|
00581 MOVE XLPC-POST-ZIP TO L331-TO-VALUE CL**4
|
|
00582 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00583 P3100-EXIT. CL**4
|
|
00584 EXIT. CL**4
|
|
00585 EJECT DTSBD580
|
|
00586 P4000-MBAA-UPDATE. DTSBD580
|
|
00587 MOVE LOW-VALUES TO MBAA-KEY-AREA. DTSBD580
|
|
00588 DTSBD580
|
|
00589 MOVE XLPC-KEY-EMP-NO TO MBAA-EMP-NO. DTSBD580
|
|
00590 DTSBD580
|
|
00591 SET MBAA-BAA-88 TO TRUE. DTSBD580
|
|
00592 DTSBD580
|
|
00593 MOVE XLPC-KEY-ADDR-ID-NO TO MBAA-ID-NO. DTSBD580
|
|
00594 DTSBD580
|
|
00595 MOVE MBAA-KEY-AREA TO MSKL-KEY-AREA. DTSBD580
|
|
00596 DTSBD580
|
|
00597 PERFORM S910-READ THRU S910-EXIT. DTSBD580
|
|
00598 DTSBD580
|
|
00599 IF L910-NO-REC-88 DTSBD580
|
|
00600 MOVE 'MBAA RECORD NOT FOUND' TO ABEND-MSG DTSBD580
|
|
00601 PERFORM S999-ABEND THRU S999-EXIT. DTSBD580
|
|
00602 DTSBD580
|
|
00603 DTSBD580
|
|
00604 MOVE MSKL-REC TO MBAA-REC. DTSBD580
|
|
00605 DTSBD580
|
|
00606 CL**4
|
|
00607 PERFORM P4100-CHECK-FOR-MLOG THRU P4100-EXIT. CL**4
|
|
00608 CL**4
|
|
00609 DTSBD580
|
|
00610 MOVE XLPC-POST-ADDRESS TO MBAA-ADDRESS. DTSBD580
|
|
00611 DTSBD580
|
|
00612 MOVE MHDR-CURR-RUN-DATE TO MBAA-CHNG-DATE. DTSBD580
|
|
00613 DTSBD580
|
|
00614 DTSBD580
|
|
00615 MOVE MBAA-REC TO MSKL-REC. DTSBD580
|
|
00616 DTSBD580
|
|
00617 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD580
|
|
00618 DTSBD580
|
|
00619 ADD +1 TO WRK-MBAA-REC-CNT. DTSBD580
|
|
00620 P4000-EXIT. DTSBD580
|
|
00621 EXIT. DTSBD580
|
|
00622 SKIP3 CL**4
|
|
00623 P4100-CHECK-FOR-MLOG. CL**4
|
|
00624 IF (MBAA-ESTB-ABSTIME NOT NUMERIC) CL**4
|
|
00625 OR CL**4
|
|
00626 (MBAA-ESTB-ABSTIME = +0) CL**4
|
|
00627 MOVE MBAA-ID-NO TO WRK-ID-NO-9 CL**4
|
|
00628 MOVE WRK-ID-NO-X TO L331-REC-OCC-ID CL**4
|
|
00629 ELSE CL**4
|
|
00630 MOVE MBAA-ESTB-ABSTIME TO L005-ABSTIME CL**4
|
|
00631 PERFORM S005-FROM-ABSTIME THRU S005-EXIT CL**4
|
|
00632 MOVE L005-DATE-8-SLASH-TIME TO L331-REC-OCC-ID. CL**4
|
|
00633 CL**4
|
|
00634 CL**4
|
|
00635 IF XLPC-POST-ATTN-LINE = MBAA-ATTN-LINE CL**4
|
|
00636 NEXT SENTENCE CL**4
|
|
00637 ELSE CL**4
|
|
00638 MOVE 'MBAA-ATTN-LINE' TO L331-FIELD-NAME CL**4
|
|
00639 MOVE MBAA-ATTN-LINE TO L331-FROM-VALUE CL**4
|
|
00640 MOVE XLPC-POST-ATTN-LINE TO L331-TO-VALUE CL**4
|
|
00641 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00642 CL**4
|
|
00643 IF XLPC-POST-DELIV-LINE-1 = MBAA-DELIV-LINE-1 CL**4
|
|
00644 NEXT SENTENCE CL**4
|
|
00645 ELSE CL**4
|
|
00646 MOVE 'MBAA-DELIV-LINE-1' TO L331-FIELD-NAME CL**4
|
|
00647 MOVE MBAA-DELIV-LINE-1 TO L331-FROM-VALUE CL**4
|
|
00648 MOVE XLPC-POST-DELIV-LINE-1 TO L331-TO-VALUE CL**4
|
|
00649 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00650 CL**4
|
|
00651 IF XLPC-POST-DELIV-LINE-2 = MBAA-DELIV-LINE-2 CL**4
|
|
00652 NEXT SENTENCE CL**4
|
|
00653 ELSE CL**4
|
|
00654 MOVE 'MBAA-DELIV-LINE-2' TO L331-FIELD-NAME CL**4
|
|
00655 MOVE MBAA-DELIV-LINE-2 TO L331-FROM-VALUE CL**4
|
|
00656 MOVE XLPC-POST-DELIV-LINE-2 TO L331-TO-VALUE CL**4
|
|
00657 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00658 CL**4
|
|
00659 IF XLPC-POST-CITY = MBAA-CITY CL**4
|
|
00660 NEXT SENTENCE CL**4
|
|
00661 ELSE CL**4
|
|
00662 MOVE 'MBAA-CITY' TO L331-FIELD-NAME CL**4
|
|
00663 MOVE MBAA-CITY TO L331-FROM-VALUE CL**4
|
|
00664 MOVE XLPC-POST-CITY TO L331-TO-VALUE CL**4
|
|
00665 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00666 CL**4
|
|
00667 IF XLPC-POST-ST = MBAA-ST CL**4
|
|
00668 NEXT SENTENCE CL**4
|
|
00669 ELSE CL**4
|
|
00670 MOVE 'MBAA-ST' TO L331-FIELD-NAME CL**4
|
|
00671 MOVE MBAA-ST TO L331-FROM-VALUE CL**4
|
|
00672 MOVE XLPC-POST-ST TO L331-TO-VALUE CL**4
|
|
00673 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00674 CL**4
|
|
00675 IF XLPC-POST-ZIP = MBAA-ZIP CL**4
|
|
00676 NEXT SENTENCE CL**4
|
|
00677 ELSE CL**4
|
|
00678 MOVE 'MBAA-ZIP' TO L331-FIELD-NAME CL**4
|
|
00679 MOVE MBAA-ZIP TO L331-FROM-VALUE CL**4
|
|
00680 MOVE XLPC-POST-ZIP TO L331-TO-VALUE CL**4
|
|
00681 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL**4
|
|
00682 P4100-EXIT. CL**4
|
|
00683 EXIT. CL**4
|
|
00684 EJECT DTSBD580
|
|
00685 P5000-MELF-UPDATE. DTSBD580
|
|
00686 MOVE LOW-VALUES TO MELF-KEY-AREA. DTSBD580
|
|
00687 DTSBD580
|
|
00688 MOVE XLPC-KEY-EMP-NO TO MELF-EMP-NO. DTSBD580
|
|
00689 DTSBD580
|
|
00690 SET MELF-ELF-88 TO TRUE. DTSBD580
|
|
00691 DTSBD580
|
|
00692 MOVE MELF-KEY-AREA TO MSKL-KEY-AREA. DTSBD580
|
|
00693 DTSBD580
|
|
00694 PERFORM S910-READ THRU S910-EXIT. DTSBD580
|
|
00695 DTSBD580
|
|
00696 IF L910-NO-REC-88 DTSBD580
|
|
00697 MOVE 'MELF RECORD NOT FOUND' TO ABEND-MSG DTSBD580
|
|
00698 PERFORM S999-ABEND THRU S999-EXIT. DTSBD580
|
|
00699 DTSBD580
|
|
00700 DTSBD580
|
|
00701 MOVE MSKL-REC TO MELF-REC. DTSBD580
|
|
00702 DTSBD580
|
|
00703 DTSBD580
|
|
00704 MOVE XLPC-POST-ADDRESS TO MELF-ADDRESS. DTSBD580
|
|
00705 DTSBD580
|
|
00706 MOVE 'SYSTEM' TO MELF-CHNG-OP-ID. DTSBD580
|
|
00707 DTSBD580
|
|
00708 MOVE MHDR-CURR-RUN-DATE TO MELF-CHNG-DATE. DTSBD580
|
|
00709 DTSBD580
|
|
00710 DTSBD580
|
|
00711 MOVE MELF-REC TO MSKL-REC. DTSBD580
|
|
00712 DTSBD580
|
|
00713 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD580
|
|
00714 DTSBD580
|
|
00715 ADD +1 TO WRK-MELF-REC-CNT. DTSBD580
|
|
00716 P5000-EXIT. DTSBD580
|
|
00717 EXIT. DTSBD580
|
|
00718 EJECT DTSBD580
|
|
00719 P9000-EMP-NO-BREAK. DTSBD580
|
|
00720 IF WRK-MTAD-ZIP-UPDATED-IND = 'N' DTSBD580
|
|
00721 GO TO P9000-EXIT. DTSBD580
|
|
00722 DTSBD580
|
|
00723 DTSBD580
|
|
00724 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD580
|
|
00725 DTSBD580
|
|
00726 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSBD580
|
|
00727 DTSBD580
|
|
00728 SET MSKL-PRF-88 TO TRUE. DTSBD580
|
|
00729 DTSBD580
|
|
00730 PERFORM S910-READ THRU S910-EXIT. DTSBD580
|
|
00731 DTSBD580
|
|
00732 IF L910-NO-REC-88 DTSBD580
|
|
00733 MOVE 'MPRF RECORD NOT FOUND' TO ABEND-MSG DTSBD580
|
|
00734 PERFORM S999-ABEND THRU S999-EXIT. DTSBD580
|
|
00735 DTSBD580
|
|
00736 DTSBD580
|
|
00737 MOVE MSKL-REC TO MPRF-REC. DTSBD580
|
|
00738 DTSBD580
|
|
00739 ADD +1 TO WRK-MPRF-REC-CNT. DTSBD580
|
|
00740 DTSBD580
|
|
00741 DTSBD580
|
|
00742 MOVE MPRF-EMP-NO TO L203-EMP-NO. DTSBD580
|
|
00743 DTSBD580
|
|
00744 MOVE MPRF-TAX-REC-ADDR-EXISTS-IND CL**2
|
|
00745 TO L203-TAX-REC-ADDR-EXISTS-IND. CL**2
|
|
00746 DTSBD580
|
|
00747 PERFORM S203-FIELD-ZIP-CODE THRU S203-EXIT. CL**2
|
|
00748 DTSBD580
|
|
00749 IF L203-OK-88 DTSBD580
|
|
00750 NEXT SENTENCE DTSBD580
|
|
00751 ELSE DTSBD580
|
|
00752 GO TO P9000-EXIT. DTSBD580
|
|
00753 DTSBD580
|
|
00754 IF (L203-FLD-ZIP = MPRF-FLD-ZIP) DTSBD580
|
|
00755 AND DTSBD580
|
|
00756 (L203-FLD-STATE = MPRF-FLD-ST) CL**2
|
|
00757 GO TO P9000-EXIT. DTSBD580
|
|
00758 DTSBD580
|
|
00759 MOVE L203-FLD-ZIP TO MPRF-FLD-ZIP. DTSBD580
|
|
00760 DTSBD580
|
|
00761 MOVE L203-FLD-STATE TO MPRF-FLD-ST. CL**2
|
|
00762 DTSBD580
|
|
00763 MOVE MHDR-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSBD580
|
|
00764 DTSBD580
|
|
00765 MOVE MPRF-REC TO MSKL-REC. DTSBD580
|
|
00766 DTSBD580
|
|
00767 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD580
|
|
00768 P9000-EXIT. DTSBD580
|
|
00769 EXIT. DTSBD580
|
|
00770 EJECT DTSBD580
|
|
00771 T0000-TERMINATE. DTSBD580
|
|
00772 DISPLAY DTSBD580
|
|
00773 '*** DTSBD580 TERMINATION STATISTICS'. CL**2
|
|
00774 DTSBD580
|
|
00775 DISPLAY ' '. DTSBD580
|
|
00776 DTSBD580
|
|
00777 DISPLAY DTSBD580
|
|
00778 '*** NUMBER OF MPRF RECORDS PROCESSED: ' DTSBD580
|
|
00779 WRK-MPRF-REC-CNT. DTSBD580
|
|
00780 DTSBD580
|
|
00781 DISPLAY DTSBD580
|
|
00782 '*** NUMBER OF MTAD RECORDS PROCESSED: ' DTSBD580
|
|
00783 WRK-MTAD-REC-CNT. DTSBD580
|
|
00784 DTSBD580
|
|
00785 DISPLAY DTSBD580
|
|
00786 '*** NUMBER OF MOPO RECORDS PROCESSED: ' DTSBD580
|
|
00787 WRK-MOPO-REC-CNT. DTSBD580
|
|
00788 DTSBD580
|
|
00789 DISPLAY DTSBD580
|
|
00790 '*** NUMBER OF MTAA RECORDS PROCESSED: ' DTSBD580
|
|
00791 WRK-MTAA-REC-CNT. DTSBD580
|
|
00792 DTSBD580
|
|
00793 DISPLAY DTSBD580
|
|
00794 '*** NUMBER OF MBAA RECORDS PROCESSED: ' DTSBD580
|
|
00795 WRK-MBAA-REC-CNT. DTSBD580
|
|
00796 DTSBD580
|
|
00797 DISPLAY DTSBD580
|
|
00798 '*** NUMBER OF MELF RECORDS PROCESSED: ' DTSBD580
|
|
00799 WRK-MELF-REC-CNT. DTSBD580
|
|
00800 DTSBD580
|
|
00801 DISPLAY DTSBD580
|
|
00802 '*** NUMBER OF XLPC RECORDS INPUT: ' DTSBD580
|
|
00803 WRK-LPC-REC-CNT. DTSBD580
|
|
00804 DTSBD580
|
|
00805 DTSBD580
|
|
00806 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD580
|
|
00807 DTSBD580
|
|
00808 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD580
|
|
00809 DTSBD580
|
|
00810 CLOSE LPC-FILE. DTSBD580
|
|
00811 T0000-EXIT. DTSBD580
|
|
00812 EXIT. DTSBD580
|
|
00813 EJECT DTSBD580
|
|
00814 S005-FROM-SYS. CL**4
|
|
00815 SET L005-FROM-SYS TO TRUE. CL**4
|
|
00816 GO TO S005-ABSTIME. CL**4
|
|
00817 CL**4
|
|
00818 S005-FROM-ABSTIME. CL**4
|
|
00819 SET L005-FROM-ABSTIME TO TRUE. CL**4
|
|
00820 GO TO S005-ABSTIME. CL**4
|
|
00821 CL**4
|
|
00822 S005-ABSTIME. CL**4
|
|
00823 CALL 'DTSBU005' USING L005-LINK-AREA. CL**4
|
|
00824 S005-EXIT. CL**4
|
|
00825 EXIT. DTSBD580
|
|
00826 SKIP3 DTSBD580
|
|
00827 S203-FIELD-ZIP-CODE. CL**4
|
|
00828 CALL 'DTSBU203' USING L203-LINK-AREA. CL**4
|
|
00829 S203-EXIT. CL**4
|
|
00830 EXIT. CL**4
|
|
00831 SKIP3 CL**4
|
|
00832 S331-WRITE-MLOG. CL**4
|
|
00833 CALL 'DTSBU331' USING L331-LINK-AREA. CL**4
|
|
00834 S331-EXIT. CL**4
|
|
00835 EXIT. CL**4
|
|
00836 SKIP3 CL**4
|
|
00837 S910-OPEN-UPDATE. DTSBD580
|
|
00838 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD580
|
|
00839 GO TO S910-MSTR-CALL. DTSBD580
|
|
00840 DTSBD580
|
|
00841 S910-READ. DTSBD580
|
|
00842 SET L910-READ-88 TO TRUE. DTSBD580
|
|
00843 GO TO S910-MSTR-CALL. DTSBD580
|
|
00844 DTSBD580
|
|
00845 S910-START-BROWSE. DTSBD580
|
|
00846 SET L910-START-BROWSE-88 TO TRUE. DTSBD580
|
|
00847 GO TO S910-MSTR-CALL. DTSBD580
|
|
00848 DTSBD580
|
|
00849 S910-READ-NEXT. DTSBD580
|
|
00850 SET L910-READ-NEXT-88 TO TRUE. DTSBD580
|
|
00851 GO TO S910-MSTR-CALL. DTSBD580
|
|
00852 DTSBD580
|
|
00853 *S910-COUNT. DTSBD580
|
|
00854 *****SET L910-COUNT-88 TO TRUE. DTSBD580
|
|
00855 *****GO TO S910-MSTR-CALL. DTSBD580
|
|
00856 DTSBD580
|
|
00857 S910-REWRITE. DTSBD580
|
|
00858 SET L910-REWRITE-88 TO TRUE. DTSBD580
|
|
00859 GO TO S910-MSTR-CALL. DTSBD580
|
|
00860 DTSBD580
|
|
00861 S910-CLOSE. DTSBD580
|
|
00862 SET L910-CLOSE-88 TO TRUE. DTSBD580
|
|
00863 GO TO S910-MSTR-CALL. DTSBD580
|
|
00864 DTSBD580
|
|
00865 S910-MSTR-CALL. DTSBD580
|
|
00866 CALL 'DTSBU910' USING L910-LINK-AREA CL**2
|
|
00867 MSKL-REC. DTSBD580
|
|
00868 S910-EXIT. DTSBD580
|
|
00869 EXIT. DTSBD580
|
|
00870 SKIP3 DTSBD580
|
|
00871 S921-OPEN-UPDATE. DTSBD580
|
|
00872 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBD580
|
|
00873 GO TO S921-AIX-IO. DTSBD580
|
|
00874 DTSBD580
|
|
00875 S921-CLOSE. DTSBD580
|
|
00876 SET L921-CLOSE-88 TO TRUE. DTSBD580
|
|
00877 GO TO S921-AIX-IO. DTSBD580
|
|
00878 DTSBD580
|
|
00879 S921-AIX-IO. DTSBD580
|
|
00880 CALL 'DTSBU921' USING L921-LINK-AREA CL**2
|
|
00881 ISKL-REC. DTSBD580
|
|
00882 S921-EXIT. DTSBD580
|
|
00883 EXIT. DTSBD580
|
|
00884 SKIP3 DTSBD580
|
|
00885 S999-ABEND. DTSBD580
|
|
00886 DISPLAY '*** DTSBD580 ABENDING. ' CL**2
|
|
00887 ABEND-MSG. DTSBD580
|
|
00888 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2
|
|
00889 S999-EXIT. DTSBD580
|
|
00890 EXIT. DTSBD580
|
|
00891 EJECT DTSBD580
|