00001  IDENTIFICATION DIVISION.                                         05/15/19
00002  PROGRAM-ID.             CHGBR130.                                CHGBR130
00003 *AUTHOR.                 TRW.                                        LV072
00004 *DATE-WRITTEN.           APRIL 2000.                              CHGBR130
00005  DATE-COMPILED.                                                   CHGBR130
00006                                                                   CHGBR130
00007 *****                                                             CHGBR130
00008 *    CALLING SEQUENCE:  CHGBD300 CALLS                            CHGBR130
00009 *                       CHGBR130 READS CHGIM004 RECORDS           CHGBR130
00010 *                       CHGBR130 WRITES FEDERAL/SPECIAL RPT.      CHGBR130
00011 *                                                                 CHGBR130
00012 *    FUNCTION:  PRINT FEDERAL SUMMARY/SPECIAL REPORT              CHGBR130
00013 *                                                                 CHGBR130
00014 *    DESCRIPTION:                                                 CHGBR130
00015 *                                                                 CHGBR130
00016 *        THIS MODULE GENERATES THE QUARTERLY/SPECIAL FEDERAL      CHGBR130
00017 *        SUMMARY/SPECIAL REPORT.                                  CHGBR130
00018 *                                                                 CHGBR130
00019 *    RECORDS READ:                                                CHGBR130
00020 *                                                                 CHGBR130
00021 *        NONE.                                                    CHGBR130
00022 *                                                                 CHGBR130
00023 *    INPUT:                                                       CHGBR130
00024 *                                                                 CHGBR130
00025 *         CHGIM004 RECORD PASSED FROM CHGBD300                    CHGBR130
00026 *                                                                 CHGBR130
00027 *    PRINTED OUTPUTS:                                             CHGBR130
00028 *                                                                 CHGBR130
00029 *         RPC130R1 - PRINT FEDERAL SUMMARY REPORT                 CHGBR130
00030 *                                                                 CHGBR130
00031 *    MODULES CALLED:                                              CHGBR130
00032 *                                                                 CHGBR130
00033 *        DTSBU001 DATE EDIT/CONVERSION MODULE                     CHGBR130
00034 *                                                                 CHGBR130
00035 *****                                                             CHGBR130
00036                                                                   CHGBR130
00037 ******************************************************************CHGBR130
00038 * MODIFICATION HISTORY:                                          *CHGBR130
00039 *                                                                *CHGBR130
00040 * 02-08-2001 ADDED A HDR TO 'GRAND TOTALS' PAGE,  AND WILL NOW   *CHGBR130
00041 *            PRINT IT ONLY IF MORE THAN ONE EMPLOYER HAS BEEN    *CHGBR130
00042 *            REPORTED. FIXED OVERRUN ON 1ST PAGE.          - JHP *CHGBR130
00043 *                                                                *CHGBR130
00044 * 04-25-2000 MODIFIED THE REPORT WRITER CHGBR130 TO COBOL II     *CHGBR130
00045 *            PROGRAM.                                            *CHGBR130
00046 *            REFERENCE RFP #              AUTHOR OF CHANGE - RLW *CHGBR130
00047 *                                                                *CHGBR130
00048 * 02-02-1999 MODIFIED FROM MT CHG100D                            *CHGBR130
00049 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBR130
00050 *                                                                *CHGBR130
00051 * 72-28-2008 REMOVED ORLANDO NAME FROM REPORT                    *CHGBR130
00052 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBR130
00053 *                                                                *CHGBR130
00054 * 04-03-2009 MODIFIED FOR NEW PROGRAM CODE VALUES                *CHGBR130
00055 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBR130
00056 *                                                                *CHGBR130
00057 * 01-07-2010 MODIFIED TO EXCLUDE EB CHARGES FOR THE FEDS         *CHGBR130
00058 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBR130
00059 *                                                                *CHGBR130
00060 * 05-14-2010 RECOMPILE FOR NEW VERSION OF CHGIM004               *CHGBR130
00061 *            PRINT LAST 4 DIGITS OF SSN                          *CHGBR130
00062 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBR130
00063 *                                                                *CHGBR130
00064 * 10-04-2014 RECOMPILE FOR NEW VERSION OF CHGIM004               *CHGBR130
00065 *            REFERENCE RFP # UCPIA        AUTHOR OF CHANGE - ZL1 *CHGBR130
00066 ******************************************************************CHGBR130
00067                                                                   CHGBR130
00068  ENVIRONMENT DIVISION.                                            CHGBR130
00069  CONFIGURATION SECTION.                                           CHGBR130
00070  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               CHGBR130
00071                                                                   CHGBR130
00072  INPUT-OUTPUT SECTION.                                            CHGBR130
00073  FILE-CONTROL.                                                    CHGBR130
00074 ***                                         BEN.CHG. RPT (O)      CHGBR130
00075      SELECT FEDERAL-CSV ASSIGN TO CSV130R1.                       CHGBR130
00076      SELECT FEDERAL-RPT ASSIGN TO RPC130R1.                       CHGBR130
00077      SELECT MILITARY-RPT ASSIGN TO RPC130R2.                      CHGBR130
00078      EJECT                                                        CHGBR130
00079  DATA DIVISION.                                                   CHGBR130
00080  FILE SECTION.                                                    CHGBR130
00081                                                                   CHGBR130
00082  FD  FEDERAL-RPT                                                  CHGBR130
00083      RECORDING MODE IS F                                          CHGBR130
00084      RECORD CONTAINS 133 CHARACTERS                               CHGBR130
00085      BLOCK CONTAINS 0 RECORDS.                                    CHGBR130
00086                                                                   CHGBR130
00087  01  FEDERAL-REPORT                  PIC X(133).                  CHGBR130
00088                                                                   CHGBR130
00089  FD  FEDERAL-CSV.                                                 CHGBR130
00090  01  FEDERAL-CSV-REC                 PIC X(678).                  CHGBR130
00091 *NH                                                               CHGBR130
00092  FD  MILITARY-RPT                                                 CHGBR130
00093      RECORDING MODE IS F                                          CHGBR130
00094      RECORD CONTAINS 133 CHARACTERS                               CHGBR130
00095      BLOCK CONTAINS 0 RECORDS.                                    CHGBR130
00096                                                                   CHGBR130
00097  01  MILITARY-REPORT                 PIC X(133).                  CHGBR130
00098 *NH                                                               CHGBR130
00099  WORKING-STORAGE SECTION.                                         CHGBR130
000995 77  PAN-VALET PICTURE X(24) VALUE '072CHGBR130  05/15/19'.       CHGBR130
00100  77  PAN-VALET PICTURE X(24) VALUE '046CHGBR130  10/24/18'.       CHGBR130
00101  77  PAN-VALET PICTURE X(24) VALUE '070CHGBR130  09/17/10'.       CHGBR130
00102                                                                   CHGBR130
00103  01  WRK-AREA.                                                    CHGBR130
00104      05  WRK-ABEND-CODE           PIC S9(04)  COMP VALUE +130.    CHGBR130
00105                                                                   CHGBR130
00106      05  ABEND-MSG                PIC  X(60) VALUE SPACE.         CHGBR130
00107                                                                   CHGBR130
00108      05  ABEND-MOD                PIC  X(08) VALUE 'DTSBU999'.    CHGBR130
00109                                                                   CHGBR130
00110      05  WRK-REG-BEN-PAYMENT      PIC  X(25)                      CHGBR130
00111                            VALUE ' REGULAR BENEFIT PAYMENT '.     CHGBR130
00112      05  WRK-EXT-BEN-PAYMENT      PIC  X(25)                      CHGBR130
00113                            VALUE ' EXTENDED BENEFIT PAYMENT'.     CHGBR130
00114      05  WRK-TEUC-BEN-PAYMENT     PIC  X(25)                      CHGBR130
00115                            VALUE ' TEUC BENEFIT PAYMENT    '.     CHGBR130
00116      05  WRK-TEUCA-BEN-PAYMENT    PIC  X(25)                      CHGBR130
00117                            VALUE ' TEUCA BENEFIT PAYMENT   '.     CHGBR130
00118      05  WRK-FAC-BEN-PAYMENT      PIC  X(25)                      CHGBR130
00119                            VALUE ' FED ADDL COMP PAYMENT   '.     CHGBR130
00120      05  WRK-ADJUSTMENTS          PIC  X(25)                      CHGBR130
00121                            VALUE '       ADJUSTMENTS       '.     CHGBR130
00122      05  WRK-RPT-SUMMARY          PIC  X(26)                      CHGBR130
00123                            VALUE 'QUARTERLY  CHARGE  SUMMARY'.    CHGBR130
00124      05  WRK-RPT-SPECIAL          PIC  X(26)                      CHGBR130
00125                            VALUE ' BENEFIT  CHARGE  SPECIAL '.    CHGBR130
00126                                                                   CHGBR130
00127      05  WRK-SSN                     PIC  9(09) VALUE 0.          CHGBR130
00128      05  FILLER REDEFINES WRK-SSN.                                CHGBR130
00129          10  WRK-SSN1                PIC  9(03).                  CHGBR130
00130          10  WRK-SSN2                PIC  9(02).                  CHGBR130
00131          10  WRK-SSN3                PIC  9(04).                  CHGBR130
00132                                                                   CHGBR130
00133      05  WRK-RUN-DATE.                                            CHGBR130
00134          10  WRK-RUN-YY              PIC  9(04) VALUE ZEROS.      CHGBR130
00135          10  WRK-RUN-MM              PIC  9(02) VALUE ZEROS.      CHGBR130
00136          10  WRK-RUN-DD              PIC  9(02) VALUE ZEROS.      CHGBR130
00137                                                                   CHGBR130
00138      05  WRK-LINE-CNT                PIC  S9(04) COMP  VALUE +0.  CHGBR130
00139      05  WRK-PAGE-CNT                PIC  S9(04) COMP  VALUE +0.  CHGBR130
00140      05  WRK-EMPLYR-CNT              PIC   9(07) COMP  VALUE  0.  CHGBR130
00141      05  WS-SYSTEM-DATE              PIC   9(08) VALUE  0.        CHGBR130
00142      05  WS-REC                      PIC  X(133) VALUE SPACES.    CHGBR130
00143                                                                   CHGBR130
00144      05  WRK-CURR-EMP              PIC 9(06)  VALUE 0.            CHGBR130
00145      05  ZWRK-CURR-EMP REDEFINES WRK-CURR-EMP.                    CHGBR130
00146          10  WRK-CURR-EMPA         PIC 999.                       CHGBR130
00147          10  WRK-CURR-EMPB         PIC 999.                       CHGBR130
00148      05  WRK-CURR-AMT              PIC S9(07)V99 COMP-3 VALUE +0. CHGBR130
00149      05  WRK-TOT-AMT               PIC S9(07)V99 COMP-3 VALUE +0. CHGBR130
00150      05  WRK-TOTAL-BENEFITS        PIC S9(09)V99 COMP-3 VALUE +0. CHGBR130
00151      05  WRK-ACCT-TOTAL            PIC S9(09)V99 COMP-3 VALUE +0. CHGBR130
00152      05  WRK-GRAND-TOTAL-BENEFITS  PIC S9(10)V99 COMP-3 VALUE +0. CHGBR130
00153      05  WRK-GRAND-TOTAL-CHARGED   PIC S9(10)V99 COMP-3 VALUE +0. CHGBR130
00154      05  WRK-GRAND-TOT-BEN         PIC Z(13)9.99-.                CHGBR130
00155      05  WRK-GRAND-TOT-CHG         PIC Z(13)9.99-.                CHGBR130
00156      05  NAME-REFORMAT-AREA.                                      CHGBR130
00157          10  NAME-MAX                PIC S9(04) COMP   VALUE +32. CHGBR130
00158          10  S1                      PIC S9(04) COMP   VALUE +0.  CHGBR130
00159          10  S2                      PIC S9(04) COMP   VALUE +0.  CHGBR130
00160          10  S3                      PIC S9(04) COMP   VALUE +0.  CHGBR130
00161          10  WRK-LAST-FOUND          PIC  X(01).                  CHGBR130
00162              88  WRK-LAST-FOUND-YES-88  VALUE 'Y'.                CHGBR130
00163              88  WRK-LAST-FOUND-NO-88   VALUE 'N'.                CHGBR130
00164          10  WRK-FIRST-FOUND         PIC  X(01).                  CHGBR130
00165              88  WRK-FIRST-FOUND-YES-88  VALUE 'Y'.               CHGBR130
00166              88  WRK-FIRST-FOUND-NO-88   VALUE 'N'.               CHGBR130
00167          10  WRK-INIT-FOUND          PIC  X(01).                  CHGBR130
00168              88  WRK-INIT-FOUND-YES-88   VALUE 'Y'.               CHGBR130
00169              88  WRK-INIT-FOUND-NO-88    VALUE 'N'.               CHGBR130
00170          10  WRK-LAST-NAME           PIC  X(32).                  CHGBR130
00171          10  WRK-FIRST-NAME          PIC  X(32).                  CHGBR130
00172          10  WRK-MID-INIT            PIC  X(01).                  CHGBR130
00173                                                                   CHGBR130
00174                                                                   CHGBR130
00175                                                                   CHGBR130
00176  01  FSDES-LINE.                                                  CHGBR130
00177          10  FILLER                   PIC X(02) VALUE 'QB'.       CHGBR130
00178          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00179          10  FSDES-DATE               PIC 9(08).                  CHGBR130
00180          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00181          10  FSDES-STATE              PIC X(02) VALUE 'DC'.       CHGBR130
00182          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00183          10  FSDES-FIC                PIC 9(03).                  CHGBR130
00184          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00185          10  FSDES-SSN                PIC X(09).                  CHGBR130
00186          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00187          10  FSDES-FNAME              PIC X(25).                  CHGBR130
00188          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00189          10  FSDES-INAME              PIC X(01).                  CHGBR130
00190          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00191          10  FSDES-LNAME              PIC X(30).                  CHGBR130
00192          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00193          10  FSDES-QTR                PIC X(01).                  CHGBR130
00194          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00195          10  FSDES-YEAR               PIC 9(04).                  CHGBR130
00196          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00197          10  FSDES-BYE                PIC 9(08).                  CHGBR130
00198          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00199          10  FSDES-PAID               PIC 9999999.99.             CHGBR130
00200          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00201          10  FSDES-CHARGED            PIC 9999999.99.             CHGBR130
00202          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00203          10  FSDES-CODE               PIC X(03).                  CHGBR130
00204          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00205          10  FSDES-PERCENT            PIC 999.99999.              CHGBR130
00206          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00207          10  FSDES-CREDIT             PIC 9999999.99.             CHGBR130
00208          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00209          10  FSDES-CRE-BEG-DATE       PIC X(08).                  CHGBR130
00210          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00211          10  FSDES-CRE-END-DATE       PIC X(08).                  CHGBR130
00212          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00213          10  FSDES-CRE-REASON         PIC X(500).                 CHGBR130
00214          10  FILLER                   PIC X(01) VALUE ','.        CHGBR130
00215          10  FSDES-BYB                PIC X(08).                  CHGBR130
00216                                                                   CHGBR130
00217                                                                   CHGBR130
00218  01  REPORT-LINE-AREA.                                            CHGBR130
00219      05  HEAD01.                                                  CHGBR130
00220          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR130
00221          10  FILLER     PIC X(08)  VALUE 'CHGBR130'.              CHGBR130
00222          10  FILLER     PIC X(47)  VALUE  SPACE.                  CHGBR130
00223          10  FILLER     PIC X(20)  VALUE 'DISTRICT OF COLUMBIA'.  CHGBR130
00224          10  FILLER     PIC X(42)  VALUE  SPACE.                  CHGBR130
00225          10  FILLER     PIC X(09)  VALUE 'PAGE NO.:'.             CHGBR130
00226          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR130
00227          10  WRK-PRT-PAGE-CNT      PIC    ZZZ99.                  CHGBR130
00228                                                                   CHGBR130
00229      05  HEAD02.                                                  CHGBR130
00230          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR130
00231          10  FILLER     PIC X(10)  VALUE '          '.            CHGBR130
00232          10  FILLER     PIC X(42)  VALUE  SPACE.                  CHGBR130
00233          10  H2-RPT-TYP PIC X(26)  VALUE  SPACE.                  CHGBR130
00234 *        10  FILLER     PIC X(13)  VALUE 'QUARTERLY  CH'.         CHGBR130
00235 *        10  FILLER     PIC X(13)  VALUE 'ARGE  SUMMARY'.         CHGBR130
00236          10  FILLER     PIC X(49)  VALUE  SPACE.                  CHGBR130
00237          10  FILLER     PIC X(02)  VALUE 'TT'.                    CHGBR130
00238          10  WRK-PRT-EMP-TYPE      PIC X(02) VALUE  SPACE.        CHGBR130
00239                                                                   CHGBR130
00240      05  HEAD03.                                                  CHGBR130
00241          10  FILLER     PIC X(01)  VALUE SPACE.                   CHGBR130
00242          10  FILLER     PIC X(10)  VALUE 'ROOM 325'.              CHGBR130
00243          10  FILLER     PIC X(35)  VALUE SPACE.                   CHGBR130
00244          10  FILLER     PIC X(13)  VALUE 'DEPARTMENT   '.         CHGBR130
00245          10  FILLER     PIC X(13)  VALUE 'OF   EMPLOYME'.         CHGBR130
00246          10  FILLER     PIC X(13)  VALUE 'NT   SERVICES'.         CHGBR130
00247                                                                   CHGBR130
00248      05  HEAD04.                                                  CHGBR130
00249          10  FILLER     PIC X(01)  VALUE SPACE.                   CHGBR130
00250          10  FILLER     PIC X(49)  VALUE SPACE.                   CHGBR130
00251          10  FILLER     PIC X(12)  VALUE 'EMPLOYER ACC'.          CHGBR130
00252          10  FILLER     PIC X(12)  VALUE 'OUNT NUMBER '.          CHGBR130
00253          10  WRK-PRT-HDR-EMP      PIC 9(06).                      CHGBR130
00254                                                                   CHGBR130
00255      05  HEAD05.                                                  CHGBR130
00256          10  FILLER     PIC X(01)  VALUE SPACE.                   CHGBR130
00257          10  FILLER     PIC X(39)  VALUE SPACE.                   CHGBR130
00258          10  FILLER     PIC X(14)  VALUE 'REPORT INCLUDE'.        CHGBR130
00259          10  FILLER     PIC X(14)  VALUE 'S PERIOD FROM '.        CHGBR130
00260          10  WS-REPORT-START-DATE  PIC X(10) VALUE SPACE.         CHGBR130
00261          10  FILLER     PIC X(04)  VALUE ' TO '.                  CHGBR130
00262          10  WS-REPORT-END-DATE    PIC X(10) VALUE SPACE.         CHGBR130
00263                                                                   CHGBR130
00264      05  HEAD06.                                                  CHGBR130
00265          10  FILLER     PIC X(01)  VALUE SPACE.                   CHGBR130
00266          10  FILLER     PIC X(05)  VALUE SPACE.                   CHGBR130
00267          10  FILLER     PIC X(03)  VALUE 'SSN'.                   CHGBR130
00268          10  FILLER     PIC X(10)  VALUE SPACE.                   CHGBR130
00269          10  FILLER     PIC X(03)  VALUE 'BYE'.                   CHGBR130
00270          10  FILLER     PIC X(09)  VALUE SPACE.                   CHGBR130
00271          10  FILLER     PIC X(09)  VALUE 'NAME  OF '.             CHGBR130
00272          10  FILLER     PIC X(09)  VALUE ' CLAIMANT'.             CHGBR130
00273          10  FILLER     PIC X(19)  VALUE SPACE.                   CHGBR130
00274          10  FILLER     PIC X(14)  VALUE 'TOTAL BENEFITS'.        CHGBR130
00275          10  FILLER     PIC X(05)  VALUE SPACE.                   CHGBR130
00276          10  FILLER     PIC X(15)  VALUE 'ACCOUNT CHARGES'.       CHGBR130
00277          10  FILLER     PIC X(09)  VALUE SPACE.                   CHGBR130
00278          10  FILLER     PIC X(11)  VALUE 'SOURCE TYPE'.           CHGBR130
00279                                                                   CHGBR130
00280      05  WRK-PRINT-LINE.                                          CHGBR130
00281          10  FILLER                   PIC X(01) VALUE SPACE.      CHGBR130
00282          10  FILLER                   PIC X(04) VALUE SPACE.      CHGBR130
00283          10  WRK-PRT-SSN1             PIC X(03) VALUE SPACE.      CHGBR130
00284          10  FILLER                   PIC X(01) VALUE '-'.        CHGBR130
00285          10  WRK-PRT-SSN2             PIC X(02) VALUE SPACE.      CHGBR130
00286          10  FILLER                   PIC X(01) VALUE '-'.        CHGBR130
00287          10  WRK-PRT-SSN3             PIC X(04) VALUE SPACE.      CHGBR130
00288          10  FILLER                   PIC X(02) VALUE SPACE.      CHGBR130
00289          10  WRK-PRT-BYE-DATE         PIC X(10) VALUE SPACE.      CHGBR130
00290          10  FILLER                   PIC X(03) VALUE SPACE.      CHGBR130
00291          10  WRK-PRT-CLMNT-NAME       PIC X(32) VALUE SPACE.      CHGBR130
00292          10  FILLER                   PIC X(02) VALUE SPACE.      CHGBR130
00293          10  WRK-PRT-TOT-AMT          PIC $$,$$$,$$$,$$9.99-.     CHGBR130
00294          10  FILLER                   PIC X(02) VALUE SPACE.      CHGBR130
00295          10  WRK-PRT-CURR-AMT         PIC $$,$$$,$$$,$$9.99-.     CHGBR130
00296          10  FILLER                   PIC X(02) VALUE SPACE.      CHGBR130
00297          10  WRK-PRT-SOURCE-TYPE      PIC X(25) VALUE SPACE.      CHGBR130
00298                                                                   CHGBR130
00299      05  WRK-PRINT-LINE-MIL.                                      CHGBR130
00300          10  FILLER                   PIC X(01) VALUE SPACE.      CHGBR130
00301          10  WRK-PRT-EMPNUM-MIL       PIC X(07) VALUE SPACE.      CHGBR130
00302          10  FILLER                   PIC X(02) VALUE SPACE.      CHGBR130
00303          10  WRK-PRT-SSN1-MIL         PIC X(03) VALUE SPACE.      CHGBR130
00304          10  FILLER                   PIC X(01) VALUE '-'.        CHGBR130
00305          10  WRK-PRT-SSN2-MIL         PIC X(02) VALUE SPACE.      CHGBR130
00306          10  FILLER                   PIC X(01) VALUE '-'.        CHGBR130
00307          10  WRK-PRT-SSN3-MIL         PIC X(04) VALUE SPACE.      CHGBR130
00308          10  FILLER                   PIC X(02) VALUE SPACE.      CHGBR130
00309          10  WRK-PRT-BYE-DATE-MIL     PIC X(10) VALUE SPACE.      CHGBR130
00310          10  FILLER                   PIC X(02) VALUE SPACE.      CHGBR130
00311          10  WRK-PRT-CLMNT-NAME-MIL   PIC X(32) VALUE SPACE.      CHGBR130
00312          10  FILLER                   PIC X(02) VALUE SPACE.      CHGBR130
00313          10  WRK-PRT-TOT-AMT-MIL      PIC $$,$$$,$$$,$$9.99-.     CHGBR130
00314          10  FILLER                   PIC X(02) VALUE SPACE.      CHGBR130
00315          10  WRK-PRT-CURR-AMT-MIL     PIC $$,$$$,$$$,$$9.99-.     CHGBR130
00316          10  FILLER                   PIC X(02) VALUE SPACE.      CHGBR130
00317          10  WRK-PRT-SOURCE-TYPE-MIL  PIC X(25) VALUE SPACE.      CHGBR130
00318                                                                   CHGBR130
00319      05  WRK-PRINT-TOTAL.                                         CHGBR130
00320          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR130
00321          10  FILLER     PIC X(34)  VALUE  SPACES.                 CHGBR130
00322          10  FILLER     PIC X(20)  VALUE 'GRAND TOTAL CHARGED:'.  CHGBR130
00323          10  FILLER     PIC X(10)  VALUE  SPACES.                 CHGBR130
00324          10  WRK-PRT-TOT-BEN       PIC $$,$$$,$$$,$$9.99-.        CHGBR130
00325          10  FILLER     PIC X(22)  VALUE  SPACES.                 CHGBR130
00326          10  FILLER     PIC X(25) VALUE                           CHGBR130
00327                                    '      ************       '.   CHGBR130
00328      05  WRK-PRINT-TOTAL-ACCT.                                    CHGBR130
00329          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR130
00330          10  FILLER     PIC X(39)  VALUE  SPACES.                 CHGBR130
00331          10  FILLER     PIC X(14)  VALUE 'GRAND TOTAL AC'.        CHGBR130
00332          10  FILLER     PIC X(14)  VALUE 'COUNT CHARGED:'.        CHGBR130
00333          10  FILLER     PIC X(17)  VALUE  SPACES.                 CHGBR130
00334          10  WRK-PRT-ACCT-TOT      PIC $$,$$$,$$$,$$9.99-.        CHGBR130
00335          10  FILLER     PIC X(04)  VALUE  SPACES.                 CHGBR130
00336          10  FILLER     PIC X(25) VALUE                           CHGBR130
00337                                    '    ************         '.   CHGBR130
00338                                                                   CHGBR130
00339      05  WRK-PRINT-GRAND.                                         CHGBR130
00340          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR130
00341          10  FILLER     PIC X(64)  VALUE  SPACES.                 CHGBR130
00342          10  FILLER     PIC X(20)  VALUE '--------------------'.  CHGBR130
00343          10  FILLER     PIC X(21)  VALUE '---------------------'. CHGBR130
00344                                                                   CHGBR130
00345      05  WRK-PRINT-GRAND-PERIOD.                                  CHGBR130
00346          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR130
00347          10  FILLER     PIC X(13)  VALUE  SPACES.                 CHGBR130
00348          10  FILLER     PIC X(19)  VALUE 'TOTAL AMOUNT CHARGE'.   CHGBR130
00349          10  FILLER     PIC X(18)  VALUE 'D FOR THE PERIOD: '.    CHGBR130
00350          10  FILLER     PIC X(14)  VALUE  SPACES.                 CHGBR130
00351          10  WRK-PRT-GRAND-TOT-BEN PIC $$,$$$,$$$,$$9.99-.        CHGBR130
00352          10  FILLER     PIC X(02)  VALUE  SPACES.                 CHGBR130
00353          10  WRK-PRT-GRAND-TOT-CHG PIC $$,$$$,$$$,$$9.99-.        CHGBR130
00354          10  FILLER     PIC X(03)  VALUE  SPACES.                 CHGBR130
00355          10  FILLER     PIC X(25)  VALUE                          CHGBR130
00356                                    '     ************        '.   CHGBR130
00357                                                                   CHGBR130
00358  01  L001-LINK-AREA.                                              CHGBR130
00359  ++INCLUDE DTSIL001                                               CHGBR130
00360                                                                   CHGBR130
00361                                                                   CHGBR130
00362  01  L004-LINK-AREA.                                              CHGBR130
00363  ++INCLUDE DTSIL004                                               CHGBR130
00364                                                                   CHGBR130
00365                                                                   CHGBR130
00366  01  L005-LINK-AREA.                                              CHGBR130
00367  ++INCLUDE DTSIL005                                               CHGBR130
00368                                                                   CHGBR130
00369      EJECT                                                        CHGBR130
00370  LINKAGE SECTION.                                                 CHGBR130
00371                                                                   CHGBR130
00372  01  REPORT-LINK-AREA.                                            CHGBR130
00373  ++INCLUDE CHGIL001                                               CHGBR130
00374                                                                   CHGBR130
00375  01  BD210-CHG-REC.                                               CHGBR130
00376  ++INCLUDE CHGIM004                                               CHGBR130
00377      EJECT                                                        CHGBR130
00378  PROCEDURE DIVISION USING REPORT-LINK-AREA                        CHGBR130
00379                           BD210-CHG-REC.                          CHGBR130
00380                                                                   CHGBR130
00381  CHGBR130-MAIN.                                                   CHGBR130
00382      IF CHG-LINK1-CMD-INIT-88                                     CHGBR130
00383         PERFORM I0000-INITIATE        THRU I0000-EXIT             CHGBR130
00384      ELSE                                                         CHGBR130
00385         IF CHG-LINK1-CMD-PROCESS-88                               CHGBR130
00386            PERFORM P0000-PROCESS      THRU P0000-EXIT             CHGBR130
00387         ELSE                                                      CHGBR130
00388            IF CHG-LINK1-CMD-CLOSE-88                              CHGBR130
00389               PERFORM T0000-TERMINATE THRU T0000-EXIT             CHGBR130
00390            ELSE                                                   CHGBR130
00391               MOVE 'INVALID CHG-LINK1-COMMAND VALUE'              CHGBR130
00392                                       TO ABEND-MSG                CHGBR130
00393               PERFORM S999-ABEND      THRU S999-EXIT              CHGBR130
00394            END-IF                                                 CHGBR130
00395         END-IF                                                    CHGBR130
00396      END-IF.                                                      CHGBR130
00397                                                                   CHGBR130
00398  CHGBR130-EXIT.                                                   CHGBR130
00399      GOBACK.                                                      CHGBR130
00400                                                                   CHGBR130
00401  I0000-INITIATE.                                                  CHGBR130
00402      IF CHG-LINK1-RUN-TYPE-SPC-88                                 CHGBR130
00403         MOVE WRK-RPT-SPECIAL TO H2-RPT-TYP                        CHGBR130
00404      ELSE                                                         CHGBR130
00405         MOVE WRK-RPT-SUMMARY TO H2-RPT-TYP                        CHGBR130
00406      END-IF.                                                      CHGBR130
00407                                                                   CHGBR130
00408      MOVE CHG-LINK1-PERIOD-BEGIN TO L001-FED-8-DATE-9.            CHGBR130
00409      PERFORM S001-FROM-FED-8     THRU S001-EXIT.                  CHGBR130
00410      MOVE L001-SLASH-8-DATE TO WS-REPORT-START-DATE.              CHGBR130
00411                                                                   CHGBR130
00412      MOVE CHG-LINK1-PERIOD-END TO L001-FED-8-DATE-9.              CHGBR130
00413      PERFORM S001-FROM-FED-8     THRU S001-EXIT.                  CHGBR130
00414      MOVE L001-SLASH-8-DATE TO WS-REPORT-END-DATE.                CHGBR130
00415                                                                   CHGBR130
00416      ACCEPT WS-SYSTEM-DATE FROM DATE.                             CHGBR130
00417      DISPLAY 'DATE: ' WS-SYSTEM-DATE.                             CHGBR130
00418                                                                   CHGBR130
00419      OPEN OUTPUT FEDERAL-RPT FEDERAL-CSV                          CHGBR130
00420                  MILITARY-RPT.                                    CHGBR130
00421  I0000-EXIT.                                                      CHGBR130
00422      EXIT.                                                        CHGBR130
00423      EJECT                                                        CHGBR130
00424  P0000-PROCESS.                                                   CHGBR130
00425      PERFORM P1000-CHK-FOR-NEW-PAGE THRU P1000-EXIT               CHGBR130
00426                                                                   CHGBR130
00427      EVALUATE TRUE                                                CHGBR130
00428        WHEN CHG4-PROG-UI                                          CHGBR130
00429          MOVE WRK-REG-BEN-PAYMENT   TO WRK-PRT-SOURCE-TYPE        CHGBR130
00430                                     WRK-PRT-SOURCE-TYPE-MIL       CHGBR130
00431                                                                   CHGBR130
00432 *      WHEN CHG4-PROG-EB                                          CHGBR130
00433 *        MOVE WRK-EXT-BEN-PAYMENT   TO WRK-PRT-SOURCE-TYPE        CHGBR130
00434                                                                   CHGBR130
00435        WHEN CHG4-PROG-TEUC                                        CHGBR130
00436          MOVE WRK-TEUC-BEN-PAYMENT  TO WRK-PRT-SOURCE-TYPE        CHGBR130
00437                                     WRK-PRT-SOURCE-TYPE-MIL       CHGBR130
00438                                                                   CHGBR130
00439        WHEN CHG4-PROG-TEUCA                                       CHGBR130
00440          MOVE WRK-TEUCA-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE        CHGBR130
00441                                     WRK-PRT-SOURCE-TYPE-MIL       CHGBR130
00442                                                                   CHGBR130
00443        WHEN CHG4-PROG-FAC                                         CHGBR130
00444          MOVE WRK-FAC-BEN-PAYMENT   TO WRK-PRT-SOURCE-TYPE        CHGBR130
00445                                     WRK-PRT-SOURCE-TYPE-MIL       CHGBR130
00446                                                                   CHGBR130
00447        WHEN OTHER                                                 CHGBR130
00448          MOVE ' UNKNOWN '           TO WRK-PRT-SOURCE-TYPE        CHGBR130
00449                                     WRK-PRT-SOURCE-TYPE-MIL       CHGBR130
00450      END-EVALUATE.                                                CHGBR130
00451                                                                   CHGBR130
00452        IF CHG4-PROG-EB                                            CHGBR130
00453           GO TO P0000-EXIT.                                       CHGBR130
00454                                                                   CHGBR130
00455      MOVE CHG4-SSN                  TO WRK-SSN                    CHGBR130
00456      MOVE WRK-SSN1                  TO WRK-PRT-SSN1               CHGBR130
00457                                     WRK-PRT-SSN1-MIL.             CHGBR130
00458      MOVE WRK-SSN2                  TO WRK-PRT-SSN2               CHGBR130
00459                                     WRK-PRT-SSN2-MIL.             CHGBR130
00460      MOVE WRK-SSN3                  TO WRK-PRT-SSN3               CHGBR130
00461                                     WRK-PRT-SSN3-MIL.             CHGBR130
00462                                                                   CHGBR130
00463      MOVE CHG4-BYE                  TO L001-FED-8-DATE-9.         CHGBR130
00464      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 CHGBR130
00465      MOVE L001-SLASH-8-DATE         TO WRK-PRT-BYE-DATE           CHGBR130
00466                                     WRK-PRT-BYE-DATE-MIL.         CHGBR130
00467      MOVE CHG4-CLMNT-NAME           TO WRK-PRT-CLMNT-NAME         CHGBR130
00468                                     WRK-PRT-CLMNT-NAME-MIL.       CHGBR130
00469                                                                   CHGBR130
00470      COMPUTE WRK-TOT-AMT =                                        CHGBR130
00471         CHG4-TOT-BEN-AMT + CHG4-TOT-ADJ-AMT                       CHGBR130
00472      MOVE WRK-TOT-AMT               TO WRK-PRT-TOT-AMT            CHGBR130
00473                                     WRK-PRT-TOT-AMT-MIL.          CHGBR130
00474                                                                   CHGBR130
00475      COMPUTE WRK-CURR-AMT =                                       CHGBR130
00476      CHG4-CURR-BEN-AMT + CHG4-CURR-ADJ-AMT                        CHGBR130
00477      MOVE WRK-CURR-AMT              TO WRK-PRT-CURR-AMT           CHGBR130
00478                                     WRK-PRT-CURR-AMT-MIL.         CHGBR130
00479                                                                   CHGBR130
00480      IF WRK-CURR-AMT NOT = ZERO                                   CHGBR130
00481         IF WRK-CURR-EMP = (000801 OR 000802 OR 000803 OR          CHGBR130
00482                             000804 OR 000805)                     CHGBR130
00483            MOVE WRK-CURR-EMP TO  WRK-PRT-EMPNUM-MIL               CHGBR130
00484            WRITE MILITARY-REPORT FROM WRK-PRINT-LINE-MIL          CHGBR130
00485            WRITE FEDERAL-REPORT FROM WRK-PRINT-LINE               CHGBR130
00486                                     AFTER ADVANCING 1 LINE        CHGBR130
00487            ADD +1                      TO WRK-LINE-CNT            CHGBR130
00488            PERFORM P1050-FSDES       THRU P1050-EXIT              CHGBR130
00489            PERFORM P4000-TOTALS      THRU P4000-EXIT              CHGBR130
00490         ELSE                                                      CHGBR130
00491            WRITE FEDERAL-REPORT FROM WRK-PRINT-LINE               CHGBR130
00492                                     AFTER ADVANCING 1 LINE        CHGBR130
00493            ADD +1                      TO WRK-LINE-CNT            CHGBR130
00494            PERFORM P1050-FSDES       THRU P1050-EXIT              CHGBR130
00495            PERFORM P4000-TOTALS      THRU P4000-EXIT              CHGBR130
00496         END-IF                                                    CHGBR130
00497      END-IF.                                                      CHGBR130
00498                                                                   CHGBR130
00499  P0000-EXIT.                                                      CHGBR130
00500      EXIT.                                                        CHGBR130
00501                                                                   CHGBR130
00502  P1000-CHK-FOR-NEW-PAGE.                                          CHGBR130
00503      IF CHG4-EMP-NO NOT = WRK-CURR-EMP                            CHGBR130
00504         IF WRK-CURR-EMP = ZERO                                    CHGBR130
00505 ***                                                     1ST TIME  CHGBR130
00506            MOVE CHG4-EMP-NO           TO WRK-CURR-EMP             CHGBR130
00507                                          WRK-PRT-HDR-EMP          CHGBR130
00508            MOVE CHG4-EMP-TYPE         TO WRK-PRT-EMP-TYPE         CHGBR130
00509            PERFORM P1100-PRINT-HEADER THRU P1100-EXIT             CHGBR130
00510            ADD       1                TO WRK-EMPLYR-CNT           CHGBR130
00511         ELSE                                                      CHGBR130
00512 ***                                                     NEW ONE   CHGBR130
00513            PERFORM P1200-PRINT-FOOTER THRU P1200-EXIT             CHGBR130
00514            MOVE CHG4-EMP-NO           TO WRK-CURR-EMP             CHGBR130
00515                                          WRK-PRT-HDR-EMP          CHGBR130
00516            MOVE CHG4-EMP-TYPE         TO WRK-PRT-EMP-TYPE         CHGBR130
00517            PERFORM P1100-PRINT-HEADER THRU P1100-EXIT             CHGBR130
00518            ADD       1                TO WRK-EMPLYR-CNT           CHGBR130
00519      ELSE                                                         CHGBR130
00520 ***                                                    SAME ONE   CHGBR130
00521         IF WRK-LINE-CNT > +54                                     CHGBR130
00522            PERFORM P1100-PRINT-HEADER THRU P1100-EXIT             CHGBR130
00523         END-IF                                                    CHGBR130
00524      END-IF.                                                      CHGBR130
00525                                                                   CHGBR130
00526  P1000-EXIT.                                                      CHGBR130
00527      EXIT.                                                        CHGBR130
00528                                                                   CHGBR130
00529  P1050-FSDES.                                                     CHGBR130
00530         IF WRK-CURR-EMP = (000801 OR 000802 OR 000803 OR          CHGBR130
00531                            000804 OR 000805)                      CHGBR130
00532          GO TO P1050-EXIT.                                        CHGBR130
00533                                                                   CHGBR130
00534          MOVE SPACES TO    FSDES-CRE-REASON.                      CHGBR130
00535          MOVE ZEROS  TO    FSDES-CREDIT                           CHGBR130
00536                            FSDES-PERCENT.                         CHGBR130
00537          MOVE SPACES TO    FSDES-CRE-BEG-DATE                     CHGBR130
00538                            FSDES-CRE-END-DATE                     CHGBR130
00539                            FSDES-BYB.                             CHGBR130
00540                                                                   CHGBR130
00541                                                                   CHGBR130
00542      MOVE CHG4-BYE                  TO L001-FED-8-DATE-9.         CHGBR130
00543      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 CHGBR130
00544      MOVE L001-FED-8-DATE-9         TO FSDES-BYE.                 CHGBR130
00545      MOVE CHG4-SSN                  TO WRK-SSN                    CHGBR130
00546      MOVE WRK-SSN                   TO FSDES-SSN                  CHGBR130
00547      MOVE CHG4-EMP-NO               TO WRK-CURR-EMP               CHGBR130
00548      DISPLAY ' EMP ' WRK-CURR-EMP                                 CHGBR130
00549      MOVE WRK-CURR-EMPB             TO FSDES-FIC.                 CHGBR130
00550                                                                   CHGBR130
00551      PERFORM P1075-REFORMAT-NAME    THRU P1075-EXIT.              CHGBR130
00552                                                                   CHGBR130
00553      IF  WRK-LAST-FOUND-YES-88                                    CHGBR130
00554          MOVE WRK-LAST-NAME         TO FSDES-LNAME                CHGBR130
00555      ELSE                                                         CHGBR130
00556          MOVE SPACES                TO FSDES-LNAME.               CHGBR130
00557                                                                   CHGBR130
00558      IF  WRK-FIRST-FOUND-YES-88                                   CHGBR130
00559          MOVE WRK-FIRST-NAME         TO FSDES-FNAME               CHGBR130
00560      ELSE                                                         CHGBR130
00561          MOVE SPACES                TO FSDES-FNAME.               CHGBR130
00562                                                                   CHGBR130
00563      IF  WRK-INIT-FOUND-YES-88                                    CHGBR130
00564          MOVE WRK-MID-INIT          TO FSDES-INAME                CHGBR130
00565      ELSE                                                         CHGBR130
00566          MOVE SPACES                TO FSDES-INAME.               CHGBR130
00567                                                                   CHGBR130
00568      EVALUATE TRUE                                                CHGBR130
00569        WHEN CHG4-PROG-UI                                          CHGBR130
00570          MOVE 'REG'                 TO FSDES-CODE                 CHGBR130
00571        WHEN CHG4-PROG-TEUC                                        CHGBR130
00572          MOVE 'UC '                 TO FSDES-CODE                 CHGBR130
00573        WHEN CHG4-PROG-TEUCA                                       CHGBR130
00574          MOVE 'UCA'                 TO FSDES-CODE                 CHGBR130
00575        WHEN CHG4-PROG-FAC                                         CHGBR130
00576          MOVE 'FED'                 TO FSDES-CODE                 CHGBR130
00577        WHEN OTHER                                                 CHGBR130
00578          MOVE 'UNK'                 TO FSDES-CODE                 CHGBR130
00579      END-EVALUATE.                                                CHGBR130
00580                                                                   CHGBR130
00581      MOVE CHG-LINK1-PERIOD-BEGIN TO L004-DATE                     CHGBR130
00582      PERFORM S004-FROM-DATE      THRU S004-EXIT.                  CHGBR130
00583      MOVE L004-SLASH-5-YR   TO FSDES-YEAR                         CHGBR130
00584      MOVE L004-SLASH-5-Q    TO FSDES-QTR                          CHGBR130
00585                                                                   CHGBR130
00586      IF WRK-CURR-AMT < 0                                          CHGBR130
00587         MOVE ZEROS                    TO FSDES-CHARGED            CHGBR130
00588         MOVE WRK-CURR-AMT             TO FSDES-CREDIT             CHGBR130
00589      ELSE                                                         CHGBR130
00590         MOVE ZEROS                    TO FSDES-CREDIT             CHGBR130
00591         MOVE WRK-CURR-AMT             TO FSDES-CHARGED.           CHGBR130
00592                                                                   CHGBR130
00593      IF WRK-TOT-AMT < 0                                           CHGBR130
00594         MOVE ZEROS                    TO FSDES-PAID               CHGBR130
00595 *       MOVE WRK-TOT-AMT              TO FSDES-CREDIT             CHGBR130
00596      ELSE                                                         CHGBR130
00597         MOVE WRK-TOT-AMT              TO FSDES-PAID.              CHGBR130
00598                                                                   CHGBR130
00599      SET L005-FROM-SYS TO TRUE.                                   CHGBR130
00600      CALL 'DTSBU005' USING L005-LINK-AREA.                        CHGBR130
00601                                                                   CHGBR130
00602      MOVE L005-DATE-8-YR    TO WRK-RUN-YY.                        CHGBR130
00603      MOVE L005-DATE-8-MO    TO WRK-RUN-MM.                        CHGBR130
00604      MOVE L005-DATE-8-DA    TO WRK-RUN-DD.                        CHGBR130
00605                                                                   CHGBR130
00606      MOVE WRK-RUN-DATE      TO FSDES-DATE.                        CHGBR130
00607      WRITE FEDERAL-CSV-REC  FROM FSDES-LINE.                      CHGBR130
00608                                                                   CHGBR130
00609  P1050-EXIT.                                                      CHGBR130
00610      EXIT.                                                        CHGBR130
00611  P1075-REFORMAT-NAME.                                             CHGBR130
00612      INSPECT CHG4-CLMNT-NAME REPLACING ALL ',' BY SPACE.          CHGBR130
00613      INSPECT CHG4-CLMNT-NAME REPLACING ALL LOW-VALUES BY SPACE.   CHGBR130
00614                                                                   CHGBR130
00615      MOVE SPACES                     TO WRK-LAST-NAME             CHGBR130
00616                                         WRK-FIRST-NAME            CHGBR130
00617                                         WRK-MID-INIT.             CHGBR130
00618                                                                   CHGBR130
00619      MOVE ZERO                       TO S1                        CHGBR130
00620                                         S2.                       CHGBR130
00621                                                                   CHGBR130
00622                                                                   CHGBR130
00623      SET WRK-LAST-FOUND-NO-88        TO TRUE.                     CHGBR130
00624      SET WRK-FIRST-FOUND-NO-88       TO TRUE.                     CHGBR130
00625      SET WRK-INIT-FOUND-NO-88        TO TRUE.                     CHGBR130
00626 **    FIND LAST NAME                                              CHGBR130
00627      PERFORM                                                      CHGBR130
00628       VARYING S1 FROM +1 BY +1                                    CHGBR130
00629       UNTIL WRK-LAST-FOUND-YES-88                                 CHGBR130
00630       OR S1 > NAME-MAX                                            CHGBR130
00631        IF CHG4-CLMNT-NAME (S1:1) NOT = '/'                        CHGBR130
00632           ADD +1                      TO S2                       CHGBR130
00633           MOVE CHG4-CLMNT-NAME (S1:1) TO WRK-LAST-NAME(S2:1)      CHGBR130
00634        ELSE                                                       CHGBR130
00635           MOVE S1                     TO S3                       CHGBR130
00636           SET WRK-LAST-FOUND-YES-88   TO TRUE                     CHGBR130
00637        END-IF                                                     CHGBR130
00638      END-PERFORM.                                                 CHGBR130
00639                                                                   CHGBR130
00640 **    FIND FIRST NAME                                             CHGBR130
00641      MOVE ZERO                        TO S2.                      CHGBR130
00642      IF S3 = +32                                                  CHGBR130
00643         GO TO P1075-EXIT                                          CHGBR130
00644      END-IF.                                                      CHGBR130
00645                                                                   CHGBR130
00646      ADD +1                           TO S3.                      CHGBR130
00647                                                                   CHGBR130
00648      PERFORM                                                      CHGBR130
00649       VARYING S1 FROM S3 BY +1                                    CHGBR130
00650       UNTIL WRK-FIRST-FOUND-YES-88                                CHGBR130
00651       OR S1 > NAME-MAX                                            CHGBR130
00652        IF CHG4-CLMNT-NAME (S1:1) NOT = ' '                        CHGBR130
00653           ADD +1                      TO S2                       CHGBR130
00654           MOVE CHG4-CLMNT-NAME (S1:1)  TO WRK-FIRST-NAME(S2:1)    CHGBR130
00655        ELSE                                                       CHGBR130
00656           MOVE S1                     TO S3                       CHGBR130
00657           SET WRK-FIRST-FOUND-YES-88  TO TRUE                     CHGBR130
00658        END-IF                                                     CHGBR130
00659      END-PERFORM.                                                 CHGBR130
00660 **    FIND MIDDLE INITIAL                                         CHGBR130
00661                                                                   CHGBR130
00662      IF S3 = +32                                                  CHGBR130
00663         GO TO P1075-EXIT                                          CHGBR130
00664      END-IF.                                                      CHGBR130
00665                                                                   CHGBR130
00666      PERFORM                                                      CHGBR130
00667       VARYING S1 FROM NAME-MAX BY -1                              CHGBR130
00668       UNTIL WRK-INIT-FOUND-YES-88                                 CHGBR130
00669       OR S1 < S3                                                  CHGBR130
00670        IF CHG4-CLMNT-NAME (S1:1) NOT = ' '                        CHGBR130
00671           IF CHG4-CLMNT-NAME ((S1 - 1):1)  = ' '                  CHGBR130
00672              MOVE CHG4-CLMNT-NAME (S1:1)        TO WRK-MID-INIT   CHGBR130
00673              SET WRK-INIT-FOUND-YES-88   TO TRUE                  CHGBR130
00674           END-IF                                                  CHGBR130
00675        END-IF                                                     CHGBR130
00676      END-PERFORM.                                                 CHGBR130
00677                                                                   CHGBR130
00678  P1075-EXIT.                                                      CHGBR130
00679      EXIT.                                                        CHGBR130
00680                                                                   CHGBR130
00681  P1100-PRINT-HEADER.                                              CHGBR130
00682      MOVE ZERO  TO WRK-LINE-CNT                                   CHGBR130
00683      ADD    1   TO WRK-PAGE-CNT.                                  CHGBR130
00684      MOVE WRK-PAGE-CNT TO WRK-PRT-PAGE-CNT.                       CHGBR130
00685      MOVE HEAD01 TO WS-REC                                        CHGBR130
00686      WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING TOP-OF-PAGE CHGBR130
00687      MOVE HEAD02 TO WS-REC                                        CHGBR130
00688      WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE      CHGBR130
00689      MOVE HEAD03 TO WS-REC                                        CHGBR130
00690      WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE      CHGBR130
00691      MOVE SPACES TO WS-REC                                        CHGBR130
00692      WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE      CHGBR130
00693      MOVE HEAD04 TO WS-REC                                        CHGBR130
00694      WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE      CHGBR130
00695      MOVE SPACES TO WS-REC                                        CHGBR130
00696      WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE      CHGBR130
00697      MOVE HEAD05 TO WS-REC                                        CHGBR130
00698      WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE      CHGBR130
00699      MOVE HEAD06 TO WS-REC                                        CHGBR130
00700      WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 2 LINE      CHGBR130
00701      MOVE SPACES TO WS-REC                                        CHGBR130
00702      WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE.     CHGBR130
00703      MOVE +10 TO WRK-LINE-CNT.                                    CHGBR130
00704                                                                   CHGBR130
00705  P1100-EXIT.                                                      CHGBR130
00706      EXIT.                                                        CHGBR130
00707                                                                   CHGBR130
00708  P1200-PRINT-FOOTER.                                              CHGBR130
00709      IF WRK-LINE-CNT > +48                                        CHGBR130
00710         PERFORM P1100-PRINT-HEADER THRU P1100-EXIT                CHGBR130
00711      END-IF                                                       CHGBR130
00712                                                                   CHGBR130
00713      MOVE WRK-TOTAL-BENEFITS  TO WRK-PRT-TOT-BEN.                 CHGBR130
00714      MOVE WRK-ACCT-TOTAL      TO WRK-PRT-ACCT-TOT.                CHGBR130
00715                                                                   CHGBR130
00716      WRITE FEDERAL-REPORT FROM WRK-PRINT-TOTAL                    CHGBR130
00717                                AFTER ADVANCING 4 LINE.            CHGBR130
00718      WRITE FEDERAL-REPORT FROM WRK-PRINT-TOTAL-ACCT               CHGBR130
00719                                AFTER ADVANCING 2 LINE.            CHGBR130
00720                                                                   CHGBR130
00721      ADD WRK-TOTAL-BENEFITS TO   WRK-GRAND-TOTAL-BENEFITS.        CHGBR130
00722      ADD WRK-ACCT-TOTAL     TO   WRK-GRAND-TOTAL-CHARGED.         CHGBR130
00723                                                                   CHGBR130
00724      MOVE ZERO              TO WRK-TOTAL-BENEFITS                 CHGBR130
00725                                WRK-ACCT-TOTAL.                    CHGBR130
00726  P1200-EXIT.                                                      CHGBR130
00727      EXIT.                                                        CHGBR130
00728                                                                   CHGBR130
00729  P4000-TOTALS.                                                    CHGBR130
00730      COMPUTE WRK-TOTAL-BENEFITS = WRK-TOTAL-BENEFITS              CHGBR130
00731         + CHG4-TOT-BEN-AMT                                        CHGBR130
00732         + CHG4-TOT-ADJ-AMT.                                       CHGBR130
00733                                                                   CHGBR130
00734      COMPUTE WRK-ACCT-TOTAL     = WRK-ACCT-TOTAL                  CHGBR130
00735         + CHG4-CURR-BEN-AMT                                       CHGBR130
00736         + CHG4-CURR-ADJ-AMT.                                      CHGBR130
00737                                                                   CHGBR130
00738  P4000-EXIT.                                                      CHGBR130
00739      EXIT.                                                        CHGBR130
00740      EJECT                                                        CHGBR130
00741  T0000-TERMINATE.                                                 CHGBR130
00742      IF WRK-EMPLYR-CNT > 0                                        CHGBR130
00743         PERFORM P1200-PRINT-FOOTER THRU P1200-EXIT                CHGBR130
00744      END-IF                                                       CHGBR130
00745                                                                   CHGBR130
00746      IF WRK-EMPLYR-CNT > 1                                        CHGBR130
00747         PERFORM T1000-PRINT-GRAND-TOTALS THRU T1000-EXIT          CHGBR130
00748      END-IF                                                       CHGBR130
00749                                                                   CHGBR130
00750      PERFORM T1100-CLOSE-FILES        THRU T1100-EXIT.            CHGBR130
00751  T0000-EXIT.                                                      CHGBR130
00752      EXIT.                                                        CHGBR130
00753      EJECT                                                        CHGBR130
00754  T1000-PRINT-GRAND-TOTALS.                                        CHGBR130
00755      MOVE       SPACE            TO HEAD04.                       CHGBR130
00756      PERFORM P1100-PRINT-HEADER  THRU P1100-EXIT.                 CHGBR130
00757                                                                   CHGBR130
00758      MOVE WRK-GRAND-TOTAL-BENEFITS TO WRK-PRT-GRAND-TOT-BEN.      CHGBR130
00759      MOVE WRK-GRAND-TOTAL-CHARGED  TO WRK-PRT-GRAND-TOT-CHG.      CHGBR130
00760                                                                   CHGBR130
00761      WRITE FEDERAL-REPORT FROM WRK-PRINT-GRAND-PERIOD             CHGBR130
00762                                          AFTER ADVANCING 3.       CHGBR130
00763      WRITE FEDERAL-REPORT FROM WRK-PRINT-GRAND                    CHGBR130
00764                                          AFTER ADVANCING 2.       CHGBR130
00765  T1000-EXIT.                                                      CHGBR130
00766      EXIT.                                                        CHGBR130
00767                                                                   CHGBR130
00768  T1100-CLOSE-FILES.                                               CHGBR130
00769       CLOSE FEDERAL-RPT FEDERAL-CSV                               CHGBR130
00770             MILITARY-RPT.                                         CHGBR130
00771  T1100-EXIT.                                                      CHGBR130
00772      EXIT.                                                        CHGBR130
00773                                                                   CHGBR130
00774  S001-FROM-FED-8.                                                 CHGBR130
00775      SET L001-FROM-FED-8 TO TRUE.                                 CHGBR130
00776      GO TO S001-DATE.                                             CHGBR130
00777                                                                   CHGBR130
00778  S001-DATE.                                                       CHGBR130
00779      CALL 'DTSBU001' USING L001-LINK-AREA.                        CHGBR130
00780                                                                   CHGBR130
00781  S001-EXIT.                                                       CHGBR130
00782      EXIT.                                                        CHGBR130
00783                                                                   CHGBR130
00784                                                                   CHGBR130
00785  S004-FROM-DATE.                                                  CHGBR130
00786      SET L004-FROM-DATE  TO TRUE.                                 CHGBR130
00787      GO TO S004-DATE.                                             CHGBR130
00788                                                                   CHGBR130
00789  S004-DATE.                                                       CHGBR130
00790      CALL 'DTSBU004' USING L004-LINK-AREA.                        CHGBR130
00791                                                                   CHGBR130
00792  S004-EXIT.                                                       CHGBR130
00793      EXIT.                                                        CHGBR130
00794                                                                   CHGBR130
00795  S999-ABEND.                                                      CHGBR130
00796      DISPLAY '****  CHGBR130 ABENDING '                           CHGBR130
00797         ABEND-MSG.                                                CHGBR130
00798      CALL ABEND-MOD USING WRK-ABEND-CODE.                         CHGBR130
00799                                                                   CHGBR130
00800  S999-EXIT.                                                       CHGBR130
00801      EXIT.                                                        CHGBR130
