00001  IDENTIFICATION DIVISION.                                         10/10/03
00002  PROGRAM-ID.             CHGBD901.                                CHGBD901
00003 *AUTHOR.                 TRW.                                        LV001
00004 *DATE-WRITTEN.           SEPTEMBER 2003.                          CHGBD901
00005  DATE-COMPILED.                                                   CHGBD901
00006      SKIP3                                                        CHGBD901
00007 *****                                                             CHGBD901
00008 *                                                                 CHGBD901
00009 *    FUNCTION:                                                    CHGBD901
00010 *                                                                 CHGBD901
00011 *        READ THE QUARTERLY DC WAGE FILE FROM PAYROLL AND         CHGBD901
00012 *        ADD RECORDS TO THE CHGM040 OUTPUT FILE.                  CHGBD901
00013 *                                                                 CHGBD901
00014 *                                                                 CHGBD901
00015 *        INPUT:                                                   CHGBD901
00016 *                                                                 CHGBD901
00017 *            CHGM040  - DC WAGE INPUT DATA                        CHGBD901
00018 *                                                                 CHGBD901
00019 *                                                                 CHGBD901
00020 *        OUTPUT:                                                  CHGBD901
00021 *            CHGM010  - DC WAGE OUTPUT FILE                       CHGBD901
00022 *                                                                 CHGBD901
00023 *****                                                             CHGBD901
00024                                                                   CHGBD901
00025 ******************************************************************CHGBD901
00026 * MODIFICATION HISTORY:                                          *CHGBD901
00027 *                                                                *CHGBD901
00028 * 09-04-2003 INITIAL DEVELOPMENT                                 *CHGBD901
00029 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD901
00030 *                                                                *CHGBD901
00031 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD901
00032 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD901
00033 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBD901
00034 ******************************************************************CHGBD901
00035                                                                   CHGBD901
00036      SKIP3                                                        CHGBD901
00037  ENVIRONMENT DIVISION.                                            CHGBD901
00038      SKIP3                                                        CHGBD901
00039  INPUT-OUTPUT SECTION.                                            CHGBD901
00040      SKIP3                                                        CHGBD901
00041  FILE-CONTROL.                                                    CHGBD901
00042      SELECT DC-AGENCY   ASSIGN TO DCAGNCY                         CHGBD901
00043             FILE STATUS IS DC-AGENCY-STATUS.                      CHGBD901
00044                                                                   CHGBD901
00045      SELECT DC-WAGE-IN  ASSIGN TO CHGM040                         CHGBD901
00046             FILE STATUS IS DC-WAGE-IN-STATUS.                     CHGBD901
00047                                                                   CHGBD901
00048      SELECT DC-WAGE-OUT    ASSIGN TO DTSWGHDC                     CHGBD901
00049             FILE STATUS IS DC-WAGE-OUT-STATUS.                    CHGBD901
00050                                                                   CHGBD901
00051      EJECT                                                        CHGBD901
00052  DATA DIVISION.                                                   CHGBD901
00053  FILE SECTION.                                                    CHGBD901
00054  FD  DC-AGENCY                                                    CHGBD901
00055      RECORDING MODE IS F                                          CHGBD901
00056      LABEL RECORDS ARE STANDARD                                   CHGBD901
00057      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD901
00058      SKIP1                                                        CHGBD901
00059  01  DC-AGENCY-REC.                                               CHGBD901
00060      05  DC-AGENCY-CODE             PIC  X(02).                   CHGBD901
00061      05  DC-AGENCY-NAME             PIC  X(38).                   CHGBD901
00062      05  DC-AGENCY-EMP-NO           PIC  9(06).                   CHGBD901
00063      05  FILLER                     PIC  X(02).                   CHGBD901
00064                                                                   CHGBD901
00065  FD  DC-WAGE-IN                                                   CHGBD901
00066      RECORDING MODE IS F                                          CHGBD901
00067      LABEL RECORDS ARE STANDARD                                   CHGBD901
00068      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD901
00069      SKIP1                                                        CHGBD901
00070  01  CHGM040-REC.                                                 CHGBD901
00071  ++INCLUDE CHGIM040                                               CHGBD901
00072                                                                   CHGBD901
00073  FD  DC-WAGE-OUT                                                  CHGBD901
00074      RECORDING MODE IS F                                          CHGBD901
00075      LABEL RECORDS ARE STANDARD                                   CHGBD901
00076      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD901
00077      SKIP1                                                        CHGBD901
00078  01  CHGM010-REC.                                                 CHGBD901
00079  ++INCLUDE CHGIM010                                               CHGBD901
00080                                                                   CHGBD901
00081      EJECT                                                        CHGBD901
00082  WORKING-STORAGE SECTION.                                         CHGBD901
000825 77  PAN-VALET PICTURE X(24) VALUE '001CHGBD901  10/10/03'.       CHGBD901
00083                                                                   CHGBD901
00084  01  WRK-AREA.                                                    CHGBD901
00085      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD901
00086                                  VALUE +220.                      CHGBD901
00087      05  ABEND-MOD                   PIC  X(08)                   CHGBD901
00088                                  VALUE 'DTSBU999'.                CHGBD901
00089      05  ABEND-MSG                   PIC  X(60).                  CHGBD901
00090                                                                   CHGBD901
00091      05  DC-WAGE-IN-STATUS           PIC  X(02) VALUE SPACES.     CHGBD901
00092          88  WAGE-IN-OK-88        VALUE ZERO.                     CHGBD901
00093          88  WAGE-IN-EOF-88       VALUE '10'.                     CHGBD901
00094                                                                   CHGBD901
00095      05  DC-WAGE-OUT-STATUS          PIC  X(02) VALUE SPACES.     CHGBD901
00096          88  WAGE-OUT-OK-88       VALUE ZERO.                     CHGBD901
00097                                                                   CHGBD901
00098      05  DC-AGENCY-STATUS            PIC  X(02) VALUE SPACES.     CHGBD901
00099          88  DC-AGENCY-OK-88      VALUE ZERO.                     CHGBD901
00100          88  DC-AGENCY-EOF-88     VALUE '10'.                     CHGBD901
00101                                                                   CHGBD901
00102                                                                   CHGBD901
00103      05  WRK-BYPASS-IND              PIC  X(01).                  CHGBD901
00104          88  WRK-BYPASS-YES-88   VALUE 'Y'.                       CHGBD901
00105          88  WRK-BYPASS-NO-88    VALUE 'N'.                       CHGBD901
00106                                                                   CHGBD901
00107      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD901
00108          88  WRK-ERROR-YES-88    VALUE 'Y'.                       CHGBD901
00109          88  WRK-ERROR-NO-88     VALUE 'N'.                       CHGBD901
00110                                                                   CHGBD901
00111      05  WRK-YEAR.                                                CHGBD901
00112          10  WRK-YEAR-CC             PIC  X(02).                  CHGBD901
00113          10  WRK-YEAR-YY             PIC  X(02).                  CHGBD901
00114      05  WRK-YEAR-CCYY REDEFINES WRK-YEAR                         CHGBD901
00115                                      PIC  9(04).                  CHGBD901
00116                                                                   CHGBD901
00117      05  WRK-DEFAULT-DC-EMP-NO       PIC S9(07) COMP-3            CHGBD901
00118                                       VALUE +998888.              CHGBD901
00119                                                                   CHGBD901
00120      05  WRK-EMP-NO                  PIC  X(06).                  CHGBD901
00121      05  WRK-EMP-NO-9  REDEFINES WRK-EMP-NO                       CHGBD901
00122                                      PIC  9(06).                  CHGBD901
00123                                                                   CHGBD901
00124      05  WRK-IN-CNT                  PIC  9(08) COMP-3 VALUE  0.  CHGBD901
00125      05  WRK-OUT-CNT                 PIC  9(08) COMP-3 VALUE  0.  CHGBD901
00126      05  WRK-AGENCY-CNT              PIC  9(08) COMP-3 VALUE  0.  CHGBD901
00127      05  WRK-ERROR-CNT               PIC  9(08) COMP-3 VALUE  0.  CHGBD901
00128                                                                   CHGBD901
00129  01  DC-AGENCY-TBL-AREA.                                          CHGBD901
00130      05  DC-TBL-SUB                  PIC S9(04)  COMP.            CHGBD901
00131      05  DC-TBL-LAST                 PIC S9(04)  COMP VALUE +0.   CHGBD901
00132      05  DC-TBL-MAX                  PIC S9(04)  COMP VALUE +200. CHGBD901
00133      05  DC-AGENCY-TBL  OCCURS 200 TIMES INDEXED BY DC-NDX.       CHGBD901
00134          10  DC-TBL-CODE             PIC  X(02).                  CHGBD901
00135          10  DC-TBL-NAME             PIC  X(38).                  CHGBD901
00136          10  DC-TBL-EMP-NO           PIC  9(06).                  CHGBD901
00137          10  FILLER                  PIC  X(02).                  CHGBD901
00138                                                                   CHGBD901
00139  01  L004-LINK-AREA.                                              CHGBD901
00140  ++INCLUDE DTSIL004                                               CHGBD901
00141                                                                   CHGBD901
00142  PROCEDURE DIVISION.                                              CHGBD901
00143      SKIP2                                                        CHGBD901
00144  CHGBD901-MAIN.                                                   CHGBD901
00145      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD901
00146      IF WRK-ERROR-YES-88                                          CHGBD901
00147         GO TO CHGBD901-EXIT.                                      CHGBD901
00148                                                                   CHGBD901
00149      PERFORM P0000-PROCESS   THRU P0000-EXIT.                     CHGBD901
00150                                                                   CHGBD901
00151      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD901
00152                                                                   CHGBD901
00153  CHGBD901-EXIT.                                                   CHGBD901
00154      STOP RUN.                                                    CHGBD901
00155      EJECT                                                        CHGBD901
00156  I0000-INITIATE.                                                  CHGBD901
00157      SET WRK-ERROR-NO-88 TO TRUE.                                 CHGBD901
00158                                                                   CHGBD901
00159      PERFORM I2000-OPEN-FILES  THRU I2000-EXIT.                   CHGBD901
00160                                                                   CHGBD901
00161      PERFORM I3000-AGENCY-DATA THRU I3000-EXIT.                   CHGBD901
00162                                                                   CHGBD901
00163  I0000-EXIT.                                                      CHGBD901
00164      EXIT.                                                        CHGBD901
00165                                                                   CHGBD901
00166  I2000-OPEN-FILES.                                                CHGBD901
00167      OPEN INPUT DC-AGENCY.                                        CHGBD901
00168      IF NOT DC-AGENCY-OK-88                                       CHGBD901
00169         DISPLAY 'DC AGENCY  OPEN ERROR: ' DC-AGENCY-STATUS        CHGBD901
00170         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD901
00171                                                                   CHGBD901
00172      OPEN INPUT DC-WAGE-IN.                                       CHGBD901
00173      IF NOT WAGE-IN-OK-88                                         CHGBD901
00174         DISPLAY 'INPUT FILE OPEN ERROR: ' DC-WAGE-IN-STATUS       CHGBD901
00175         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD901
00176                                                                   CHGBD901
00177      OPEN OUTPUT DC-WAGE-OUT.                                     CHGBD901
00178      IF NOT WAGE-OUT-OK-88                                        CHGBD901
00179         DISPLAY 'OUTPUT FILE OPEN ERROR: ' DC-WAGE-OUT-STATUS     CHGBD901
00180         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD901
00181                                                                   CHGBD901
00182  I2000-EXIT.                                                      CHGBD901
00183      EXIT.                                                        CHGBD901
00184                                                                   CHGBD901
00185  I3000-AGENCY-DATA.                                               CHGBD901
00186      MOVE +0        TO DC-TBL-LAST.                               CHGBD901
00187                                                                   CHGBD901
00188      READ DC-AGENCY.                                              CHGBD901
00189      IF DC-AGENCY-EOF-88                                          CHGBD901
00190         DISPLAY 'CANNOT READ DC AGENCY FILE '                     CHGBD901
00191            DC-AGENCY-STATUS                                       CHGBD901
00192         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD901
00193         GO TO I3000-EXIT                                          CHGBD901
00194      END-IF.                                                      CHGBD901
00195                                                                   CHGBD901
00196      PERFORM                                                      CHGBD901
00197        UNTIL DC-AGENCY-EOF-88                                     CHGBD901
00198           PERFORM I3100-TABLE-DATA      THRU I3100-EXIT           CHGBD901
00199           IF WRK-ERROR-NO-88                                      CHGBD901
00200              PERFORM I3200-READ-AGENCY  THRU I3200-EXIT           CHGBD901
00201           END-IF                                                  CHGBD901
00202      END-PERFORM.                                                 CHGBD901
00203                                                                   CHGBD901
00204  I3000-EXIT.                                                      CHGBD901
00205      EXIT.                                                        CHGBD901
00206                                                                   CHGBD901
00207  I3100-TABLE-DATA.                                                CHGBD901
00208      IF DC-TBL-LAST < DC-TBL-MAX                                  CHGBD901
00209         ADD +1 TO DC-TBL-LAST                                     CHGBD901
00210         MOVE DC-AGENCY-REC TO DC-AGENCY-TBL (DC-TBL-LAST)         CHGBD901
00211      ELSE                                                         CHGBD901
00212         DISPLAY 'AGENCY TABLE LENGTH EXCEEDED'                    CHGBD901
00213         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD901
00214         SET DC-AGENCY-EOF-88 TO TRUE                              CHGBD901
00215      END-IF.                                                      CHGBD901
00216                                                                   CHGBD901
00217  I3100-EXIT.                                                      CHGBD901
00218      EXIT.                                                        CHGBD901
00219                                                                   CHGBD901
00220  I3200-READ-AGENCY.                                               CHGBD901
00221      READ DC-AGENCY                                               CHGBD901
00222      IF DC-AGENCY-EOF-88                                          CHGBD901
00223         NEXT SENTENCE                                             CHGBD901
00224      ELSE                                                         CHGBD901
00225         IF NOT WAGE-IN-OK-88                                      CHGBD901
00226            DISPLAY 'CANNOT READ DC WAGE IN FILE '                 CHGBD901
00227               DC-WAGE-IN-STATUS                                   CHGBD901
00228            SET WRK-ERROR-YES-88 TO TRUE                           CHGBD901
00229            SET DC-AGENCY-EOF-88 TO TRUE                           CHGBD901
00230         ELSE                                                      CHGBD901
00231            ADD 1 TO WRK-AGENCY-CNT                                CHGBD901
00232         END-IF                                                    CHGBD901
00233      END-IF.                                                      CHGBD901
00234                                                                   CHGBD901
00235  I3200-EXIT.                                                      CHGBD901
00236      EXIT.                                                        CHGBD901
00237                                                                   CHGBD901
00238  P0000-PROCESS.                                                   CHGBD901
00239      PERFORM S1000-READ-CHGM040  THRU S1000-EXIT.                 CHGBD901
00240      IF NOT WAGE-IN-OK-88                                         CHGBD901
00241         DISPLAY 'DC-WAGE INPUT FILE EMPTY: ' DC-WAGE-IN-STATUS    CHGBD901
00242         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD901
00243         GO TO P0000-EXIT.                                         CHGBD901
00244                                                                   CHGBD901
00245      PERFORM P1000-PROCESS-WAGES   THRU P1000-EXIT                CHGBD901
00246         UNTIL WAGE-IN-EOF-88                                      CHGBD901
00247         OR    WRK-ERROR-YES-88.                                   CHGBD901
00248                                                                   CHGBD901
00249  P0000-EXIT.                                                      CHGBD901
00250      EXIT.                                                        CHGBD901
00251                                                                   CHGBD901
00252  P1000-PROCESS-WAGES.                                             CHGBD901
00253      SET WRK-BYPASS-NO-88  TO TRUE.                               CHGBD901
00254                                                                   CHGBD901
00255      PERFORM P1100-FORMAT-OUTPUT       THRU P1100-EXIT.           CHGBD901
00256      IF WRK-BYPASS-NO-88                                          CHGBD901
00257         PERFORM P1200-FIND-EMP-NO      THRU P1200-EXIT            CHGBD901
00258         IF WRK-BYPASS-NO-88                                       CHGBD901
00259            PERFORM S2000-WRITE-CHGM010 THRU S2000-EXIT.           CHGBD901
00260                                                                   CHGBD901
00261      PERFORM S1000-READ-CHGM040     THRU S1000-EXIT.              CHGBD901
00262                                                                   CHGBD901
00263  P1000-EXIT.                                                      CHGBD901
00264      EXIT.                                                        CHGBD901
00265                                                                   CHGBD901
00266  P1100-FORMAT-OUTPUT.                                             CHGBD901
00267      IF CHG40-YEAR NOT NUMERIC                                    CHGBD901
00268         SET WRK-BYPASS-YES-88 TO TRUE                             CHGBD901
00269         ADD +1             TO WRK-ERROR-CNT                       CHGBD901
00270         DISPLAY 'ERR - YEAR ' CHG40-YEAR '  ' CHG40-SSN           CHGBD901
00271         GO TO P1100-EXIT                                          CHGBD901
00272      ELSE                                                         CHGBD901
00273         MOVE CHG40-YEAR    TO L004-QTR-3-YR                       CHGBD901
00274      END-IF.                                                      CHGBD901
00275                                                                   CHGBD901
00276      EVALUATE CHG40-MONTH                                         CHGBD901
00277         WHEN 'M'                                                  CHGBD901
00278            MOVE 1          TO L004-QTR-3-Q                        CHGBD901
00279                                                                   CHGBD901
00280         WHEN 'J'                                                  CHGBD901
00281            MOVE 2          TO L004-QTR-3-Q                        CHGBD901
00282                                                                   CHGBD901
00283         WHEN 'S'                                                  CHGBD901
00284            MOVE 3          TO L004-QTR-3-Q                        CHGBD901
00285                                                                   CHGBD901
00286         WHEN 'D'                                                  CHGBD901
00287            MOVE 4          TO L004-QTR-3-Q                        CHGBD901
00288                                                                   CHGBD901
00289         WHEN OTHER                                                CHGBD901
00290            ADD +1             TO WRK-ERROR-CNT                    CHGBD901
00291            DISPLAY 'ERR - MONTH ' CHG40-MONTH '  ' CHG40-SSN      CHGBD901
00292            SET WRK-BYPASS-YES-88 TO TRUE                          CHGBD901
00293                                                                   CHGBD901
00294      END-EVALUATE.                                                CHGBD901
00295                                                                   CHGBD901
00296      IF WRK-BYPASS-YES-88                                         CHGBD901
00297         GO TO P1100-EXIT.                                         CHGBD901
00298                                                                   CHGBD901
00299      PERFORM S004-FROM-3    THRU S004-EXIT.                       CHGBD901
00300      IF L004-INVALID-QTR                                          CHGBD901
00301         ADD +1             TO WRK-ERROR-CNT                       CHGBD901
00302         SET WRK-BYPASS-YES-88 TO TRUE                             CHGBD901
00303         DISPLAY 'ERR - QTR ' CHG40-YEAR '  ' CHG40-MONTH          CHGBD901
00304            CHG40-SSN                                              CHGBD901
00305         GO TO P1100-EXIT                                          CHGBD901
00306      ELSE                                                         CHGBD901
00307         MOVE L004-QTR-5-9    TO CHG10-YRQ.                        CHGBD901
00308                                                                   CHGBD901
00309      IF CHG40-SSN    NUMERIC                                      CHGBD901
00310         MOVE CHG40-SSN        TO CHG10-SSN                        CHGBD901
00311      ELSE                                                         CHGBD901
00312         ADD +1             TO WRK-ERROR-CNT                       CHGBD901
00313         SET WRK-BYPASS-YES-88 TO TRUE                             CHGBD901
00314         DISPLAY 'ERR - SSN ' CHG40-SSN                            CHGBD901
00315         GO TO P1100-EXIT.                                         CHGBD901
00316                                                                   CHGBD901
00317      MOVE CHG40-DC-AGENCY-CD  TO CHG10-DC-AGENCY-CD.              CHGBD901
00318                                                                   CHGBD901
00319      IF CHG40-WAGES  NUMERIC                                      CHGBD901
00320         MOVE CHG40-WAGES      TO CHG10-WAGES                      CHGBD901
00321      ELSE                                                         CHGBD901
00322         IF CHG40-WAGES        = ZERO                              CHGBD901
00323            ADD +1             TO WRK-ERROR-CNT                    CHGBD901
00324            SET WRK-BYPASS-YES-88 TO TRUE                          CHGBD901
00325            DISPLAY 'ERR - WAGES ' CHG40-WAGES                     CHGBD901
00326            GO TO P1100-EXIT                                       CHGBD901
00327         ELSE                                                      CHGBD901
00328            ADD +1             TO WRK-ERROR-CNT                    CHGBD901
00329            SET WRK-BYPASS-YES-88 TO TRUE                          CHGBD901
00330            DISPLAY 'ERR - WAGES = ZERO ' CHG40-WAGES              CHGBD901
00331            GO TO P1100-EXIT.                                      CHGBD901
00332                                                                   CHGBD901
00333  P1100-EXIT.                                                      CHGBD901
00334      EXIT.                                                        CHGBD901
00335                                                                   CHGBD901
00336  P1200-FIND-EMP-NO.                                               CHGBD901
00337      SET DC-NDX                         TO +1.                    CHGBD901
00338      SEARCH DC-AGENCY-TBL               VARYING DC-NDX            CHGBD901
00339         AT END                                                    CHGBD901
00340            MOVE WRK-DEFAULT-DC-EMP-NO   TO CHG10-EMP-NO           CHGBD901
00341         WHEN DC-TBL-CODE (DC-NDX)   = CHG40-DC-AGENCY-CD          CHGBD901
00342            MOVE DC-TBL-EMP-NO (DC-NDX)  TO CHG10-EMP-NO           CHGBD901
00343      END-SEARCH.                                                  CHGBD901
00344                                                                   CHGBD901
00345  P1200-EXIT.                                                      CHGBD901
00346      EXIT.                                                        CHGBD901
00347                                                                   CHGBD901
00348  S1000-READ-CHGM040.                                              CHGBD901
00349      READ DC-WAGE-IN.                                             CHGBD901
00350      IF WAGE-IN-EOF-88                                            CHGBD901
00351         GO TO S1000-EXIT                                          CHGBD901
00352      ELSE                                                         CHGBD901
00353         IF NOT WAGE-IN-OK-88                                      CHGBD901
00354            DISPLAY 'CANNOT READ DC WAGE IN FILE '                 CHGBD901
00355               DC-WAGE-IN-STATUS                                   CHGBD901
00356            SET WRK-ERROR-YES-88 TO TRUE                           CHGBD901
00357         ELSE                                                      CHGBD901
00358            ADD 1 TO WRK-IN-CNT                                    CHGBD901
00359         END-IF                                                    CHGBD901
00360      END-IF.                                                      CHGBD901
00361                                                                   CHGBD901
00362  S1000-EXIT.                                                      CHGBD901
00363      EXIT.                                                        CHGBD901
00364                                                                   CHGBD901
00365  S2000-WRITE-CHGM010.                                             CHGBD901
00366      WRITE CHGM010-REC.                                           CHGBD901
00367      IF WAGE-OUT-OK-88                                            CHGBD901
00368         ADD 1 TO WRK-OUT-CNT                                      CHGBD901
00369      ELSE                                                         CHGBD901
00370         DISPLAY 'CANNOT WRITE OUTPUT ' DC-WAGE-OUT-STATUS         CHGBD901
00371         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD901
00372      END-IF.                                                      CHGBD901
00373                                                                   CHGBD901
00374  S2000-EXIT.                                                      CHGBD901
00375      EXIT.                                                        CHGBD901
00376                                                                   CHGBD901
00377  S004-FROM-3.                                                     CHGBD901
00378      SET L004-FROM-3    TO TRUE.                                  CHGBD901
00379      GO TO S004-YRQ.                                              CHGBD901
00380                                                                   CHGBD901
00381  S004-YRQ.                                                        CHGBD901
00382      CALL 'DTSBU004' USING L004-LINK-AREA.                        CHGBD901
00383                                                                   CHGBD901
00384  S004-EXIT. EXIT.                                                 CHGBD901
00385                                                                   CHGBD901
00386 ** REPORT RECORD I-O                                              CHGBD901
00387 *S946-RPT-REC-O.                                                  CHGBD901
00388 *    CALL 'DTSBU946' USING RSKL-REC.                              CHGBD901
00389 *                                                                 CHGBD901
00390 *S946-EXIT.                                                       CHGBD901
00391 *    EXIT.                                                        CHGBD901
00392                                                                   CHGBD901
00393  T0000-TERMINATE.                                                 CHGBD901
00394      CLOSE DC-WAGE-IN                                             CHGBD901
00395            DC-WAGE-OUT.                                           CHGBD901
00396                                                                   CHGBD901
00397                                                                   CHGBD901
00398      DISPLAY '***********************************************'.   CHGBD901
00399      DISPLAY '***             CHGBD901 COUNTS             *** '.  CHGBD901
00400      DISPLAY '***'.                                               CHGBD901
00401                                                                   CHGBD901
00402      DISPLAY ' INPUT WAGE RECORDS READ      :      '              CHGBD901
00403         WRK-IN-CNT.                                               CHGBD901
00404                                                                   CHGBD901
00405      DISPLAY ' OUTPUT WAGE RECORDS WRITTEN  :      '              CHGBD901
00406         WRK-OUT-CNT.                                              CHGBD901
00407                                                                   CHGBD901
00408      DISPLAY ' DC AGENCY RECORDS READ       :      '              CHGBD901
00409         WRK-AGENCY-CNT.                                           CHGBD901
00410                                                                   CHGBD901
00411      DISPLAY ' ERRORS                       :      '              CHGBD901
00412         WRK-ERROR-CNT.                                            CHGBD901
00413                                                                   CHGBD901
00414      DISPLAY '***********************************************'.   CHGBD901
00415                                                                   CHGBD901
00416  T0000-EXIT.                                                      CHGBD901
00417      EXIT.                                                        CHGBD901
00418      EJECT                                                        CHGBD901
00419                                                                   CHGBD901
00420  S999-ABEND.                                                      CHGBD901
00421      DISPLAY '****  CHGBD901 ABENDING '                           CHGBD901
00422         ABEND-MSG.                                                CHGBD901
00423      CALL ABEND-MOD USING ABEND-CODE.                             CHGBD901
00424                                                                   CHGBD901
00425  S999-EXIT.                                                       CHGBD901
00426      EXIT.                                                        CHGBD901
00427                                                                   CHGBD901
