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
