1059 lines
84 KiB
Plaintext
1059 lines
84 KiB
Plaintext
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 <UPD> ' WRK-EMP-NO CL*55
|
|
00747 STRING CL*38
|
|
00748 'X427 DUTAS MAILING ADDRESS <UPDATED> ' 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 <UPD> ' WRK-EMP-NO CL*55
|
|
00758 STRING CL*38
|
|
00759 'X427 DUTAS DC ADDRESS <UPDATED > ' 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
|
|
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
|