00001 IDENTIFICATION DIVISION. 10/24/03 00002 PROGRAM-ID. EFTBD100. EFTBD100 00003 *AUTHOR. TRW INC. LV070 00004 *DATE-WRITTEN. AUGUST 2003. CL**8 00005 DATE-COMPILED. EFTBD100 00006 EFTBD100 00007 ***** EFTBD100 00008 * EFTBD100 00009 * FUNCTION: EFTBD100 00010 * EFTBD100 00011 * DRIVER PROGRAM CONTROLS THE GOVONE EFT PROCESS CL**4 00012 * EFTBD100 00013 * INPUT: EFTBD100 00014 * EFTBD100 00015 * EFT100F1 - REPORT RECORDS PRODUCED DURING THE INPUT CL**8 00016 * EDIT. CL**4 00017 * EFTBD100 00018 * OUTPUT: EFTBD100 00019 * EFTBD100 00020 * EFT100R1 - REPORT RECORDS SUMMARY COUNT REPORT. CL*58 00021 ***** EFTBD100 00022 EFTBD100 00023 ******************************************************************EFTBD100 00024 * MODIFICATION HISTORY: *EFTBD100 00025 * *EFTBD100 00026 * 08-26-2003 INITIAL DEVELOPMENT * CL**4 00027 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL**4 00028 * *EFTBD100 00029 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *EFTBD100 00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *EFTBD100 00031 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *EFTBD100 00032 ******************************************************************EFTBD100 00033 EFTBD100 00034 ENVIRONMENT DIVISION. EFTBD100 00035 EFTBD100 00036 CONFIGURATION SECTION. EFTBD100 00037 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. EFTBD100 00038 EFTBD100 00039 INPUT-OUTPUT SECTION. EFTBD100 00040 EFTBD100 00041 FILE-CONTROL. EFTBD100 00042 SELECT EFT-REC-FILE ASSIGN TO EFT100F1 CL*12 00043 FILE STATUS IS EFT-FILE-STATUS. CL*15 00044 EFTBD100 00045 SELECT PRT-FILE ASSIGN TO EFT100R1. CL*24 00046 CL*18 00047 DATA DIVISION. EFTBD100 00048 EFTBD100 00049 FILE SECTION. EFTBD100 00050 EFTBD100 00051 ************************************************************ EFTBD100 00052 * REPORT FILE RECORD PASSED FROM BENEFITS UPDATE. EFTBD100 00053 ************************************************************ EFTBD100 00054 CL**8 00055 FD EFT-REC-FILE CL*12 00056 RECORDING MODE IS V CL**8 00057 BLOCK CONTAINS 0 RECORDS. CL**8 00058 01 EFT-TRANS-IN. CL**8 00059 05 EFT-SORT-KEY. CL**8 00060 10 EFT-SORT-TRACE-NO PIC 9(13). CL**8 00061 10 EFT-SORT-TRAN PIC 9(02). CL**8 00062 05 EFT-TRANS-REC PIC X(4074). CL**8 00063 EFTBD100 00064 FD PRT-FILE EFTBD100 00065 RECORDING MODE IS F. EFTBD100 00066 01 REPORT-LISTING1 PIC X(133). EFTBD100 00067 CL*18 00068 EFTBD100 00069 WORKING-STORAGE SECTION. EFTBD100 000695 77 PAN-VALET PICTURE X(24) VALUE '070EFTBD100 10/24/03'. EFTBD100 00070 EFTBD100 00071 01 WRK-AREA. EFTBD100 00072 05 WRK-MOD-NAME PIC X(08) VALUE 'EFTBD100'. CL*34 00073 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. CL*46 00074 05 ABEND-CODE PIC S9(04) COMP VALUE +0. EFTBD100 00075 88 ABEND-NULL-88 VALUE +0. EFTBD100 00076 88 ABEND-RPT-FILE-OPEN VALUE +1. EFTBD100 00077 88 ABEND-RPT-FILE-READ VALUE +2. EFTBD100 00078 88 ABEND-PRT-FILE-OPEN VALUE +3. CL*10 00079 05 ABEND-CODE-DISP PIC 9(04). EFTBD100 00080 05 ABEND-MOD PIC X(08) EFTBD100 00081 VALUE 'ILBOABN0'. EFTBD100 00082 EFTBD100 00083 05 WS-REC-LEN PIC S9(04) COMP VALUE +0. CL*34 00084 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. EFTBD100 00085 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. EFTBD100 00086 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. EFTBD100 00087 EFTBD100 00088 05 EFT-FILE-STATUS PIC X(02) VALUE SPACES. CL*15 00089 88 EFT-FILE-OK-88 VALUE ZERO. CL**8 00090 88 EFT-FILE-EOF-88 VALUE '10'. CL**8 00091 EFTBD100 00092 05 WS-EFT-PROGRAM PIC X(08). CL**4 00093 88 WS-FENR-110-88 VALUE 'EFTBD110'. CL*38 00094 88 WS-FEST-120-88 VALUE 'EFTBD120'. CL*38 00095 88 WS-FDPT-130-88 VALUE 'EFTBD130'. CL**8 00096 88 WS-FQTF-140-88 VALUE 'EFTBD140'. CL**8 00097 88 WS-FDPT-140-88 VALUE 'EFTBD140'. CL**8 00098 88 WS-FCQW-140-88 VALUE 'EFTBD140'. CL**8 00099 EFTBD100 00100 05 WRK-RPT-FILE-READ-CNT PIC 9(07) COMP-3. CL*69 00101 05 WRK-FENR-REC-CNT PIC 9(07) COMP-3. CL*38 00102 05 WRK-FEST-REC-CNT PIC 9(07) COMP-3. CL*38 00103 05 WRK-FDPT-REC-CNT PIC 9(07) COMP-3. CL**4 00104 05 WRK-FDPY-REC-CNT PIC 9(07) COMP-3. CL*10 00105 05 WRK-FCQW-REC-CNT PIC 9(07) COMP-3. CL**4 00106 05 WRK-FQTF-REC-CNT PIC 9(07) COMP-3. CL**8 00107 EFTBD100 00108 05 WRK-FED-8-DATE PIC X(08). EFTBD100 00109 05 FILLER REDEFINES WRK-FED-8-DATE. EFTBD100 00110 10 WRK-FED-CC PIC X(02). EFTBD100 00111 10 WRK-FED-6-DATE. EFTBD100 00112 15 WRK-FED-YY PIC X(02). EFTBD100 00113 15 WRK-FED-MM PIC X(02). EFTBD100 00114 15 WRK-FED-DD PIC X(02). EFTBD100 00115 EFTBD100 00116 05 WRK-DISPLAY-8-DATE. EFTBD100 00117 10 WRK-DISPLAY-8-MM PIC X(02). EFTBD100 00118 10 WRK-SLASH1 PIC X(01) VALUE '/'. EFTBD100 00119 10 WRK-DISPLAY-8-DD PIC X(02). EFTBD100 00120 10 WRK-SLASH2 PIC X(01) VALUE '/'. EFTBD100 00121 10 WRK-DISPLAY-8-CC PIC X(02). EFTBD100 00122 10 WRK-DISPLAY-8-YY PIC X(02). EFTBD100 00123 EFTBD100 00124 05 WRK-DISPLAY-6-DATE. EFTBD100 00125 10 WRK-DISPLAY-6-MM PIC X(02). EFTBD100 00126 10 WRK-SLASH3 PIC X(01) VALUE '/'. EFTBD100 00127 10 WRK-DISPLAY-6-DD PIC X(02). EFTBD100 00128 10 WRK-SLASH4 PIC X(01) VALUE '/'. EFTBD100 00129 10 WRK-DISPLAY-6-YY PIC X(02). EFTBD100 00130 EFTBD100 00131 05 WRK-TIME PIC X(08). EFTBD100 00132 05 FILLER REDEFINES WRK-TIME. EFTBD100 00133 10 WRK-TIME-HOURS PIC X(02). EFTBD100 00134 10 WRK-TIME-MINUTES PIC X(02). EFTBD100 00135 10 WRK-TIME-SECONDS PIC X(02). EFTBD100 00136 10 WRK-TIME-HUNDRETHS PIC X(02). EFTBD100 00137 EFTBD100 00138 05 WRK-DISPLAY-TIME. EFTBD100 00139 10 WRK-DISPLAY-HOURS PIC X(02). EFTBD100 00140 10 WRK-DOT1 PIC X(01) VALUE '.'. EFTBD100 00141 10 WRK-DISPLAY-MINUTES PIC X(02). EFTBD100 00142 10 WRK-DOT2 PIC X(01) VALUE '.'. EFTBD100 00143 10 WRK-DISPLAY-SECONDS PIC X(02). EFTBD100 00144 EFTBD100 00145 01 EFT-REC-TYPE-LINK-AREA. CL*11 00146 ++INCLUDE EFTIL100 CL*11 00147 CL*45 00148 01 L921-LINK-AREA. CL*45 00149 ++INCLUDE DTSIL921 CL*45 00150 CL*19 00151 01 L931-LINK-AREA. CL*66 00152 ++INCLUDE DTSIL931 CL*66 00153 CL*66 00154 01 L927-LINK-AREA. CL*19 00155 ++INCLUDE DTSIL927 CL*19 00156 CL*19 00157 01 L910-LINK-AREA. CL*45 00158 ++INCLUDE DTSIL910 CL*45 00159 CL*64 00160 01 L985-LINK-AREA. CL*64 00161 ++INCLUDE DTSIL985 CL*64 00162 CL*64 00163 CL*45 00164 01 RSKL-REC. CL*21 00165 ++INCLUDE EFTIRSKL CL*21 00166 CL*21 00167 01 ISKL-REC. CL*45 00168 ++INCLUDE DTSIISKL CL*46 00169 CL*45 00170 01 WSKL-REC. CL*54 00171 ++INCLUDE DTSIWSKL CL*54 00172 CL*54 00173 01 MSKL-REC. CL*45 00174 ++INCLUDE DTSIMSKL CL*47 00175 CL*45 00176 01 TSKL-REC. CL*41 00177 ++INCLUDE DTSITSKL CL*41 00178 CL*51 00179 01 EROR-MSG. CL*51 00180 ++INCLUDE EFTERMSG CL*51 00181 CL*51 00182 CL*38 00183 01 R907-REC. CL*22 00184 ++INCLUDE DTSIR907 CL*22 00185 CL*21 00186 01 F907-REC. CL*50 00187 ++INCLUDE EFTIF907 CL*50 00188 CL*50 00189 CL*18 00190 01 PAGE-HEADING. EFTBD100 00191 05 HDR1-LINE-1. EFTBD100 00192 10 FILLER PIC X(04) VALUE SPACES. EFTBD100 00193 10 FILLER PIC X(05) EFTBD100 00194 VALUE '100R1'. CL*58 00195 10 FILLER PIC X(37) VALUE SPACES. EFTBD100 00196 10 HDR1-AGY-NAME-LINE1 PIC X(20). EFTBD100 00197 10 FILLER PIC X(25) VALUE SPACES. EFTBD100 00198 10 FILLER PIC X(05) EFTBD100 00199 VALUE 'DATE:'. EFTBD100 00200 10 FILLER PIC X(01) VALUE SPACE. EFTBD100 00201 10 HDR1-SYS-DATE PIC X(08). EFTBD100 00202 05 HDR1-LINE-2. EFTBD100 00203 10 FILLER PIC X(40) VALUE SPACES. EFTBD100 00204 10 HDR1-AGY-NAME-LINE2 PIC X(34). EFTBD100 00205 10 FILLER PIC X(17) VALUE SPACES. EFTBD100 00206 10 FILLER PIC X(05) EFTBD100 00207 VALUE 'TIME:'. EFTBD100 00208 10 FILLER PIC X(01) VALUE SPACE. EFTBD100 00209 10 HDR1-SYS-TIME PIC X(08). EFTBD100 00210 05 HDR1-LINE-3. EFTBD100 00211 10 FILLER PIC X(04) VALUE SPACES. EFTBD100 00212 10 FILLER PIC X(30) EFTBD100 00213 VALUE 'ROUTE TO: PROGRAMMING UNIT '. CL**4 00214 10 FILLER PIC X(57) VALUE SPACES. EFTBD100 00215 10 FILLER PIC X(05) EFTBD100 00216 VALUE 'PAGE:'. EFTBD100 00217 10 FILLER PIC X(01) VALUE SPACE. EFTBD100 00218 10 HDR1-PAGE-CNT PIC Z9. EFTBD100 00219 05 HDR1-LINE-4 PIC X(133) VALUE SPACES. EFTBD100 00220 05 HDR1-LINE-5. EFTBD100 00221 10 FILLER PIC X(30) VALUE SPACES. EFTBD100 00222 10 FILLER PIC X(37) EFTBD100 00223 VALUE 'GOVONE E.F.T. SUMMARY CONTROL REPORT'. CL**4 00224 10 FILLER PIC X(66) VALUE SPACES. EFTBD100 00225 05 HDR1-LINE-6 PIC X(133) VALUE SPACES. EFTBD100 00226 05 HDR1-LINE-7 PIC X(133) VALUE SPACES. EFTBD100 00227 05 HDR1-LINE-8. EFTBD100 00228 10 FILLER PIC X(04) VALUE SPACES. EFTBD100 00229 10 FILLER PIC X(17) EFTBD100 00230 VALUE 'PROCESSING DATE: '. EFTBD100 00231 10 HDR1-PROC-DATE PIC X(10) VALUE SPACES. EFTBD100 00232 05 HDR1-LINE-9 PIC X(133) VALUE SPACES. EFTBD100 00233 EFTBD100 00234 01 DETAIL-LINE. EFTBD100 00235 05 DTL-LINE-2. EFTBD100 00236 10 FILLER PIC X(16) VALUE SPACES. EFTBD100 00237 10 FILLER PIC X(40) CL*61 00238 VALUE 'NUMBER OF INPUT REPORT RECORDS READ:'. EFTBD100 00239 10 FILLER PIC X(05) VALUE SPACES. CL*63 00240 10 DTL-READ-CNT PIC ZZZ,ZZ9. EFTBD100 00241 10 FILLER PIC X(63) VALUE SPACES. EFTBD100 00242 CL*42 00243 05 DTL-LINE-3. CL*42 00244 10 FILLER PIC X(16) VALUE SPACES. CL*42 00245 10 FILLER PIC X(40) CL*60 00246 VALUE 'NO. OF ENROLLMENT - FENR TYPE (00): '. CL*60 00247 10 FILLER PIC X(05) VALUE SPACES. CL*63 00248 10 DTL-FENR-CNT PIC ZZZ,ZZ9. CL*42 00249 10 FILLER PIC X(63) VALUE SPACES. CL*42 00250 CL*42 00251 EFTBD100 00252 05 DTL-LINE-5. EFTBD100 00253 10 FILLER PIC X(16) VALUE SPACES. EFTBD100 00254 10 FILLER PIC X(40) CL*60 00255 VALUE 'NO. OF EMP STATUS - FEST TYPE (01): '. CL*60 00256 10 FILLER PIC X(05) VALUE SPACES. CL*63 00257 10 DTL-FEST-CNT PIC ZZZ,ZZ9. CL**4 00258 10 FILLER PIC X(63) VALUE SPACES. EFTBD100 00259 EFTBD100 00260 05 DTL-LINE-6. CL*13 00261 10 FILLER PIC X(16) VALUE SPACES. CL*13 00262 10 FILLER PIC X(40) CL*60 00263 VALUE 'NO. OF PAYMENT ONLY - FDPT TYPE (02): '. CL*60 00264 10 FILLER PIC X(05) VALUE SPACES. CL*63 00265 10 DTL-FDPT-CNT PIC ZZZ,ZZ9. CL*13 00266 10 FILLER PIC X(63) VALUE SPACES. CL*13 00267 CL*13 00268 05 DTL-LINE-7. EFTBD100 00269 10 FILLER PIC X(16) VALUE SPACES. CL*59 00270 10 FILLER PIC X(40) CL*60 00271 VALUE 'NO. OF REPORT RECS - FQTF TYPE (03): '. CL*60 00272 10 FILLER PIC X(05) VALUE SPACES. CL*63 00273 10 DTL-FQTF-CNT PIC ZZZ,ZZ9. CL*59 00274 10 FILLER PIC X(63) VALUE SPACES. CL*59 00275 CL*13 00276 05 DTL-LINE-8. CL*13 00277 10 FILLER PIC X(16) VALUE SPACES. CL*13 00278 10 FILLER PIC X(40) CL*60 00279 VALUE 'NO. PAYMENT WITH REP - FDPT TYPE (04): '. CL*60 00280 10 FILLER PIC X(05) VALUE SPACES. CL*63 00281 10 DTL-FDPY-CNT PIC ZZZ,ZZ9. CL*13 00282 10 FILLER PIC X(63) VALUE SPACES. CL*13 00283 CL*13 00284 05 DTL-LINE-9. EFTBD100 00285 10 FILLER PIC X(16) VALUE SPACES. CL*59 00286 10 FILLER PIC X(40) CL*60 00287 VALUE 'NO. OF WAGE RECORDS - FCQW TYPE (05): '. CL*60 00288 10 FILLER PIC X(05) VALUE SPACES. CL*63 00289 10 DTL-FCQW-CNT PIC ZZZ,ZZ9. CL*59 00290 10 FILLER PIC X(63) VALUE SPACES. CL*59 00291 CL*59 00292 EFTBD100 00293 05 DTL-LINE-12. EFTBD100 00294 10 FILLER PIC X(36) VALUE SPACES. EFTBD100 00295 10 FILLER PIC X(17) EFTBD100 00296 VALUE '*** END OF REPORT'. EFTBD100 00297 10 FILLER PIC X(80) VALUE SPACES. EFTBD100 00298 EFTBD100 00299 05 WRK-PARM-REC. CL*14 00300 10 WRK-PARM-REC00 PIC X(02). CL*42 00301 10 WRK-PARM-REC01 PIC X(02). CL*42 00302 10 WRK-PARM-REC02 PIC X(02). CL*42 00303 10 WRK-PARM-REC03 PIC X(02). CL*42 00304 10 WRK-PARM-REC04 PIC X(02). CL*42 00305 10 WRK-PARM-REC05 PIC X(02). CL*42 00306 CL*13 00307 EFTBD100 00308 LINKAGE SECTION. EFTBD100 00309 01 PARM-AREA. EFTBD100 00310 05 PARM-LENGTH PIC S9(04) COMP. EFTBD100 00311 05 PARM-REC00 PIC X(02). CL*42 00312 05 FILLER PIC X(01). EFTBD100 00313 05 PARM-REC01 PIC X(02). CL*42 00314 05 FILLER PIC X(01). EFTBD100 00315 05 PARM-REC02 PIC X(02). CL*42 00316 05 FILLER PIC X(01). CL**4 00317 05 PARM-REC03 PIC X(02). CL*42 00318 05 FILLER PIC X(01). CL**4 00319 05 PARM-REC04 PIC X(02). CL*42 00320 05 FILLER PIC X(01). CL*42 00321 05 PARM-REC05 PIC X(02). CL*42 00322 CL*21 00323 CL*21 00324 PROCEDURE DIVISION USING PARM-AREA. EFTBD100 00325 EFTBD100 00326 PROC0000-MAIN. EFTBD100 00327 PERFORM INIT0000-INITIATE THRU INIT0000-EXIT. EFTBD100 00328 EFTBD100 00329 PERFORM PROC1000-SCAN-EFT-FILE THRU PROC1000-EXIT CL*17 00330 UNTIL EFT-FILE-EOF-88. CL*13 00331 EFTBD100 00332 PERFORM TERM0000-TERMINATE THRU TERM0000-EXIT. EFTBD100 00333 EFTBD100 00334 PROC0000-EXIT. EFTBD100 00335 EFTBD100 00336 GOBACK. EFTBD100 00337 EFTBD100 00338 INIT0000-INITIATE. EFTBD100 00339 EFTBD100 00340 PERFORM INIT0100-PARMS THRU INIT0100-EXIT. EFTBD100 00341 EFTBD100 00342 PERFORM INIT1000-INIT-WRK-DATA THRU INIT1000-EXIT. EFTBD100 00343 PERFORM INIT2000-OPEN-FILES THRU INIT2000-EXIT. EFTBD100 00344 PERFORM INIT4000-SYSTEM-DATE THRU INIT4000-EXIT. EFTBD100 00345 PERFORM INIT5000-READ-FIRST THRU INIT5000-EXIT. CL*52 00346 PERFORM INIT6000-INIT-REPORTS THRU INIT6000-EXIT. EFTBD100 00347 EFTBD100 00348 INIT0000-EXIT. EFTBD100 00349 EXIT. EFTBD100 00350 EFTBD100 00351 INIT0100-PARMS. EFTBD100 00352 MOVE SPACES TO WRK-PARM-REC00 CL*42 00353 WRK-PARM-REC01 CL*42 00354 WRK-PARM-REC02 CL*42 00355 WRK-PARM-REC03 CL*42 00356 WRK-PARM-REC04 CL*42 00357 WRK-PARM-REC05. CL*42 00358 EFTBD100 00359 IF PARM-LENGTH = +0 CL*16 00360 PERFORM INIT0120-DEFAULT-PARMS THRU INIT0120-EXIT CL*16 00361 ELSE EFTBD100 00362 PERFORM INIT0110-EDIT-PARMS THRU INIT0110-EXIT CL*16 00363 END-IF. EFTBD100 00364 EFTBD100 00365 INIT0100-EXIT. EFTBD100 00366 EXIT. EFTBD100 00367 EFTBD100 00368 INIT0110-EDIT-PARMS. EFTBD100 00369 IF PARM-REC00 = '00' OR '01' OR '02' OR '03' OR CL*42 00370 '04' OR '05' OR ' ' CL*42 00371 MOVE PARM-REC00 TO WRK-PARM-REC00 CL*42 00372 ELSE CL*42 00373 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC00 CL*42 00374 SET ABEND-RPT-FILE-READ TO TRUE CL*42 00375 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*42 00376 END-IF. CL*42 00377 CL*42 00378 IF PARM-REC01 = '00' OR '01' OR '02' OR '03' OR CL*42 00379 '04' OR '05' OR ' ' CL*42 00380 MOVE PARM-REC01 TO WRK-PARM-REC01 CL**6 00381 ELSE CL*16 00382 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC01 CL*16 00383 SET ABEND-RPT-FILE-READ TO TRUE CL*16 00384 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 00385 END-IF. EFTBD100 00386 CL*16 00387 IF PARM-REC02 = '00' OR '01' OR '02' OR '03' OR CL*42 00388 '04' OR '05' OR ' ' CL*42 00389 MOVE PARM-REC02 TO WRK-PARM-REC02 CL*16 00390 ELSE CL*16 00391 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC02 CL*16 00392 SET ABEND-RPT-FILE-READ TO TRUE CL*16 00393 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 00394 END-IF. CL*16 00395 CL*16 00396 IF PARM-REC03 = '00' OR '01' OR '02' OR '03' OR CL*42 00397 '04' OR '05' OR ' ' CL*42 00398 MOVE PARM-REC03 TO WRK-PARM-REC03 CL*16 00399 ELSE CL*16 00400 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC03 CL*16 00401 SET ABEND-RPT-FILE-READ TO TRUE CL*16 00402 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 00403 END-IF. CL*16 00404 CL*16 00405 IF PARM-REC04 = '00' OR '01' OR '02' OR '03' OR CL*42 00406 '04' OR '05' OR ' ' CL*42 00407 MOVE PARM-REC04 TO WRK-PARM-REC04 CL*16 00408 ELSE CL*16 00409 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC04 CL*16 00410 SET ABEND-RPT-FILE-READ TO TRUE CL*16 00411 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 00412 END-IF. CL*16 00413 CL*16 00414 IF PARM-REC05 = '00' OR '01' OR '02' OR '03' OR CL*42 00415 '04' OR '05' OR ' ' CL*42 00416 MOVE PARM-REC05 TO WRK-PARM-REC05 CL*16 00417 ELSE CL*16 00418 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC05 CL*16 00419 SET ABEND-RPT-FILE-READ TO TRUE CL*16 00420 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 00421 END-IF. CL*16 00422 INIT0110-EXIT. EFTBD100 00423 EXIT. EFTBD100 00424 EFTBD100 00425 INIT0120-DEFAULT-PARMS. EFTBD100 00426 MOVE '00' TO WRK-PARM-REC00. CL*42 00427 MOVE '01' TO WRK-PARM-REC01. CL*42 00428 MOVE '02' TO WRK-PARM-REC02. CL*42 00429 MOVE '03' TO WRK-PARM-REC03. CL*42 00430 MOVE '04' TO WRK-PARM-REC04. CL*42 00431 MOVE '05' TO WRK-PARM-REC05. CL*42 00432 EFTBD100 00433 INIT0120-EXIT. EFTBD100 00434 EXIT. EFTBD100 00435 EFTBD100 00436 INIT1000-INIT-WRK-DATA. EFTBD100 00437 EFTBD100 00438 MOVE ZERO TO WRK-RPT-FILE-READ-CNT EFTBD100 00439 WRK-FENR-REC-CNT CL*39 00440 WRK-FEST-REC-CNT CL*39 00441 WRK-FDPT-REC-CNT CL**6 00442 WRK-FDPY-REC-CNT CL*12 00443 WRK-FQTF-REC-CNT CL**6 00444 WRK-FCQW-REC-CNT. CL**7 00445 EFTBD100 00446 MOVE 'DISTRICT OF COLUMBIA' TO EFTBD100 00447 HDR1-AGY-NAME-LINE1. EFTBD100 00448 MOVE 'UNEMPLOYMENT COMPENSATION DIVISION' TO EFTBD100 00449 HDR1-AGY-NAME-LINE2. EFTBD100 00450 MOVE SPACES TO REPORT-LISTING1. EFTBD100 00451 EFTBD100 00452 INIT1000-EXIT. EFTBD100 00453 EXIT. EFTBD100 00454 EFTBD100 00455 INIT2000-OPEN-FILES. EFTBD100 00456 EFTBD100 00457 PERFORM SERV1100-OPEN-FILES THRU SERV1100-EXIT. CL*33 00458 EFTBD100 00459 EFTBD100 00460 INIT2000-EXIT. EFTBD100 00461 EXIT. EFTBD100 00462 EFTBD100 00463 INIT4000-SYSTEM-DATE. EFTBD100 00464 ACCEPT WRK-FED-6-DATE FROM DATE. EFTBD100 00465 EFTBD100 00466 MOVE WRK-FED-YY TO WRK-DISPLAY-6-YY. EFTBD100 00467 MOVE WRK-FED-MM TO WRK-DISPLAY-6-MM. EFTBD100 00468 MOVE WRK-FED-DD TO WRK-DISPLAY-6-DD. EFTBD100 00469 EFTBD100 00470 MOVE WRK-DISPLAY-6-DATE TO HDR1-SYS-DATE EFTBD100 00471 EFTBD100 00472 ACCEPT WRK-TIME FROM TIME. EFTBD100 00473 EFTBD100 00474 MOVE WRK-TIME-HOURS TO WRK-DISPLAY-HOURS. EFTBD100 00475 MOVE WRK-TIME-MINUTES TO WRK-DISPLAY-MINUTES, EFTBD100 00476 MOVE WRK-TIME-SECONDS TO WRK-DISPLAY-SECONDS. EFTBD100 00477 EFTBD100 00478 MOVE WRK-DISPLAY-TIME TO HDR1-SYS-TIME. CL*13 00479 EFTBD100 00480 INIT4000-EXIT. EFTBD100 00481 EXIT. EFTBD100 00482 EFTBD100 00483 INIT5000-READ-FIRST. EFTBD100 00484 EFTBD100 00485 PERFORM SERV1200-READ-NEXT THRU SERV1200-EXIT. EFTBD100 00486 EFTBD100 00487 INIT5000-EXIT. EFTBD100 00488 EXIT. EFTBD100 00489 EFTBD100 00490 INIT6000-INIT-REPORTS. EFTBD100 00491 EFTBD100 00492 SET EFT-L100-CMD-INIT-88 TO TRUE. CL*12 00493 EFTBD100 00494 SET WS-FENR-110-88 TO TRUE. CL*38 00495 PERFORM PROC1100-FENR THRU PROC1100-EXIT. CL*43 00496 EFTBD100 00497 SET WS-FEST-120-88 TO TRUE. CL*38 00498 PERFORM PROC1200-FEST THRU PROC1200-EXIT. CL*38 00499 CL*38 00500 SET WS-FDPT-130-88 TO TRUE. CL**8 00501 PERFORM PROC1300-FDPT THRU PROC1300-EXIT. CL*38 00502 EFTBD100 00503 SET WS-FQTF-140-88 TO TRUE. CL*53 00504 PERFORM PROC1400-FQTF THRU PROC1400-EXIT. CL*53 00505 EFTBD100 00506 INIT6000-EXIT. EFTBD100 00507 EXIT. EFTBD100 00508 EFTBD100 00509 PROC1000-SCAN-EFT-FILE. CL*19 00510 EFTBD100 00511 SET EFT-L100-CMD-PROCESS-88 TO TRUE. CL*12 00512 CL*26 00513 IF EFT-SORT-TRAN NOT = WRK-PARM-REC00 CL*42 00514 AND WRK-PARM-REC01 CL*42 00515 AND WRK-PARM-REC02 CL*42 00516 AND WRK-PARM-REC03 CL*16 00517 AND WRK-PARM-REC04 CL*16 00518 AND WRK-PARM-REC05 CL*16 00519 GO TO PROC1000-READ-NEXT. CL*16 00520 EFTBD100 00521 IF EFT-SORT-TRAN = 00 CL*38 00522 ADD +1 TO WRK-FENR-REC-CNT CL*52 00523 PERFORM PROC1100-FENR THRU PROC1100-EXIT CL*39 00524 ELSE EFTBD100 00525 IF EFT-SORT-TRAN = 01 CL*38 00526 ADD +1 TO WRK-FEST-REC-CNT CL*52 00527 PERFORM PROC1200-FEST THRU PROC1200-EXIT CL*39 00528 ELSE CL**8 00529 IF EFT-SORT-TRAN = 02 CL*38 00530 ADD +1 TO WRK-FDPT-REC-CNT CL*52 00531 PERFORM PROC1300-FDPT THRU PROC1300-EXIT CL*39 00532 ELSE CL**8 00533 IF EFT-SORT-TRAN = 03 CL*38 00534 ADD +1 TO WRK-FQTF-REC-CNT CL*52 00535 PERFORM PROC1400-FQTF THRU PROC1400-EXIT CL*39 00536 ELSE CL**8 00537 IF EFT-SORT-TRAN = 04 CL*38 00538 ADD +1 TO WRK-FDPY-REC-CNT CL*52 00539 PERFORM PROC1500-FDPT THRU PROC1500-EXIT CL*39 00540 ELSE CL**8 00541 IF EFT-SORT-TRAN = 05 CL*38 00542 ADD +1 TO WRK-FCQW-REC-CNT CL*52 00543 PERFORM PROC1600-FCQW THRU PROC1600-EXIT CL*38 00544 ELSE CL*38 00545 DISPLAY '***** INVLAID RECORD TYPE**** ' CL*16 00546 SET ABEND-RPT-FILE-READ TO TRUE CL*16 00547 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 00548 END-IF CL*38 00549 END-IF CL*38 00550 END-IF CL**8 00551 END-IF CL**8 00552 END-IF CL**8 00553 END-IF. EFTBD100 00554 EFTBD100 00555 EFTBD100 00556 PROC1000-READ-NEXT. EFTBD100 00557 PERFORM SERV1200-READ-NEXT THRU SERV1200-EXIT. EFTBD100 00558 EFTBD100 00559 PROC1000-EXIT. EFTBD100 00560 EXIT. EFTBD100 00561 EFTBD100 00562 PROC1100-FENR. CL*38 00563 DISPLAY ' CALLING 110' CL*49 00564 SET WS-FENR-110-88 TO TRUE. CL*38 00565 MOVE EFT-TRANS-REC TO RSKL-REC. CL*38 00566 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*38 00567 RSKL-REC. CL*39 00568 CL*38 00569 PROC1100-EXIT. EFTBD100 00570 EXIT. EFTBD100 00571 EFTBD100 00572 PROC1200-FEST. CL*38 00573 CL*38 00574 DISPLAY ' CALLING 120' CL*49 00575 SET WS-FEST-120-88 TO TRUE. CL*38 00576 MOVE EFT-TRANS-REC TO RSKL-REC. CL*42 00577 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*42 00578 RSKL-REC. CL*42 00579 CL*42 00580 CL*38 00581 PROC1200-EXIT. CL*38 00582 EXIT. CL*38 00583 CL*38 00584 PROC1300-FDPT. CL*38 00585 DISPLAY ' CALLING 130' CL*49 00586 MOVE EFT-TRANS-REC TO RSKL-REC. CL*18 00587 SET WS-FDPT-130-88 TO TRUE. CL**8 00588 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*18 00589 RSKL-REC. CL*39 00590 CL*36 00591 PROC1300-EXIT. CL*38 00592 EXIT. EFTBD100 00593 EFTBD100 00594 PROC1400-FQTF. CL*38 00595 EFTBD100 00596 DISPLAY ' CALLING 140' CL*49 00597 SET WS-FQTF-140-88 TO TRUE. CL**8 00598 MOVE EFT-TRANS-REC TO RSKL-REC. CL*42 00599 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*42 00600 RSKL-REC. CL*42 00601 CL*42 00602 EFTBD100 00603 PROC1400-EXIT. CL*38 00604 EXIT. EFTBD100 00605 EFTBD100 00606 PROC1500-FDPT. CL*38 00607 CL**8 00608 SET WS-FDPT-140-88 TO TRUE. CL**8 00609 MOVE EFT-TRANS-REC TO RSKL-REC. CL*42 00610 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*42 00611 RSKL-REC. CL*42 00612 CL*42 00613 CL**8 00614 PROC1500-EXIT. CL*38 00615 EXIT. CL**8 00616 CL**8 00617 CL**8 00618 PROC1600-FCQW. CL*38 00619 CL**8 00620 SET WS-FCQW-140-88 TO TRUE. CL*13 00621 MOVE EFT-TRANS-REC TO RSKL-REC. CL*42 00622 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*42 00623 RSKL-REC. CL*42 00624 CL*42 00625 CL**8 00626 PROC1600-EXIT. CL*38 00627 EXIT. CL**8 00628 CL**8 00629 PROC2000-PRINT-HEADER. EFTBD100 00630 EFTBD100 00631 IF WS-LINE-CNT GREATER 58 OR EFTBD100 00632 WS-LINE-CNT2 GREATER 58 EFTBD100 00633 MOVE +0 TO WS-LINE-CNT EFTBD100 00634 MOVE +0 TO WS-LINE-CNT2 EFTBD100 00635 ADD +1 TO WS-PAGE-CNT EFTBD100 00636 MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT EFTBD100 00637 WRITE REPORT-LISTING1 FROM HDR1-LINE-1 EFTBD100 00638 AFTER TOP-OF-PAGE EFTBD100 00639 WRITE REPORT-LISTING1 FROM HDR1-LINE-2 AFTER 1 EFTBD100 00640 WRITE REPORT-LISTING1 FROM HDR1-LINE-3 AFTER 1 EFTBD100 00641 WRITE REPORT-LISTING1 FROM HDR1-LINE-4 AFTER 1 EFTBD100 00642 WRITE REPORT-LISTING1 FROM HDR1-LINE-5 AFTER 1 EFTBD100 00643 WRITE REPORT-LISTING1 FROM HDR1-LINE-6 AFTER 1 EFTBD100 00644 WRITE REPORT-LISTING1 FROM HDR1-LINE-7 AFTER 1 EFTBD100 00645 WRITE REPORT-LISTING1 FROM HDR1-LINE-8 AFTER 1 EFTBD100 00646 WRITE REPORT-LISTING1 FROM HDR1-LINE-9 AFTER 1 EFTBD100 00647 ADD +9 TO WS-LINE-CNT2. EFTBD100 00648 EFTBD100 00649 PROC2000-EXIT. EFTBD100 00650 EXIT. EFTBD100 00651 EFTBD100 00652 EFTBD100 00653 TERM0000-TERMINATE. EFTBD100 00654 PERFORM TERM1000-CLOSE-REPORT THRU TERM1000-EXIT. EFTBD100 00655 PERFORM TERM2000-CONTROL-REPORT THRU TERM2000-EXIT. EFTBD100 00656 PERFORM TERM3000-CLOSE-FILES THRU TERM3000-EXIT. EFTBD100 00657 EFTBD100 00658 DISPLAY ' BD100 TERM END '. CL*28 00659 TERM0000-EXIT. EFTBD100 00660 EXIT. EFTBD100 00661 EFTBD100 00662 TERM1000-CLOSE-REPORT. EFTBD100 00663 EFTBD100 00664 SET EFT-L100-CMD-TERMINATE-88 TO TRUE. CL*12 00665 CL**9 00666 SET WS-FENR-110-88 TO TRUE. CL*43 00667 PERFORM PROC1100-FENR THRU PROC1100-EXIT. CL*39 00668 CL*38 00669 SET WS-FEST-120-88 TO TRUE. CL*38 00670 PERFORM PROC1200-FEST THRU PROC1200-EXIT. CL*39 00671 EFTBD100 00672 SET WS-FDPT-130-88 TO TRUE. CL**9 00673 PERFORM PROC1300-FDPT THRU PROC1300-EXIT. CL*39 00674 EFTBD100 00675 SET WS-FQTF-140-88 TO TRUE. CL*53 00676 PERFORM PROC1400-FQTF THRU PROC1400-EXIT. CL*53 00677 EFTBD100 00678 TERM1000-EXIT. EFTBD100 00679 EXIT. EFTBD100 00680 EFTBD100 00681 TERM2000-CONTROL-REPORT. EFTBD100 00682 EFTBD100 00683 DISPLAY '**** BD100 STATS ***** : ' CL*42 00684 DISPLAY 'BD110-35 FENR RECORDS CNT : ' CL*69 00685 WRK-FENR-REC-CNT. CL*69 00686 CL*69 00687 DISPLAY 'BD120-34 FEST RECORDS CNT : ' CL*69 00688 WRK-FEST-REC-CNT. CL**7 00689 CL*42 00690 DISPLAY 'FDPT -NO RPTS RECORDS CNT : ' CL*10 00691 WRK-FDPT-REC-CNT. CL**7 00692 EFTBD100 00693 CL*10 00694 DISPLAY 'FDPT -W/RPTS RECORDS CNT : ' CL*10 00695 WRK-FDPY-REC-CNT. CL*10 00696 CL*10 00697 DISPLAY 'BD140-30 FQTF RECORDS CNT : ' CL*69 00698 WRK-FQTF-REC-CNT. CL**7 00699 EFTBD100 00700 DISPLAY 'BD140-33 FCQW RECORDS CNT : ' CL*69 00701 WRK-FCQW-REC-CNT. CL**8 00702 CL**7 00703 DISPLAY ' TOTAL GOV1 INPUT REPORT RECORDS READ : ' CL**7 00704 WRK-RPT-FILE-READ-CNT. EFTBD100 00705 EFTBD100 00706 MOVE WRK-RPT-FILE-READ-CNT TO DTL-READ-CNT. EFTBD100 00707 MOVE WRK-FENR-REC-CNT TO DTL-FENR-CNT. CL*42 00708 MOVE WRK-FEST-REC-CNT TO DTL-FEST-CNT. CL*42 00709 MOVE WRK-FDPT-REC-CNT TO DTL-FDPT-CNT. CL**7 00710 MOVE WRK-FCQW-REC-CNT TO DTL-FCQW-CNT. CL**7 00711 MOVE WRK-FQTF-REC-CNT TO DTL-FQTF-CNT. CL**7 00712 MOVE WRK-FDPY-REC-CNT TO DTL-FDPY-CNT. CL*10 00713 EFTBD100 00714 PERFORM PROC2000-PRINT-HEADER THRU PROC2000-EXIT. EFTBD100 00715 WRITE REPORT-LISTING1 FROM DTL-LINE-2 AFTER 2. EFTBD100 00716 WRITE REPORT-LISTING1 FROM DTL-LINE-3 AFTER 2. CL*42 00717 WRITE REPORT-LISTING1 FROM DTL-LINE-5 AFTER 2. CL*70 00718 WRITE REPORT-LISTING1 FROM DTL-LINE-6 AFTER 2. CL*70 00719 WRITE REPORT-LISTING1 FROM DTL-LINE-7 AFTER 2. EFTBD100 00720 WRITE REPORT-LISTING1 FROM DTL-LINE-8 AFTER 2. CL*63 00721 WRITE REPORT-LISTING1 FROM DTL-LINE-9 AFTER 2. EFTBD100 00722 WRITE REPORT-LISTING1 FROM DTL-LINE-12 AFTER 3. EFTBD100 00723 EFTBD100 00724 EFTBD100 00725 TERM2000-EXIT. EFTBD100 00726 EXIT. EFTBD100 00727 EFTBD100 00728 TERM3000-CLOSE-FILES. EFTBD100 00729 PERFORM SERV3300-CLOSE-FILE THRU SERV3300-EXIT. CL*33 00730 EFTBD100 00731 TERM3000-EXIT. EFTBD100 00732 EXIT. EFTBD100 00733 EFTBD100 00734 SERV1100-OPEN-FILES. CL*34 00735 OPEN INPUT EFT-REC-FILE. CL*12 00736 EFTBD100 00737 IF NOT EFT-FILE-OK-88 CL*13 00738 DISPLAY 'REPORT FILE OPEN ERROR: ' EFT-FILE-STATUS CL*13 00739 SET ABEND-RPT-FILE-OPEN TO TRUE EFTBD100 00740 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. EFTBD100 00741 EFTBD100 00742 OPEN OUTPUT PRT-FILE. CL*33 00743 CL*33 00744 MOVE 'N' TO L927-TRACE-IND. CL*33 00745 MOVE WRK-MOD-NAME TO L927-MOD-NAME. CL*33 00746 PERFORM SERV2000-OPEN-BTC THRU SERV2000-EXIT. CL*33 00747 CL*44 00748 MOVE 'N' TO WRK-TRACE-IND. CL*44 00749 MOVE WRK-TRACE-IND TO L910-TRACE-IND. CL*44 00750 MOVE WRK-MOD-NAME TO L910-MOD-NAME. CL*44 00751 * PERFORM S910-OPEN-UPDATE THRU S910-EXIT. CL*44 00752 PERFORM S910-OPEN-READ THRU S910-EXIT. CL*44 00753 PERFORM S931-OPEN-READ THRU S931-EXIT. CL*65 00754 CL*44 00755 MOVE WRK-TRACE-IND TO L921-TRACE-IND. CL*44 00756 MOVE WRK-MOD-NAME TO L921-MOD-NAME. CL*44 00757 PERFORM S921-OPEN-READ THRU S921-EXIT. CL*55 00758 CL*50 00759 MOVE WRK-TRACE-IND TO L985-TRACE-IND. CL*64 00760 MOVE WRK-MOD-NAME TO L985-MOD-NAME. CL*64 00761 *** PERFORM S985-OPEN-UPDATE THRU S985-EXIT. CL*67 00762 CL*54 00763 MOVE LENGTH OF F907-REC TO F907-LENGTH. CL*50 00764 MOVE '035' TO F907-MSG-ID CL*50 00765 MOVE EFT035 TO F907-MSG-TEXT CL*50 00766 MOVE ZEROS TO F907-EMP-NO CL*50 00767 MOVE RSKL-REC-TYPE TO F907-GOV1-RECID CL*50 00768 CALL 'DTSBU946' USING F907-REC. CL*50 00769 CL*50 00770 CL*44 00771 CL*44 00772 CL*33 00773 SERV1100-EXIT. EFTBD100 00774 EXIT. EFTBD100 00775 EFTBD100 00776 SERV1200-READ-NEXT. EFTBD100 00777 EFTBD100 00778 READ EFT-REC-FILE AT END CL*26 00779 SET EFT-FILE-EOF-88 TO TRUE. CL*26 00780 CL*26 00781 IF EFT-FILE-OK-88 CL*13 00782 ADD 1 TO WRK-RPT-FILE-READ-CNT EFTBD100 00783 ELSE EFTBD100 00784 IF EFT-FILE-EOF-88 CL*13 00785 NEXT SENTENCE EFTBD100 00786 ELSE EFTBD100 00787 DISPLAY 'REPORT FILE READ ERROR: ' EFTBD100 00788 EFT-FILE-STATUS CL*13 00789 ' RECS READ ' WRK-RPT-FILE-READ-CNT EFTBD100 00790 SET ABEND-RPT-FILE-READ TO TRUE EFTBD100 00791 PERFORM SERV9999-ABEND THRU SERV9999-EXIT EFTBD100 00792 END-IF EFTBD100 00793 END-IF. EFTBD100 00794 EFTBD100 00795 SERV1200-EXIT. EFTBD100 00796 EXIT. EFTBD100 00797 EFTBD100 00798 CL*18 00799 SERV2000-OPEN-BTC. CL*33 00800 CL*33 00801 SET L927-OPEN-UPDATE-88 TO TRUE. CL*33 00802 GO TO SERV2000-CALL-PROG. CL*33 00803 CL*33 00804 SERV2000-CLOS-BTC. CL*33 00805 CL*33 00806 SET L927-CLOSE-88 TO TRUE. CL*33 00807 GO TO SERV2000-CALL-PROG. CL*33 00808 CL*41 00809 SERV2000-CALL-PROG. CL*41 00810 CL*41 00811 CALL 'DTSBU927' USING L927-LINK-AREA CL*41 00812 TSKL-REC. CL*41 00813 CL*41 00814 CL*41 00815 SERV2000-EXIT. CL*18 00816 EXIT. CL*18 00817 EFTBD100 00818 SERV3300-CLOSE-FILE. CL*33 00819 CLOSE PRT-FILE. CL**6 00820 CL*42 00821 CLOSE EFT-REC-FILE. CL*33 00822 CL*42 00823 PERFORM SERV2000-CLOS-BTC THRU SERV2000-EXIT. CL*33 00824 CL*42 00825 MOVE -1 TO R907-LENGTH. CL*42 00826 CALL 'DTSBU946' USING R907-REC. CL*40 00827 CL*44 00828 PERFORM S910-CLOSE THRU S910-EXIT. CL*44 00829 CL*44 00830 PERFORM S921-CLOSE THRU S921-EXIT. CL*44 00831 *** PERFORM S985-CLOSE THRU S985-EXIT. CL*67 00832 CL*44 00833 SERV3300-EXIT. CL*45 00834 EXIT. CL*45 00835 CL*45 00836 S910-OPEN-READ. CL*44 00837 SET L910-OPEN-READ-88 TO TRUE. CL*44 00838 GO TO S910-MSTR-IO. CL*44 00839 CL*44 00840 S910-OPEN-UPDATE. CL*44 00841 SET L910-OPEN-UPDATE-88 TO TRUE. CL*44 00842 GO TO S910-MSTR-IO. CL*44 00843 CL*44 00844 S910-OPEN-UPDATE-NO-AIX. CL*44 00845 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. CL*44 00846 GO TO S910-MSTR-IO. CL*44 00847 CL*44 00848 S910-READ. CL*44 00849 SET L910-READ-88 TO TRUE. CL*44 00850 GO TO S910-MSTR-IO. CL*44 00851 CL*44 00852 S910-START-BROWSE. CL*44 00853 SET L910-START-BROWSE-88 TO TRUE. CL*44 00854 GO TO S910-MSTR-IO. CL*44 00855 CL*44 00856 S910-READ-NEXT. CL*44 00857 SET L910-READ-NEXT-88 TO TRUE. CL*44 00858 GO TO S910-MSTR-IO. CL*44 00859 CL*44 00860 S910-COUNT. CL*44 00861 SET L910-COUNT-88 TO TRUE. CL*44 00862 GO TO S910-MSTR-IO. CL*44 00863 CL*44 00864 S910-CLOSE. CL*44 00865 SET L910-CLOSE-88 TO TRUE. CL*44 00866 GO TO S910-MSTR-IO. CL*44 00867 CL*44 00868 S910-MSTR-IO. CL*44 00869 CALL 'DTSBU910' USING L910-LINK-AREA CL*44 00870 MSKL-REC. CL*44 00871 S910-EXIT. CL*44 00872 EXIT. CL*44 00873 CL*44 00874 S921-OPEN-READ. CL*56 00875 SET L921-OPEN-READ-88 TO TRUE. CL*56 00876 GO TO S921-AIX-IO. CL*44 00877 CL*44 00878 S921-CLOSE. CL*44 00879 SET L921-CLOSE-88 TO TRUE. CL*44 00880 GO TO S921-AIX-IO. CL*44 00881 CL*44 00882 S921-AIX-IO. CL*44 00883 CALL 'DTSBU921' USING L921-LINK-AREA CL*44 00884 ISKL-REC. CL*44 00885 S921-EXIT. CL*44 00886 EXIT. EFTBD100 00887 EFTBD100 00888 S931-OPEN-READ. CL*65 00889 SET L931-OPEN-READ-88 TO TRUE. CL*65 00890 GO TO S931-CALL-931. CL*65 00891 CL*65 00892 S931-CLOSE. CL*65 00893 SET L931-CLOSE-88 TO TRUE. CL*65 00894 CL*65 00895 S931-CALL-931. CL*65 00896 CALL 'DTSBU931' USING L931-LINK-AREA. CL*65 00897 S931-EXIT. CL*65 00898 EXIT. CL*65 00899 CL*65 00900 CL*54 00901 S985-OPEN-UPDATE. CL*64 00902 SET L985-OPEN-UPDATE-88 TO TRUE. CL*64 00903 GO TO S985-WAGE-IO. CL*64 00904 CL*54 00905 S985-CLOSE. CL*64 00906 SET L985-CLOSE-88 TO TRUE. CL*64 00907 GO TO S985-WAGE-IO. CL*64 00908 CL*54 00909 S985-WAGE-IO. CL*64 00910 CALL 'DTSBU985' USING L985-LINK-AREA CL*64 00911 WSKL-REC. CL*54 00912 S985-EXIT. CL*64 00913 EXIT. CL*54 00914 CL*54 00915 SERV9999-ABEND. EFTBD100 00916 DISPLAY '**** EFTBD100 ABENDING '. CL**7 00917 CALL ABEND-MOD USING ABEND-CODE. EFTBD100 00918 SERV9999-EXIT. EFTBD100 00919 EXIT. EFTBD100 00920 EFTBD100