00001  IDENTIFICATION DIVISION.                                         10/06/14
00002  PROGRAM-ID.             CHGBD221.                                CHGBD221
00003 *AUTHOR.                 NGC.                                        LV002
00004 *DATE-WRITTEN.           JULY 2007.                               CHGBD221
00005  DATE-COMPILED.                                                   CHGBD221
00006      SKIP3                                                        CHGBD221
00007 *****                                                             CHGBD221
00008 *                                                                 CHGBD221
00009 *    FUNCTION:                                                    CHGBD221
00010 *                                                                 CHGBD221
00011 *        THIS PROGRAM IS USED FOR RATED EMPLOYERS ONLY.  CHGBD220 CHGBD221
00012 *        IS USED FOR ALL OTHER EMPLOYER TYPES.                    CHGBD221
00013 *                                                                 CHGBD221
00014 *        THE PROGRAM BUILDS CHGIM004 RECORDS FROM CHGIM005 RECORDSCHGBD221
00015 *        ADDING THE EMPLOYER'S MAILING ADDRESS, AND WRITING       CHGBD221
00016 * MAILING LABELS.                                                 CHGBD221
00017 *                                                                 CHGBD221
00018 *        INPUT:                                                   CHGBD221
00019 *                                                                 CHGBD221
00020 *            BD200CHG - CHARGE REPORT RECORDS GENERATED BY        CHGBD221
00021 *                       CHGBD200.                                 CHGBD221
00022 *             CHGPARM - PARAMETER DATA INPUT FROM CHGBD305        CHGBD221
00023 *                                                                 CHGBD221
00024 *        OUTPUT:                                                  CHGBD221
00025 *            BD210CHG - CHARGE REPORT RECORDS GENERATED BY        CHGBD221
00026 *                       CHGBD220.                                 CHGBD221
00027 *                                                                 CHGBD221
00028 *****                                                             CHGBD221
00029                                                                   CHGBD221
00030 ******************************************************************CHGBD221
00031 * MODIFICATION HISTORY:                                          *CHGBD221
00032 *                                                                *CHGBD221
00033 * 02-02-1999 INITIAL DEVELOPMENT                                 *CHGBD221
00034 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD221
00035 *                                                                *CHGBD221
00036 * 04-23-2002 MODIFIED TO OUTPUT TEUC RPC150R1 REPORT             *CHGBD221
00037 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW1 *CHGBD221
00038 *                                                                *CHGBD221
00039 * 04-02-2007 MODIFIED TO OUTPUT LABELS WHEN REQUESTING CWC AND   *CHGBD221
00040 *            FED REPORTS                                         *CHGBD221
00041 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW1 *CHGBD221
00042 *                                                                *CHGBD221
00043 * 05-11-2007 MODIFIED TO SEPARATE CHARGES TRANSFERRED BETWEEN    *CHGBD221
00044 *            PREDECESSORS AND SUCCESSORS.  THESE CHARGES CANNOT  *CHGBD221
00045 *            BE SUMMED INTO THE TOTAL AMOUNT FOR THE SSN - THEY  *CHGBD221
00046 *            NEED TO BE REPORTED SEPARATLY.                      *CHGBD221
00047 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD221
00048 *                                                                *CHGBD221
00049 * 03-09-2009 RECOMPLIED FOR NEW VERSION OF CHGIM004.             *CHGBD221
00050 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD221
00051 *                                                                *CHGBD221
00052 *                                                                *CHGBD221
00053 * 05-14-2019 RECOMPLIED FOR NEW VERSION OF CHGIM004.             *CHGBD221
00054 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBD221
00055 *                                                                *CHGBD221
00056 *                                                                *   CL**2
00057 * 10-04-2014 RECOMPLIED FOR NEW VERSION OF CHGIM004.             *   CL**2
00058 *            REFERENCE RFP # UCPIA        AUTHOR OF CHANGE - ZL1 *   CL**2
00059 *                                                                *   CL**2
00060 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD221
00061 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD221
00062 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBD221
00063 ******************************************************************CHGBD221
00064                                                                   CHGBD221
00065      SKIP3                                                        CHGBD221
00066  ENVIRONMENT DIVISION.                                            CHGBD221
00067      SKIP3                                                        CHGBD221
00068  INPUT-OUTPUT SECTION.                                            CHGBD221
00069      SKIP3                                                        CHGBD221
00070  FILE-CONTROL.                                                    CHGBD221
00071      SELECT CHG-FILE-IN ASSIGN TO BD210CHG                        CHGBD221
00072             FILE STATUS IS CHG-IN-STATUS.                         CHGBD221
00073                                                                   CHGBD221
00074      SELECT CHG-FILE-OUT   ASSIGN TO BD220CHG                     CHGBD221
00075             FILE STATUS IS CHG-OUT-STATUS.                        CHGBD221
00076                                                                   CHGBD221
00077      SELECT CHG-PARM-FILE  ASSIGN TO CHGPARM                      CHGBD221
00078             FILE STATUS IS CHG-PARM-STATUS.                       CHGBD221
00079      EJECT                                                        CHGBD221
00080  DATA DIVISION.                                                   CHGBD221
00081  FILE SECTION.                                                    CHGBD221
00082  FD  CHG-FILE-IN                                                  CHGBD221
00083      RECORDING MODE IS F                                          CHGBD221
00084      LABEL RECORDS ARE STANDARD                                   CHGBD221
00085      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD221
00086      SKIP1                                                        CHGBD221
00087  01  CHG-REC-IN.                                                  CHGBD221
00088  ++INCLUDE CHGIM004                                               CHGBD221
00089                                                                   CHGBD221
00090  FD  CHG-FILE-OUT                                                 CHGBD221
00091      RECORDING MODE IS F                                          CHGBD221
00092      LABEL RECORDS ARE STANDARD                                   CHGBD221
00093      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD221
00094      SKIP1                                                        CHGBD221
00095  01  CHG-REC-OUT                     PIC X(388).                  CHGBD221
00096                                                                   CHGBD221
00097  FD  CHG-PARM-FILE                                                CHGBD221
00098      RECORDING MODE IS F                                          CHGBD221
00099      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD221
00100      SKIP1                                                        CHGBD221
00101  01  CHG-PARM-REC.                                                CHGBD221
00102  ++INCLUDE CHGIM003                                               CHGBD221
00103                                                                   CHGBD221
00104      EJECT                                                        CHGBD221
00105  WORKING-STORAGE SECTION.                                         CHGBD221
001055 77  PAN-VALET PICTURE X(24) VALUE '002CHGBD221  10/06/14'.       CHGBD221
00106  77  PAN-VALET PICTURE X(24) VALUE '005CHGBD221  05/25/10'.       CHGBD221
00107                                                                   CHGBD221
00108  01  WRK-AREA.                                                    CHGBD221
00109      05  WRK-ZERO-CHG-CNT            PIC  9(07) COMP-3 VALUE  0.  CHGBD221
00110      05  WRK-TOT-CHG             PIC S9(09)V99 COMP-3 VALUE +0.   CHGBD221
00111      05  WRK-TOT-CHG-DISP        PIC Z(08)9.99-.                  CHGBD221
00112      05  WRK-EMP-CHG             PIC S9(09)V99 COMP-3 VALUE +0.   CHGBD221
00113      05  WRK-DISP-AREA.                                           CHGBD221
00114          10  WRK-EMP-DISP            PIC 9(06).                   CHGBD221
00115          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD221
00116          10  WRK-SSN-DISP            PIC 9(09).                   CHGBD221
00117          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD221
00118          10  WRK-CHG-DISP            PIC Z9(08)9.99-.             CHGBD221
00119                                                                   CHGBD221
00120      05  WRK-CHG-IN-CNT              PIC  9(08) COMP-3 VALUE  0.  CHGBD221
00121      05  WRK-CHG-OUT-CNT             PIC  9(08) COMP-3 VALUE  0.  CHGBD221
00122      05  WRK-CHG-SUM-CNT             PIC  9(08) COMP-3 VALUE  0.  CHGBD221
00123      05  WRK-LABEL-CNT               PIC  9(08) COMP-3 VALUE  0.  CHGBD221
00124      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD221
00125                                  VALUE +221.                      CHGBD221
00126      05  ABEND-MOD                   PIC  X(08)                   CHGBD221
00127                                  VALUE 'DTSBU999'.                CHGBD221
00128      05  ABEND-MSG                   PIC  X(60).                  CHGBD221
00129                                                                   CHGBD221
00130      05  CHG-IN-STATUS               PIC  X(02) VALUE SPACES.     CHGBD221
00131          88  CHG-IN-OK-88        VALUE ZERO.                      CHGBD221
00132          88  CHG-IN-EOF-88       VALUE '10'.                      CHGBD221
00133                                                                   CHGBD221
00134      05  CHG-OUT-STATUS              PIC  X(02) VALUE SPACES.     CHGBD221
00135          88  CHG-OUT-OK-88       VALUE ZERO.                      CHGBD221
00136                                                                   CHGBD221
00137      05  CHG-PARM-STATUS             PIC  X(02) VALUE SPACES.     CHGBD221
00138          88  CHG-PARM-FILE-OK-88      VALUE ZERO.                 CHGBD221
00139          88  CHG-PARM-FILE-EOF-88     VALUE '10'.                 CHGBD221
00140                                                                   CHGBD221
00141      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD221
00142          88  WRK-ERROR-YES-88    VALUE 'Y'.                       CHGBD221
00143          88  WRK-ERROR-NO-88     VALUE 'N'.                       CHGBD221
00144                                                                   CHGBD221
00145      05  WRK-LAST-LABEL-EMP          PIC S9(07) COMP-3            CHGBD221
00146                                  VALUE ZERO.                      CHGBD221
00147                                                                   CHGBD221
00148      05  WRK-L030-SSN                PIC  9(10).                  CHGBD221
00149      05  FILLER REDEFINES WRK-L030-SSN.                           CHGBD221
00150          10  WRK-L030-SSN-9          PIC  9(09).                  CHGBD221
00151          10  WRK-L030-SSN-SEQ        PIC  9(01).                  CHGBD221
00152                                                                   CHGBD221
00153      05  WRK-CURR-RPT-TYPE           PIC  X(01) VALUE SPACE.      CHGBD221
00154          88  WRK-CURR-RPT-RATED-88     VALUE '1'.                 CHGBD221
00155          88  WRK-CURR-RPT-SELF-INS-88  VALUE '2'.                 CHGBD221
00156          88  WRK-CURR-RPT-CWC-88       VALUE '3'.                 CHGBD221
00157          88  WRK-CURR-RPT-FED-88       VALUE '4'.                 CHGBD221
00158                                                                   CHGBD221
00159      05  WRK-LABEL-ROUTE-AREA.                                    CHGBD221
00160          10  WRK-LABEL-ROUTE-STARS      PIC X(40)  VALUE          CHGBD221
00161              ALL '*'.                                             CHGBD221
00162          10  WRK-LABEL-ROUTE-SELF-INS   PIC X(40)  VALUE          CHGBD221
00163              '             SELF-INSURED               '.          CHGBD221
00164          10  WRK-LABEL-ROUTE-CWC        PIC X(40)  VALUE          CHGBD221
00165              '                  CWC                   '.          CHGBD221
00166          10  WRK-LABEL-ROUTE-FED        PIC X(40)  VALUE          CHGBD221
00167              '                FEDERAL                 '.          CHGBD221
00168  01  DISPLAY-PARM-REC.                                            CHGBD221
00169      05  DISPLAY-RUN-TYPE                 PIC X(03).              CHGBD221
00170      05  FILLER                           PIC X(01).              CHGBD221
00171      05  DISPLAY-BEGIN-DATE               PIC 9(06).              CHGBD221
00172      05  FILLER                           PIC X(01).              CHGBD221
00173      05  DISPLAY-END-DATE                 PIC 9(06).              CHGBD221
00174      05  FILLER                           PIC X(01).              CHGBD221
00175      05  DISPLAY-REPORT-TYPES.                                    CHGBD221
00176          10  DISPLAY-RPT-TYPE-RATED       PIC X(01).              CHGBD221
00177          10  DISPLAY-RPT-TYPE-SELF-IND    PIC X(01).              CHGBD221
00178          10  DISPLAY-RPT-TYPE-CWC         PIC X(01).              CHGBD221
00179          10  DISPLAY-RPT-TYPE-FED         PIC X(01).              CHGBD221
00180          10  DISPLAY-RPT-TYPE-TEUC        PIC X(01).              CHGBD221
00181      05  FILLER                           PIC X(01).              CHGBD221
00182      05  DISPLAY-EMP-NO                   PIC 9(06).              CHGBD221
00183      05  FILLER                           PIC X(50).              CHGBD221
00184                                                                   CHGBD221
00185 ** REPORT I-O SKELETAL RECORD                                     CHGBD221
00186  01  RSKL-REC.                                                    CHGBD221
00187  ++INCLUDE DTSIRSK1                                               CHGBD221
00188 ** MAILING LABEL RECORD                                           CHGBD221
00189  01  R901-REC.                                                    CHGBD221
00190  ++INCLUDE DTSIR901                                               CHGBD221
00191                                                                   CHGBD221
00192  01  CG-L030-LINK-AREA.                                           CHGBD221
00193  ++INCLUDE CHGIL030                                               CHGBD221
00194                                                                   CHGBD221
00195  PROCEDURE DIVISION.                                              CHGBD221
00196      SKIP2                                                        CHGBD221
00197  CHGBD220-MAIN.                                                   CHGBD221
00198      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD221
00199      IF WRK-ERROR-YES-88                                          CHGBD221
00200         GO TO CHGBD220-EXIT.                                      CHGBD221
00201                                                                   CHGBD221
00202      PERFORM P0000-PROCESS   THRU P0000-EXIT.                     CHGBD221
00203      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD221
00204                                                                   CHGBD221
00205  CHGBD220-EXIT.                                                   CHGBD221
00206      STOP RUN.                                                    CHGBD221
00207      EJECT                                                        CHGBD221
00208  I0000-INITIATE.                                                  CHGBD221
00209                                                                   CHGBD221
00210      MOVE ZERO TO  WRK-CHG-IN-CNT                                 CHGBD221
00211                    WRK-CHG-OUT-CNT                                CHGBD221
00212                    WRK-LABEL-CNT                                  CHGBD221
00213                    WRK-CHG-SUM-CNT.                               CHGBD221
00214                                                                   CHGBD221
00215      SET WRK-ERROR-NO-88 TO TRUE.                                 CHGBD221
00216                                                                   CHGBD221
00217      MOVE LENGTH OF R901-REC TO R901-LENGTH.                      CHGBD221
00218                                                                   CHGBD221
00219      PERFORM I2000-OPEN-FILES THRU I2000-EXIT.                    CHGBD221
00220                                                                   CHGBD221
00221  I0000-EXIT.                                                      CHGBD221
00222      EXIT.                                                        CHGBD221
00223                                                                   CHGBD221
00224  I2000-OPEN-FILES.                                                CHGBD221
00225      OPEN INPUT CHG-FILE-IN.                                      CHGBD221
00226      IF NOT CHG-IN-OK-88                                          CHGBD221
00227         DISPLAY 'INPUT FILE OPEN ERROR: ' CHG-IN-STATUS           CHGBD221
00228         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD221
00229                                                                   CHGBD221
00230      OPEN OUTPUT CHG-FILE-OUT.                                    CHGBD221
00231      IF NOT CHG-OUT-OK-88                                         CHGBD221
00232         DISPLAY 'OUTPUT FILE OPEN ERROR: ' CHG-OUT-STATUS         CHGBD221
00233         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD221
00234                                                                   CHGBD221
00235      OPEN INPUT CHG-PARM-FILE.                                    CHGBD221
00236      IF NOT CHG-PARM-FILE-OK-88                                   CHGBD221
00237         DISPLAY 'CHARGE PARM FILE OPEN ERROR: '                   CHGBD221
00238            CHG-PARM-STATUS                                        CHGBD221
00239         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD221
00240                                                                   CHGBD221
00241      READ CHG-PARM-FILE.                                          CHGBD221
00242      IF NOT CHG-PARM-FILE-OK-88                                   CHGBD221
00243         DISPLAY 'CHARGE PARM FILE READ ERROR: '                   CHGBD221
00244            CHG-PARM-STATUS                                        CHGBD221
00245         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD221
00246                                                                   CHGBD221
00247      DISPLAY '***** CHGBD220 PARM RECORD  *****'.                 CHGBD221
00248      MOVE CHG3-RUN-TYPE       TO DISPLAY-RUN-TYPE.                CHGBD221
00249      MOVE CHG3-BEGIN-DATE     TO DISPLAY-BEGIN-DATE.              CHGBD221
00250      MOVE CHG3-END-DATE       TO DISPLAY-END-DATE.                CHGBD221
00251      MOVE CHG3-RPT-TYPES      TO DISPLAY-REPORT-TYPES.            CHGBD221
00252      MOVE CHG3-EMP-NO         TO DISPLAY-EMP-NO.                  CHGBD221
00253      DISPLAY DISPLAY-PARM-REC.                                    CHGBD221
00254      DISPLAY SPACE.                                               CHGBD221
00255                                                                   CHGBD221
00256      SET CG-L030-CMND-INIT-88 TO TRUE.                            CHGBD221
00257      PERFORM S030-TOT-CHARGE THRU S030-EXIT.                      CHGBD221
00258                                                                   CHGBD221
00259  I2000-EXIT.                                                      CHGBD221
00260      EXIT.                                                        CHGBD221
00261                                                                   CHGBD221
00262  P0000-PROCESS.                                                   CHGBD221
00263      PERFORM S1000-READ-BD210     THRU S1000-EXIT.                CHGBD221
00264      IF CHG-IN-EOF-88                                             CHGBD221
00265         DISPLAY 'CHGBD220: INPUT FILE EMPTY'                      CHGBD221
00266      END-IF.                                                      CHGBD221
00267                                                                   CHGBD221
00268      PERFORM P1000-PROCESS-CHARGES THRU P1000-EXIT                CHGBD221
00269         UNTIL CHG-IN-EOF-88                                       CHGBD221
00270         OR    WRK-ERROR-YES-88.                                   CHGBD221
00271                                                                   CHGBD221
00272  P0000-EXIT.                                                      CHGBD221
00273      EXIT.                                                        CHGBD221
00274                                                                   CHGBD221
00275  P1000-PROCESS-CHARGES.                                           CHGBD221
00276      ADD 1 TO WRK-CHG-IN-CNT.                                     CHGBD221
00277                                                                   CHGBD221
00278      PERFORM P1200-WRITE-CHARGES THRU P1200-EXIT.                 CHGBD221
00279                                                                   CHGBD221
00280      PERFORM S1000-READ-BD210     THRU S1000-EXIT.                CHGBD221
00281      IF CHG-IN-EOF-88                                             CHGBD221
00282         GO TO P1000-EXIT                                          CHGBD221
00283      ELSE                                                         CHGBD221
00284         IF NOT CHG-IN-OK-88                                       CHGBD221
00285            DISPLAY 'BD210 FILE READ ERROR: ' CHG-IN-STATUS        CHGBD221
00286            SET WRK-ERROR-YES-88 TO TRUE                           CHGBD221
00287         END-IF                                                    CHGBD221
00288      END-IF.                                                      CHGBD221
00289                                                                   CHGBD221
00290  P1000-EXIT.                                                      CHGBD221
00291      EXIT.                                                        CHGBD221
00292                                                                   CHGBD221
00293  P1200-WRITE-CHARGES.                                             CHGBD221
00294      COMPUTE WRK-EMP-CHG =                                        CHGBD221
00295         (CHG4-CURR-BEN-AMT                                        CHGBD221
00296         + CHG4-CURR-ADJ-AMT).                                     CHGBD221
00297                                                                   CHGBD221
00298      IF WRK-EMP-CHG = ZERO                                        CHGBD221
00299         ADD +1 TO WRK-ZERO-CHG-CNT                                CHGBD221
00300         IF CHG4-RPT-TYPE-NULL-88                                  CHGBD221
00301            PERFORM S1100-WRITE-BD220 THRU S1100-EXIT              CHGBD221
00302         END-IF                                                    CHGBD221
00303      ELSE                                                         CHGBD221
00304         PERFORM P1210-TOT-CHG     THRU P1210-EXIT                 CHGBD221
00305         PERFORM S1100-WRITE-BD220 THRU S1100-EXIT                 CHGBD221
00306         IF CHG4-EMP-NO NOT = WRK-LAST-LABEL-EMP                   CHGBD221
00307            PERFORM P3000-MAILING-LABEL THRU P3000-EXIT            CHGBD221
00308         END-IF                                                    CHGBD221
00309      END-IF.                                                      CHGBD221
00310                                                                   CHGBD221
00311  P1200-EXIT.                                                      CHGBD221
00312      EXIT.                                                        CHGBD221
00313                                                                   CHGBD221
00314  P1210-TOT-CHG.                                                   CHGBD221
00315      MOVE CHG4-SSN                     TO CG-L030-SSN.            CHGBD221
00316      MOVE CHG3-BEGIN-DATE              TO CG-L030-START-DATE.     CHGBD221
00317      MOVE CHG3-END-DATE                TO CG-L030-END-DATE.       CHGBD221
00318      MOVE CHG4-BYE                     TO CG-L030-BYE.            CHGBD221
00319      MOVE CHG4-PROGRAM                 TO CG-L030-PROGRAM.        CHGBD221
00320 *&                                                                CHGBD221
00321 *    DISPLAY 'INP ' CG-L030-SSN                                   CHGBD221
00322 *       '  ' CG-L030-START-DATE                                   CHGBD221
00323 *       '  ' CG-L030-END-DATE                                     CHGBD221
00324 *       '  ' CG-L030-BYE                                          CHGBD221
00325 *       '  ' CG-L030-PROGRAM.                                     CHGBD221
00326 *&                                                                CHGBD221
00327                                                                   CHGBD221
00328      SET CG-L030-CMND-PROCESS-88 TO TRUE.                         CHGBD221
00329      PERFORM S030-TOT-CHARGE THRU S030-EXIT.                      CHGBD221
00330                                                                   CHGBD221
00331      MOVE CG-L030-TOT-CHG    TO CHG4-TOT-BEN-AMT.                 CHGBD221
00332      MOVE ZERO               TO CHG4-TOT-ADJ-AMT.                 CHGBD221
00333 *&                                                                CHGBD221
00334 *    MOVE CHG4-TOT-BEN-AMT TO WRK-TOT-CHG-DISP.                   CHGBD221
00335 *    DISPLAY 'TOT CHG ' WRK-TOT-CHG-DISP                          CHGBD221
00336 *       '  ' CHG4-EMP-NO                                          CHGBD221
00337 *       '  ' CHG4-SSN.                                            CHGBD221
00338 *&                                                                CHGBD221
00339                                                                   CHGBD221
00340  P1210-EXIT.                                                      CHGBD221
00341      EXIT.                                                        CHGBD221
00342                                                                   CHGBD221
00343  P3000-MAILING-LABEL.                                             CHGBD221
00344      IF CHG3-RUN-TYPE-QTRLY-88 OR                                 CHGBD221
00345         CHG3-RUN-TYPE-RPTS-88                                     CHGBD221
00346         NEXT SENTENCE                                             CHGBD221
00347      ELSE                                                         CHGBD221
00348         GO TO P3000-EXIT.                                         CHGBD221
00349                                                                   CHGBD221
00350      IF CHG4-RPT-TYPE-SELF-INS-88                                 CHGBD221
00351      OR CHG4-RPT-TYPE-CWC-88                                      CHGBD221
00352      OR CHG4-RPT-TYPE-FED-88                                      CHGBD221
00353         NEXT SENTENCE                                             CHGBD221
00354      ELSE                                                         CHGBD221
00355         GO TO P3000-EXIT.                                         CHGBD221
00356                                                                   CHGBD221
00357      IF CHG4-REPORT-TYPE NOT = WRK-CURR-RPT-TYPE                  CHGBD221
00358         MOVE CHG4-REPORT-TYPE TO WRK-CURR-RPT-TYPE                CHGBD221
00359         PERFORM P3100-SEPARATOR-LABEL THRU P3100-EXIT.            CHGBD221
00360                                                                   CHGBD221
00361      PERFORM P3200-PRINT-LABEL    THRU P3200-EXIT.                CHGBD221
00362                                                                   CHGBD221
00363  P3000-EXIT.                                                      CHGBD221
00364      EXIT.                                                        CHGBD221
00365                                                                   CHGBD221
00366  P3100-SEPARATOR-LABEL.                                           CHGBD221
00367      SET R901-ON-REQUEST-88 TO TRUE.                              CHGBD221
00368      MOVE LOW-VALUE TO R901-SORT-VAR-AREA.                        CHGBD221
00369      MOVE SPACES TO R901-FMT-ADDR                                 CHGBD221
00370                     R901-ZIP                                      CHGBD221
00371                     R901-ADVANCED-BARCODE.                        CHGBD221
00372                                                                   CHGBD221
00373      IF WRK-CURR-RPT-SELF-INS-88                                  CHGBD221
00374         MOVE WRK-LABEL-ROUTE-SELF-INS TO R901-FMT-LINE (2)        CHGBD221
00375      ELSE                                                         CHGBD221
00376        IF WRK-CURR-RPT-CWC-88                                     CHGBD221
00377           MOVE WRK-LABEL-ROUTE-CWC      TO R901-FMT-LINE (2)      CHGBD221
00378        ELSE                                                       CHGBD221
00379          IF WRK-CURR-RPT-FED-88                                   CHGBD221
00380             MOVE WRK-LABEL-ROUTE-FED      TO R901-FMT-LINE (2)    CHGBD221
00381          ELSE                                                     CHGBD221
00382             GO TO P3100-EXIT.                                     CHGBD221
00383                                                                   CHGBD221
00384      MOVE WRK-CURR-RPT-TYPE     TO R901-GRP1-OP-ID.               CHGBD221
00385      MOVE 000000                TO R901-EMP-NO.                   CHGBD221
00386      MOVE +1                    TO R901-LABEL-CNT.                CHGBD221
00387      MOVE WRK-LABEL-ROUTE-STARS TO R901-FMT-LINE (1)              CHGBD221
00388                                    R901-FMT-LINE (3).             CHGBD221
00389                                                                   CHGBD221
00390      MOVE R901-REC              TO RSKL-REC.                      CHGBD221
00391      PERFORM S946-RPT-REC-O THRU S946-EXIT.                       CHGBD221
00392                                                                   CHGBD221
00393  P3100-EXIT.                                                      CHGBD221
00394      EXIT.                                                        CHGBD221
00395                                                                   CHGBD221
00396  P3200-PRINT-LABEL.                                               CHGBD221
00397      SET R901-ON-REQUEST-88 TO TRUE.                              CHGBD221
00398      MOVE LOW-VALUE TO R901-SORT-VAR-AREA.                        CHGBD221
00399                                                                   CHGBD221
00400      MOVE CHG4-REPORT-TYPE      TO R901-GRP1-OP-ID.               CHGBD221
00401      MOVE CHG4-EMP-NO           TO R901-EMP-NO                    CHGBD221
00402                                    WRK-LAST-LABEL-EMP.            CHGBD221
00403      MOVE +1                    TO R901-LABEL-CNT.                CHGBD221
00404                                                                   CHGBD221
00405      MOVE CHG4-FMT-ADDR         TO R901-FMT-ADDR.                 CHGBD221
00406      MOVE CHG4-ZIP              TO R901-ZIP.                      CHGBD221
00407      MOVE CHG4-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE.         CHGBD221
00408                                                                   CHGBD221
00409      MOVE R901-REC              TO RSKL-REC.                      CHGBD221
00410      PERFORM S946-RPT-REC-O THRU S946-EXIT.                       CHGBD221
00411                                                                   CHGBD221
00412      ADD +1                     TO WRK-LABEL-CNT.                 CHGBD221
00413                                                                   CHGBD221
00414  P3200-EXIT.                                                      CHGBD221
00415      EXIT.                                                        CHGBD221
00416                                                                   CHGBD221
00417  S1000-READ-BD210.                                                CHGBD221
00418      READ CHG-FILE-IN.                                            CHGBD221
00419                                                                   CHGBD221
00420  S1000-EXIT.                                                      CHGBD221
00421      EXIT.                                                        CHGBD221
00422                                                                   CHGBD221
00423  S1100-WRITE-BD220.                                               CHGBD221
00424      COMPUTE WRK-TOT-CHG = WRK-TOT-CHG                            CHGBD221
00425         + CHG4-CURR-BEN-AMT                                       CHGBD221
00426         + CHG4-CURR-ADJ-AMT.                                      CHGBD221
00427                                                                   CHGBD221
00428      WRITE CHG-REC-OUT   FROM CHG-REC-IN.                         CHGBD221
00429      IF CHG-OUT-OK-88                                             CHGBD221
00430         ADD 1 TO WRK-CHG-OUT-CNT.                                 CHGBD221
00431                                                                   CHGBD221
00432  S1100-EXIT.                                                      CHGBD221
00433      EXIT.                                                        CHGBD221
00434                                                                   CHGBD221
00435  S030-TOT-CHARGE.                                                 CHGBD221
00436      CALL 'CHGBD235' USING CG-L030-LINK-AREA.                     CHGBD221
00437  S030-EXIT. EXIT.                                                 CHGBD221
00438                                                                   CHGBD221
00439 ** REPORT RECORD I-O                                              CHGBD221
00440  S946-RPT-REC-O.                                                  CHGBD221
00441      CALL 'DTSBU946' USING RSKL-REC.                              CHGBD221
00442                                                                   CHGBD221
00443  S946-EXIT.                                                       CHGBD221
00444      EXIT.                                                        CHGBD221
00445                                                                   CHGBD221
00446  T0000-TERMINATE.                                                 CHGBD221
00447      CLOSE CHG-FILE-IN                                            CHGBD221
00448            CHG-FILE-OUT                                           CHGBD221
00449            CHG-PARM-FILE.                                         CHGBD221
00450                                                                   CHGBD221
00451      SET CG-L030-CMND-TERM-88 TO TRUE.                            CHGBD221
00452      PERFORM S030-TOT-CHARGE THRU S030-EXIT.                      CHGBD221
00453                                                                   CHGBD221
00454      DISPLAY '***********************************************'.   CHGBD221
00455      DISPLAY '***             CHGBD221 COUNTS             *** '.  CHGBD221
00456      DISPLAY '***'.                                               CHGBD221
00457                                                                   CHGBD221
00458      DISPLAY ' INPUT CHARGE RECORDS READ    :      '              CHGBD221
00459         WRK-CHG-IN-CNT.                                           CHGBD221
00460                                                                   CHGBD221
00461      DISPLAY ' OUTPUT CHARGE RECORDS WRITTEN:      '              CHGBD221
00462         WRK-CHG-OUT-CNT.                                          CHGBD221
00463                                                                   CHGBD221
00464      DISPLAY ' TOTAL CHARGE = ZERO BYPASSED :      '              CHGBD221
00465         WRK-ZERO-CHG-CNT.                                         CHGBD221
00466                                                                   CHGBD221
00467      DISPLAY ' MAILING LABELS WRITTEN       :      '              CHGBD221
00468         WRK-LABEL-CNT.                                            CHGBD221
00469                                                                   CHGBD221
00470      MOVE WRK-TOT-CHG TO WRK-TOT-CHG-DISP.                        CHGBD221
00471      DISPLAY ' TOTAL CHARGES                :      '              CHGBD221
00472         WRK-TOT-CHG-DISP.                                         CHGBD221
00473                                                                   CHGBD221
00474      DISPLAY '***********************************************'.   CHGBD221
00475                                                                   CHGBD221
00476  T0000-EXIT.                                                      CHGBD221
00477      EXIT.                                                        CHGBD221
00478      EJECT                                                        CHGBD221
00479                                                                   CHGBD221
00480  S999-ABEND.                                                      CHGBD221
00481      DISPLAY '****  CHGBD221 ABENDING '                           CHGBD221
00482         ABEND-MSG.                                                CHGBD221
00483      CALL ABEND-MOD USING ABEND-CODE.                             CHGBD221
00484                                                                   CHGBD221
00485  S999-EXIT.                                                       CHGBD221
00486      EXIT.                                                        CHGBD221
00487                                                                   CHGBD221
