00001 IDENTIFICATION DIVISION. 10/09/03 00002 PROGRAM-ID. EFTBD800. EFTBD800 00003 AUTHOR. NGI. LV002 00004 DATE-WRITTEN. OCTOBER 2003. CL**2 00005 DATE-COMPILED. EFTBD800 00006 EFTBD800 00007 ***** EFTBD800 00008 * EFTBD800 00009 * FUNCTION: REPORT DRIVER MODULE. EFTBD800 00010 * EFTBD800 00011 * EFTBD800 00012 * MODIFICATION HISTORY: EFTBD800 00013 * EFTBD800 00014 * 10-09-03 INITIAL DEVELOPMENT COPIED FROM DTSBD800 CL**2 00015 * REFERENCE: EFT AUTHOR OF CHANGE - ZL1 CL**2 00016 * EFTBD800 00017 * EFTBD800 00018 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX EFTBD800 00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX EFTBD800 00020 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX EFTBD800 00021 * EFTBD800 00022 * EFTBD800 00023 * DESCRIPTION: EFTBD800 00024 * EFTBD800 00025 * THE FUNCTION OF EFTBD800 IS TO READ THE SORTED INCOMING CL**2 00026 * REPORT RECORD FILE AND CALL THE APPROPRIATE MODULE TO EFTBD800 00027 * PROCESS EACH REPORT RECORD. THE RECORD TYPE IS APPENDED EFTBD800 00028 * TO THE CONSTANT 'EFTBR' TO FORM THE LOAD MODULE NAME CL**2 00029 * ASSOCIATED WITH THE RECORD. EFTBD800 00030 * EFTBD800 00031 * TWO TYPES OF PARAMETER FILES ARE INPUT: EFTBD800 00032 * EFTBD800 00033 * - ONE PARAMETER FILE (CALLED PARM-FILE) SPECIFIES WHICH OF EFTBD800 00034 * THE INCOMING REPORT RECORD TYPES ARE TO BE PROCESSED, THIS EFTBD800 00035 * IS DONE BY EITHER SPECIFYING: EFTBD800 00036 * A: REPORT RECORD TYPES TO BE INCLUDED (PROCESSED) EFTBD800 00037 * OR EFTBD800 00038 * B: REPORT RECORD TYPES TO BE EXCLUDED (NOT PROCESSED). EFTBD800 00039 * EFTBD800 00040 * - THE OTHER PARAMETER FILE (CALLED ATLEAST-ONCE-FILE) EFTBD800 00041 * SPECIFIES THE REPORT RECORD TYPES CORRESPONDING TO ALL EFTBD800 00042 * REPORT MODULES WHICH MUST BE EXECUTED AT LEAST ONCE. EFTBD800 00043 * EFTBD800 00044 * EFTBD800 00045 * - THE TABLE INTRODUCED FOR EFTBR980 IS 999 ENTRIES LONG CL**2 00046 * TO HANDLE EVERY POSSIBLE REPORT PROGRAM EFTBD800 00047 * (EFTBR001 TO EFTBR999). CL**2 00048 * EFTBD800 00049 * EFTBD800 00050 * MODULES CALLED: EFTBD800 00051 * EFTBD800 00052 * DTSBR980 REPORT CONTROL LIST EFTBD800 00053 * DTSBU001 DATE MODULE EFTBD800 00054 * DTSBU119 AGENCY FACTS MODULE EFTBD800 00055 * DTSBU931 REFERENCE FILE I-O MODULE EFTBD800 00056 * DTSBU941 REPORT FILE SEQUENTIAL INPUT MODULE EFTBD800 00057 * DTSBU999 ABEND MODULE EFTBD800 00058 * EFTBD800 00059 ***** EFTBD800 00060 EJECT EFTBD800 00061 ENVIRONMENT DIVISION. EFTBD800 00062 EFTBD800 00063 INPUT-OUTPUT SECTION. EFTBD800 00064 EFTBD800 00065 FILE-CONTROL. EFTBD800 00066 SELECT PARM-FILE ASSIGN TO PARMIN. EFTBD800 00067 SELECT ATLEAST-ONCE-FILE ASSIGN TO ATLSTIN. EFTBD800 00068 EFTBD800 00069 DATA DIVISION. EFTBD800 00070 EFTBD800 00071 FILE SECTION. EFTBD800 00072 EFTBD800 00073 FD PARM-FILE EFTBD800 00074 LABEL RECORDS ARE STANDARD. EFTBD800 00075 EFTBD800 00076 01 PARM-REC. EFTBD800 00077 05 PARM-MOD-NAME PIC X(08). EFTBD800 00078 05 FILLER PIC X(01). EFTBD800 00079 05 PARM-CONTROL-TYPE PIC X(03). EFTBD800 00080 05 PARM-RPT-TYPE-AREA OCCURS 15 TIMES EFTBD800 00081 INDEXED BY PARM-RPT-IDX. EFTBD800 00082 10 FILLER PIC X(01). EFTBD800 00083 10 PARM-RPT-TYPE PIC X(03). EFTBD800 00084 05 FILLER PIC X(08). EFTBD800 00085 EFTBD800 00086 EFTBD800 00087 EFTBD800 00088 FD ATLEAST-ONCE-FILE EFTBD800 00089 LABEL RECORDS ARE STANDARD. EFTBD800 00090 EFTBD800 00091 01 ATLEAST-ONCE-REC. EFTBD800 00092 05 ATLEAST-ONCE-MOD-NAME PIC X(08). EFTBD800 00093 05 ATLEAST-ONCE-RPT-TYPE-AREA OCCURS 15 TIMES EFTBD800 00094 INDEXED BY ATLEAST-ONCE-RPT-IDX. EFTBD800 00095 10 FILLER PIC X(01). EFTBD800 00096 10 ATLEAST-ONCE-RPT-TYPE PIC X(03). EFTBD800 00097 05 FILLER PIC X(12). EFTBD800 00098 EJECT EFTBD800 00099 WORKING-STORAGE SECTION. EFTBD800 000995 77 PAN-VALET PICTURE X(24) VALUE '002EFTBD800 10/09/03'. EFTBD800 00100 EFTBD800 00101 01 WRK-AREA. EFTBD800 00102 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +800.EFTBD800 00103 EFTBD800 00104 05 ABEND-MSG PIC X(50). EFTBD800 00105 EFTBD800 00106 05 INCLUDE-REC-CNT PIC S9(07) COMP-3. EFTBD800 00107 EFTBD800 00108 05 EXCLUDE-REC-CNT PIC S9(07) COMP-3. EFTBD800 00109 EFTBD800 00110 05 PARM-REC-CNT PIC S9(04) COMP. EFTBD800 00111 EFTBD800 00112 05 PARM-EOF-IND PIC X(01). EFTBD800 00113 EFTBD800 00114 05 ATLEAST-ONCE-REC-CNT PIC S9(04) COMP. EFTBD800 00115 EFTBD800 00116 05 ATLEAST-ONCE-EOF-IND PIC X(01). EFTBD800 00117 EFTBD800 00118 05 NDX-1 PIC S9(04) COMP. EFTBD800 00119 EFTBD800 00120 05 SYS-TIME. EFTBD800 00121 10 SYS-H PIC X(02). EFTBD800 00122 10 SYS-M PIC X(02). EFTBD800 00123 10 SYS-S PIC X(02). EFTBD800 00124 10 FILLER PIC X(02). EFTBD800 00125 EFTBD800 00126 05 DISP-TIME. EFTBD800 00127 10 DISP-H PIC X(02). EFTBD800 00128 10 FILLER PIC X(01) VALUE '.'. EFTBD800 00129 10 DISP-M PIC X(02). EFTBD800 00130 10 FILLER PIC X(01) VALUE '.'. EFTBD800 00131 10 DISP-S PIC X(02). EFTBD800 00132 EJECT EFTBD800 00133 05 WRK-CONTROL-CNT PIC S9(04) COMP. EFTBD800 00134 EFTBD800 00135 05 WRK-CONTROL-TYPE PIC X(03). EFTBD800 00136 88 WRK-INCLUDE-88 VALUE 'INC'. EFTBD800 00137 88 WRK-EXCLUDE-88 VALUE 'EXC'. EFTBD800 00138 EFTBD800 00139 05 WRK-CONTROL-REC-TYPE OCCURS 15 TIMES EFTBD800 00140 INDEXED BY WRK-CONTROL-REC-IDX EFTBD800 00141 PIC X(03). EFTBD800 00142 EFTBD800 00143 EFTBD800 00144 EFTBD800 00145 05 WRK-SELECT-IND PIC X(01). EFTBD800 00146 EFTBD800 00147 EFTBD800 00148 EFTBD800 00149 05 WRK-ATLEAST-ONCE-CNT PIC S9(04) COMP. EFTBD800 00150 EFTBD800 00151 05 WRK-ATLEAST-ONCE-OCCURS OCCURS 15 TIMES EFTBD800 00152 INDEXED BY WRK-ATLEAST-ONCE-IDX. EFTBD800 00153 10 WRK-ATLEAST-ONCE-REC-TYPE EFTBD800 00154 PIC X(03). EFTBD800 00155 10 WRK-ATLEAST-ONCE-CALLED-IND EFTBD800 00156 PIC X(01). EFTBD800 00157 88 WRK-ATLEAST-ONCE-CALLED-88 VALUE 'Y'. EFTBD800 00158 EFTBD800 00159 EFTBD800 00160 EFTBD800 00161 05 HOLD-REC-TYPE PIC X(03) VALUE ZEROES. EFTBD800 00162 05 HOLD-REC-TYPE-9 REDEFINES HOLD-REC-TYPE EFTBD800 00163 PIC 9(03). EFTBD800 00164 EFTBD800 00165 05 HOLD-REC-CNT PIC S9(07) COMP-3. EFTBD800 00166 EFTBD800 00167 05 PRINT-MODULE. EFTBD800 00168 10 FILLER PIC X(05) VALUE 'EFTBR'. CL**2 00169 10 PRINT-TYPE PIC X(03) VALUE SPACES. EFTBD800 00170 EJECT EFTBD800 00171 01 L001-LINK-AREA. EFTBD800 00172 ++INCLUDE DTSIL001 EFTBD800 00173 EJECT EFTBD800 00174 01 L119-LINK-AREA. EFTBD800 00175 ++INCLUDE DTSIL119 EFTBD800 00176 EJECT EFTBD800 00177 01 L931-LINK-AREA. EFTBD800 00178 ++INCLUDE DTSIL931 EFTBD800 00179 EJECT EFTBD800 00180 01 L941-LINK-AREA. EFTBD800 00181 ++INCLUDE DTSIL941 EFTBD800 00182 EJECT EFTBD800 00183 01 L980-LINK-AREA. EFTBD800 00184 ++INCLUDE DTSIL980 EFTBD800 00185 EJECT EFTBD800 00186 01 RSK3-REC. EFTBD800 00187 ++INCLUDE DTSIRSK3 EFTBD800 00188 EJECT EFTBD800 00189 01 LRCM-LINK-AREA. EFTBD800 00190 ++INCLUDE DTSILRCM EFTBD800 00191 EJECT EFTBD800 00192 01 FSKL-REC. EFTBD800 00193 ++INCLUDE DTSIFSKL EFTBD800 00194 EJECT EFTBD800 00195 PROCEDURE DIVISION. EFTBD800 00196 EFTBD800 00197 PERFORM I0000-INITIATE THRU I0000-EXIT. EFTBD800 00198 EFTBD800 00199 PERFORM P0000-PROCESS THRU P0000-EXIT. EFTBD800 00200 EFTBD800 00201 PERFORM T0000-TERMINATE THRU T0000-EXIT. EFTBD800 00202 EFTBD800 00203 GOBACK. EFTBD800 00204 EJECT EFTBD800 00205 I0000-INITIATE. EFTBD800 00206 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. EFTBD800 00207 EFTBD800 00208 PERFORM I2000-PARM THRU I2000-EXIT. EFTBD800 00209 EFTBD800 00210 PERFORM I3000-ATLEAST-ONCE THRU I3000-EXIT. EFTBD800 00211 EFTBD800 00212 PERFORM I4000-INIT-LRCM THRU I4000-EXIT. EFTBD800 00213 I0000-EXIT. EFTBD800 00214 EXIT. EFTBD800 00215 EFTBD800 00216 EFTBD800 00217 EFTBD800 00218 I1000-OPEN-FILES. EFTBD800 00219 SET L931-OPEN-READ-88 TO TRUE. EFTBD800 00220 EFTBD800 00221 PERFORM S931-REF-IO THRU S931-EXIT. EFTBD800 00222 EFTBD800 00223 SET L941-OPEN-READ-88 TO TRUE. EFTBD800 00224 EFTBD800 00225 PERFORM S941-RPT-I THRU S941-EXIT. EFTBD800 00226 I1000-EXIT. EFTBD800 00227 EXIT. EFTBD800 00228 EFTBD800 00229 EFTBD800 00230 EFTBD800 00231 I2000-PARM. EFTBD800 00232 OPEN INPUT PARM-FILE. EFTBD800 00233 EFTBD800 00234 MOVE 'N' TO PARM-EOF-IND. EFTBD800 00235 EFTBD800 00236 MOVE +0 TO PARM-REC-CNT. EFTBD800 00237 EFTBD800 00238 DISPLAY ' '. EFTBD800 00239 EFTBD800 00240 DISPLAY '*** EFTBD800 PARAMETERS'. CL**2 00241 EFTBD800 00242 PERFORM I2100-READ-PARM THRU I2100-EXIT EFTBD800 00243 UNTIL PARM-EOF-IND = 'Y'. EFTBD800 00244 EFTBD800 00245 IF PARM-REC-CNT = +0 EFTBD800 00246 SET WRK-EXCLUDE-88 TO TRUE EFTBD800 00247 MOVE +0 TO WRK-CONTROL-CNT EFTBD800 00248 DISPLAY ' (NONE)' EFTBD800 00249 ELSE EFTBD800 00250 IF PARM-REC-CNT > +1 EFTBD800 00251 MOVE 'NO MORE THAN ONE PARM RECORD ALLOWED' EFTBD800 00252 TO ABEND-MSG EFTBD800 00253 PERFORM S999-ABEND THRU S999-EXIT. EFTBD800 00254 EFTBD800 00255 DISPLAY ' '. EFTBD800 00256 EFTBD800 00257 CLOSE PARM-FILE. EFTBD800 00258 I2000-EXIT. EFTBD800 00259 EXIT. EFTBD800 00260 EFTBD800 00261 EFTBD800 00262 EFTBD800 00263 I2100-READ-PARM. EFTBD800 00264 READ PARM-FILE EFTBD800 00265 AT END EFTBD800 00266 MOVE 'Y' TO PARM-EOF-IND EFTBD800 00267 GO TO I2100-EXIT. EFTBD800 00268 EFTBD800 00269 DISPLAY '*** ' PARM-REC. EFTBD800 00270 EFTBD800 00271 ADD +1 TO PARM-REC-CNT. EFTBD800 00272 EFTBD800 00273 IF PARM-MOD-NAME NOT = 'EFTBD800' CL**2 00274 MOVE 'INVALID PARM MODULE NAME' TO ABEND-MSG EFTBD800 00275 PERFORM S999-ABEND THRU S999-EXIT. EFTBD800 00276 EFTBD800 00277 MOVE PARM-CONTROL-TYPE TO WRK-CONTROL-TYPE. EFTBD800 00278 EFTBD800 00279 IF WRK-INCLUDE-88 OR WRK-EXCLUDE-88 EFTBD800 00280 NEXT SENTENCE EFTBD800 00281 ELSE EFTBD800 00282 MOVE 'INVALID PARM CONTROL TYPE' TO ABEND-MSG EFTBD800 00283 PERFORM S999-ABEND THRU S999-EXIT. EFTBD800 00284 EFTBD800 00285 MOVE +0 TO WRK-CONTROL-CNT. EFTBD800 00286 EFTBD800 00287 PERFORM I2110-RPT-TYPE-LOOP THRU I2110-EXIT EFTBD800 00288 VARYING PARM-RPT-IDX FROM 1 BY 1 EFTBD800 00289 UNTIL PARM-RPT-IDX > 15. EFTBD800 00290 EFTBD800 00291 IF (WRK-INCLUDE-88) AND (WRK-CONTROL-CNT = +0) EFTBD800 00292 MOVE 'AT LEAST ONE PARM REC TYPE REQUIRED FOR INCLUDING' EFTBD800 00293 TO ABEND-MSG EFTBD800 00294 PERFORM S999-ABEND THRU S999-EXIT. EFTBD800 00295 I2100-EXIT. EFTBD800 00296 EXIT. EFTBD800 00297 EFTBD800 00298 EFTBD800 00299 EFTBD800 00300 I2110-RPT-TYPE-LOOP. EFTBD800 00301 IF PARM-RPT-TYPE (PARM-RPT-IDX) = SPACES EFTBD800 00302 NEXT SENTENCE EFTBD800 00303 ELSE EFTBD800 00304 ADD +1 TO WRK-CONTROL-CNT EFTBD800 00305 MOVE PARM-RPT-TYPE (PARM-RPT-IDX) EFTBD800 00306 TO WRK-CONTROL-REC-TYPE (WRK-CONTROL-CNT). EFTBD800 00307 I2110-EXIT. EFTBD800 00308 EXIT. EFTBD800 00309 EJECT EFTBD800 00310 I3000-ATLEAST-ONCE. EFTBD800 00311 OPEN INPUT ATLEAST-ONCE-FILE. EFTBD800 00312 EFTBD800 00313 MOVE 'N' TO ATLEAST-ONCE-EOF-IND. EFTBD800 00314 EFTBD800 00315 MOVE +0 TO ATLEAST-ONCE-REC-CNT. EFTBD800 00316 EFTBD800 00317 DISPLAY ' '. EFTBD800 00318 EFTBD800 00319 DISPLAY '*** EFTBD800 AT LEAST ONCE PARAMETERS'. CL**2 00320 EFTBD800 00321 PERFORM I3100-READ-ATLEAST-ONCE-FILE THRU I3100-EXIT EFTBD800 00322 UNTIL ATLEAST-ONCE-EOF-IND = 'Y'. EFTBD800 00323 EFTBD800 00324 IF ATLEAST-ONCE-REC-CNT = +0 EFTBD800 00325 MOVE +0 TO WRK-ATLEAST-ONCE-CNT EFTBD800 00326 DISPLAY ' (NONE)' EFTBD800 00327 ELSE EFTBD800 00328 IF ATLEAST-ONCE-REC-CNT > +1 EFTBD800 00329 MOVE 'NO MORE THAN ONE AT LEAST ONCE RECORD ALLOWED' EFTBD800 00330 TO ABEND-MSG EFTBD800 00331 PERFORM S999-ABEND THRU S999-EXIT. EFTBD800 00332 EFTBD800 00333 DISPLAY ' '. EFTBD800 00334 EFTBD800 00335 CLOSE ATLEAST-ONCE-FILE. EFTBD800 00336 I3000-EXIT. EFTBD800 00337 EXIT. EFTBD800 00338 EFTBD800 00339 EFTBD800 00340 EFTBD800 00341 I3100-READ-ATLEAST-ONCE-FILE. EFTBD800 00342 READ ATLEAST-ONCE-FILE EFTBD800 00343 AT END EFTBD800 00344 MOVE 'Y' TO ATLEAST-ONCE-EOF-IND EFTBD800 00345 GO TO I3100-EXIT. EFTBD800 00346 EFTBD800 00347 DISPLAY '*** ' ATLEAST-ONCE-REC. EFTBD800 00348 EFTBD800 00349 ADD +1 TO ATLEAST-ONCE-REC-CNT. EFTBD800 00350 EFTBD800 00351 IF ATLEAST-ONCE-MOD-NAME NOT = 'EFTBD800' CL**2 00352 MOVE 'INVALID AT LEAST ONCE MODULE NAME' TO ABEND-MSG EFTBD800 00353 PERFORM S999-ABEND THRU S999-EXIT. EFTBD800 00354 EFTBD800 00355 MOVE +0 TO WRK-ATLEAST-ONCE-CNT. EFTBD800 00356 EFTBD800 00357 PERFORM I3110-RPT-TYPE-LOOP EFTBD800 00358 THRU I3110-EXIT EFTBD800 00359 VARYING ATLEAST-ONCE-RPT-IDX FROM 1 BY 1 EFTBD800 00360 UNTIL ATLEAST-ONCE-RPT-IDX > 15. EFTBD800 00361 I3100-EXIT. EFTBD800 00362 EXIT. EFTBD800 00363 EFTBD800 00364 EFTBD800 00365 EFTBD800 00366 I3110-RPT-TYPE-LOOP. EFTBD800 00367 IF ATLEAST-ONCE-RPT-TYPE (ATLEAST-ONCE-RPT-IDX) NOT = SPACES EFTBD800 00368 ADD +1 TO WRK-ATLEAST-ONCE-CNT EFTBD800 00369 MOVE ATLEAST-ONCE-RPT-TYPE (ATLEAST-ONCE-RPT-IDX) EFTBD800 00370 TO WRK-ATLEAST-ONCE-REC-TYPE (WRK-ATLEAST-ONCE-CNT) EFTBD800 00371 MOVE 'N' EFTBD800 00372 TO WRK-ATLEAST-ONCE-CALLED-IND (WRK-ATLEAST-ONCE-CNT). EFTBD800 00373 I3110-EXIT. EFTBD800 00374 EXIT. EFTBD800 00375 EJECT EFTBD800 00376 I4000-INIT-LRCM. EFTBD800 00377 MOVE SPACES TO LRCM-LINK-AREA. EFTBD800 00378 EFTBD800 00379 PERFORM I4010-INIT-L980 THRU I4010-EXIT EFTBD800 00380 VARYING NDX-1 FROM 1 BY 1 EFTBD800 00381 UNTIL NDX-1 > 999. EFTBD800 00382 EFTBD800 00383 SET L001-FROM-FED-6 TO TRUE. EFTBD800 00384 EFTBD800 00385 ACCEPT L001-FED-6-DATE-9 FROM DATE. EFTBD800 00386 EFTBD800 00387 PERFORM S001-CONVERT-DATE THRU S001-EXIT. EFTBD800 00388 EFTBD800 00389 MOVE L001-SLASH-DATE TO LRCM-SYS-DATE. EFTBD800 00390 EFTBD800 00391 MOVE L001-SLASH-8-DATE TO LRCM-SYS-8-DATE. EFTBD800 00392 EFTBD800 00393 EFTBD800 00394 SET L119-REQ-MIXED-88 TO TRUE. EFTBD800 00395 EFTBD800 00396 SET L119-REQ-NO-UNIT-88 TO TRUE. EFTBD800 00397 EFTBD800 00398 PERFORM S119-AGENCY-FACTS THRU S119-EXIT. EFTBD800 00399 EFTBD800 00400 MOVE L119-UC-OFFICE-NAME TO LRCM-DEFAULT-NAME. EFTBD800 00401 EFTBD800 00402 MOVE L119-UC-OFFICE-VOICE TO LRCM-DEFAULT-VOICE. EFTBD800 00403 EFTBD800 00404 EFTBD800 00405 ACCEPT SYS-TIME FROM TIME. EFTBD800 00406 EFTBD800 00407 MOVE SYS-H TO DISP-H. EFTBD800 00408 EFTBD800 00409 MOVE SYS-M TO DISP-M. EFTBD800 00410 EFTBD800 00411 MOVE SYS-S TO DISP-S. EFTBD800 00412 EFTBD800 00413 MOVE DISP-TIME TO LRCM-SYS-TIME. EFTBD800 00414 EFTBD800 00415 MOVE +19924 TO LRCM-PICKUP-YRQ. EFTBD800 00416 EFTBD800 00417 EFTBD800 00418 MOVE ' DISTRICT OF COLUMBIA ' EFTBD800 00419 TO LRCM-AGY-NAME-LINE1. EFTBD800 00420 EFTBD800 00421 MOVE ' TAX DIVISION ' EFTBD800 00422 TO LRCM-AGY-NAME-LINE2. EFTBD800 00423 I4000-EXIT. EFTBD800 00424 EXIT. EFTBD800 00425 I4010-INIT-L980. EFTBD800 00426 MOVE ZERO TO L980-REC-CNT (NDX-1). EFTBD800 00427 I4010-EXIT. EFTBD800 00428 EXIT. EFTBD800 00429 EJECT EFTBD800 00430 P0000-PROCESS. EFTBD800 00431 MOVE +0 TO INCLUDE-REC-CNT EFTBD800 00432 EXCLUDE-REC-CNT. EFTBD800 00433 EFTBD800 00434 DISPLAY ' '. EFTBD800 00435 EFTBD800 00436 DISPLAY '*** EFTBD800 STATISTICS'. CL**2 00437 EFTBD800 00438 SET L941-READ-NEXT-88 TO TRUE. EFTBD800 00439 EFTBD800 00440 PERFORM S941-RPT-I THRU S941-EXIT. EFTBD800 00441 EFTBD800 00442 IF L941-NO-REC-88 EFTBD800 00443 GO TO P0000-EXIT. EFTBD800 00444 EFTBD800 00445 EFTBD800 00446 PERFORM P1000-PROCESS-RETURN THRU P1000-EXIT EFTBD800 00447 UNTIL L941-NO-REC-88. EFTBD800 00448 EFTBD800 00449 EFTBD800 00450 IF WRK-SELECT-IND = 'I' EFTBD800 00451 PERFORM P1500-TERM-REC-TYPE THRU P1500-EXIT. EFTBD800 00452 P0000-EXIT. EFTBD800 00453 EXIT. EFTBD800 00454 EFTBD800 00455 EFTBD800 00456 EFTBD800 00457 P1000-PROCESS-RETURN. EFTBD800 00458 IF RSK3-REC-TYPE NOT = HOLD-REC-TYPE EFTBD800 00459 IF HOLD-REC-TYPE = SPACES EFTBD800 00460 PERFORM P1100-INIT-REC-TYPE THRU P1100-EXIT EFTBD800 00461 ELSE EFTBD800 00462 IF WRK-SELECT-IND = 'I' EFTBD800 00463 PERFORM P1500-TERM-REC-TYPE THRU P1500-EXIT EFTBD800 00464 ELSE EFTBD800 00465 CONTINUE EFTBD800 00466 END-IF EFTBD800 00467 PERFORM P1100-INIT-REC-TYPE THRU P1100-EXIT. EFTBD800 00468 EFTBD800 00469 IF WRK-SELECT-IND = 'I' EFTBD800 00470 ADD +1 TO INCLUDE-REC-CNT EFTBD800 00471 HOLD-REC-CNT EFTBD800 00472 PERFORM S1000-CALL-R-MOD THRU S1000-EXIT EFTBD800 00473 ELSE EFTBD800 00474 ADD +1 TO EXCLUDE-REC-CNT. EFTBD800 00475 EFTBD800 00476 SET L941-READ-NEXT-88 TO TRUE. EFTBD800 00477 EFTBD800 00478 PERFORM S941-RPT-I THRU S941-EXIT. EFTBD800 00479 P1000-EXIT. EFTBD800 00480 EXIT. EFTBD800 00481 EJECT EFTBD800 00482 P1100-INIT-REC-TYPE. EFTBD800 00483 MOVE RSK3-REC-TYPE TO HOLD-REC-TYPE. EFTBD800 00484 EFTBD800 00485 IF WRK-EXCLUDE-88 EFTBD800 00486 IF WRK-CONTROL-CNT = +0 EFTBD800 00487 MOVE 'I' TO WRK-SELECT-IND EFTBD800 00488 ELSE EFTBD800 00489 MOVE 'I' TO WRK-SELECT-IND EFTBD800 00490 PERFORM P1110-EXCLUDE THRU P1110-EXIT EFTBD800 00491 VARYING WRK-CONTROL-REC-IDX FROM 1 BY 1 EFTBD800 00492 UNTIL (WRK-CONTROL-REC-IDX > WRK-CONTROL-CNT) EFTBD800 00493 OR EFTBD800 00494 (WRK-SELECT-IND = 'E') EFTBD800 00495 ELSE EFTBD800 00496 MOVE 'E' TO WRK-SELECT-IND EFTBD800 00497 PERFORM P1120-INCLUDE THRU P1120-EXIT EFTBD800 00498 VARYING WRK-CONTROL-REC-IDX FROM 1 BY 1 EFTBD800 00499 UNTIL (WRK-CONTROL-REC-IDX > WRK-CONTROL-CNT) EFTBD800 00500 OR EFTBD800 00501 (WRK-SELECT-IND = 'I'). EFTBD800 00502 EFTBD800 00503 IF WRK-SELECT-IND = 'E' EFTBD800 00504 GO TO P1100-EXIT. EFTBD800 00505 EFTBD800 00506 IF WRK-ATLEAST-ONCE-CNT = +0 EFTBD800 00507 NEXT SENTENCE EFTBD800 00508 ELSE EFTBD800 00509 PERFORM P1130-UPDT-ATLEAST-ONCE-CALLED THRU P1130-EXIT EFTBD800 00510 VARYING WRK-ATLEAST-ONCE-IDX FROM 1 BY 1 EFTBD800 00511 UNTIL (WRK-ATLEAST-ONCE-IDX > WRK-ATLEAST-ONCE-CNT). EFTBD800 00512 EFTBD800 00513 MOVE HOLD-REC-TYPE TO PRINT-TYPE. EFTBD800 00514 EFTBD800 00515 MOVE +0 TO HOLD-REC-CNT. EFTBD800 00516 EFTBD800 00517 MOVE 'N' TO LRCM-EOR-IND. EFTBD800 00518 P1100-EXIT. EFTBD800 00519 EXIT. EFTBD800 00520 EFTBD800 00521 EFTBD800 00522 EFTBD800 00523 P1110-EXCLUDE. EFTBD800 00524 IF RSK3-REC-TYPE = WRK-CONTROL-REC-TYPE (WRK-CONTROL-REC-IDX)EFTBD800 00525 MOVE 'E' TO WRK-SELECT-IND. EFTBD800 00526 P1110-EXIT. EFTBD800 00527 EXIT. EFTBD800 00528 EFTBD800 00529 EFTBD800 00530 EFTBD800 00531 P1120-INCLUDE. EFTBD800 00532 IF RSK3-REC-TYPE = WRK-CONTROL-REC-TYPE (WRK-CONTROL-REC-IDX)EFTBD800 00533 MOVE 'I' TO WRK-SELECT-IND. EFTBD800 00534 P1120-EXIT. EFTBD800 00535 EXIT. EFTBD800 00536 EFTBD800 00537 EFTBD800 00538 EFTBD800 00539 P1130-UPDT-ATLEAST-ONCE-CALLED. EFTBD800 00540 IF RSK3-REC-TYPE EFTBD800 00541 = WRK-ATLEAST-ONCE-REC-TYPE (WRK-ATLEAST-ONCE-IDX) EFTBD800 00542 MOVE 'Y' EFTBD800 00543 TO WRK-ATLEAST-ONCE-CALLED-IND (WRK-ATLEAST-ONCE-IDX) EFTBD800 00544 SET WRK-ATLEAST-ONCE-IDX TO WRK-ATLEAST-ONCE-CNT. EFTBD800 00545 P1130-EXIT. EFTBD800 00546 EXIT. EFTBD800 00547 EJECT EFTBD800 00548 P1500-TERM-REC-TYPE. EFTBD800 00549 MOVE 'Y' TO LRCM-EOR-IND. EFTBD800 00550 EFTBD800 00551 PERFORM S1000-CALL-R-MOD THRU S1000-EXIT. EFTBD800 00552 EFTBD800 00553 DISPLAY HOLD-REC-CNT EFTBD800 00554 ' RECORD TYPE ' EFTBD800 00555 HOLD-REC-TYPE EFTBD800 00556 ' RECORDS PROCESSED'. EFTBD800 00557 EFTBD800 00558 MOVE HOLD-REC-CNT TO L980-REC-CNT (HOLD-REC-TYPE-9). EFTBD800 00559 EFTBD800 00560 CANCEL PRINT-MODULE. EFTBD800 00561 P1500-EXIT. EFTBD800 00562 EXIT. EFTBD800 00563 EJECT EFTBD800 00564 T0000-TERMINATE. EFTBD800 00565 DISPLAY ' '. EFTBD800 00566 EFTBD800 00567 DISPLAY '*** EFTBD800 TERMINATION STATISTICS'. CL**2 00568 EFTBD800 00569 DISPLAY INCLUDE-REC-CNT EFTBD800 00570 ' RECORDS INCLUDED'. EFTBD800 00571 EFTBD800 00572 DISPLAY EXCLUDE-REC-CNT EFTBD800 00573 ' RECORDS EXCLUDED'. EFTBD800 00574 EFTBD800 00575 EFTBD800 00576 IF WRK-ATLEAST-ONCE-CNT = +0 EFTBD800 00577 NEXT SENTENCE EFTBD800 00578 ELSE EFTBD800 00579 PERFORM T1000-CHK-ATLEAST-ONCE-CALLED THRU T1000-EXIT EFTBD800 00580 VARYING WRK-ATLEAST-ONCE-IDX FROM 1 BY 1 EFTBD800 00581 UNTIL (WRK-ATLEAST-ONCE-IDX > WRK-ATLEAST-ONCE-CNT). EFTBD800 00582 EFTBD800 00583 EFTBD800 00584 SET L931-CLOSE-88 TO TRUE. EFTBD800 00585 EFTBD800 00586 PERFORM S931-REF-IO THRU S931-EXIT. EFTBD800 00587 EFTBD800 00588 SET L941-CLOSE-88 TO TRUE. EFTBD800 00589 EFTBD800 00590 PERFORM S941-RPT-I THRU S941-EXIT. EFTBD800 00591 EFTBD800 00592 PERFORM S980-CTRL-RPT-O THRU S980-EXIT. EFTBD800 00593 T0000-EXIT. EFTBD800 00594 EXIT. EFTBD800 00595 EFTBD800 00596 EFTBD800 00597 T1000-CHK-ATLEAST-ONCE-CALLED. EFTBD800 00598 IF WRK-ATLEAST-ONCE-CALLED-88 (WRK-ATLEAST-ONCE-IDX) EFTBD800 00599 NEXT SENTENCE EFTBD800 00600 ELSE EFTBD800 00601 MOVE WRK-ATLEAST-ONCE-REC-TYPE (WRK-ATLEAST-ONCE-IDX) EFTBD800 00602 TO PRINT-TYPE EFTBD800 00603 MOVE 'Y' TO LRCM-EOR-IND EFTBD800 00604 PERFORM S1000-CALL-R-MOD THRU S1000-EXIT EFTBD800 00605 CANCEL PRINT-MODULE. EFTBD800 00606 T1000-EXIT. EFTBD800 00607 EXIT. EFTBD800 00608 EJECT EFTBD800 00609 S1000-CALL-R-MOD. EFTBD800 00610 CALL PRINT-MODULE USING LRCM-LINK-AREA EFTBD800 00611 RSK3-REC. EFTBD800 00612 S1000-EXIT. EFTBD800 00613 EXIT. EFTBD800 00614 EJECT EFTBD800 00615 S001-CONVERT-DATE. EFTBD800 00616 CALL 'DTSBU001' USING L001-LINK-AREA. EFTBD800 00617 S001-EXIT. EFTBD800 00618 EXIT. EFTBD800 00619 EFTBD800 00620 EFTBD800 00621 S119-AGENCY-FACTS. EFTBD800 00622 CALL 'DTSBU119' USING L119-LINK-AREA. EFTBD800 00623 S119-EXIT. EFTBD800 00624 EXIT. EFTBD800 00625 EFTBD800 00626 EFTBD800 00627 S931-REF-IO. EFTBD800 00628 CALL 'DTSBU931' USING L931-LINK-AREA EFTBD800 00629 FSKL-REC. EFTBD800 00630 S931-EXIT. EFTBD800 00631 EXIT. EFTBD800 00632 EFTBD800 00633 EFTBD800 00634 S941-RPT-I. EFTBD800 00635 CALL 'DTSBU941' USING L941-LINK-AREA EFTBD800 00636 RSK3-REC. EFTBD800 00637 S941-EXIT. EFTBD800 00638 EXIT. EFTBD800 00639 EFTBD800 00640 EFTBD800 00641 S980-CTRL-RPT-O. EFTBD800 00642 CALL 'DTSBR980' USING LRCM-LINK-AREA, EFTBD800 00643 L980-LINK-AREA. EFTBD800 00644 S980-EXIT. EFTBD800 00645 EXIT. EFTBD800 00646 EFTBD800 00647 EFTBD800 00648 S999-ABEND. EFTBD800 00649 DISPLAY '*** EFTBD800 ABENDING - ' ABEND-MSG. CL**2 00650 EFTBD800 00651 CALL 'DTSBU999' USING WRK-ABEND-CD. EFTBD800 00652 S999-EXIT. EFTBD800 00653 EXIT. EFTBD800