00001 IDENTIFICATION DIVISION. 02/27/20 00002 PROGRAM-ID. DTSBX427. DTSBX427 00003 AUTHOR. NORTHROP GRUMMAN. LV094 00004 DATE-WRITTEN. SEPT 2014. CL**2 00005 DATE-COMPILED. DTSBX427 00006 SKIP3 DTSBX427 00007 ***** DTSBX427 00008 * DTSBX427 00009 * FUNCTION: UPDATE MAILING AND BUSINESS ADDRESS FROM ESSP. CL**2 00010 * DTSBX427 00011 * MODIFICATION LOG: DTSBX427 00012 * DTSBX427 00013 * 09/15/2014 INITIAL DEVELOPMENT. CL**2 00014 * WORK ORDER: ESSP PROGRAMMER: ZL1 CL**2 00015 * DTSBX427 00016 * CL*48 00017 * 02/15/2017 MODIFIED TO CONVERT ADDRESS FIELDS INTO UPPER CL*48 00018 * CASE PROGRAMMER: ZL1 CL*48 00019 * CL*48 00020 * CL*50 00021 * CL*50 00022 * 04/06/2017 MODIFIED TO UPDATE THE RETURN MAIL FLAG WHEN CL*50 00023 * ADDRESS UPDATES COMPLETED PROGRAMMER: ZL1 CL*50 00024 * CL*50 00025 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX427 00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX427 00027 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX427 00028 * DTSBX427 00029 * DESCRIPTION: DTSBX427 00030 * DTSBX427 00031 * UPDATE ADDRESSES AND THE MPRF MASTER FILE. DTSBX427 00032 * DTSBX427 00033 * DTSBX427 IS THE MAILING ADDRESS UPDATE PROCESS FROM A CL**2 00034 * ESSP ADDRESS FILE. CL**2 00035 * DTSBX427 00036 * REPORT RECORDS INPUT: DTSBX427 00037 * NONE DTSBX427 00038 * DTSBX427 00039 * TAPES INPUT: DTSBX427 00040 * NONE. DTSBX427 00041 * DTSBX427 00042 * MASTER FILE RECORDS READ: DTSBX427 00043 * MHDR DTSBX427 00044 * MPRF DTSBX427 00045 * MTAD DTSBX427 00046 * DTSBX427 00047 * MASTER FILE RECORDS UPDATED: DTSBX427 00048 * MPRF (REWRITE). DTSBX427 00049 * MTAD (REWRITE). DTSBX427 00050 * MELOG(WRITTEN). DTSBX427 00051 * DTSBX427 00052 * RECORDS READ: DTSBX427 00053 * ESSP ADDRESS FILE (X110). CL**2 00054 * DTSBX427 00055 * MODULES CALLED: DTSBX427 00056 * DTSBU203 FIELD ZIP AND JS ZIP DETERMINATION. DTSBX427 00057 * DTSBU910 MASTER FILE I/O. DTSBX427 00058 * DTSBU921 ALTERNATE INDEX I/O. DTSBX427 00059 * DTSBX427 00060 ***** DTSBX427 00061 SKIP3 DTSBX427 00062 ENVIRONMENT DIVISION. DTSBX427 00063 CONFIGURATION SECTION. CL*82 00064 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*82 00065 SKIP2 CL*82 00066 CL*82 00067 INPUT-OUTPUT SECTION. DTSBX427 00068 DTSBX427 00069 FILE-CONTROL. DTSBX427 00070 SELECT REPT-PAID-FILE ASSIGN TO X427RPT1 CL*75 00071 FILE STATUS IS REPT-STATUS. CL*75 00072 CL*75 00073 SELECT REPT-PEND-FILE ASSIGN TO X427RPT2 CL*75 00074 FILE STATUS IS REPT-STATUS. CL*75 00075 CL*75 00076 SELECT ESSP-X110-FILE ASSIGN TO DTSFX110. CL**2 00077 DATA DIVISION. DTSBX427 00078 DTSBX427 00079 FILE SECTION. DTSBX427 00080 DTSBX427 00081 FD ESSP-X110-FILE CL**2 00082 LABEL RECORDS ARE STANDARD DTSBX427 00083 RECORDING MODE IS F DTSBX427 00084 BLOCK CONTAINS 0 RECORDS. DTSBX427 00085 DTSBX427 00086 01 ESSP-X110-REC PIC X(512). CL*67 00087 CL*75 00088 FD REPT-PAID-FILE CL*75 00089 RECORDING MODE IS F CL*75 00090 BLOCK CONTAINS 0 RECORDS CL*75 00091 LABEL RECORDS ARE OMITTED. CL*75 00092 CL*75 00093 01 REPT-PAID-REC PIC X(200). CL*75 00094 CL*75 00095 CL*75 00096 FD REPT-PEND-FILE CL*75 00097 RECORDING MODE IS F CL*75 00098 BLOCK CONTAINS 0 RECORDS CL*75 00099 LABEL RECORDS ARE OMITTED. CL*75 00100 CL*75 00101 01 REPT-PEND-REC PIC X(133). CL*75 00102 CL*75 00103 CL*75 00104 EJECT DTSBX427 00105 DTSBX427 00106 WORKING-STORAGE SECTION. DTSBX427 001065 77 PAN-VALET PICTURE X(24) VALUE '094DTSBX427 02/27/20'. DTSBX427 00107 77 PAN-VALET PICTURE X(24) VALUE '062DTSBX427 03/06/07'. DTSBX427 00108 SKIP3 DTSBX427 00109 01 WRK-AREA. DTSBX427 00110 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +427. CL**2 00111 05 ABEND-MSG PIC X(60). DTSBX427 00112 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE +0. DTSBX427 00113 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +1000. CL*29 00114 05 W-EMP-NO PIC S9(07) COMP-3 VALUE +0. CL*77 00115 CL*77 00116 05 UPD-MTAD-IND PIC 9(01) VALUE 0. CL**7 00117 05 WRK-MPRF-MAIL-UPD-CNT PIC 9 VALUE 0. CL*55 00118 05 WRK-MTAD-MAIL-UPD-CNT PIC 9 VALUE 0. CL*55 00119 05 WRK-MTAD-MAIL-ADD-CNT PIC 9 VALUE 0. CL*55 00120 05 X110-EOF-IND PIC X(01). CL**7 00121 05 WRK-MPRF-ADD-CNT PIC S9(07) COMP-3. CL*18 00122 05 WRK-MPRF-UPD-CNT PIC S9(07) COMP-3. CL*18 00123 05 WRK-MPRF-NOT-CNT PIC S9(07) COMP-3. CL*19 00124 05 WRK-MTAD-ADD-CNT PIC S9(07) COMP-3. CL*18 00125 05 WRK-MTAD-UPD-CNT PIC S9(07) COMP-3. CL*18 00126 05 WRK-MDCD-ADD-CNT PIC S9(07) COMP-3. CL*18 00127 05 WRK-MDCD-UPD-CNT PIC S9(07) COMP-3. CL*18 00128 05 WRK-MLOG-REC-CNT PIC S9(07) COMP-3. DTSBX427 00129 05 WRK-X110-REC-CNT PIC S9(07) COMP-3. CL**5 00130 05 W-T002-ADDR-CNT PIC S9(07) COMP-3. CL*13 00131 05 REPT-STATUS PIC X(02). CL*76 00132 88 REPT-STATUS-OK-88 VALUE '00'. CL*76 00133 88 REPT-STATUS-EOF-88 VALUE '10'. CL*76 00134 CL*76 00135 CL*21 00136 05 W-ERROR-IND PIC X(01) VALUE 'N'. CL*21 00137 88 W-ERROR-YES-88 VALUE 'Y'. CL*21 00138 88 W-ERROR-NO-88 VALUE 'N'. CL*21 00139 CL*21 00140 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. CL*21 00141 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. CL*21 00142 88 W-FATAL-ERROR-NO-88 VALUE 'N'. CL*21 00143 CL*21 00144 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBX427 00145 05 WRK-TAD-EMP-NO PIC S9(07) COMP-3. DTSBX427 00146 05 WRK-MTAD-ZIP-UPDATED-IND PIC X(01). DTSBX427 00147 DTSBX427 00148 05 WRK-ID-NO-9 PIC 9(03). DTSBX427 00149 05 WRK-ID-NO-X REDEFINES WRK-ID-NO-9 DTSBX427 00150 PIC X(03). DTSBX427 00151 05 WRK-ZIP. CL**3 00152 10 WRK-ZIP-5 PIC X(05). CL**3 00153 10 WRK-DASH PIC X(01) VALUE '-'. CL**3 00154 10 WRK-ZIP-PLUS4 PIC X(04). CL**3 00155 01 HEADER-3. CL*75 00156 05 FILLER PIC X(01) VALUE SPACES. CL*75 00157 05 FILLER PIC X(38) VALUE CL*75 00158 ' TAX STATUS STAFF'. CL*84 00159 05 HDR3-LITERAL PIC X(43) VALUE CL*75 00160 ' ESSP DAILY ADDRESS UPDATES '. CL*84 00161 05 FILLER PIC X(28) VALUE SPACES. CL*75 00162 * 05 FILLER PIC X(06) VALUE 'PAGE:'. CL*75 00163 * 05 HDR3-PAGE PIC ZZ,ZZ9. CL*75 00164 01 HEADER-43. CL*75 00165 05 FILLER PIC X(02) VALUE SPACES. CL*75 00166 05 FILLER PIC X(52) VALUE CL*80 00167 'EMP NO TYPE QAS ATTN LINE1'. CL*80 00168 05 FILLER PIC X(27) VALUE CL*80 00169 ' LINE2'. CL*80 00170 05 FILLER PIC X(22) VALUE SPACES. CL*85 00171 05 FILLER PIC X(44) VALUE CL*85 00172 ' CITY ST '. CL*94 00173 05 HDR5-NAME PIC X(31) VALUE CL*75 00174 'ZIP EMAIL '. CL*93 00175 DTSBX427 00176 CL*66 00177 01 BLANK-LINE PIC X(200) VALUE SPACES. CL*85 00178 01 DETAIL-LINE-1. CL*85 00179 15 FILLER PIC X(02) VALUE SPACES. CL*75 00180 15 X427-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*75 00181 15 FILLER PIC X(03) VALUE SPACES. CL*80 00182 15 X427-TYPE PIC X(02). CL*79 00183 15 FILLER PIC X(04) VALUE SPACES. CL*80 00184 15 X427-QAS PIC X(01). CL*75 00185 15 FILLER PIC X(03) VALUE SPACES. CL*84 00186 15 X427-ATTN PIC X(20). CL*75 00187 15 FILLER PIC X(07) VALUE SPACES. CL*80 00188 15 X427-LINE1 PIC X(25). CL*75 00189 15 FILLER PIC X(02) VALUE SPACES. CL*75 00190 15 X427-LINE2 PIC X(40). CL*92 00191 15 FILLER PIC X(02) VALUE SPACES. CL*75 00192 15 X427-CITY PIC X(20). CL*92 00193 15 FILLER PIC X(02) VALUE SPACES. CL*75 00194 15 X427-STATE PIC X(02). CL*75 00195 15 FILLER PIC X(02) VALUE SPACES. CL*75 00196 15 X427-ZIP PIC X(10). CL*75 00197 15 FILLER PIC X(02) VALUE SPACES. CL*75 00198 15 X427-EMAIL PIC X(30). CL*75 00199 15 FILLER PIC X(02) VALUE SPACES. CL*75 00200 15 X427-MESSAGE PIC X(10) VALUE SPACES. CL*79 00201 CL*75 00202 01 DETAIL-PEND-1. CL*75 00203 15 FILLER PIC X(02) VALUE SPACES. CL*75 00204 15 P427-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*75 00205 15 FILLER PIC X(02) VALUE SPACES. CL*75 00206 15 P427-TYPE PIC X(01). CL*75 00207 15 FILLER PIC X(02) VALUE SPACES. CL*75 00208 15 P427-ATTN PIC X(20). CL*75 00209 15 FILLER PIC X(02) VALUE SPACES. CL*75 00210 15 P427-LINE1 PIC X(25). CL*75 00211 15 FILLER PIC X(02) VALUE SPACES. CL*75 00212 15 P427-LINE2 PIC X(25). CL*75 00213 15 FILLER PIC X(02) VALUE SPACES. CL*75 00214 15 P427-CITY PIC X(15). CL*75 00215 15 FILLER PIC X(02) VALUE SPACES. CL*75 00216 15 P427-STATE PIC X(02). CL*75 00217 15 FILLER PIC X(02) VALUE SPACES. CL*75 00218 15 P427-ZIP PIC X(10). CL*75 00219 15 FILLER PIC X(02) VALUE SPACES. CL*75 00220 15 P427-MESSAGE PIC X(10). CL*75 00221 CL*75 00222 01 FOOTING-LINE-51. CL*75 00223 05 FILLER PIC X(25) VALUE SPACES. CL*75 00224 05 WS-X110-PEN-CNT PIC ZZ,ZZ9. CL*75 00225 05 FILLER PIC X(02) VALUE SPACES. CL*75 00226 05 FILLER PIC X(40) VALUE CL*75 00227 '# OF ADDRESSES RECEIVED FROM ESSP '. CL*75 00228 05 FILLER PIC X(32) VALUE SPACES. CL*75 00229 CL*75 00230 01 FOOTING-LINE-6. CL*75 00231 05 FILLER PIC X(25) VALUE SPACES. CL*75 00232 05 WS-X102-RED-CNT PIC ZZ,ZZ9. CL*75 00233 05 FILLER PIC X(02) VALUE SPACES. CL*75 00234 05 FILLER PIC X(45) VALUE CL*75 00235 '# OF ADDRESSES DUTAS PASSED '. CL*89 00236 05 FILLER PIC X(32) VALUE SPACES. CL*75 00237 01 FOOTING-LINE-7. CL*75 00238 05 FILLER PIC X(25) VALUE SPACES. CL*75 00239 05 WS-X102-ERR-CNT PIC ZZ,ZZ9. CL*75 00240 05 FILLER PIC X(02) VALUE SPACES. CL*75 00241 05 FILLER PIC X(40) VALUE CL*75 00242 '# OF ADDRESSES DUTAS FAILED '. CL*75 00243 05 FILLER PIC X(32) VALUE SPACES. CL*75 00244 CL*75 00245 01 X110-REC. CL*75 00246 ++INCLUDE DTSUX110 CL*66 00247 EJECT CL*66 00248 CL*66 00249 CL*18 00250 01 R140-REC. CL*18 00251 ++INCLUDE DTSIR140 CL*18 00252 EJECT DTSBX427 00253 CL*47 00254 01 L009-LINK-AREA. CL*47 00255 ++INCLUDE DTSIL009 CL*47 00256 EJECT CL*47 00257 01 L005-LINK-AREA. DTSBX427 00258 ++INCLUDE DTSIL005 DTSBX427 00259 EJECT DTSBX427 00260 01 L203-LINK-AREA. DTSBX427 00261 ++INCLUDE DTSIL203 DTSBX427 00262 EJECT DTSBX427 00263 01 L331-LINK-AREA. DTSBX427 00264 ++INCLUDE DTSIL331 DTSBX427 00265 EJECT DTSBX427 00266 01 L910-LINK-AREA. DTSBX427 00267 ++INCLUDE DTSIL910 DTSBX427 00268 EJECT DTSBX427 00269 01 MSKL-REC. DTSBX427 00270 ++INCLUDE DTSIMSKL DTSBX427 00271 EJECT DTSBX427 00272 01 MHDR-REC. DTSBX427 00273 ++INCLUDE DTSIMHDR DTSBX427 00274 EJECT DTSBX427 00275 01 MPRF-REC. DTSBX427 00276 ++INCLUDE DTSIMPRF DTSBX427 00277 EJECT DTSBX427 00278 CL*12 00279 01 T002-REC. CL*12 00280 ++INCLUDE DTSIT002 CL*12 00281 CL*12 00282 * ADDRESS CL*12 00283 01 Y110-REC. CL*12 00284 ++INCLUDE DTSIY110 CL*12 00285 CL*12 00286 01 MTAD-REC. DTSBX427 00287 ++INCLUDE DTSIMTAD DTSBX427 00288 EJECT DTSBX427 00289 01 L921-LINK-AREA. DTSBX427 00290 ++INCLUDE DTSIL921 DTSBX427 00291 CL*12 00292 01 L927-LINK-AREA. CL*12 00293 ++INCLUDE DTSIL927 CL*12 00294 CL*12 00295 01 TSKL-REC. CL*12 00296 ++INCLUDE DTSITSKL CL*12 00297 CL*12 00298 EJECT DTSBX427 00299 01 ISKL-REC. DTSBX427 00300 ++INCLUDE DTSIISKL DTSBX427 00301 EJECT DTSBX427 00302 PROCEDURE DIVISION. DTSBX427 00303 DTSBX427 00304 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX427 00305 DTSBX427 00306 MOVE 'N' TO X110-EOF-IND. CL**5 00307 DTSBX427 00308 MOVE +0 TO WRK-EMP-NO WRK-TAD-EMP-NO. DTSBX427 00309 DTSBX427 00310 MOVE 'N' TO WRK-MTAD-ZIP-UPDATED-IND. DTSBX427 00311 DTSBX427 00312 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX427 00313 UNTIL X110-EOF-IND = 'Y'. CL**3 00314 DTSBX427 00315 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX427 00316 IF W-ERROR-YES-88 CL*18 00317 MOVE 02 TO RETURN-CODE. CL*36 00318 DTSBX427 00319 GOBACK. DTSBX427 00320 EJECT DTSBX427 00321 DTSBX427 00322 I0000-INITIATE. DTSBX427 00323 PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBX427 00324 DTSBX427 00325 PERFORM S921-OPEN-UPDATE THRU S921-EXIT. DTSBX427 00326 DTSBX427 00327 PERFORM S927A-OPEN-UPDATE THRU S927A-EXIT. CL*19 00328 CL*16 00329 OPEN INPUT ESSP-X110-FILE. CL**6 00330 OPEN OUTPUT REPT-PAID-FILE REPT-PEND-FILE. CL*75 00331 DTSBX427 00332 WRITE REPT-PAID-REC FROM HEADER-3 CL*82 00333 AFTER ADVANCING TOP-OF-PAGE CL*82 00334 CL*82 00335 WRITE REPT-PAID-REC FROM HEADER-43 CL*83 00336 AFTER ADVANCING 2 LINE. CL*85 00337 WRITE REPT-PAID-REC FROM BLANK-LINE CL*85 00338 AFTER ADVANCING 1 LINE. CL*85 00339 MOVE +0 TO WRK-MPRF-UPD-CNT CL*19 00340 W-T002-ADDR-CNT CL*30 00341 WRK-MTAD-UPD-CNT CL*19 00342 WRK-MPRF-NOT-CNT CL*20 00343 WRK-MPRF-ADD-CNT CL*19 00344 WRK-MTAD-ADD-CNT CL*19 00345 WRK-MDCD-ADD-CNT CL*26 00346 WRK-MDCD-UPD-CNT CL*26 00347 WRK-MLOG-REC-CNT CL*26 00348 WRK-X110-REC-CNT. CL**5 00349 DTSBX427 00350 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX427 00351 DTSBX427 00352 MOVE +0 TO MSKL-EMP-NO. DTSBX427 00353 DTSBX427 00354 SET MSKL-HDR-88 TO TRUE. DTSBX427 00355 DTSBX427 00356 PERFORM S910-READ THRU S910-EXIT. DTSBX427 00357 DTSBX427 00358 IF L910-NO-REC-88 DTSBX427 00359 MOVE 'MHDR RECORD NOT FOUND' TO ABEND-MSG DTSBX427 00360 PERFORM S999-ABEND THRU S999-EXIT. DTSBX427 00361 DTSBX427 00362 MOVE MSKL-REC TO MHDR-REC. DTSBX427 00363 DTSBX427 00364 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX427 00365 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. DTSBX427 00366 MOVE LENGTH OF R140-REC TO R140-LENGTH. CL*18 00367 MOVE '140' TO R140-REC-TYPE. CL*18 00368 DTSBX427 00369 I0000-EXIT. DTSBX427 00370 EXIT. DTSBX427 00371 DTSBX427 00372 P0000-PROCESS. DTSBX427 00373 READ ESSP-X110-FILE INTO X110-REC CL*66 00374 AT END DTSBX427 00375 MOVE 'Y' TO X110-EOF-IND CL**3 00376 PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT DTSBX427 00377 GO TO P0000-EXIT. DTSBX427 00378 DTSBX427 00379 ADD +1 TO WRK-X110-REC-CNT. CL**3 00380 DTSBX427 00381 DTSBX427 00382 * IF X110-EMP-NO = WRK-EMP-NO OR CL*68 00383 * WRK-X110-REC-CNT = 1 CL*68 00384 * NEXT SENTENCE CL*68 00385 * ELSE CL*68 00386 * PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT CL*68 00387 * IF L910-NO-REC-88 CL*68 00388 * DISPLAY ' EMPL NOT FOUND IN DUTAS ADDR NOT ADDED> ' CL*68 00389 * X110-EMP-NO CL*68 00390 * GO TO P0000-EXIT. CL*68 00391 IF X110-STREET-2 = SPACES CL*72 00392 MOVE X110-STREET-1 TO X110-STREET-2 CL*72 00393 MOVE SPACES TO X110-STREET-1. CL*72 00394 CL*62 00395 MOVE X110-EMP-NO TO WRK-EMP-NO CL*62 00396 MOVE 'N' TO WRK-MTAD-ZIP-UPDATED-IND CL*62 00397 MOVE X110-EMP-NO TO L331-EMP-NO CL*62 00398 MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE CL*62 00399 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL*62 00400 MOVE 'WEBESSP ' TO L331-OP-ID. CL*62 00401 DTSBX427 00402 MOVE LOW-VALUES TO MTAD-KEY-AREA. CL**4 00403 IF X110-ADDR-TYPE-MAIL-88 CL**3 00404 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE CL**3 00405 ELSE CL**3 00406 IF X110-ADDR-TYPE-RECS-88 CL**3 00407 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE CL**3 00408 ELSE CL**3 00409 SET W-ERROR-YES-88 TO TRUE CL*18 00410 MOVE SPACES TO R140-MESSAGE CL*18 00411 MOVE WRK-EMP-NO TO R140-EMP-NO CL*19 00412 STRING CL*18 00413 'X427 INV ADDR CODE ON X110 ADDR REC ' X110-ADDR-TYPE CL*19 00414 DELIMITED BY SIZE CL*18 00415 INTO R140-MESSAGE CL*18 00416 END-STRING CL*18 00417 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*18 00418 GO TO P0000-EXIT. CL**3 00419 CL**3 00420 IF MTAD-ID-TAX-RECORDS-ADDR-88 AND X110-STATE NOT = 'DC' CL*42 00421 SET W-ERROR-YES-88 TO TRUE CL*34 00422 MOVE SPACES TO R140-MESSAGE CL*34 00423 MOVE WRK-EMP-NO TO R140-EMP-NO CL*34 00424 STRING CL*34 00425 'X427 STATE NOT DC FOR DC ADDRESS ' X110-STATE CL*34 00426 DELIMITED BY SIZE CL*34 00427 INTO R140-MESSAGE CL*34 00428 END-STRING CL*34 00429 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*34 00430 GO TO P0000-EXIT. CL*34 00431 CL*34 00432 MOVE ZEROS TO UPD-MTAD-IND CL**5 00433 CL**5 00434 DISPLAY '+++++++ CHECKING FOR ADDRESS UPDATES: ' X110-EMP-NO. CL*57 00435 PERFORM P1000-MTAD-UPDATE THRU P1000-EXIT. CL**3 00436 CL*78 00437 MOVE X110-EMP-NO TO X427-EMP-NO. CL*78 00438 MOVE X110-ADDR-TYPE TO X427-TYPE CL*78 00439 MOVE X110-ATTENTION TO X427-ATTN CL*78 00440 MOVE X110-STREET-1 TO X427-LINE1 CL*78 00441 MOVE X110-STREET-2 TO X427-LINE2 CL*78 00442 MOVE X110-CITY TO X427-CITY CL*78 00443 MOVE X110-STATE TO X427-STATE. CL*78 00444 MOVE X110-ZIP TO X427-ZIP. CL*78 00445 MOVE X110-EMAIL TO X427-EMAIL. CL*78 00446 MOVE X110-QAS-FLAG TO X427-QAS. CL*78 00447 WRITE REPT-PAID-REC FROM DETAIL-LINE-1. CL*78 00448 CL**3 00449 P0000-EXIT. DTSBX427 00450 EXIT. DTSBX427 00451 DTSBX427 00452 P1000-MTAD-UPDATE. DTSBX427 00453 DTSBX427 00454 * MOVE LOW-VALUES TO MTAD-KEY-AREA. CL*43 00455 MOVE X110-EMP-NO TO WRK-TAD-EMP-NO WRK-EMP-NO. CL*44 00456 DTSBX427 00457 MOVE WRK-TAD-EMP-NO TO MTAD-EMP-NO. DTSBX427 00458 SET MTAD-TAD-88 TO TRUE. DTSBX427 00459 CL**3 00460 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX427 00461 DTSBX427 00462 PERFORM S910-READ THRU S910-EXIT. DTSBX427 00463 DTSBX427 00464 IF L910-NO-REC-88 DTSBX427 00465 * DISPLAY 'MTAD NOT FOUND ' MTAD-KEY-AREA CL*57 00466 MOVE SPACES TO R140-MESSAGE CL*18 00467 MOVE WRK-EMP-NO TO R140-EMP-NO CL*19 00468 IF X110-ADDR-TYPE-MAIL-88 CL*37 00469 DISPLAY '------ X427 MAIL ADDR NOT IN DUTAS -ADDED ' CL*57 00470 X110-EMP-NO CL*45 00471 STRING CL*18 00472 'X427 MAIL ADDR NOT IN DUTAS -ADDED ' CL*37 00473 X110-EMP-NO CL*37 00474 DELIMITED BY SIZE CL*18 00475 INTO R140-MESSAGE CL*18 00476 END-STRING CL*18 00477 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*18 00478 PERFORM P1050-MTAD-ADD THRU P1050-EXIT CL*18 00479 PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT CL*68 00480 GO TO P1000-EXIT CL*37 00481 ELSE CL*38 00482 DISPLAY '----- X427 DC ADDR NOT IN DUTAS -ADDED ' CL*57 00483 X110-EMP-NO CL*45 00484 STRING CL*37 00485 'X427 DC ADDR NOT IN DUTAS -ADDED ' CL*37 00486 X110-EMP-NO CL*37 00487 DELIMITED BY SIZE CL*37 00488 INTO R140-MESSAGE CL*37 00489 END-STRING CL*37 00490 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*37 00491 PERFORM P1050-MTAD-ADD THRU P1050-EXIT CL*37 00492 GO TO P1000-EXIT. CL*37 00493 CL*18 00494 MOVE MSKL-REC TO MTAD-REC. DTSBX427 00495 DTSBX427 00496 MOVE X110-ZIP TO WRK-ZIP. CL**3 00497 DTSBX427 00498 IF WRK-ZIP = MTAD-ZIP CL**3 00499 MOVE 'N' TO WRK-MTAD-ZIP-UPDATED-IND CL**3 00500 ELSE DTSBX427 00501 MOVE 'Y' TO WRK-MTAD-ZIP-UPDATED-IND. DTSBX427 00502 DTSBX427 00503 MOVE ZEROS TO UPD-MTAD-IND. CL*32 00504 CL*32 00505 PERFORM P1100-CHECK-FOR-MLOG THRU P1100-EXIT. DTSBX427 00506 DTSBX427 00507 DTSBX427 00508 IF UPD-MTAD-IND = 1 CL**5 00509 DISPLAY '===== DUTAS ADDRESS UPDATED ' X110-EMP-NO CL*56 00510 MOVE MHDR-CURR-RUN-DATE TO MTAD-CHNG-DATE CL**5 00511 MOVE MTAD-REC TO MSKL-REC CL**5 00512 PERFORM S910-REWRITE THRU S910-EXIT CL*68 00513 PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT. CL*68 00514 DTSBX427 00515 P1000-EXIT. DTSBX427 00516 EXIT. DTSBX427 00517 DTSBX427 00518 P1050-MTAD-ADD. CL*11 00519 MOVE +0 TO WRK-MTAD-MAIL-ADD-CNT. CL*51 00520 IF X110-ADDR-TYPE-MAIL-88 CL*35 00521 ADD +1 TO WRK-MTAD-ADD-CNT CL*18 00522 MOVE +1 TO WRK-MTAD-MAIL-ADD-CNT CL*51 00523 * DISPLAY '<<< X427--ADDIN T002 MAIL ADDR ' WRK-EMP-NO CL*57 00524 ELSE CL*18 00525 * DISPLAY '<<< X427--ADDIN T002 DC ADDR ' WRK-EMP-NO CL*57 00526 ADD +1 TO WRK-MDCD-ADD-CNT. CL*18 00527 CL*18 00528 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*13 00529 MOVE LOW-VALUES TO T002-REC. CL*11 00530 CL*11 00531 SET T002-LENGTH-EMP-ADDR-88 TO TRUE. CL*11 00532 MOVE '002' TO T002-REC-TYPE. CL*11 00533 MOVE X110-EMP-NO TO T002-EMP-NO. CL*13 00534 MOVE 'WEB ESSP ' TO T002-ORIGIN. CL*12 00535 MOVE L005-DATE TO T002-SYS-DATE. CL*13 00536 MOVE L005-TIME TO T002-SYS-TIME. CL*13 00537 CL*11 00538 MOVE X110-ADDR-TYPE TO Y110-EMP-ADDR-TYPE. CL*11 00539 CL*47 00540 IF X110-ATTENTION > SPACES CL*47 00541 MOVE X110-ATTENTION TO L009-DATA CL*47 00542 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*47 00543 MOVE L009-DATA TO Y110-EMP-ATTN CL*49 00544 ELSE CL*47 00545 MOVE X110-ATTENTION TO Y110-EMP-ATTN. CL*11 00546 CL*47 00547 IF X110-STREET-1 > SPACES CL*47 00548 MOVE X110-STREET-1 TO L009-DATA CL*47 00549 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*47 00550 MOVE L009-DATA TO Y110-EMP-DELV1 CL*47 00551 ELSE CL*47 00552 MOVE X110-STREET-1 TO Y110-EMP-DELV1. CL*11 00553 CL*47 00554 IF X110-STREET-2 > SPACES CL*47 00555 MOVE X110-STREET-2 TO L009-DATA CL*47 00556 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*47 00557 MOVE L009-DATA TO Y110-EMP-DELV2 CL*47 00558 ELSE CL*47 00559 MOVE X110-STREET-2 TO Y110-EMP-DELV2. CL*11 00560 CL*47 00561 IF X110-CITY > SPACES CL*47 00562 MOVE X110-CITY TO L009-DATA CL*47 00563 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*47 00564 MOVE L009-DATA TO Y110-EMP-CITY CL*47 00565 ELSE CL*47 00566 MOVE X110-CITY TO Y110-EMP-CITY. CL*11 00567 CL*47 00568 IF X110-STATE > SPACES CL*47 00569 MOVE X110-STATE TO L009-DATA CL*47 00570 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*47 00571 MOVE L009-DATA TO Y110-EMP-STATE CL*47 00572 ELSE CL*47 00573 MOVE X110-STATE TO Y110-EMP-STATE. CL*11 00574 * MOVE X110-STATE TO Y110-EMP-STATE. CL*51 00575 MOVE X110-ZIP TO Y110-EMP-ZIP. CL*11 00576 MOVE X110-PHONE TO Y110-EMP-VOICE. CL*11 00577 MOVE X110-FAX TO Y110-EMP-FAX. CL*11 00578 MOVE X110-EMAIL TO Y110-EMP-EMAIL. CL*11 00579 MOVE Y110-REC TO T002-DATA-AREA. CL*11 00580 SET T002-EMP-ADDR-88 TO TRUE. CL*11 00581 MOVE T002-REC TO TSKL-REC. CL*11 00582 PERFORM S927B-WRITE THRU S927B-EXIT. CL*11 00583 ADD +1 TO W-T002-ADDR-CNT. CL*11 00584 CL*11 00585 P1050-EXIT. CL*11 00586 EXIT. CL*11 00587 CL*11 00588 P1100-CHECK-FOR-MLOG. DTSBX427 00589 DTSBX427 00590 MOVE 0 TO WRK-MTAD-MAIL-UPD-CNT. CL*55 00591 ADD +100 TO WRK-ABSTIME CL*29 00592 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*27 00593 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL*27 00594 MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO CL*44 00595 MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE CL*27 00596 ADD WRK-ABSTIME TO WRK-SYS-ABSTIME. CL*29 00597 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL*27 00598 MOVE 'WEBESSP ' TO L331-OP-ID. CL*41 00599 CL*24 00600 IF MTAD-ID-TAX-MAILING-ADDR-88 DTSBX427 00601 MOVE 'MAILING ADDRESS' TO L331-REC-OCC-ID DTSBX427 00602 * ADD +1 TO WRK-MTAD-ADD-CNT CL*46 00603 ELSE DTSBX427 00604 IF MTAD-ID-TAX-RECORDS-ADDR-88 DTSBX427 00605 MOVE 'RECORDS ADDRESS' TO L331-REC-OCC-ID DTSBX427 00606 * ADD +1 TO WRK-MDCD-ADD-CNT CL*46 00607 ELSE DTSBX427 00608 MOVE MTAD-ID-NO TO WRK-ID-NO-9 DTSBX427 00609 MOVE WRK-ID-NO-X TO L331-REC-OCC-ID. DTSBX427 00610 DTSBX427 00611 MOVE X110-ATTENTION TO L009-DATA CL*69 00612 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*69 00613 MOVE L009-DATA TO X110-ATTENTION CL*69 00614 IF X110-ATTENTION = MTAD-ATTN-LINE CL**5 00615 NEXT SENTENCE DTSBX427 00616 ELSE DTSBX427 00617 MOVE 'MTAD-ATTENTION ' TO L331-FIELD-NAME CL**3 00618 MOVE MTAD-ATTN-LINE TO L331-FROM-VALUE CL**5 00619 DISPLAY 'MTAD-ATTENTION B ' MTAD-ATTN-LINE CL**7 00620 MOVE X110-ATTENTION TO L331-TO-VALUE CL**4 00621 MOVE X110-ATTENTION TO MTAD-ATTN-LINE CL**5 00622 DISPLAY 'MTAD-ATTENTION A ' X110-ATTENTION CL**7 00623 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 00624 MOVE 1 TO UPD-MTAD-IND CL**5 00625 ADD +1 TO WRK-MLOG-REC-CNT. DTSBX427 00626 DTSBX427 00627 CL**3 00628 MOVE X110-STREET-1 TO L009-DATA CL*69 00629 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*69 00630 MOVE L009-DATA TO X110-STREET-1 CL*69 00631 IF X110-STREET-1 = MTAD-DELIV-LINE-1 CL**6 00632 NEXT SENTENCE CL**3 00633 ELSE CL**3 00634 MOVE 'MTAD-DELIV-LINE-1' TO L331-FIELD-NAME CL**4 00635 MOVE MTAD-DELIV-LINE-1 TO L331-FROM-VALUE CL**4 00636 DISPLAY 'MTAD-DELV LIN1 B ' MTAD-DELIV-LINE-1 CL**7 00637 MOVE X110-STREET-1 TO MTAD-DELIV-LINE-1 CL**6 00638 MOVE X110-STREET-1 TO L331-TO-VALUE CL*52 00639 DISPLAY 'MTAD-DELV LIN1 A ' X110-STREET-1 CL**7 00640 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 00641 MOVE 1 TO UPD-MTAD-IND CL**5 00642 ADD +1 TO WRK-MLOG-REC-CNT. CL**3 00643 CL**3 00644 MOVE X110-STREET-2 TO L009-DATA CL*69 00645 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*69 00646 MOVE L009-DATA TO X110-STREET-2 CL*69 00647 CL**4 00648 IF X110-STREET-2 = MTAD-DELIV-LINE-2 CL**6 00649 NEXT SENTENCE CL**4 00650 ELSE CL**4 00651 MOVE 'MTAD-DELIV-LINE-2' TO L331-FIELD-NAME CL**4 00652 MOVE MTAD-DELIV-LINE-2 TO L331-FROM-VALUE CL**4 00653 DISPLAY 'MTAD-DELV LIN2 B ' MTAD-DELIV-LINE-2 CL**7 00654 MOVE X110-STREET-2 TO L331-TO-VALUE CL**6 00655 MOVE X110-STREET-2 TO MTAD-DELIV-LINE-2 CL**6 00656 DISPLAY 'MTAD-DELV LIN3 A ' X110-STREET-2 CL**7 00657 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 00658 MOVE 1 TO UPD-MTAD-IND CL**5 00659 ADD +1 TO WRK-MLOG-REC-CNT. CL**4 00660 CL**4 00661 MOVE X110-CITY TO L009-DATA CL*69 00662 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*69 00663 MOVE L009-DATA TO X110-CITY CL*69 00664 IF X110-CITY = MTAD-CITY CL**4 00665 NEXT SENTENCE DTSBX427 00666 ELSE DTSBX427 00667 MOVE 'MTAD-CITY' TO L331-FIELD-NAME DTSBX427 00668 MOVE MTAD-CITY TO L331-FROM-VALUE DTSBX427 00669 DISPLAY 'MTAD-CITY B ' MTAD-CITY CL**7 00670 MOVE X110-CITY TO L331-TO-VALUE CL**6 00671 MOVE X110-CITY TO MTAD-CITY CL**6 00672 DISPLAY 'MTAD-CITY A ' X110-CITY CL**7 00673 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 00674 MOVE 1 TO UPD-MTAD-IND CL**5 00675 ADD +1 TO WRK-MLOG-REC-CNT. DTSBX427 00676 DTSBX427 00677 MOVE X110-STATE TO L009-DATA CL*69 00678 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*69 00679 MOVE L009-DATA TO X110-STATE CL*69 00680 IF X110-STATE = MTAD-ST CL**4 00681 NEXT SENTENCE DTSBX427 00682 ELSE DTSBX427 00683 MOVE 'MTAD-ST' TO L331-FIELD-NAME DTSBX427 00684 MOVE MTAD-ST TO L331-FROM-VALUE DTSBX427 00685 DISPLAY 'MTAD-STATE B ' MTAD-ST CL**7 00686 MOVE X110-STATE TO L331-TO-VALUE CL**4 00687 MOVE X110-STATE TO MTAD-ST CL**5 00688 DISPLAY 'MTAD-STATE A ' X110-STATE CL**7 00689 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 00690 MOVE 1 TO UPD-MTAD-IND CL**5 00691 ADD +1 TO WRK-MLOG-REC-CNT. DTSBX427 00692 DTSBX427 00693 IF WRK-ZIP = MTAD-ZIP CL**4 00694 NEXT SENTENCE DTSBX427 00695 ELSE DTSBX427 00696 MOVE 'MTAD-ZIP' TO L331-FIELD-NAME DTSBX427 00697 MOVE MTAD-ZIP TO L331-FROM-VALUE DTSBX427 00698 DISPLAY 'MTAD-ZIP B ' MTAD-ZIP CL**7 00699 MOVE WRK-ZIP TO L331-TO-VALUE CL**4 00700 MOVE WRK-ZIP TO MTAD-ZIP CL**6 00701 DISPLAY 'MTAD-ZIP A ' MTAD-ZIP CL*38 00702 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 00703 MOVE 1 TO UPD-MTAD-IND CL**6 00704 ADD +1 TO WRK-MLOG-REC-CNT. DTSBX427 00705 DTSBX427 00706 P1100-CHECK-EMAIL. CL*91 00707 IF X110-EMAIL = SPACES CL*91 00708 GO TO P1100-CHECK-PHONE. CL*91 00709 CL*91 00710 IF X110-EMAIL = MTAD-EMAIL-ADDRESS CL*91 00711 NEXT SENTENCE CL**4 00712 ELSE CL**4 00713 MOVE 'MTAD-EMAIL ADDR' TO L331-FIELD-NAME CL**4 00714 MOVE MTAD-EMAIL-ADDRESS TO L331-FROM-VALUE CL**4 00715 DISPLAY 'MTAD-EMAIL B ' MTAD-EMAIL-ADDRESS CL**7 00716 MOVE X110-EMAIL TO L331-TO-VALUE CL**4 00717 MOVE X110-EMAIL TO MTAD-EMAIL-ADDRESS CL**5 00718 DISPLAY 'MTAD-EMAIL A ' X110-EMAIL CL**7 00719 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 00720 MOVE 1 TO UPD-MTAD-IND CL**5 00721 ADD +1 TO WRK-MLOG-REC-CNT. CL**4 00722 CL*38 00723 P1100-CHECK-PHONE. CL*91 00724 IF X110-PHONE = SPACES CL*91 00725 GO TO P1100-CHECK-MTAD. CL*91 00726 CL*91 00727 IF X110-PHONE = MTAD-VOICE-1 CL*90 00728 NEXT SENTENCE CL*90 00729 ELSE CL*90 00730 MOVE 'MTAD-PHONE ' TO L331-FIELD-NAME CL*90 00731 MOVE MTAD-VOICE-1 TO L331-FROM-VALUE CL*90 00732 DISPLAY 'MTAD-PHONE B ' MTAD-VOICE-1 CL*90 00733 MOVE X110-PHONE TO L331-TO-VALUE CL*90 00734 MOVE X110-PHONE TO MTAD-VOICE-1 CL*90 00735 DISPLAY 'MTAD-PHONE A ' X110-PHONE CL*90 00736 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*90 00737 MOVE 1 TO UPD-MTAD-IND CL*90 00738 ADD +1 TO WRK-MLOG-REC-CNT. CL*90 00739 CL*90 00740 P1100-CHECK-MTAD. CL*91 00741 IF UPD-MTAD-IND = 0 CL*38 00742 GO TO P1100-EXIT. CL*39 00743 CL*38 00744 IF X110-ADDR-TYPE-MAIL-88 CL*38 00745 MOVE +1 TO WRK-MTAD-MAIL-UPD-CNT CL*51 00746 DISPLAY '<<<< ---X427 DUTAS MAILING ADDR ' WRK-EMP-NO CL*55 00747 STRING CL*38 00748 'X427 DUTAS MAILING ADDRESS ' CL*38 00749 X110-EMP-NO CL*38 00750 DELIMITED BY SIZE CL*38 00751 INTO R140-MESSAGE CL*38 00752 END-STRING CL*38 00753 MOVE WRK-EMP-NO TO R140-EMP-NO CL*44 00754 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*38 00755 ADD +1 TO WRK-MTAD-UPD-CNT CL*46 00756 ELSE CL*38 00757 DISPLAY '<<<< ---X427 DUTAS DC WORK ADDR ' WRK-EMP-NO CL*55 00758 STRING CL*38 00759 'X427 DUTAS DC ADDRESS ' CL*38 00760 X110-EMP-NO CL*38 00761 DELIMITED BY SIZE CL*38 00762 INTO R140-MESSAGE CL*38 00763 END-STRING CL*38 00764 MOVE WRK-EMP-NO TO R140-EMP-NO CL*44 00765 ADD +1 TO WRK-MDCD-UPD-CNT CL*46 00766 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL*38 00767 CL**4 00768 P1100-EXIT. DTSBX427 00769 EXIT. DTSBX427 00770 DTSBX427 00771 P2000-EMP-NO-BREAK. DTSBX427 00772 CL*33 00773 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX427 00774 DTSBX427 00775 DISPLAY 'OLDE ' WRK-EMP-NO ' NEWE ' X110-EMP-NO. CL*65 00776 MOVE WRK-EMP-NO TO MSKL-EMP-NO. CL*65 00777 DTSBX427 00778 SET MSKL-PRF-88 TO TRUE. DTSBX427 00779 DTSBX427 00780 PERFORM S910-READ THRU S910-EXIT. DTSBX427 00781 DTSBX427 00782 IF L910-NO-REC-88 DTSBX427 00783 MOVE SPACES TO R140-MESSAGE CL*18 00784 MOVE X110-EMP-NO TO R140-EMP-NO CL*32 00785 STRING CL*18 00786 'X427 NO EMPLOYER PROFILE FOUND IN DUTAS >>>> ' CL*37 00787 X110-EMP-NO CL*37 00788 DELIMITED BY SIZE CL*18 00789 INTO R140-MESSAGE CL*18 00790 END-STRING CL*18 00791 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*18 00792 ADD +1 TO WRK-MPRF-NOT-CNT CL*18 00793 GO TO P2000-EXIT. CL*31 00794 CL*18 00795 MOVE MSKL-REC TO MPRF-REC. DTSBX427 00796 MOVE 0 TO WRK-MPRF-MAIL-UPD-CNT. CL*55 00797 CL*54 00798 DISPLAY ' MPRF: ' WRK-EMP-NO CL*65 00799 ' MUPD: ' WRK-MTAD-MAIL-UPD-CNT CL*56 00800 ' MADD: ' WRK-MTAD-MAIL-ADD-CNT CL*55 00801 ' MIND: ' MPRF-RETURN-MAIL-IND. CL*55 00802 CL*51 00803 * IF MPRF-RETURN-MAIL-IND = 'N' CL*74 00804 * GO TO P2000-EMP-CONTINUE. CL*74 00805 CL*70 00806 IF WRK-MTAD-MAIL-UPD-CNT = 1 OR CL*70 00807 WRK-MTAD-MAIL-ADD-CNT = 1 CL*59 00808 ADD +100 TO WRK-ABSTIME CL*51 00809 PERFORM S005-FROM-SYS THRU S005-EXIT CL*51 00810 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME CL*51 00811 MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO CL*51 00812 MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE CL*51 00813 ADD WRK-ABSTIME TO WRK-SYS-ABSTIME CL*51 00814 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL*51 00815 MOVE 'WEBESSP ' TO L331-OP-ID CL*51 00816 MOVE 'RETURN MAIL IND' TO L331-FIELD-NAME CL*51 00817 MOVE MPRF-RETURN-MAIL-IND TO L331-FROM-VALUE CL*51 00818 MOVE 'N' TO L331-TO-VALUE CL*52 00819 MOVE 'N' TO MPRF-RETURN-MAIL-IND CL*52 00820 MOVE +1 TO WRK-MPRF-MAIL-UPD-CNT CL*51 00821 DISPLAY ' RETURN MAIL UPDATED: ' WRK-EMP-NO CL*52 00822 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*51 00823 CL*51 00824 IF MTAD-UC223-IND = 'N' CL*70 00825 ADD +100 TO WRK-ABSTIME CL*70 00826 PERFORM S005-FROM-SYS THRU S005-EXIT CL*70 00827 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME CL*70 00828 MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO CL*70 00829 MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE CL*70 00830 ADD WRK-ABSTIME TO WRK-SYS-ABSTIME CL*70 00831 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL*70 00832 MOVE 'WEBESSP ' TO L331-OP-ID CL*70 00833 MOVE 'DEBIT MEMO IND ' TO L331-FIELD-NAME CL*70 00834 MOVE MTAD-UC223-IND TO L331-FROM-VALUE CL*70 00835 MOVE 'Y' TO L331-TO-VALUE CL*70 00836 MOVE 'Y' TO MTAD-UC223-IND CL*71 00837 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*70 00838 CL*70 00839 IF MTAD-MISSING-RPT-LETTERS-IND = 'N' CL*71 00840 ADD +100 TO WRK-ABSTIME CL*70 00841 PERFORM S005-FROM-SYS THRU S005-EXIT CL*70 00842 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME CL*70 00843 MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO CL*70 00844 MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE CL*70 00845 ADD WRK-ABSTIME TO WRK-SYS-ABSTIME CL*70 00846 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL*70 00847 MOVE 'WEBESSP ' TO L331-OP-ID CL*70 00848 MOVE 'MISS RPT LETTER' TO L331-FIELD-NAME CL*70 00849 MOVE MTAD-MISSING-RPT-LETTERS-IND TO L331-FROM-VALUE CL*73 00850 MOVE 'Y' TO L331-TO-VALUE CL*70 00851 MOVE 'Y' TO MTAD-MISSING-RPT-LETTERS-IND CL*71 00852 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*70 00853 CL*70 00854 DTSBX427 00855 P2000-EMP-CONTINUE. CL*70 00856 MOVE MPRF-EMP-NO TO L203-EMP-NO. DTSBX427 00857 DTSBX427 00858 MOVE MPRF-TAX-REC-ADDR-EXISTS-IND DTSBX427 00859 TO L203-TAX-REC-ADDR-EXISTS-IND. DTSBX427 00860 DTSBX427 00861 PERFORM S203-FIELD-ZIP-CODE THRU S203-EXIT. DTSBX427 00862 DTSBX427 00863 * IF L203-OK-88 CL*56 00864 * NEXT SENTENCE CL*56 00865 * ELSE CL*56 00866 * GO TO P2000-EXIT. CL*56 00867 DTSBX427 00868 DISPLAY 'Z203: ' L203-FLD-ZIP ' ' L203-FLD-STATE CL*61 00869 ' MPRF: ' MPRF-FLD-ZIP ' ' MPRF-FLD-ST CL*60 00870 ' MAIL: ' WRK-MPRF-MAIL-UPD-CNT. CL*60 00871 IF ((L203-FLD-ZIP = MPRF-FLD-ZIP) AND CL*60 00872 (L203-FLD-STATE = MPRF-FLD-ST) AND CL*56 00873 (WRK-MPRF-MAIL-UPD-CNT = 0)) CL*60 00874 GO TO P2000-EXIT CL*56 00875 ELSE CL*56 00876 MOVE L203-FLD-ZIP TO MPRF-FLD-ZIP CL*56 00877 MOVE L203-FLD-STATE TO MPRF-FLD-ST. DTSBX427 00878 DTSBX427 00879 MOVE MHDR-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSBX427 00880 DTSBX427 00881 MOVE MPRF-REC TO MSKL-REC. DTSBX427 00882 DTSBX427 00883 PERFORM S910-REWRITE THRU S910-EXIT. DTSBX427 00884 ADD +1 TO WRK-MPRF-UPD-CNT. CL*18 00885 DTSBX427 00886 P2000-EXIT. DTSBX427 00887 EXIT. DTSBX427 00888 DTSBX427 00889 CL**3 00890 T0000-TERMINATE. DTSBX427 00891 DISPLAY DTSBX427 00892 '*** DTSBX427 TERMINATION STATISTICS'. CL**2 00893 DTSBX427 00894 DISPLAY ' '. DTSBX427 00895 DTSBX427 00896 DISPLAY DTSBX427 00897 '*** NUMBER OF X110 FILE RECORDS READ : ' CL**5 00898 WRK-X110-REC-CNT. CL**5 00899 MOVE WRK-X110-REC-CNT TO WS-X110-PEN-CNT. CL*87 00900 DTSBX427 00901 DISPLAY ' '. DTSBX427 00902 DTSBX427 00903 DISPLAY DTSBX427 00904 '*** NUMBER OF PROFILE RECORDS NOT FOUND : ' CL*40 00905 WRK-MPRF-NOT-CNT. CL*18 00906 DTSBX427 00907 DISPLAY CL*18 00908 '*** NUMBER OF PROFILE RECORDS UPDATED : ' CL*40 00909 WRK-MPRF-UPD-CNT. CL*18 00910 CL*18 00911 DISPLAY DTSBX427 00912 '*** NUMBER OF MAIL RECORDS ADDED : ' CL*18 00913 WRK-MTAD-ADD-CNT. CL*18 00914 DTSBX427 00915 DISPLAY CL*20 00916 '*** NUMBER OF MAIL RECORDS UPDATED : ' CL*18 00917 WRK-MTAD-UPD-CNT. CL*18 00918 CL*18 00919 DISPLAY CL*18 00920 '*** NUMBER OF DC RECORDS ADDED : ' CL*18 00921 WRK-MDCD-ADD-CNT. CL*18 00922 CL*18 00923 DISPLAY CL*20 00924 '*** NUMBER OF DC RECORDS UPDATED : ' CL*18 00925 WRK-MDCD-UPD-CNT. CL*18 00926 CL*18 00927 DISPLAY DTSBX427 00928 '*** NUMBER OF MLOG RECORDS WRITTEN : ' DTSBX427 00929 WRK-MLOG-REC-CNT. DTSBX427 00930 DTSBX427 00931 DTSBX427 00932 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX427 00933 DTSBX427 00934 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX427 00935 PERFORM S927C-CLOSE THRU S927C-EXIT. CL*20 00936 DTSBX427 00937 WRITE REPT-PAID-REC FROM FOOTING-LINE-51 AFTER ADVANCING 3. CL*87 00938 WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER ADVANCING 2. CL*87 00939 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER ADVANCING 2. CL*87 00940 CLOSE ESSP-X110-FILE REPT-PAID-FILE REPT-PEND-FILE. CL*75 00941 T0000-EXIT. DTSBX427 00942 EXIT. DTSBX427 00943 EJECT DTSBX427 00944 S005-FROM-SYS. DTSBX427 00945 SET L005-FROM-SYS TO TRUE. DTSBX427 00946 GO TO S005-ABSTIME. DTSBX427 00947 DTSBX427 00948 S005-FROM-ABSTIME. DTSBX427 00949 SET L005-FROM-ABSTIME TO TRUE. DTSBX427 00950 GO TO S005-ABSTIME. DTSBX427 00951 DTSBX427 00952 S005-ABSTIME. DTSBX427 00953 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX427 00954 S005-EXIT. DTSBX427 00955 EXIT. DTSBX427 00956 SKIP3 DTSBX427 00957 S203-FIELD-ZIP-CODE. DTSBX427 00958 CALL 'DTSBU203' USING L203-LINK-AREA. DTSBX427 00959 S203-EXIT. DTSBX427 00960 EXIT. DTSBX427 00961 SKIP3 DTSBX427 00962 S009-CONVERT-TO-CAPS. CL*47 00963 CALL 'DTSBU009' USING L009-LINK-AREA. CL*47 00964 S009-EXIT. CL*47 00965 EXIT. CL*47 00966 SKIP3 CL*47 00967 S331-WRITE-MLOG. DTSBX427 00968 CALL 'DTSBU331' USING L331-LINK-AREA. DTSBX427 00969 S331-EXIT. DTSBX427 00970 EXIT. DTSBX427 00971 SKIP3 DTSBX427 00972 S910-OPEN-UPDATE. DTSBX427 00973 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX427 00974 GO TO S910-MSTR-CALL. DTSBX427 00975 DTSBX427 00976 S910-READ. DTSBX427 00977 SET L910-READ-88 TO TRUE. DTSBX427 00978 GO TO S910-MSTR-CALL. DTSBX427 00979 DTSBX427 00980 S910-START-BROWSE. DTSBX427 00981 SET L910-START-BROWSE-88 TO TRUE. DTSBX427 00982 GO TO S910-MSTR-CALL. DTSBX427 00983 DTSBX427 00984 S910-READ-NEXT. DTSBX427 00985 SET L910-READ-NEXT-88 TO TRUE. DTSBX427 00986 GO TO S910-MSTR-CALL. DTSBX427 00987 DTSBX427 00988 *S910-COUNT. DTSBX427 00989 *****SET L910-COUNT-88 TO TRUE. DTSBX427 00990 *****GO TO S910-MSTR-CALL. DTSBX427 00991 DTSBX427 00992 S910-REWRITE. DTSBX427 00993 SET L910-REWRITE-88 TO TRUE. DTSBX427 00994 GO TO S910-MSTR-CALL. DTSBX427 00995 DTSBX427 00996 S910-CLOSE. DTSBX427 00997 SET L910-CLOSE-88 TO TRUE. DTSBX427 00998 GO TO S910-MSTR-CALL. DTSBX427 00999 DTSBX427 01000 S910-MSTR-CALL. DTSBX427 DISPLAY 'L910-LINK-AREA-' L910-LINK-AREA DISPLAY 'MSKL-REC-' MSKL-REC 01001 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX427 01002 MSKL-REC. DTSBX427 01003 S910-EXIT. DTSBX427 01004 EXIT. DTSBX427 01005 SKIP3 DTSBX427 01006 S921-OPEN-UPDATE. DTSBX427 01007 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBX427 01008 GO TO S921-AIX-IO. DTSBX427 01009 DTSBX427 01010 S921-CLOSE. DTSBX427 01011 SET L921-CLOSE-88 TO TRUE. DTSBX427 01012 GO TO S921-AIX-IO. DTSBX427 01013 DTSBX427 01014 S921-AIX-IO. DTSBX427 01015 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX427 01016 ISKL-REC. DTSBX427 01017 S921-EXIT. DTSBX427 01018 EXIT. DTSBX427 01019 SKIP3 DTSBX427 01020 S927A-OPEN-UPDATE. CL*19 01021 SET L927-OPEN-UPDATE-88 TO TRUE. CL*19 01022 PERFORM S927Z-IO THRU S927Z-EXIT. CL*19 01023 S927A-EXIT. CL*19 01024 EXIT. CL*19 01025 CL*19 01026 S927B-WRITE. CL*12 01027 SET L927-WRITE-88 TO TRUE. CL*12 01028 PERFORM S927Z-IO THRU S927Z-EXIT. CL*12 01029 CL*12 01030 S927B-EXIT. CL*12 01031 EXIT. CL*12 01032 CL*12 01033 S927C-CLOSE. CL*16 01034 SET L927-CLOSE-88 TO TRUE. CL*16 01035 PERFORM S927Z-IO THRU S927Z-EXIT. CL*16 01036 CL*16 01037 S927C-EXIT. CL*16 01038 EXIT. CL*16 01039 CL*12 01040 S927Z-IO. CL*12 01041 CALL 'DTSBU927' USING L927-LINK-AREA CL*12 01042 TSKL-REC. CL*12 01043 S927Z-EXIT. CL*12 01044 EXIT. CL*12 01045 S946-WRITE-R140. CL*18 01046 CL*18 01047 CALL 'DTSBU946' USING R140-REC. CL*18 01048 CL*18 01049 S946-EXIT. CL*18 01050 EXIT. CL*18 01051 S999-ABEND. DTSBX427 01052 DISPLAY '*** DTSBX427 ABENDING. ' CL**2 01053 ABEND-MSG. DTSBX427 01054 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX427 01055 S999-EXIT. DTSBX427 01056 EXIT. DTSBX427 01057 EJECT DTSBX427