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