00001 IDENTIFICATION DIVISION. 03/18/04 00002 PROGRAM-ID. EFTBD120. EFTBD120 00003 AUTHOR. NORTHROP GRUMMAN. LV147 00004 DATE-WRITTEN. JULY 2003. CL168 00005 DATE-COMPILED. CL146 00006 SKIP3 CL146 00007 ***** CL146 00008 * CL146 00009 * FUNCTION: 1. THIS PROGRAM PROCESSES STATUS UPDATE RECORDS CL198 00010 * FROM THE WEB REPORTING SYSTEM. THE EFTIFEST CL232 00011 * RECORD WHICH CONTAINS THE STATUS OF EACH FIELD CL232 00012 * TO BE CHANGED. CL*50 00013 * 2. IT MATCHES THE EMP-NO WITH THE MTAD MASTER TO CL198 00014 * PRODUCE A BUSINESS T002 STATUS CHANGE REC. ON CL199 00015 * THE FIELDS OF BUSINESS NAME, ADDRESS, TELEPHONE CL232 00016 * NUMBER, OR EMAIL ADDRESS. CL232 00017 * 3. THEN IT MATCHES THE EMP-NO WITH THE MOPO MASTER CL199 00018 * TO PRODUCE A CONTACT T002 STATUS CHANGE REC. ON CL199 00019 * THE FIELDS OF CONTACT NAME, SSN, TITLE, TELEPHONE CL232 00020 * NUMBER, OR FAX NUMBER. CL232 00021 * 4. IT ALSO PRODUCES PRINTED REPORTS FOR OTHER CL198 00022 * STATUS CHANGES. CL180 00023 * CL146 00024 * MODIFICATION LOG: CL146 00025 * CL146 00026 * 07/15/03 INITIAL DEVELOPMENT CL228 00027 * WORK ORDER: PROGRAMMER: RW1 CL**3 00028 * CL**3 00029 * 99/99/99 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3 00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3 00031 * WORK ORDER: PROGRAMMER: XXX CL**3 00032 * CL146 00033 * DESCRIPTION: CL146 00034 * CL146 00035 * INITIATION: CL146 00036 * NONE CL*91 00037 * CL146 00038 * PARAMETERS INPUT: CL*50 00039 * NONE CL*91 00040 * CL*50 00041 * PROCESSING: CL146 00042 * READ THE STATUS UPDATE FILE SEQUENTIALLY FROM GOVONE CL169 00043 * AND MATCHES THE FEST-EMP-NO WITH THE MPRF MASTER FILE, CL170 00044 * MTAD, AND MOPO FILES TO CREATE A T002 STATUS UPDATE CL*55 00045 * FILE FOR ACCOUNT UPDATING PROCESSES. CL*50 00046 * CL181 00047 * TERMINATION: CL146 00048 * OUTPUT STATISTICAL RECORDS COUNT. CL*50 00049 * CL146 00050 * RECORDS READ: CL206 00051 * MASTER: CL**3 00052 * MPRF, MTAD, AND MOPO MASTER FILES. CL*55 00053 * CL**3 00054 * ALTERNATE INDEX: CL146 00055 * YES. CL170 00056 * CL146 00057 * REFERENCE: CL146 00058 * NONE. CL146 00059 * CL146 00060 * REPORT RECORDS WRITTEN: CL146 00061 * STATUS REPORT. CL170 00062 * CL*50 00063 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: CL241 00064 * T002 CL170 00065 * CL146 00066 * MODULES CALLED: CL146 00067 * DTSBU001 DATE CONVERSION/EDIT. CL146 00068 * DTSBU004 QUARERLY SUMMARY REPORT REC. CL*47 00069 * DTSBU910 VSAM MASTER FILES I/O. CL*74 00070 * DTSBU927 VARIABLE LENGTH RECORD BTC OUTPUT. CL166 00071 * DTSBU941 VARIABLE LENGTH RECORD INPUT 1. CL166 00072 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. CL*35 00073 * DTSBU947 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 2. CL*35 00074 * CL146 00075 * VERMONT REFERENCE: CL146 00076 * NONE. CL146 00077 * CL146 00078 ***** CL146 00079 SKIP3 CL*13 00080 ENVIRONMENT DIVISION. CL146 00081 CL211 00082 INPUT-OUTPUT SECTION. CL*58 00083 CL*58 00084 DATA DIVISION. CL*13 00085 CL*58 00086 WORKING-STORAGE SECTION. CL146 000865 77 PAN-VALET PICTURE X(24) VALUE '147EFTBD120 03/18/04'. CL146 00087 CL*40 00088 01 WRK-AREA. CL146 00089 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +120. CL243 00090 05 WRK-MOD-NAME PIC X(08) VALUE 'EFTBD120'. CL243 00091 05 WRK-ABEND-MSG PIC X(60). CL*83 00092 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. CL126 00093 CL*98 00094 05 DISP-DATE PIC X(10) VALUE SPACES. CL*92 00095 05 DISP-TIME PIC X(08) VALUE SPACES. CL*92 00096 05 DISP-ABSTIME PIC X(16) VALUE SPACES. CL132 00097 05 WRK-L076-NAME PIC X(32) VALUE SPACES. CL125 00098 CL132 00099 05 WRK-CURR-TIME PIC S9(07) COMP-3 VALUE +0. CL133 00100 05 WRK-CURR-DATE PIC S9(09) COMP-3 VALUE +0. CL132 00101 05 WRK-CURR-YR PIC 9(04) VALUE ZEROS. CL*92 00102 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +0. CL132 00103 05 WRK-MPRF-FEIN PIC S9(09) COMP-3 VALUE +0. CL102 00104 CL132 00105 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3 VALUE +0. CL101 00106 05 WRK-ERROR-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*78 00107 05 WRK-STATUS-READ-CNT PIC S9(07) COMP-3 VALUE +0. CL234 00108 05 WRK-BTC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL172 00109 05 WRK-R907-REC-CNT PIC S9(07) COMP-3 VALUE +0. CL172 00110 05 WRK-R120-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*23 00111 05 WRK-T002-ADDR-CNT PIC S9(07) COMP-3 VALUE +0. CL240 00112 05 WRK-T002-CONTACT-CNT PIC S9(07) COMP-3 VALUE +0. CL240 00113 05 WRK-REPORT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL209 00114 CL112 00115 05 WRK-MPRF-IND PIC X(01). CL182 00116 88 WRK-MPRF-OK-88 VALUE '0'. CL182 00117 88 WRK-MPRF-NO-REC-88 VALUE '1'. CL235 00118 CL182 00119 05 WRK-ERROR-IND PIC X(01). CL*37 00120 88 WRK-ERROR-YES-88 VALUE 'Y'. CL182 00121 88 WRK-ERROR-NO-88 VALUE 'N'. CL182 00122 CL141 00123 05 WRK-MOPO-IND PIC X(01). CL141 00124 88 WRK-MOPO-FOUND-YES-88 VALUE 'Y'. CL182 00125 88 WRK-MOPO-FOUND-NO-88 VALUE 'N'. CL182 00126 CL176 00127 05 WRK-STATUS-CHNG-IND PIC X(01). CL240 00128 88 WRK-STATUS-CHNG-YES-88 VALUE 'Y'. CL240 00129 88 WRK-STATUS-CHNG-NO-88 VALUE 'N'. CL240 00130 CL241 00131 05 WRK-MTAD-T002-IND PIC X(01). CL*18 00132 88 WRK-MTAD-T002-YES-88 VALUE 'Y'. CL*18 00133 88 WRK-MTAD-T002-NO-88 VALUE 'N'. CL*18 00134 CL238 00135 05 WRK-MOPO-T002-IND PIC X(01). CL*18 00136 88 WRK-MOPO-T002-YES-88 VALUE 'Y'. CL*18 00137 88 WRK-MOPO-T002-NO-88 VALUE 'N'. CL*18 00138 CL*18 00139 05 WRK-CONT-T002-IND PIC X(01). CL118 00140 88 WRK-CONT-T002-YES-88 VALUE 'Y'. CL118 00141 88 WRK-CONT-T002-NO-88 VALUE 'N'. CL118 00142 CL118 00143 05 WRK-NAME-IN PIC X(40). CL238 00144 05 WRK-NAME-OUT PIC X(40). CL238 00145 05 START-SUB PIC S9(04) COMP. CL238 00146 05 SUB1 PIC S9(04) COMP. CL238 00147 05 SUB2 PIC S9(04) COMP. CL238 00148 CL*91 00149 01 ERROR-ADDRESS-AREA. CL*91 00150 05 FILLER PIC X(03). CL*95 00151 05 WRK-ERROR-ADDR PIC X(26). CL100 00152 05 WRK-ERROR-CITY PIC X(16). CL100 00153 05 WRK-ERROR-STATE PIC X(02). CL*91 00154 05 FILLER PIC X(01). CL*96 00155 05 WRK-ERROR-ZIP PIC X(10). CL*91 00156 CL*91 00157 01 ERROR-MESSAGE-AREA. CL236 00158 05 MSG1-CHG-ONLY. CL236 00159 10 MSG1-ID PIC X(03) VALUE '001'. CL236 00160 10 MSG1-TEXT. CL236 00161 15 FILLER PIC X(30) CL236 00162 VALUE 'TRANSACTION FAILED - CHARGING '. CL236 00163 15 FILLER PIC X(30) CL236 00164 VALUE 'ONLY EMPLOYER '. CL236 00165 CL236 00166 05 MSG2-INACTIVE. CL236 00167 10 MSG2-ID PIC X(03) VALUE '002'. CL236 00168 10 MSG2-TEXT. CL236 00169 15 FILLER PIC X(30) CL236 00170 VALUE 'STATUS CHANGE ACCEPTED FOR INA'. CL236 00171 15 FILLER PIC X(30) CL236 00172 VALUE 'CTIVE EMPLOYER '. CL236 00173 CL236 00174 05 MSG3-NOT-LIABLE. CL236 00175 10 MSG3-ID PIC X(03) VALUE '003'. CL236 00176 10 MSG3-TEXT. CL236 00177 15 FILLER PIC X(30) CL236 00178 VALUE 'STATUS CHANGE ACCEPTED FOR NON'. CL236 00179 15 FILLER PIC X(30) CL236 00180 VALUE '-LIABLE EMPLOYER '. CL236 00181 CL236 00182 05 MSG4-INVALID-ADDRESS. CL237 00183 10 MSG4-ID PIC X(03) VALUE '004'. CL237 00184 10 MSG4-TEXT. CL237 00185 15 FILLER PIC X(30) CL237 00186 VALUE 'TRANSACTION REJECTED - INVALID'. CL237 00187 15 FILLER PIC X(30) CL237 00188 VALUE ' ADDRESS '. CL237 00189 CL237 00190 05 MSG5-INCOMPLETE-NAMES. CL*71 00191 10 MSG5-ID PIC X(03) VALUE '005'. CL238 00192 10 MSG5-TEXT. CL238 00193 15 FILLER PIC X(30) CL238 00194 VALUE 'TRANSACTION REJECTED - NO TRAD'. CL*73 00195 15 FILLER PIC X(30) CL238 00196 VALUE 'E/ENTITY NAMES '. CL*73 00197 CL238 00198 05 MSG6-INCOMPLETE-CONTACT. CL*71 00199 10 MSG6-ID PIC X(03) VALUE '006'. CL*71 00200 10 MSG6-TEXT. CL*71 00201 15 FILLER PIC X(30) CL*71 00202 VALUE 'TRANSACTION REJECTED - CONTACT'. CL*71 00203 15 FILLER PIC X(30) CL*71 00204 VALUE ' INFORMATION NOT COMPLETE '. CL*71 00205 CL*71 00206 EJECT CL211 00207 01 FEST-REC. CL176 00208 ++INCLUDE EFTIFEST CL167 00209 SKIP3 CL*58 00210 01 T002-REC. CL167 00211 ++INCLUDE DTSIT002 CL167 00212 SKIP3 CL167 00213 01 R120-REC. CL*22 00214 ++INCLUDE EFTIR120 CL*22 00215 SKIP3 CL*22 00216 01 EFTE-REC. CL*22 00217 ++INCLUDE EFTERMSG CL*22 00218 SKIP3 CL*22 00219 01 L001-LINK-AREA. CL146 00220 ++INCLUDE DTSIL001 CL146 00221 EJECT CL146 00222 01 L004-LINK-AREA. CL*24 00223 ++INCLUDE DTSIL004 CL*24 00224 EJECT CL*24 00225 01 L005-COMM-AREA. CL*61 00226 ++INCLUDE DTSIL005 CL*61 00227 EJECT CL100 00228 01 L021-COMM-AREA. CL*17 00229 ++INCLUDE DTSIL021 CL*17 00230 EJECT CL*17 00231 01 L072-LINK-AREA. CL242 00232 ++INCLUDE DTSIL072 CL241 00233 EJECT CL241 00234 01 L076-LINK-AREA. CL125 00235 ++INCLUDE DTSIL076 CL125 00236 EJECT CL*15 00237 01 L910-LINK-AREA. CL*94 00238 ++INCLUDE DTSIL910 CL*94 00239 EJECT CL162 00240 01 MSKL-REC. CL234 00241 ++INCLUDE DTSIMSKL CL234 00242 EJECT CL234 00243 01 MPRF-REC. CL234 00244 ++INCLUDE DTSIMPRF CL234 00245 EJECT CL234 00246 01 MTAD-REC. CL234 00247 ++INCLUDE DTSIMTAD CL234 00248 EJECT CL234 00249 01 MOPO-REC. CL234 00250 ++INCLUDE DTSIMOPO CL234 00251 EJECT CL234 00252 01 L927-LINK-AREA. CL173 00253 ++INCLUDE DTSIL927 CL167 00254 EJECT CL167 00255 01 TSKL-REC. CL167 00256 ++INCLUDE DTSITSKL CL167 00257 EJECT CL167 00258 01 L941-LINK-AREA. CL162 00259 ++INCLUDE DTSIL941 CL162 00260 EJECT CL*94 00261 01 STATUS-REC. CL234 00262 ++INCLUDE DTSIRSK3 CL234 00263 SKIP3 CL234 00264 01 F907-REC. CL**8 00265 ++INCLUDE EFTIF907 CL**6 00266 EJECT CL226 00267 CL249 00268 LINKAGE SECTION. CL249 00269 01 EFT-REC-TYPE-LINK-AREA. CL249 00270 ++INCLUDE EFTIL100 CL249 00271 CL249 00272 01 RSKL-REC. CL249 00273 ++INCLUDE EFTIRSKL CL249 00274 CL249 00275 PROCEDURE DIVISION USING CL248 00276 EFT-REC-TYPE-LINK-AREA CL248 00277 RSKL-REC. CL248 00278 CL248 00279 MOVE RSKL-REC TO FEST-REC. CL248 00280 CL248 00281 IF EFT-L100-CMD-INIT-88 CL248 00282 PERFORM I0000-INITIALIZE THRU I0000-EXIT CL248 00283 ELSE CL248 00284 IF EFT-L100-CMD-PROCESS-88 CL248 00285 PERFORM P0000-PROCESS THRU P0000-EXIT CL248 00286 ELSE CL248 00287 IF EFT-L100-CMD-TERMINATE-88 CL251 00288 PERFORM T0000-TERMINATE THRU T0000-EXIT CL248 00289 ELSE CL248 00290 DISPLAY 'INVLAID CALL FROM BD100 ' CL248 00291 PERFORM S999-ABEND THRU S999-EXIT. CL248 00292 CL*62 00293 GOBACK. CL146 00294 EJECT CL146 00295 I0000-INITIALIZE. CL146 00296 CL*72 00297 SET WRK-MPRF-OK-88 TO TRUE. CL151 00298 CL*72 00299 PERFORM I1000-SYS-DATE THRU I1000-EXIT. CL*74 00300 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CL*74 00301 CL*63 00302 PERFORM I3000-INIT-T002 THRU I3000-EXIT. CL240 00303 CL240 00304 I0000-EXIT. CL146 00305 EXIT. CL146 00306 CL107 00307 I1000-SYS-DATE. CL*72 00308 SET L005-FROM-SYS TO TRUE. CL*72 00309 PERFORM S005-SYS-DATE THRU S005-EXIT. CL*72 00310 MOVE L005-DATE TO DISP-DATE WRK-CURR-DATE. CL132 00311 MOVE L005-TIME TO DISP-TIME WRK-CURR-TIME. CL132 00312 MOVE L005-ABSTIME TO DISP-ABSTIME WRK-ABSTIME. CL132 00313 CL132 00314 * DISPLAY ' '. CL245 00315 * DISPLAY 'L005-DATE ' DISP-DATE ' L005-TIME ' DISP-TIME CL245 00316 * ' L005-ABSTIME ' DISP-ABSTIME. CL247 00317 I1000-EXIT. CL*72 00318 EXIT. CL*72 00319 CL**1 00320 I2000-OPEN-FILES. CL*72 00321 CL172 00322 MOVE LENGTH OF T002-REC TO T002-LENGTH. CL172 00323 MOVE LENGTH OF F907-REC TO F907-LENGTH. CL**6 00324 MOVE LENGTH OF R120-REC TO R120-LENGTH. CL*25 00325 CL161 00326 I2000-EXIT. CL*72 00327 EXIT. CL*58 00328 CL*58 00329 I3000-INIT-T002. CL240 00330 CL240 00331 MOVE ZERO TO T002-EMP-NO CL240 00332 T002-SYS-DATE CL240 00333 T002-SYS-TIME. CL240 00334 CL240 00335 MOVE SPACES TO T002-ORIGIN CL240 00336 T002-DATA-AREA. CL240 00337 CL240 00338 I3000-EXIT. CL240 00339 EXIT. CL240 00340 CL240 00341 ************************************************************** CL146 00342 * READ THE EFT STATUS CHANGE FILE FROM GOVONE AND * CL175 00343 * MATCHES THE EMPLOYER NNUMBER WITH THE MPRF MASTER. * CL175 00344 ************************************************************** CL146 00345 CL146 00346 P0000-PROCESS. CL146 00347 DISPLAY ' FEST EMP NO...... ' FEST-EMP-NO CL127 00348 SET WRK-MOPO-FOUND-NO-88 TO TRUE. CL*90 00349 SET WRK-MTAD-T002-YES-88 TO TRUE. CL138 00350 SET WRK-MOPO-T002-YES-88 TO TRUE. CL*90 00351 SET WRK-CONT-T002-YES-88 TO TRUE. CL120 00352 SET WRK-STATUS-CHNG-NO-88 TO TRUE. CL*90 00353 ADD +1 TO WRK-STATUS-READ-CNT CL*90 00354 PERFORM I3000-INIT-T002 THRU I3000-EXIT CL*90 00355 CL*18 00356 PERFORM P1100-READ-MPRF THRU P1100-EXIT CL*90 00357 CL*18 00358 IF WRK-MPRF-NO-REC-88 CL*90 00359 DISPLAY ' EMP REC NOT FOUND ' FEST-EMP-NO CL117 00360 GO TO P0000-EXIT. CL*90 00361 CL*18 00362 PERFORM P1200-CHECK-FEST-NAME THRU P1200-EXIT. CL122 00363 CL120 00364 IF WRK-MTAD-T002-YES-88 CL*90 00365 PERFORM P1300-CHECK-FEST-ADDRESS THRU P1300-EXIT CL135 00366 PERFORM P1600-CHECK-FEST-DATA THRU P1600-EXIT CL120 00367 PERFORM P1700-WRITE-MTAD-T002 THRU P1700-EXIT CL134 00368 ELSE CL120 00369 DISPLAY '***** NO MTAD T002 REC CREATED ' FEST-EMP-NO. CL134 00370 * CL120 00371 ***** WRITE T002 CONTACT REC. CL118 00372 * CL118 00373 PERFORM I3000-INIT-T002 THRU I3000-EXIT CL*90 00374 INITIALIZE MOPO-REC CL*90 00375 PERFORM P2000-MOPO THRU P2000-EXIT CL*90 00376 * CL128 00377 PERFORM P2100-CONT-NAME THRU P2100-EXIT CL128 00378 * CL118 00379 IF WRK-CONT-T002-YES-88 CL118 00380 DISPLAY ' T002 YES FOUND ' FEST-EMP-NO CL127 00381 PERFORM P2300-WRITE-CONT-T002 THRU P2300-EXIT. CL118 00382 * CL120 00383 ***** WRITE 120 REPORT REC. CL118 00384 * CL118 00385 PERFORM P3000-STATUS-SALES THRU P3000-EXIT CL*90 00386 PERFORM P3100-STATUS-PAID THRU P3100-EXIT CL*90 00387 PERFORM P3200-STATUS-DESC THRU P3200-EXIT CL*90 00388 PERFORM P3300-STATUS-FEIN THRU P3300-EXIT CL*90 00389 PERFORM P3400-STATUS-TRACE THRU P3400-EXIT CL*90 00390 CL*18 00391 IF WRK-STATUS-CHNG-YES-88 CL*21 00392 PERFORM P3500-WRITE-R120 THRU P3500-EXIT. CL*36 00393 CL*18 00394 P0000-EXIT. CL146 00395 EXIT. CL146 00396 CL135 00397 CL234 00398 P1100-READ-MPRF. CL235 00399 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL235 00400 MOVE FEST-EMP-NO TO MSKL-EMP-NO. CL235 00401 SET MSKL-PRF-88 TO TRUE. CL235 00402 PERFORM S910-READ THRU S910-EXIT. CL235 00403 IF L910-NO-REC-88 CL235 00404 SET WRK-MPRF-NO-REC-88 TO TRUE CL240 00405 DISPLAY 'NO MPRF RECORD FOUND ' FEST-EMP-NO CL235 00406 GO TO P1100-EXIT CL236 00407 ELSE CL235 00408 MOVE MSKL-REC TO MPRF-REC CL235 00409 SET WRK-MPRF-OK-88 TO TRUE CL235 00410 END-IF. CL235 00411 CL235 00412 EVALUATE TRUE CL236 00413 WHEN MPRF-CLASS-CHG-ONLY-88 CL236 00414 MOVE MSG1-ID TO F907-MSG-ID CL**6 00415 MOVE MSG1-TEXT TO F907-MSG-TEXT CL*11 00416 PERFORM S946-ERROR THRU S946-EXIT CL**6 00417 CL236 00418 WHEN MPRF-STATUS-INACT-88 CL236 00419 MOVE MSG2-ID TO F907-MSG-ID CL**6 00420 MOVE MSG2-TEXT TO F907-MSG-TEXT CL*11 00421 PERFORM S946-ERROR THRU S946-EXIT CL**6 00422 CL236 00423 WHEN MPRF-STATUS-UNK-88 CL236 00424 OR MPRF-STATUS-NEVERSUB-88 CL236 00425 MOVE MSG3-ID TO F907-MSG-ID CL**6 00426 MOVE MSG3-TEXT TO F907-MSG-TEXT CL*11 00427 PERFORM S946-ERROR THRU S946-EXIT CL**6 00428 CL236 00429 END-EVALUATE. CL236 00430 CL236 00431 P1100-EXIT. CL235 00432 EXIT. CL235 00433 CL235 00434 P1200-CHECK-FEST-NAME. CL122 00435 *BW1 CL*71 00436 MOVE SPACES TO T002-BSNS-ENTITY-NAME. CL122 00437 MOVE SPACES TO T002-BSNS-TRADE-NAME. CL122 00438 CL135 00439 IF (FEST-TRADE-NAME = SPACES OR LOW-VALUES) AND CL*71 00440 (FEST-ENTITY-NAME = SPACES OR LOW-VALUES) CL*71 00441 MOVE MSG5-ID TO F907-MSG-ID CL*71 00442 MOVE MSG5-TEXT TO F907-MSG-TEXT CL*71 00443 PERFORM S946-ERROR THRU S946-EXIT CL*71 00444 SET WRK-MTAD-T002-NO-88 TO TRUE CL135 00445 GO TO P1200-EXIT. CL*71 00446 *BW2 CL*71 00447 CL*71 00448 IF FEST-TRADE-NAME = SPACES OR LOW-VALUES CL244 00449 MOVE SPACES TO T002-BSNS-TRADE-NAME CL*55 00450 ELSE CL244 00451 MOVE FEST-TRADE-NAME TO WRK-NAME-IN CL236 00452 MOVE SPACES TO WRK-NAME-OUT CL236 00453 PERFORM P1210-UPDATE-NAME THRU P1210-EXIT CL241 00454 MOVE WRK-NAME-OUT TO T002-BSNS-TRADE-NAME CL120 00455 END-IF. CL236 00456 CL236 00457 P1200-EXIT. CL235 00458 EXIT. CL235 00459 CL235 00460 P1210-UPDATE-NAME. CL236 00461 MOVE +0 TO START-SUB CL236 00462 SUB2. CL236 00463 CL236 00464 IF WRK-NAME-IN (1:2) = 'A ' CL236 00465 IF WRK-NAME-IN (4:1) = ' ' CL236 00466 NEXT SENTENCE CL236 00467 ELSE CL236 00468 MOVE +3 TO START-SUB CL236 00469 END-IF CL236 00470 ELSE CL236 00471 IF WRK-NAME-IN (1:3) = 'AN ' CL236 00472 MOVE +4 TO START-SUB CL236 00473 ELSE CL236 00474 IF WRK-NAME-IN (1:4) = 'THE ' CL236 00475 MOVE +5 TO START-SUB CL236 00476 END-IF CL236 00477 END-IF CL236 00478 END-IF. CL236 00479 CL236 00480 IF START-SUB > +0 CL236 00481 PERFORM CL236 00482 VARYING SUB1 FROM START-SUB BY +1 CL236 00483 UNTIL SUB1 > +40 CL236 00484 ADD +1 TO SUB2 CL236 00485 MOVE WRK-NAME-IN (SUB1:1) TO WRK-NAME-OUT (SUB2:1) CL236 00486 END-PERFORM CL236 00487 ELSE CL236 00488 MOVE WRK-NAME-IN TO WRK-NAME-OUT CL236 00489 END-IF. CL236 00490 CL236 00491 P1210-EXIT. CL236 00492 EXIT. CL236 00493 CL236 00494 P1300-CHECK-FEST-ADDRESS. CL120 00495 CL120 00496 SET WRK-MTAD-T002-YES-88 TO TRUE CL120 00497 MOVE SPACES TO T002-BSNS-ATTN CL120 00498 MOVE SPACES TO T002-BSNS-DELV1 CL120 00499 MOVE SPACES TO T002-BSNS-DELV2 CL120 00500 MOVE SPACES TO T002-BSNS-CITY CL120 00501 MOVE SPACES TO T002-BSNS-ST CL120 00502 MOVE SPACES TO T002-BSNS-ZIP CL120 00503 MOVE SPACES TO T002-BSNS-ENTITY-NAME CL142 00504 CL**4 00505 IF FEST-ADDRESS-AREA = SPACES OR LOW-VALUES CL236 00506 SET WRK-MTAD-T002-NO-88 TO TRUE CL120 00507 MOVE MSG4-ID TO F907-MSG-ID CL*55 00508 MOVE MSG4-TEXT TO F907-MSG-TEXT CL*55 00509 PERFORM S946-ERROR THRU S946-EXIT CL*55 00510 GO TO P1300-EXIT. CL238 00511 CL236 00512 MOVE SPACES TO L072-ADDRESS. CL237 00513 MOVE 'Y' TO L072-CASS-IND. CL110 00514 SET L072-MTAD-88 TO TRUE. CL236 00515 MOVE MPRF-PRIMARY-NAME TO L072-NAME. CL237 00516 MOVE FEST-ATTN-LINE TO L072-ATTN-LINE. CL237 00517 MOVE FEST-STREET-ADDRESS-1 TO L072-DELIV-LINE-1. CL236 00518 MOVE FEST-STREET-ADDRESS-2 TO L072-DELIV-LINE-2. CL236 00519 MOVE FEST-CITY TO L072-CITY. CL237 00520 MOVE FEST-STATE TO L072-ST. CL237 00521 MOVE FEST-ZIP TO L072-ZIP. CL237 00522 CL*27 00523 PERFORM S072-ADDRESS-EDIT THRU S072-EXIT. CL236 00524 CL120 00525 IF L072-ADDRESS-NOT-VALID-88 CL*46 00526 DISPLAY 'L072 ADDRESS INVALID ' L072-MSG-AREA CL120 00527 SET WRK-MTAD-T002-NO-88 TO TRUE CL*47 00528 MOVE MSG4-ID TO F907-MSG-ID CL*46 00529 MOVE MSG4-TEXT TO F907-MSG-TEXT CL*46 00530 MOVE FEST-STREET-ADDRESS-2 TO WRK-ERROR-ADDR CL*91 00531 MOVE FEST-CITY TO WRK-ERROR-CITY CL*91 00532 MOVE FEST-STATE TO WRK-ERROR-STATE CL*91 00533 MOVE FEST-ZIP TO WRK-ERROR-ZIP CL*91 00534 MOVE ERROR-ADDRESS-AREA TO F907-GOV1-REC-ERR CL*93 00535 PERFORM S946-ERROR THRU S946-EXIT CL*91 00536 GO TO P1300-EXIT. CL*46 00537 CL239 00538 MOVE L072-ATTN-LINE TO T002-BSNS-ATTN. CL121 00539 MOVE L072-DELIV-LINE-1 TO T002-BSNS-DELV1. CL121 00540 MOVE L072-DELIV-LINE-2 TO T002-BSNS-DELV2. CL121 00541 MOVE L072-CITY TO T002-BSNS-CITY. CL121 00542 MOVE L072-ST TO T002-BSNS-ST. CL121 00543 MOVE L072-ZIP TO T002-BSNS-ZIP. CL121 00544 CL115 00545 P1300-EXIT. CL120 00546 EXIT. CL120 00547 CL120 00548 P1600-CHECK-FEST-DATA. CL120 00549 CL120 00550 IF FEST-BUSINESS-PHONE > SPACES CL120 00551 MOVE FEST-BUSINESS-PHONE TO T002-BUSINESS-VOICE CL120 00552 *RW1 CL144 00553 * (THIS IS THE BUSINESS !!!) R120-CONTACT-PHONE CL145 00554 *RW2 CL144 00555 ELSE CL120 00556 MOVE SPACES TO T002-BUSINESS-VOICE. CL120 00557 CL*18 00558 IF FEST-FAX > SPACES CL120 00559 MOVE FEST-FAX TO T002-BUSINESS-FAX CL120 00560 ELSE CL120 00561 MOVE SPACES TO T002-BUSINESS-FAX. CL120 00562 CL*19 00563 IF FEST-EMAIL-ADDRESS > SPACES CL120 00564 MOVE FEST-EMAIL-ADDRESS TO T002-BUSINESS-EMAIL CL120 00565 ELSE CL120 00566 MOVE SPACES TO T002-BUSINESS-EMAIL. CL120 00567 CL*19 00568 P1600-EXIT. CL*19 00569 EXIT. CL*19 00570 CL*18 00571 P1700-WRITE-MTAD-T002. CL134 00572 CL137 00573 DISPLAY ' WRITING T002 STATUS REC ' T002-EMP-NO. CL137 00574 CL137 00575 IF WRK-MTAD-T002-NO-88 CL137 00576 GO TO P1700-EXIT. CL137 00577 CL137 00578 MOVE MPRF-EMP-NO TO T002-EMP-NO. CL237 00579 MOVE 'AUTOSTATUS' TO T002-ORIGIN. CL237 00580 MOVE L005-DATE TO T002-SYS-DATE. CL237 00581 MOVE L005-TIME TO T002-SYS-TIME. CL237 00582 SET T002-UPD-MAIL-ADDR-88 TO TRUE. CL237 00583 CL237 00584 MOVE T002-REC TO TSKL-REC. CL239 00585 PERFORM S927B-WRITE THRU S927B-EXIT CL239 00586 ADD +1 TO WRK-T002-ADDR-CNT. CL240 00587 CL237 00588 P1700-EXIT. CL*18 00589 EXIT. CL237 00590 CL237 00591 ************************************************************** CL*37 00592 * USING THE MPRF EMP-NO TO FIND MOPO RECORD. * CL135 00593 ************************************************************** CL*37 00594 CL176 00595 P2000-MOPO. CL239 00596 CL*17 00597 MOVE LOW-VALUES TO MOPO-KEY-AREA. CL176 00598 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. CL176 00599 SET MOPO-OPO-88 TO TRUE. CL176 00600 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. CL176 00601 CL176 00602 PERFORM S910-START-BROWSE THRU S910-EXIT. CL176 00603 IF L910-NO-REC-88 CL176 00604 NEXT SENTENCE CL238 00605 ELSE CL176 00606 PERFORM CL176 00607 UNTIL L910-NO-REC-88 CL176 00608 OR WRK-MOPO-FOUND-YES-88 CL176 00609 MOVE MSKL-REC TO MOPO-REC CL*78 00610 IF MOPO-TYPE-STATUS-88 CL*75 00611 MOVE MOPO-REC TO MSKL-REC CL*79 00612 SET WRK-MOPO-FOUND-YES-88 TO TRUE CL192 00613 ELSE CL192 00614 PERFORM S910-READ-NEXT THRU S910-EXIT CL176 00615 END-IF CL176 00616 END-PERFORM CL176 00617 END-IF. CL176 00618 CL**1 00619 CL179 00620 P2000-EXIT. CL239 00621 EXIT. CL176 00622 CL135 00623 P2100-CONT-NAME. CL*20 00624 SET WRK-CONT-T002-YES-88 TO TRUE CL118 00625 MOVE FEST-CONTACT-FIRST-NAME TO L076-NAMEF CL125 00626 MOVE FEST-CONTACT-MI TO L076-NAMEI CL125 00627 MOVE FEST-CONTACT-LAST-NAME TO L076-NAMEL CL125 00628 CL*28 00629 PERFORM S076-NAME THRU S076-EXIT CL125 00630 CL*28 00631 IF L076-NAME-INVALID CL125 00632 MOVE '061' TO F907-MSG-ID CL139 00633 MOVE L076-NAME-GROUP TO F907-GOV1-DATA CL133 00634 MOVE EFT061 TO F907-MSG-TEXT CL139 00635 PERFORM S946-ERROR THRU S946-EXIT CL*20 00636 MOVE SPACES TO F907-GOV1-DATA CL*72 00637 MOVE SPACES TO T002-CONTACT-NAME CL*20 00638 *RW1 CL144 00639 MOVE SPACES TO R120-CONTACT-NAME CL144 00640 *RW2 CL144 00641 SET WRK-CONT-T002-NO-88 TO TRUE CL118 00642 DISPLAY ' INV CONT NAME NO T002 CREATED' FEST-EMP-NO CL118 00643 ELSE CL118 00644 DISPLAY ' L076 NAME STATUS CONT NAME ' L076-NAM CL126 00645 MOVE L076-NAM TO T002-CONTACT-NAME CL142 00646 R120-CONTACT-NAME. CL142 00647 CL*28 00648 P2100-EXIT. CL*20 00649 EXIT. CL*20 00650 CL*20 00651 CL*20 00652 P2300-WRITE-CONT-T002. CL*81 00653 CL118 00654 MOVE SPACES TO TSKL-REC. CL118 00655 CL118 00656 MOVE MPRF-EMP-NO TO T002-EMP-NO. CL*20 00657 MOVE 'AUTOSTATUS' TO T002-ORIGIN. CL*20 00658 MOVE L005-DATE TO T002-SYS-DATE. CL*20 00659 MOVE L005-TIME TO T002-SYS-TIME. CL*20 00660 MOVE ZEROS TO T002-CONTACT-SSN. CL118 00661 MOVE SPACES TO T002-CONTACT-TITLE. CL118 00662 MOVE SPACES TO T002-CONTACT-FAX. CL118 00663 MOVE SPACES TO T002-CONTACT-EMAIL. CL118 00664 MOVE FEST-CONTACT-AREA-CD TO T002-C-VOICE-AREA-CD. CL119 00665 MOVE FEST-CONTACT-PREFIX TO T002-C-VOICE-PREFIX. CL119 00666 MOVE FEST-CONTACT-SUFFIX TO T002-C-VOICE-SUFFIX. CL119 00667 MOVE FEST-CONTACT-EXT TO T002-C-VOICE-EXT. CL119 00668 CL*20 00669 IF WRK-MOPO-FOUND-YES-88 CL*20 00670 SET T002-UPD-CONTACT-88 TO TRUE CL*20 00671 ELSE CL*20 00672 SET T002-ADD-CONTACT-88 TO TRUE CL*20 00673 END-IF. CL*20 00674 CL*20 00675 SET T002-CONTACT-STATUS-88 TO TRUE. CL*76 00676 CL*20 00677 MOVE T002-REC TO TSKL-REC. CL*20 00678 PERFORM S927B-WRITE THRU S927B-EXIT. CL*20 00679 ADD +1 TO WRK-T002-CONTACT-CNT. CL*20 00680 CL*81 00681 CL118 00682 P2300-EXIT. CL*20 00683 EXIT. CL*20 00684 CL*20 00685 ************************************************************** CL207 00686 * IF FEST SALE DATE, LAST WAGES PAID DATE, OR STATUS CHANGE * CL209 00687 * DESCRIPTION FIELDS CONTAIN DATA, PRINT A STATUS CHANGE * CL207 00688 * REPORT RECORD. * CL207 00689 ************************************************************** CL207 00690 CL207 00691 P3000-STATUS-SALES. CL*21 00692 CL207 00693 IF FEST-SALE-DATE NUMERIC CL106 00694 IF FEST-SALE-DATE > ZEROS CL106 00695 MOVE FEST-SALE-DATE TO R120-SALE-DATE CL106 00696 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL106 00697 ELSE CL106 00698 MOVE ZEROS TO R120-SALE-DATE CL106 00699 END-IF CL106 00700 ELSE CL106 00701 MOVE FEST-SALE-DATE TO R120-SALE-DATE CL106 00702 END-IF. CL106 00703 CL106 00704 P3000-EXIT. CL*21 00705 EXIT. CL*21 00706 CL*21 00707 P3100-STATUS-PAID. CL*21 00708 CL209 00709 IF FEST-LAST-WAGES-PAID-DATE NUMERIC CL106 00710 IF FEST-LAST-WAGES-PAID-DATE > ZEROS CL106 00711 MOVE FEST-LAST-WAGES-PAID-DATE TO CL106 00712 R120-LAST-WAGES-PAID-DATE CL106 00713 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL106 00714 ELSE CL106 00715 MOVE ZEROS TO R120-LAST-WAGES-PAID-DATE CL106 00716 END-IF CL106 00717 ELSE CL106 00718 MOVE FEST-LAST-WAGES-PAID-DATE TO CL106 00719 R120-LAST-WAGES-PAID-DATE CL106 00720 END-IF. CL209 00721 CL209 00722 P3100-EXIT. CL*21 00723 EXIT. CL*21 00724 CL*21 00725 P3200-STATUS-DESC. CL*21 00726 IF FEST-STATUS-CHG-DESCRIPTION NOT = SPACES CL209 00727 MOVE FEST-STATUS-CHG-DESCRIPTION TO CL209 00728 R120-STATUS-CHNG-DESC CL*23 00729 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL241 00730 ELSE CL221 00731 MOVE SPACES TO R120-STATUS-CHNG-DESC CL*23 00732 END-IF. CL209 00733 CL209 00734 P3200-EXIT. CL*21 00735 EXIT. CL*21 00736 CL*36 00737 P3300-STATUS-FEIN. CL*36 00738 * IF FEST-FEIN > ZEROS CL101 00739 MOVE MPRF-FEIN TO WRK-MPRF-FEIN CL103 00740 IF FEST-FEIN NOT = WRK-MPRF-FEIN CL102 00741 MOVE FEST-FEIN TO R120-FEIN CL140 00742 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL140 00743 ELSE CL*36 00744 MOVE ZEROS TO R120-FEIN CL140 00745 END-IF. CL*36 00746 CL*36 00747 P3300-EXIT. CL*36 00748 EXIT. CL*36 00749 CL*36 00750 P3400-STATUS-TRACE. CL*36 00751 IF FEST-TRACE-NO > ZEROS CL*36 00752 MOVE FEST-TRACE-NO TO R120-TRACE-NO CL*36 00753 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL*36 00754 ELSE CL*36 00755 MOVE ZEROS TO R120-TRACE-NO CL*36 00756 END-IF. CL*36 00757 CL*36 00758 P3400-EXIT. CL*36 00759 EXIT. CL*36 00760 CL*21 00761 P3500-WRITE-R120. CL*36 00762 MOVE '120' TO R120-REC-TYPE. CL105 00763 MOVE MPRF-EMP-NO TO R120-EMP-NO CL105 00764 *RW1 CL147 00765 IF MPRF-PRIMARY-IS-ENTITY-88 CL147 00766 IF FEST-ENTITY-NAME NOT = MPRF-PRIMARY-NAME CL147 00767 IF FEST-ENTITY-NAME <= SPACES CL147 00768 MOVE SPACES TO R120-ENTITY-NAME CL147 00769 ELSE CL147 00770 MOVE FEST-ENTITY-NAME TO R120-ENTITY-NAME CL147 00771 END-IF CL147 00772 ELSE CL147 00773 MOVE SPACES TO R120-ENTITY-NAME CL147 00774 END-IF CL147 00775 ELSE CL147 00776 IF FEST-ENTITY-NAME NOT = MPRF-ENTITY-NAME CL147 00777 IF FEST-ENTITY-NAME <= SPACES CL147 00778 MOVE SPACES TO R120-ENTITY-NAME CL147 00779 ELSE CL147 00780 MOVE FEST-ENTITY-NAME TO R120-ENTITY-NAME CL147 00781 END-IF CL147 00782 ELSE CL147 00783 MOVE SPACES TO R120-ENTITY-NAME CL147 00784 END-IF CL147 00785 END-IF. CL147 00786 CL147 00787 IF FEST-CONTACT-PHONE > SPACES CL144 00788 MOVE FEST-CONTACT-AREA-CD TO R120-VOICE-AREA-CD CL144 00789 MOVE FEST-CONTACT-PREFIX TO R120-VOICE-PREFIX CL144 00790 MOVE FEST-CONTACT-SUFFIX TO R120-VOICE-SUFFIX CL144 00791 MOVE FEST-CONTACT-EXT TO R120-VOICE-EXT CL144 00792 ELSE CL144 00793 MOVE SPACES TO R120-CONTACT-PHONE. CL144 00794 *RW2 CL144 00795 MOVE R120-REC TO RSKL-REC CL105 00796 PERFORM S946-RPT-O THRU S946-EXIT CL105 00797 ADD +1 TO WRK-R120-WRITE-CNT. CL105 00798 CL226 00799 P3500-EXIT. CL*36 00800 EXIT. CL207 00801 CL207 00802 T0000-TERMINATE. CL146 00803 CL212 00804 DISPLAY ' '. CL221 00805 DISPLAY ' '. CL221 00806 CL*71 00807 DISPLAY '*** EFTBD120 TERMINATION STATISTICS ***'. CL243 00808 CL*71 00809 DISPLAY ' '. CL237 00810 DISPLAY ' EFT-STATUS-(01) RECS PASSED FROM BD100 :' CL253 00811 WRK-STATUS-READ-CNT. CL242 00812 CL*98 00813 DISPLAY ' '. CL205 00814 CL195 00815 DISPLAY ' T002 MTAD - BUSINESS TRANSACTIONS WRITTEN :' CL*37 00816 WRK-T002-ADDR-CNT. CL240 00817 CL205 00818 DISPLAY ' T002 MOPO - CONTACT TRANSACTIONS WRITTEN :' CL*41 00819 WRK-T002-CONTACT-CNT. CL240 00820 CL205 00821 DISPLAY ' '. CL205 00822 CL210 00823 DISPLAY ' REPORT RECS TYPE(120) WRITTEN TO ERROR FILE :' CL*51 00824 WRK-R120-WRITE-CNT. CL*21 00825 CL*41 00826 DISPLAY ' EDIT ERRORS TYPE(907) WRITTEN TO ERROR FILE :' CL*41 00827 WRK-R907-REC-CNT. CL*41 00828 CL210 00829 DISPLAY ' '. CL210 00830 CL226 00831 T0000-EXIT. CL146 00832 EXIT. CL146 00833 CL*59 00834 S001-FROM-FED-8. CL108 00835 SET L001-FROM-FED-8 TO TRUE. CL108 00836 GO TO S001-DATE. CL108 00837 CL108 00838 S001-FROM-ABS-DAY. CL108 00839 SET L001-FROM-ABS-DAY TO TRUE. CL108 00840 GO TO S001-DATE. CL108 00841 CL108 00842 S001-FROM-CAL-6. CL108 00843 SET L001-FROM-CAL-6 TO TRUE. CL108 00844 GO TO S001-DATE. CL108 00845 CL108 00846 S001-DATE. CL108 00847 CALL 'DTSBU001' USING L001-LINK-AREA. CL108 00848 S001-EXIT. CL108 00849 EXIT. CL108 00850 CL*15 00851 S004-FROM-3. CL*24 00852 SET L004-FROM-3 TO TRUE. CL*24 00853 GO TO S004-YRQ. CL*24 00854 CL*24 00855 S004-YRQ. CL*24 00856 CALL 'DTSBU004' USING L004-LINK-AREA. CL*24 00857 CL*24 00858 S004-EXIT. CL*24 00859 EXIT. CL*24 00860 CL*24 00861 S005-SYS-DATE. CL*61 00862 CALL 'DTSBU005' USING L005-COMM-AREA. CL*61 00863 CL*61 00864 S005-EXIT. CL*61 00865 EXIT. CL*61 00866 CL*17 00867 S072-ADDRESS-EDIT. CL242 00868 CALL 'DTSBU072' USING L072-LINK-AREA. CL242 00869 CL242 00870 S072-EXIT. CL242 00871 EXIT. CL242 00872 CL*15 00873 S076-NAME. CL126 00874 CALL 'DTSBU076' USING L076-LINK-AREA. CL126 00875 CL*15 00876 S076-EXIT. CL126 00877 EXIT. CL*15 00878 CL*70 00879 S910-READ. CL*70 00880 SET L910-READ-88 TO TRUE. CL*70 00881 GO TO S910-MSTR-IO. CL*70 00882 CL*70 00883 S910-START-BROWSE. CL*70 00884 SET L910-START-BROWSE-88 TO TRUE. CL*70 00885 GO TO S910-MSTR-IO. CL*70 00886 CL*13 00887 S910-READ-NEXT. CL*70 00888 SET L910-READ-NEXT-88 TO TRUE. CL*70 00889 GO TO S910-MSTR-IO. CL*70 00890 CL*70 00891 S910-COUNT. CL*70 00892 SET L910-COUNT-88 TO TRUE. CL*70 00893 GO TO S910-MSTR-IO. CL*70 00894 CL*70 00895 S910-MSTR-IO. CL*70 00896 CALL 'DTSBU910' USING L910-LINK-AREA CL*70 00897 MSKL-REC. CL*70 00898 S910-EXIT. CL*70 00899 EXIT. CL*70 00900 CL*80 00901 S927B-WRITE. CL238 00902 SET L927-WRITE-88 TO TRUE. CL166 00903 CALL 'DTSBU927' USING L927-LINK-AREA CL238 00904 TSKL-REC. CL238 00905 CL238 00906 S927B-EXIT. CL238 00907 EXIT. CL238 00908 CL161 00909 S946-RPT-O. CL226 00910 CALL 'DTSBU946' USING RSKL-REC. CL252 00911 GO TO S946-EXIT. CL**6 00912 CL*42 00913 S946-ERROR. CL**6 00914 ADD +1 TO WRK-R907-REC-CNT. CL*43 00915 MOVE FEST-EMP-NO TO F907-EMP-NO. CL**6 00916 MOVE '34' TO F907-GOV1-RECID. CL*34 00917 MOVE 'EFTBD120 ' TO F907-MODULE-NAME. CL*42 00918 CALL 'DTSBU946' USING F907-REC. CL*42 00919 CL*42 00920 S946-EXIT. CL226 00921 EXIT. CL226 00922 CL226 00923 S999-ABEND. CL146 00924 DISPLAY '*** EFTBD120 ABENDING : ' CL243 00925 WRK-ABEND-MSG. CL*83 00926 CL146 00927 CALL 'DTSBU999' USING WRK-ABEND-CD. CL146 00928 S999-EXIT. CL146 00929 EXIT. CL146 00930 CL*42