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