DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
654
Batch/EFTBD800.cob
Normal file
654
Batch/EFTBD800.cob
Normal file
@ -0,0 +1,654 @@
|
||||
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
|
||||
Reference in New Issue
Block a user