922 lines
73 KiB
COBOL
922 lines
73 KiB
COBOL
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
|