00001  IDENTIFICATION DIVISION.                                         04/05/24
00002  PROGRAM-ID.             CHGBR100.                                CHGBR100
00003 *AUTHOR.                 NORTHROP GRUMMAN.                           LV020
00004 *DATE-WRITTEN.           JULY 2007.                               CHGBR100
00005  DATE-COMPILED.                                                   CHGBR100
00006                                                                   CHGBR100
00007 *****                                                             CHGBR100
00008 ***                                                               CHGBR100
00009 *    FUNCTION:  PRINT RATED NOTICES OR SPECIAL REPORT             CHGBR100
00010 *                                                                 CHGBR100
00011 *    DESCRIPTION:                                                 CHGBR100
00012 *                                                                 CHGBR100
00013 *        (1) QUARTERLY OR ANNUAL RUN:                             CHGBR100
00014 *            IT WILL GIVE YOU THE RATED NOTICES, MANAGER RPT, AND CHGBR100
00015 *            A FISCAL AGENT DISK FILE. THE FISCAL AGENT FILE THAN CHGBR100
00016 *            COPY TO A MAGNETIC MEDIA TAPE USING THE IBM IEBGENER CHGBR100
00017 *            UTILITIES. THE OUTPUT OF THE MAGNETIC TAPE WILL SEND CHGBR100
00018 *            TO THE FISCAL AGENT.                                 CHGBR100
00019 *        (2) SPECIAL RUN:                                         CHGBR100
00020 *            THIS MODULE WILL GENERATE A BENEFIT CHARGE REPORT ANDCHGBR100
00021 *            A RATED NOTICE ON ONE EMPLOYER ACCOUNT ONLY.         CHGBR100
00022 *                                                                 CHGBR100
00023 *    RECORDS READ:                                                CHGBR100
00024 *                                                                 CHGBR100
00025 *        NONE.                                                    CHGBR100
00026 *                                                                 CHGBR100
00027 *    INPUT:                                                       CHGBR100
00028 *                                                                 CHGBR100
00029 *         CHGIM004 RECORD PASSED FROM CHGBD301                    CHGBR100
00030 *                                                                 CHGBR100
00031 *    PRINTED OUTPUTS:                                             CHGBR100
00032 *                                                                 CHGBR100
00033 *         RPC100R1 - RATED NOTICES                                CHGBR100
00034 *                                                                 CHGBR100
00035 *         RPC100R3 - MANAGEMENT RPT.                              CHGBR100
00036 *                                                                 CHGBR100
00037 *    RECORDS WRITTEN ON DISK:                                     CHGBR100
00038 *                                                                 CHGBR100
00039 *         RPC100R2 - FISCAL AGENT FILE                            CHGBR100
00040 *                                                                 CHGBR100
00041 *    MODULES CALLED:                                              CHGBR100
00042 *                                                                 CHGBR100
00043 *        DTSBU001 DATE EDIT/CONVERSION MODULE                     CHGBR100
00044 *        DTSBU071 NAME CONVERSION MODULE                          CHGBR100
00045 *                                                                 CHGBR100
00046 *****                                                             CHGBR100
00047                                                                   CHGBR100
00048 ******************************************************************CHGBR100
00049 * MODIFICATION HISTORY:                                          *CHGBR100
00050 *                                                                *CHGBR100
00051 * 02-08-2001 FIXED PAGE OVERRUN ON IST PAGE OF RPT, ADDED A HDR  *CHGBR100
00052 *            TO 'GRAND TOTALS' PAGE, AND WILL NOW PRINT IT ONLY  *CHGBR100
00053 *            IF MORE THAN ONE EMPLOYER HAS BEEN REPORTED   - JHP *CHGBR100
00054 *                                                                *CHGBR100
00055 * 08-07-2000 CHANGED "TOTALS" LINE ON S-M TO "TOTAL CHARGE OR    *CHGBR100
00056 *            CREDIT" AND ADDED A SIGN (+/-) TO THE TOTAL-AMT     *CHGBR100
00057 *            EDIT FIELD (REQST FM FRANK O.)       CHNGD BY - JHP *CHGBR100
00058 *                                                                *CHGBR100
00059 * 04-27-2000 REWRITTEN                                           *CHGBR100
00060 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBR100
00061 *                                                                *CHGBR100
00062 * 02-02-1999 MODIFIED FROM MT CHG100D                            *CHGBR100
00063 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBR100
00064 *                                                                *CHGBR100
00065 * 07-11-2007 THE BENEFIT CHARGED REPORT OF THE RATED EMPLOYERS   *CHGBR100
00066 *            HAS BEEN CHANGED TO ACCOMMODATE THE REQUIREMENTS    *CHGBR100
00067 *            OF PARTIAL TRANSFERED OF ASSETS FROM ONE BUSINESS   *CHGBR100
00068 *            TO ANOTHER. THEREFORE, THE PROGRAM CHANGES APPLID   *CHGBR100
00069 *            AND USED FOR THE RATED EMPLOYER REPORTS ONLY.       *CHGBR100
00070 *            (THIS PGM ORIGINAL NAME CHGBR101, BUT IT RENAMED    *CHGBR100
00071 *            TO CHGBR100 BY GD.)                                 *CHGBR100
00072 *                                                                *CHGBR100
00073 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW1 *CHGBR100
00074 *                                                                *CHGBR100
00075 * 07-28-2008 REMOVED F ORLANDO NAME FROM REPORT              ZL1 *CHGBR100
00076 *                                                                *CHGBR100
00077 * 03-09-2009 RECOMPLIED FOR NEW VERSION OF CHGIM004.         GD  *CHGBR100
00078 *                                                                *CHGBR100
00079 * 05-14-2010 RECOMPLIED FOR NEW VERSION OF CHGIM004.         ZL1 *CHGBR100
00080 *            MOVE XXX TO SSN PRINT LAST 4 DIGITS                 *CHGBR100
00081 *                                                                *   CL**2
00082 * 06-05-2020 RECOMPLIED FOR NEW VERSION OF CHGIM004.         ZL1 *   CL**2
00083 *                                                                *   CL**2
00084 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBR100
00085 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBR100
00086 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBR100
00087 ******************************************************************CHGBR100
00088                                                                   CHGBR100
00089  ENVIRONMENT DIVISION.                                            CHGBR100
00090  CONFIGURATION SECTION.                                           CHGBR100
00091  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               CHGBR100
00092                                                                   CHGBR100
00093  INPUT-OUTPUT SECTION.                                            CHGBR100
00094  FILE-CONTROL.                                                    CHGBR100
00095 ***                                             SELF-MAILER (R)   CHGBR100
00096      SELECT RATED-FILE1 ASSIGN TO RPC100R1.                       CHGBR100
00097 ***                                             FISC.AGNT FILE    CHGBR100
00098      SELECT FISCAL-AGENT-FILE ASSIGN TO RPC100R2.                 CHGBR100
00099 ***                                             BEN.CHG. RPT (O)  CHGBR100
00100      SELECT RATED-RPT ASSIGN TO RPC100R3.                         CHGBR100
00101      SELECT RATED-DATA ASSIGN TO RPC100R4.                           CL**5
00102                                                                   CHGBR100
00103      EJECT                                                        CHGBR100
00104  DATA DIVISION.                                                   CHGBR100
00105                                                                   CHGBR100
00106  FILE SECTION.                                                    CHGBR100
00107                                                                   CHGBR100
00108  FD  RATED-FILE1                                                  CHGBR100
00109      RECORDING MODE IS F                                          CHGBR100
00110      BLOCK CONTAINS 0 RECORDS                                     CHGBR100
00111      LABEL RECORDS ARE OMITTED.                                   CHGBR100
00112                                                                   CHGBR100
00113  01  RATED-PRINT-REC                 PIC X(133).                  CHGBR100
00114                                                                   CHGBR100
00115  FD  RATED-DATA                                                      CL**5
00116      RECORDING MODE IS F                                             CL**3
00117      BLOCK CONTAINS 0 RECORDS                                        CL**3
00118      LABEL RECORDS ARE OMITTED.                                      CL**3
00119                                                                      CL**3
00120  01  RATED-DAT                      PIC X(133).                      CL**5
00121                                                                      CL**3
00122  FD  FISCAL-AGENT-FILE                                            CHGBR100
00123      RECORDING MODE IS F                                          CHGBR100
00124      BLOCK CONTAINS 0 RECORDS                                     CHGBR100
00125      LABEL RECORDS ARE OMITTED.                                   CHGBR100
00126                                                                   CHGBR100
00127  01  CHG8-REC.                                                    CHGBR100
00128  ++INCLUDE CHGIM008                                               CHGBR100
00129                                                                   CHGBR100
00130  FD  RATED-RPT                                                    CHGBR100
00131      RECORDING MODE IS F                                          CHGBR100
00132      RECORD CONTAINS 133 CHARACTERS                               CHGBR100
00133      BLOCK CONTAINS 0 RECORDS.                                    CHGBR100
00134                                                                   CHGBR100
00135  01  RATED-REPORT                    PIC X(133).                  CHGBR100
00136      EJECT                                                        CHGBR100
00137  WORKING-STORAGE SECTION.                                         CHGBR100
001375 77  PAN-VALET PICTURE X(24) VALUE '020CHGBR100  04/05/24'.       CHGBR100
00138  77  PAN-VALET PICTURE X(24) VALUE '010CHGBR100  10/06/11'.       CHGBR100
00139 ***                                             WRK-AREA          CHGBR100
00140  01  FILLER.                                                      CHGBR100
00141      05  WRK-ABEND-CODE              PIC S9(04) COMP VALUE +100.  CHGBR100
00142      05  ABEND-MSG                   PIC  X(60)     VALUE SPACES. CHGBR100
00143                                                                   CHGBR100
00144      05  X1-CA-JDEA          PIC X(11) VALUE 'JDE=UC399A,'.       CHGBR100
00145      05  X1-CA-JDEQ          PIC X(11) VALUE 'JDE=UC399Q,'.       CHGBR100
00146                                                                   CHGBR100
00147      05  WRK-CURR-PAGE               PIC S9(03) COMP-3 VALUE +0.  CHGBR100
00148      05  WRK-TOTAL-PAGES             PIC S9(03) COMP-3 VALUE +0.  CHGBR100
00149      05  WRK-MAX-LINES-PER-PAGE      PIC S9(03) COMP-3 VALUE +34. CHGBR100
00150      05  WRK-CURR-LINE               PIC S9(03) COMP-3 VALUE +0.  CHGBR100
00151      05  ADVANCE-LINE-CNT            PIC  9(02)     VALUE ZEROS.  CHGBR100
00152                                                                   CHGBR100
00153      05  WRK-PRINT-COMPLETE-IND      PIC  X(01).                  CHGBR100
00154          88  WRK-PRINT-COMPLETE-YES-88  VALUE 'Y'.                CHGBR100
00155          88  WRK-PRINT-COMPLETE-NO-88   VALUE 'N'.                CHGBR100
00156                                                                   CHGBR100
00157      05  WS-SSN                      PIC  9(09)     VALUE ZEROS.  CHGBR100
00158      05  FILLER REDEFINES WS-SSN.                                 CHGBR100
00159          10  WS-SSN1                 PIC  9(03).                  CHGBR100
00160          10  WS-SSN2                 PIC  9(02).                  CHGBR100
00161          10  WS-SSN3                 PIC  9(04).                  CHGBR100
00162                                                                   CHGBR100
00163      05  WRK-CURRENT-EMP             PIC S9(07) COMP-3 VALUE +0.  CHGBR100
00164      05  WRK-CURR-FISC-AGNT-EMP      PIC S9(07) COMP-3 VALUE +0.  CHGBR100
00165                                                                   CHGBR100
00166      05  REMAINDER-CNT               PIC  9(02)     VALUE ZEROS.  CHGBR100
00167                                                                   CHGBR100
00168      05  WRK-EMP-CURR-AMT          PIC S9(10)V99 COMP-3 VALUE +0. CHGBR100
00169      05  WRK-EMP-TOT-AMT           PIC S9(10)V99 COMP-3 VALUE +0. CHGBR100
00170      05  WRK-CHG8-TOT-CHG-AMT      PIC S9(08)V99 COMP-3 VALUE +0. CHGBR100
00171      05  WRK-FISCAL-TOT-AMT        PIC S9(11)V99 COMP-3 VALUE +0. CHGBR100
00172      05  WRK-RATED-TOT-AMT         PIC S9(11)V99 COMP-3 VALUE +0. CHGBR100
00173      05  WRK-RATED-TOT-DISP        PIC $$,$$$,$$$,$$9.99-.        CHGBR100
00174                                                                   CHGBR100
00175      05  WRK-FISCAL-AGNT-EMP-CNT     PIC 9(07) COMP-3 VALUE 0.    CHGBR100
00176      05  WRK-PRINTED-FORM-EMP-CNT    PIC 9(07) COMP-3 VALUE 0.    CHGBR100
00177      05  WRK-SELF-MAILER-CNT         PIC 9(07) COMP-3 VALUE 0.    CHGBR100
00178      05  WRK-EMPLYR-CNT              PIC 9(07) COMP-3 VALUE 0.    CHGBR100
00179      05  CHG8-REC-CNT                PIC 9(07) COMP-3 VALUE 0.    CHGBR100
00180                                                                   CHGBR100
00181 ***                                            WRK-AREA2          CHGBR100
00182  01  FILLER.                                                      CHGBR100
00183      05  ABEND-MOD                   PIC  X(08)                   CHGBR100
00184                                VALUE 'DTSBU999'.                  CHGBR100
00185                                                                   CHGBR100
00186      05  WRK-REG-BEN-PAYMENT         PIC  X(25)                   CHGBR100
00187                                VALUE ' REGULAR BENEFIT PAYMENT '. CHGBR100
00188      05  WRK-EXT-BEN-PAYMENT         PIC  X(25)                   CHGBR100
00189                                VALUE ' EXTENDED BENEFIT PAYMENT'. CHGBR100
00190      05  WRK-TEUC-BEN-PAYMENT        PIC  X(25)                   CHGBR100
00191                                VALUE ' TEUC BENEFIT PAYMENT    '. CHGBR100
00192      05  WRK-TEUCA-BEN-PAYMENT       PIC  X(25)                   CHGBR100
00193                                VALUE ' TEUCA BENEFIT PAYMENT   '. CHGBR100
00194      05  WRK-FAC-BEN-PAYMENT         PIC  X(25)                   CHGBR100
00195                                VALUE ' FED ADDL COMP PAYMENT   '. CHGBR100
00196      05  WRK-ADJUSTMENTS       PIC  X(25)                         CHGBR100
00197                                VALUE '       ADJUSTMENTS       '. CHGBR100
00198      05  WRK-RPT-ANNUAL-SUMM   PIC  X(26)                         CHGBR100
00199                               VALUE 'ANNUALLY  CHARGE  SUMMARY '. CHGBR100
00200      05  WRK-RPT-SUMMARY       PIC  X(26)                         CHGBR100
00201                               VALUE 'QUARTERLY  CHARGE  SUMMARY'. CHGBR100
00202      05  WRK-RPT-SPECIAL       PIC  X(26)                         CHGBR100
00203                               VALUE ' BENEFIT  CHARGE  SPECIAL '. CHGBR100
00204 *RW1                                                              CHGBR100
00205      05  WRK-PERCENT           PIC  9(03)V99 VALUE ZEROS.         CHGBR100
00206 *RW2                                                              CHGBR100
00207      05  WRK-SSN                     PIC  9(09) VALUE ZERO.       CHGBR100
00208      05  FILLER REDEFINES WRK-SSN.                                CHGBR100
00209          10  WRK-SSN1                PIC  9(03).                  CHGBR100
00210          10  WRK-SSN2                PIC  9(02).                  CHGBR100
00211          10  WRK-SSN3                PIC  9(04).                  CHGBR100
00212                                                                   CHGBR100
00213      05  WRK-LINE-CNT                PIC  S9(04) COMP  VALUE +0.  CHGBR100
00214      05  WRK-PAGE-CNT                PIC  S9(04) COMP  VALUE +0.  CHGBR100
00215      05  WS-REC                      PIC  X(133) VALUE SPACES.    CHGBR100
00216                                                                   CHGBR100
00217      05  WRK-CURR-EMP              PIC S9(07)    COMP-3 VALUE +0. CHGBR100
00218      05  WRK-CURR-AMT              PIC S9(07)V99 COMP-3 VALUE +0. CHGBR100
00219      05  WRK-TOT-AMT               PIC S9(07)V99 COMP-3 VALUE +0. CHGBR100
00220      05  WRK-TOTAL-BENEFITS        PIC S9(09)V99 COMP-3 VALUE +0. CHGBR100
00221      05  WRK-ACCT-TOTAL            PIC S9(09)V99 COMP-3 VALUE +0. CHGBR100
00222      05  WRK-GRAND-TOTAL-BENEFITS  PIC S9(10)V99 COMP-3 VALUE +0. CHGBR100
00223      05  WRK-GRAND-TOTAL-CHARGED   PIC S9(10)V99 COMP-3 VALUE +0. CHGBR100
00224                                                                   CHGBR100
00225 ***                                      REPORT-LINE-AREA         CHGBR100
00226  01  FILLER.                                                      CHGBR100
00227      05  HEAD01.                                                  CHGBR100
00228          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR100
00229          10  FILLER     PIC X(08)  VALUE 'CHGBR100'.              CHGBR100
00230          10  FILLER     PIC X(47)  VALUE  SPACE.                  CHGBR100
00231          10  FILLER     PIC X(20)  VALUE 'DISTRICT OF COLUMBIA'.  CHGBR100
00232          10  FILLER     PIC X(42)  VALUE  SPACE.                  CHGBR100
00233          10  FILLER     PIC X(09)  VALUE 'PAGE NO.:'.             CHGBR100
00234          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR100
00235          10  WRK-PRT-PAGE-CNT      PIC    ZZZ99.                  CHGBR100
00236                                                                   CHGBR100
00237      05  HEAD02.                                                  CHGBR100
00238          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR100
00239          10  FILLER     PIC X(10)  VALUE '          '.            CHGBR100
00240          10  FILLER     PIC X(42)  VALUE  SPACE.                  CHGBR100
00241          10  H2-RPT-TYP PIC X(26)  VALUE  SPACES.                 CHGBR100
00242 *        10  FILLER     PIC X(13)  VALUE ' BENEFIT  CHA'.         CHGBR100
00243 *        10  FILLER     PIC X(13)  VALUE 'RGE  SPECIAL '.         CHGBR100
00244          10  FILLER     PIC X(49)  VALUE  SPACE.                  CHGBR100
00245          10  FILLER     PIC X(02)  VALUE 'TT'.                    CHGBR100
00246          10  WRK-PRT-EMP-TYPE             PIC X(02).              CHGBR100
00247                                                                   CHGBR100
00248      05  HEAD03.                                                  CHGBR100
00249          10  FILLER     PIC X(01)  VALUE SPACE.                   CHGBR100
00250          10  FILLER     PIC X(10)  VALUE 'ROOM 325'.              CHGBR100
00251          10  FILLER     PIC X(35)  VALUE SPACE.                   CHGBR100
00252          10  FILLER     PIC X(13)  VALUE 'DEPARTMENT   '.         CHGBR100
00253          10  FILLER     PIC X(13)  VALUE 'OF   EMPLOYME'.         CHGBR100
00254          10  FILLER     PIC X(13)  VALUE 'NT   SERVICES'.         CHGBR100
00255                                                                   CHGBR100
00256      05  HEAD04.                                                  CHGBR100
00257          10  FILLER     PIC X(01)  VALUE SPACE.                   CHGBR100
00258          10  FILLER     PIC X(49)  VALUE SPACE.                   CHGBR100
00259          10  FILLER     PIC X(12)  VALUE 'EMPLOYER ACC'.          CHGBR100
00260          10  FILLER     PIC X(12)  VALUE 'OUNT NUMBER '.          CHGBR100
00261          10  WRK-PRT-HDR-EMP      PIC 9(06) VALUE 0.              CHGBR100
00262                                                                   CHGBR100
00263      05  HEAD05.                                                  CHGBR100
00264          10  FILLER     PIC X(01)  VALUE SPACE.                   CHGBR100
00265          10  FILLER     PIC X(39)  VALUE SPACE.                   CHGBR100
00266          10  FILLER     PIC X(14)  VALUE 'REPORT INCLUDE'.        CHGBR100
00267          10  FILLER     PIC X(14)  VALUE 'S PERIOD FROM '.        CHGBR100
00268          10  WS-REPORT-START-DATE  PIC X(10) VALUE SPACES.        CHGBR100
00269          10  FILLER     PIC X(04)  VALUE ' TO '.                  CHGBR100
00270          10  WS-REPORT-END-DATE    PIC X(10) VALUE SPACES.        CHGBR100
00271                                                                   CHGBR100
00272      05  HEAD06.                                                  CHGBR100
00273          10  FILLER    PIC X(01)  VALUE SPACE.                    CHGBR100
00274          10  FILLER    PIC X(05)  VALUE SPACE.                    CHGBR100
00275          10  FILLER    PIC X(03)  VALUE 'SSN'.                    CHGBR100
00276          10  FILLER    PIC X(10)  VALUE SPACE.                    CHGBR100
00277          10  FILLER    PIC X(03)  VALUE 'BYE'.                    CHGBR100
00278          10  FILLER    PIC X(09)  VALUE SPACE.                    CHGBR100
00279          10  FILLER    PIC X(09)  VALUE 'NAME  OF '.              CHGBR100
00280          10  FILLER    PIC X(09)  VALUE ' CLAIMANT'.              CHGBR100
00281          10  FILLER    PIC X(19)  VALUE SPACE.                    CHGBR100
00282          10  FILLER    PIC X(14)  VALUE 'TOTAL BENEFITS'.         CHGBR100
00283          10  FILLER    PIC X(05)  VALUE SPACE.                    CHGBR100
00284          10  FILLER    PIC X(15)  VALUE 'ACCOUNT CHARGES'.        CHGBR100
00285          10  FILLER    PIC X(04)  VALUE SPACE.                    CHGBR100
00286          10  FILLER    PIC X(23)  VALUE 'CHARGE TYPE            '.CHGBR100
00287                                                                   CHGBR100
00288      05  WRK-PRINT-LINE.                                          CHGBR100
00289          10  FILLER                      PIC X(01) VALUE SPACE.   CHGBR100
00290          10  FILLER                      PIC X(04) VALUE SPACE.   CHGBR100
00291          10  WRK-PRT-SSN1                PIC X(03) VALUE SPACE.   CHGBR100
00292          10  FILLER                      PIC X(01) VALUE '-'.     CHGBR100
00293          10  WRK-PRT-SSN2                PIC X(02) VALUE SPACE.   CHGBR100
00294          10  FILLER                      PIC X(01) VALUE '-'.     CHGBR100
00295          10  WRK-PRT-SSN3                PIC X(04) VALUE SPACE.   CHGBR100
00296          10  FILLER                      PIC X(02) VALUE SPACE.   CHGBR100
00297          10  WRK-PRT-BYE-DATE            PIC X(10) VALUE SPACE.   CHGBR100
00298          10  FILLER                      PIC X(03) VALUE SPACE.   CHGBR100
00299          10  WRK-PRT-CLMNT-NAME          PIC X(32) VALUE SPACE.   CHGBR100
00300          10  FILLER                      PIC X(02) VALUE SPACE.   CHGBR100
00301          10  WRK-PRT-TOT-AMT             PIC $$,$$$,$$$,$$9.99-.  CHGBR100
00302          10  FILLER                      PIC X(02) VALUE SPACE.   CHGBR100
00303          10  WRK-PRT-CURR-AMT            PIC $$,$$$,$$$,$$9.99-.  CHGBR100
00304          10  FILLER                      PIC X(02) VALUE SPACE.   CHGBR100
00305          10  WRK-PRT-SOURCE-TYPE         PIC X(27) VALUE SPACE.   CHGBR100
00306          10  FILLER REDEFINES WRK-PRT-SOURCE-TYPE.                CHGBR100
00307              15  WRK-PRINT-MSG           PIC X(12).               CHGBR100
00308              15  FILLER                  PIC X(01).               CHGBR100
00309              15  WRK-SUCC-PRED-EMP-NO    PIC 999999.              CHGBR100
00310              15  FILLER                  PIC X(01).               CHGBR100
00311              15  WRK-PRED-PERCENT        PIC ZZZ.99.              CHGBR100
00312              15  WRK-PERCENT-SIGN        PIC X(01).               CHGBR100
00313                                                                   CHGBR100
00314      05  WRK-PRINT-TOTAL.                                         CHGBR100
00315          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR100
00316          10  FILLER     PIC X(34)  VALUE  SPACES.                 CHGBR100
00317          10  FILLER     PIC X(20)  VALUE 'GRAND TOTAL CHARGED:'.  CHGBR100
00318          10  FILLER     PIC X(10)  VALUE  SPACES.                 CHGBR100
00319          10  WRK-PRT-TOT-BEN       PIC $$,$$$,$$$,$$9.99-.        CHGBR100
00320          10  FILLER     PIC X(22)  VALUE  SPACES.                 CHGBR100
00321          10  FILLER     PIC X(25) VALUE                           CHGBR100
00322                                    '      ************       '.   CHGBR100
00323      05  WRK-PRINT-TOTAL-ACCT.                                    CHGBR100
00324          10  FILLER     PIC X(10)  VALUE  SPACE.                     CL*20
00325          10  WRK-PRT-ACCT-EAN      PIC 9(6) VALUE 0.                 CL*20
00326          10  FILLER     PIC X(30)  VALUE  SPACES.                    CL*20
00327          10  FILLER     PIC X(14)  VALUE 'GRAND TOTAL AC'.        CHGBR100
00328          10  FILLER     PIC X(14)  VALUE 'COUNT CHARGED:'.        CHGBR100
00329          10  FILLER     PIC X(17)  VALUE  SPACES.                 CHGBR100
00330          10  WRK-PRT-ACCT-TOT      PIC $$,$$$,$$$,$$9.99-.        CHGBR100
00331          10  FILLER     PIC X(04)  VALUE  SPACES.                 CHGBR100
00332          10  FILLER     PIC X(25) VALUE                           CHGBR100
00333                                    '    ************         '.   CHGBR100
00334                                                                   CHGBR100
00335      05  WRK-PRINT-GRAND.                                         CHGBR100
00336          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR100
00337          10  FILLER     PIC X(63)  VALUE  SPACES.                 CHGBR100
00338          10  FILLER     PIC X(20)  VALUE '--------------------'.  CHGBR100
00339          10  FILLER     PIC X(21)  VALUE '---------------------'. CHGBR100
00340                                                                   CHGBR100
00341      05  WRK-PRINT-GRAND-PERIOD.                                  CHGBR100
00342          10  FILLER     PIC X(01)  VALUE  SPACE.                  CHGBR100
00343          10  FILLER     PIC X(13)  VALUE  SPACES.                 CHGBR100
00344          10  FILLER     PIC X(19)  VALUE 'TOTAL AMOUNT CHARGE'.   CHGBR100
00345          10  FILLER     PIC X(18)  VALUE 'D FOR THE PERIOD: '.    CHGBR100
00346          10  FILLER     PIC X(14)  VALUE  SPACES.                 CHGBR100
00347          10  WRK-PRT-GRAND-TOT-BEN PIC $$,$$$,$$$,$$9.99-.        CHGBR100
00348          10  FILLER     PIC X(02)  VALUE  SPACES.                 CHGBR100
00349          10  WRK-PRT-GRAND-TOT-CHG PIC $$,$$$,$$$,$$9.99-.        CHGBR100
00350          10  FILLER     PIC X(03)  VALUE  SPACES.                 CHGBR100
00351          10  FILLER     PIC X(25)  VALUE                          CHGBR100
00352                                    '     ************        '.   CHGBR100
00353      05  DAT-PRINT-LINE.                                             CL**3
00354          10  FILLER                      PIC X(01) VALUE SPACE.      CL**3
00355          10  DAT-EMP-NO                  PIC X(06) VALUE SPACE.      CL**3
00356          10  FILLEZ                      PIC X(01) VALUE ';'.        CL**9
00357          10  DAT-PRT-SSN1                PIC X(03) VALUE SPACE.      CL**3
00358          10  DAT-PRT-SSN2                PIC X(02) VALUE SPACE.      CL**3
00359          10  DAT-PRT-SSN3                PIC X(04) VALUE SPACE.      CL**3
00360          10  FILLER                      PIC X(01) VALUE ';'.        CL**8
00361          10  DAT-PRT-BYE-DATE            PIC X(10) VALUE SPACE.      CL**3
00362          10  FILLER                      PIC X(01) VALUE ';'.        CL**8
00363          10  DAT-PRT-CLMNT-NAME          PIC X(32) VALUE SPACE.      CL**3
00364          10  FILLER                      PIC X(01) VALUE ';'.        CL**8
00365 *        10  DAT-PRT-TOT-AMT             PIC $$,$$$,$$$,$$9.99-.     CL*15
00366 *        10  FILLER                      PIC X(01) VALUE ','.        CL*15
00367          10  DAT-PRT-CURR-AMT            PIC $$,$$$,$$$,$$9.99-.     CL**3
00368          10  FILLER                      PIC X(01) VALUE ';'.        CL**8
00369          10  DAT-PRT-SOURCE-TYPE         PIC X(27) VALUE SPACE.      CL**3
00370          10  FILLER REDEFINES DAT-PRT-SOURCE-TYPE.                   CL**5
00371              15  DAT-PRINT-MSG           PIC X(12).                  CL**3
00372              15  DAT-SUCC-PRED-EMP-NO    PIC 999999.                 CL**3
00373              15  DAT-PRED-PERCENT        PIC ZZZ.99.                 CL**3
00374              15  DAT-PERCENT-SIGN        PIC X(01).                  CL**3
00375                                                                      CL**3
00376      05  DAT-TOTAL-LINE.                                             CL*12
00377          10  FILLER                      PIC X(01) VALUE SPACE.      CL*12
00378          10  DAT-TOT-EMP-NO               PIC X(06) VALUE SPACE.     CL*12
00379          10  FILLEY                      PIC X(01) VALUE ';'.        CL*16
00380 *        10  FILLER                      PIC X(53) VALUE SPACES.     CL*17
00381          10  FILLEX                      PIC X(01) VALUE ';'.        CL*15
00382          10  DAT-TOT-CURR-AMT            PIC $$,$$$,$$$,$$9.99-.     CL*12
00383          10  FILLER                      PIC X(50) VALUE SPACES.     CL*12
00384                                                                      CL*12
00385                                                                   CHGBR100
00386  01  VSCA-LINE.                                                   CHGBR100
00387      05  VSCA-DATA                   PIC X(133) VALUE SPACES.     CHGBR100
00388                                                                   CHGBR100
00389  01  XF-CA-CNTL-LINE.                                             CHGBR100
00390 *    05  FILLER              PIC X     VALUE SPACES.              CHGBR100
00391      05  X1-CA-DJDE          PIC X(12) VALUE '$X9700$DJDE '.      CHGBR100
00392      05  X1-CA-JDL           PIC X(09) VALUE 'JDL=XMOM,'.         CHGBR100
00393      05  X1-CA-JDE           PIC X(11) VALUE SPACES.              CHGBR100
00394      05  X1-CA-LINE-END      PIC X(01) VALUE ';'.                 CHGBR100
00395                                                                   CHGBR100
00396  01  X2-CA-CNTL-LINE.                                             CHGBR100
00397 *    05  FILLER              PIC X     VALUE SPACES.              CHGBR100
00398      05  X2-CA-DJDE          PIC X(12) VALUE '$X9700$DJDE '.      CHGBR100
00399      05  X2-CA-DUPLEX        PIC X(11) VALUE 'DUPLEX=YES,'.       CHGBR100
00400      05  X2-CA-LINE-END      PIC X(01) VALUE ';'.                 CHGBR100
00401                                                                   CHGBR100
00402  01  X3-CA-CNTL-LINE.                                             CHGBR100
00403 *    05  FILLER              PIC X     VALUE SPACES.              CHGBR100
00404      05  X3-CA-DJDE          PIC X(12) VALUE '$X9700$DJDE '.      CHGBR100
00405      05  X3-CA-DATA          PIC X(13) VALUE 'DATA=(0,132),'.     CHGBR100
00406      05  X3-CA-ASSIGN        PIC X(13) VALUE 'ASSIGN=(1,1),'.     CHGBR100
00407      05  X3-CA-LINE-END      PIC X(04) VALUE 'END;'.              CHGBR100
00408                                                                   CHGBR100
00409  01  PAGE-HEAD01.                                                 CHGBR100
00410      05  FILLER                      PIC X(25) VALUE SPACES.      CHGBR100
00411      05  PRT-EMP-NO                  PIC 999B999.                 CHGBR100
00412      05  FILLER                      PIC X(55) VALUE SPACES.      CHGBR100
00413      05  PRT-END-DATE                PIC X(10) VALUE SPACE.       CHGBR100
00414                                                                   CHGBR100
00415      EJECT                                                        CHGBR100
00416                                                                   CHGBR100
00417  01  EMPLOYER-DETAIL-LINE.                                        CHGBR100
00418      05  FILLER                      PIC X(05) VALUE SPACES.      CHGBR100
00419      05  PRT-CHARGE-NAME             PIC X(25) VALUE SPACE.       CHGBR100
00420      05  FILLER                      PIC X(04) VALUE SPACES.      CHGBR100
00421      05  PRT-WS-SSN1                 PIC X(03) VALUE SPACE.       CHGBR100
00422      05  FILLER                      PIC X     VALUE '-'.         CHGBR100
00423      05  PRT-WS-SSN2                 PIC X(02) VALUE SPACE.       CHGBR100
00424      05  FILLER                      PIC X     VALUE '-'.         CHGBR100
00425      05  PRT-WS-SSN3                 PIC X(04) VALUE SPACE.       CHGBR100
00426      05  FILLER                      PIC X(02) VALUE SPACES.      CHGBR100
00427      05  PRT-CHARGE-CURR-AMT         PIC $$$,$$$,$$9.99-.         CHGBR100
00428 *RW1                                                              CHGBR100
00429      05  FILLER                      PIC X(03) VALUE SPACES.      CHGBR100
00430      05  PRT-PRT-SOURCE-TYPE         PIC X(25) VALUE SPACE.       CHGBR100
00431      05  FILLER REDEFINES PRT-PRT-SOURCE-TYPE.                    CHGBR100
00432          10  PRT-PRINT-MSG           PIC X(17).                   CHGBR100
00433          10  FILLER                  PIC X(01).                   CHGBR100
00434          10  PRT-SUCC-PRED-EMP-NO    PIC 999B999.                 CHGBR100
00435 *RW2                                                              CHGBR100
00436 ***                                 CHARGE-TABLE-AREA             CHGBR100
00437  01  FILLER.                                                      CHGBR100
00438      05  CHG-TAB-SUB                 PIC S9(04) COMP VALUE 0.     CHGBR100
00439      05  CHG-TAB-LEN                 PIC S9(04) COMP VALUE 0.     CHGBR100
00440      05  CHG-TAB-MAX                 PIC S9(04) COMP              CHGBR100
00441                                                  VALUE +2500.     CHGBR100
00442      05  CHG-TAB-ENTRY        OCCURS  2500 TIMES.                 CHGBR100
00443          10  CHG-TAB-NAME            PIC X(32) VALUE SPACE.       CHGBR100
00444          10  CHG-TAB-SSN             PIC S9(9) COMP-3 VALUE +0.   CHGBR100
00445          10  CHG-TAB-AMT             PIC S9(10)V99 VALUE +0.      CHGBR100
00446          10  CHG-TAB-PRED            PIC S9(07)    VALUE +0.      CHGBR100
00447          10  CHG-TAB-SUCC            PIC S9(07)    VALUE +0.      CHGBR100
00448                                                                   CHGBR100
00449  01  FINAL-FOOTER.                                                CHGBR100
00450      05  FILLER                      PIC X(15) VALUE SPACES.      CHGBR100
00451      05  FILLER                      PIC X(06) VALUE 'PAGE: '.    CHGBR100
00452      05  PAGE-NO                     PIC ZZ9.                     CHGBR100
00453      05  FILLER                      PIC X(04) VALUE ' OF '.      CHGBR100
00454      05  TOTAL-PAGE-NO               PIC ZZ9.                     CHGBR100
00455      05  FILLER                      PIC X(06) VALUE SPACES.      CHGBR100
00456      05  PRT-MESSAGE                 PIC X(28) VALUE SPACE.       CHGBR100
00457 *RW  05  FILLER                      PIC X(17) VALUE SPACES.      CHGBR100
00458      05  PRT-TOTAL-EMPLOYER-CHARGES  PIC $$,$$$,$$$,$$9.99-.      CHGBR100
00459                                                                   CHGBR100
00460  01  CONTINUED-FOOTER.                                            CHGBR100
00461      05  FILLER                      PIC X(15) VALUE SPACES.      CHGBR100
00462      05  FILLER                      PIC X(06) VALUE 'PAGE: '.    CHGBR100
00463      05  PAGE-NOC                    PIC ZZ9.                     CHGBR100
00464      05  FILLER                      PIC X(04) VALUE ' OF '.      CHGBR100
00465      05  TOTAL-PAGE-NOC              PIC ZZ9.                     CHGBR100
00466      05  FILLER                      PIC X(06) VALUE SPACES.      CHGBR100
00467      05  PRT-MESSAGEC                PIC X(40) VALUE SPACE.       CHGBR100
00468      05  FILLER                      PIC X(55) VALUE SPACES.      CHGBR100
00469                                                                   CHGBR100
00470 ***                                     EMPL-ADDR-AREA            CHGBR100
00471  01  FILLER.                                                      CHGBR100
00472      05  ADDR-SUB                    PIC S9(04) COMP VALUE +0.    CHGBR100
00473      05  EMPL-ADDR-LINE OCCURS 5 TIMES.                           CHGBR100
00474          10  PRT-ADDR-FILLER         PIC X(45) VALUE SPACES.      CHGBR100
00475          10  PRT-ADDR-LINE           PIC X(40) VALUE SPACES.      CHGBR100
00476                                                                   CHGBR100
00477      EJECT                                                        CHGBR100
00478  01  L001-LINK-AREA.                                              CHGBR100
00479  ++INCLUDE DTSIL001                                               CHGBR100
00480      EJECT                                                        CHGBR100
00481  01  L071-LINK-AREA.                                              CHGBR100
00482  ++INCLUDE DTSIL071                                               CHGBR100
00483      EJECT                                                        CHGBR100
00484  LINKAGE SECTION.                                                 CHGBR100
00485  01  CHG-LINK-REC.                                                CHGBR100
00486  ++INCLUDE CHGIL001                                               CHGBR100
00487                                                                   CHGBR100
00488  01  BD210-CHG-REC.                                               CHGBR100
00489  ++INCLUDE CHGIM004                                               CHGBR100
00490      EJECT                                                        CHGBR100
00491  PROCEDURE DIVISION USING CHG-LINK-REC                            CHGBR100
00492                           BD210-CHG-REC.                          CHGBR100
00493  CHGBR100-MAIN.                                                   CHGBR100
00494      EVALUATE TRUE                                                CHGBR100
00495         WHEN CHG-LINK1-CMD-PROCESS-88                             CHGBR100
00496            PERFORM P0000-PROCESS        THRU P0000-EXIT           CHGBR100
00497            PERFORM P5000-PROCESS        THRU P5000-EXIT           CHGBR100
00498                                                                   CHGBR100
00499         WHEN CHG-LINK1-CMD-INIT-88                                CHGBR100
00500            PERFORM I0000-INITIATE       THRU I0000-EXIT           CHGBR100
00501                                                                   CHGBR100
00502         WHEN CHG-LINK1-CMD-CLOSE-88                               CHGBR100
00503            PERFORM T0000-TERMINATE      THRU T0000-EXIT           CHGBR100
00504                                                                   CHGBR100
00505         WHEN OTHER                                                CHGBR100
00506            MOVE 'INVALID CHG-LINK1-COMMAND ' TO ABEND-MSG         CHGBR100
00507            PERFORM S999-ABEND        THRU S999-EXIT               CHGBR100
00508      END-EVALUATE.                                                CHGBR100
00509                                                                   CHGBR100
00510      GOBACK.                                                      CHGBR100
00511      EJECT                                                        CHGBR100
00512  I0000-INITIATE.                                                  CHGBR100
00513      DISPLAY '    '.                                              CHGBR100
00514      DISPLAY '*** CHG-LINK-REC:   ' CHG-LINK-REC.                 CHGBR100
00515      DISPLAY '    '.                                              CHGBR100
00516                                                                   CHGBR100
00517      MOVE ZERO TO WRK-CURR-EMP                                    CHGBR100
00518                   WRK-LINE-CNT                                    CHGBR100
00519                   WRK-TOT-AMT                                     CHGBR100
00520                   WRK-CURR-AMT                                    CHGBR100
00521                   WRK-TOTAL-BENEFITS                              CHGBR100
00522                   WRK-ACCT-TOTAL                                  CHGBR100
00523                   WRK-GRAND-TOTAL-BENEFITS                        CHGBR100
00524                   WRK-GRAND-TOTAL-CHARGED.                        CHGBR100
00525                                                                   CHGBR100
00526      EVALUATE TRUE                                                CHGBR100
00527         WHEN CHG-LINK1-RUN-TYPE-QTRLY-88                          CHGBR100
00528            MOVE WRK-RPT-SUMMARY      TO  H2-RPT-TYP               CHGBR100
00529                                                                   CHGBR100
00530         WHEN CHG-LINK1-RUN-TYPE-ANN-88                            CHGBR100
00531            MOVE WRK-RPT-ANNUAL-SUMM  TO  H2-RPT-TYP               CHGBR100
00532                                                                   CHGBR100
00533         WHEN CHG-LINK1-RUN-TYPE-SPC-88                            CHGBR100
00534            MOVE WRK-RPT-SPECIAL      TO  H2-RPT-TYP               CHGBR100
00535      END-EVALUATE.                                                CHGBR100
00536                                                                   CHGBR100
00537      MOVE CHG-LINK1-PERIOD-BEGIN TO L001-FED-8-DATE-9.            CHGBR100
00538      SET L001-FROM-FED-8       TO  TRUE.                          CHGBR100
00539      CALL 'DTSBU001'         USING L001-LINK-AREA.                CHGBR100
00540      MOVE L001-SLASH-8-DATE TO WS-REPORT-START-DATE.              CHGBR100
00541 *                                                                 CHGBR100
00542      MOVE CHG-LINK1-PERIOD-END TO  L001-FED-8-DATE-9.             CHGBR100
00543      SET L001-FROM-FED-8       TO  TRUE.                          CHGBR100
00544      CALL 'DTSBU001'         USING L001-LINK-AREA.                CHGBR100
00545      MOVE L001-SLASH-8-DATE    TO  PRT-END-DATE                   CHGBR100
00546                                    WS-REPORT-END-DATE.            CHGBR100
00547                                                                   CHGBR100
00548      IF CHG-LINK1-RUN-TYPE-QTRLY-88                               CHGBR100
00549      OR CHG-LINK1-RUN-TYPE-AGTS-88                                CHGBR100
00550         MOVE  X1-CA-JDEQ TO X1-CA-JDE                             CHGBR100
00551 **      OPEN OUTPUT RATED-FILE1                                   CHGBR100
00552 *                   FISCAL-AGENT-FILE                             CHGBR100
00553 **                  RATED-RPT                                     CHGBR100
00554      ELSE                                                         CHGBR100
00555         IF CHG-LINK1-RUN-TYPE-ANN-88                              CHGBR100
00556            MOVE  X1-CA-JDEA TO X1-CA-JDE                          CHGBR100
00557 **         OPEN OUTPUT RATED-FILE1                                CHGBR100
00558 **                     RATED-RPT                                  CHGBR100
00559         ELSE                                                      CHGBR100
00560            MOVE  X1-CA-JDEQ TO X1-CA-JDE                          CHGBR100
00561 *          OPEN OUTPUT RATED-RPT                                  CHGBR100
00562         END-IF                                                    CHGBR100
00563      END-IF.                                                      CHGBR100
00564                                                                   CHGBR100
00565         OPEN OUTPUT RATED-FILE1                                   CHGBR100
00566                     RATED-DATA                                       CL**5
00567                     FISCAL-AGENT-FILE                             CHGBR100
00568                     RATED-RPT.                                    CHGBR100
00569      WRITE RATED-PRINT-REC  FROM XF-CA-CNTL-LINE                  CHGBR100
00570 *        AFTER ADVANCING TOP-OF-PAGE.                             CHGBR100
00571      WRITE RATED-PRINT-REC  FROM X2-CA-CNTL-LINE.                 CHGBR100
00572      WRITE RATED-PRINT-REC  FROM X3-CA-CNTL-LINE.                 CHGBR100
00573                                                                   CHGBR100
00574 *    WRITE RATED-PRINT-REC  FROM VSCA-LINE                        CHGBR100
00575 *        AFTER ADVANCING TOP-OF-PAGE.                             CHGBR100
00576                                                                   CHGBR100
00577      PERFORM I1000-INIT-TABLE THRU I1000-EXIT.                    CHGBR100
00578                                                                   CHGBR100
00579  I0000-EXIT.                                                      CHGBR100
00580      EXIT.                                                        CHGBR100
00581  I1000-INIT-TABLE.                                                CHGBR100
00582      PERFORM                                                      CHGBR100
00583         VARYING CHG-TAB-SUB FROM +1 BY +1                         CHGBR100
00584         UNTIL CHG-TAB-SUB > CHG-TAB-MAX                           CHGBR100
00585            INITIALIZE CHG-TAB-ENTRY (CHG-TAB-SUB)                 CHGBR100
00586      END-PERFORM.                                                 CHGBR100
00587                                                                   CHGBR100
00588      MOVE +0 TO CHG-TAB-SUB                                       CHGBR100
00589                 CHG-TAB-LEN.                                      CHGBR100
00590                                                                   CHGBR100
00591  I1000-EXIT.                                                      CHGBR100
00592      EXIT.                                                        CHGBR100
00593                                                                   CHGBR100
00594 *I2000-INITIATE.                                                  CHGBR100
00595 *    MOVE ZERO TO WRK-CURR-EMP                                    CHGBR100
00596 *                 WRK-LINE-CNT                                    CHGBR100
00597 *                 WRK-TOT-AMT                                     CHGBR100
00598 *                 WRK-CURR-AMT                                    CHGBR100
00599 *                 WRK-TOTAL-BENEFITS                              CHGBR100
00600 *                 WRK-ACCT-TOTAL                                  CHGBR100
00601 *                 WRK-GRAND-TOTAL-BENEFITS                        CHGBR100
00602 *                 WRK-GRAND-TOTAL-CHARGED.                        CHGBR100
00603 *                                                                 CHGBR100
00604 *    MOVE ZERO TO WRK-CURR-EMP.                                   CHGBR100
00605 *                                                                 CHGBR100
00606 *    MOVE WRK-RPT-SPECIAL      TO  H2-RPT-TYP.                    CHGBR100
00607 *    MOVE CHG-LINK1-PERIOD-BEGIN TO L001-FED-8-DATE-9.            CHGBR100
00608 *    PERFORM S001-FROM-FED-8     THRU S001-EXIT.                  CHGBR100
00609 *    MOVE L001-SLASH-8-DATE TO WS-REPORT-START-DATE.              CHGBR100
00610 *                                                                 CHGBR100
00611 *    MOVE CHG-LINK1-PERIOD-END TO L001-FED-8-DATE-9.              CHGBR100
00612 *    PERFORM S001-FROM-FED-8     THRU S001-EXIT.                  CHGBR100
00613 *    MOVE L001-SLASH-8-DATE TO WS-REPORT-END-DATE.                CHGBR100
00614 *                                                                 CHGBR100
00615 *    IF CHG-LINK1-RUN-TYPE-QTRLY-88 OR CHG-LINK1-RUN-TYPE-AGTS-88 CHGBR100
00616 *        OPEN OUTPUT RATED-FILE1 RATED-RPT FISCAL-AGENT-FILE      CHGBR100
00617 *    ELSE                                                         CHGBR100
00618 *        OPEN OUTPUT RATED-RPT                                    CHGBR100
00619 *    END-IF.                                                      CHGBR100
00620 *                                                                 CHGBR100
00621 *I2000-EXIT.                                                      CHGBR100
00622 *    EXIT.                                                        CHGBR100
00623 *    EJECT                                                        CHGBR100
00624                                                                   CHGBR100
00625  P0000-PROCESS.                                                   CHGBR100
00626 *RW1                                                              CHGBR100
00627      IF CHG-LINK1-RUN-TYPE-AGTS-88                                CHGBR100
00628         IF NOT CHG4-FISC-AG-NONE-88                               CHGBR100
00629            PERFORM P4000-FISCAL-AGENT THRU P4000-EXIT             CHGBR100
00630            GO TO P0000-EXIT                                       CHGBR100
00631         ELSE                                                      CHGBR100
00632            GO TO P0000-EXIT                                       CHGBR100
00633         END-IF                                                    CHGBR100
00634      END-IF.                                                      CHGBR100
00635                                                                   CHGBR100
00636      IF CHG-LINK1-RUN-TYPE-QTRLY-88                               CHGBR100
00637         IF NOT CHG4-FISC-AG-NONE-88                               CHGBR100
00638            PERFORM P4000-FISCAL-AGENT THRU P4000-EXIT             CHGBR100
00639            GO TO P0000-EXIT                                       CHGBR100
00640         END-IF                                                    CHGBR100
00641      END-IF.                                                      CHGBR100
00642 *RW2                                                              CHGBR100
00643      IF CHG4-EMP-NO NOT = WRK-CURRENT-EMP                         CHGBR100
00644         IF WRK-CURRENT-EMP = ZERO                                 CHGBR100
00645            PERFORM P1000-INIT-EMP          THRU P1000-EXIT        CHGBR100
00646            PERFORM P2000-ADD-REC-TO-TABLE  THRU P2000-EXIT        CHGBR100
00647         ELSE                                                      CHGBR100
00648            PERFORM P3000-PRINT-FORMS       THRU P3000-EXIT        CHGBR100
00649            PERFORM P1000-INIT-EMP          THRU P1000-EXIT        CHGBR100
00650            PERFORM P2000-ADD-REC-TO-TABLE  THRU P2000-EXIT        CHGBR100
00651         END-IF                                                    CHGBR100
00652      ELSE                                                         CHGBR100
00653         PERFORM P2000-ADD-REC-TO-TABLE     THRU P2000-EXIT        CHGBR100
00654      END-IF.                                                      CHGBR100
00655                                                                   CHGBR100
00656  P0000-EXIT.                                                      CHGBR100
00657      EXIT.                                                        CHGBR100
00658                                                                   CHGBR100
00659  P1000-INIT-EMP.                                                  CHGBR100
00660      MOVE CHG4-EMP-NO    TO WRK-CURRENT-EMP                       CHGBR100
00661                             PRT-EMP-NO.                           CHGBR100
00662      MOVE ZERO           TO CHG-TAB-LEN                           CHGBR100
00663                             WRK-EMP-TOT-AMT.                      CHGBR100
00664                                                                   CHGBR100
00665      ADD +1              TO WRK-PRINTED-FORM-EMP-CNT.             CHGBR100
00666                                                                   CHGBR100
00667      PERFORM                                                      CHGBR100
00668         VARYING ADDR-SUB FROM +1 BY +1                            CHGBR100
00669         UNTIL ADDR-SUB > +5                                       CHGBR100
00670            MOVE CHG4-FMT-LINE (ADDR-SUB)                          CHGBR100
00671                  TO PRT-ADDR-LINE (ADDR-SUB)                      CHGBR100
00672      END-PERFORM.                                                 CHGBR100
00673                                                                   CHGBR100
00674  P1000-EXIT.                                                      CHGBR100
00675      EXIT.                                                        CHGBR100
00676                                                                   CHGBR100
00677  P2000-ADD-REC-TO-TABLE.                                          CHGBR100
00678      ADD +1 TO CHG-TAB-LEN.                                       CHGBR100
00679      IF CHG-TAB-LEN > CHG-TAB-MAX                                 CHGBR100
00680         MOVE 'SIZE ERROR ON CHG-TAB' TO ABEND-MSG                 CHGBR100
00681         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBR100
00682                                                                   CHGBR100
00683      MOVE CHG4-CLMNT-NAME    TO CHG-TAB-NAME (CHG-TAB-LEN).       CHGBR100
00684      MOVE CHG4-SSN           TO CHG-TAB-SSN (CHG-TAB-LEN).        CHGBR100
00685      COMPUTE WRK-EMP-CURR-AMT =                                   CHGBR100
00686             CHG4-CURR-BEN-AMT +                                   CHGBR100
00687             CHG4-CURR-ADJ-AMT.                                    CHGBR100
00688      MOVE WRK-EMP-CURR-AMT   TO CHG-TAB-AMT (CHG-TAB-LEN).        CHGBR100
00689      MOVE CHG4-PRED-EMP-NO   TO CHG-TAB-PRED (CHG-TAB-LEN).       CHGBR100
00690      MOVE CHG4-SUCC-EMP-NO   TO CHG-TAB-SUCC (CHG-TAB-LEN).       CHGBR100
00691                                                                   CHGBR100
00692  P2000-EXIT.                                                      CHGBR100
00693      EXIT.                                                        CHGBR100
00694      EJECT                                                        CHGBR100
00695                                                                   CHGBR100
00696  P3000-PRINT-FORMS.                                               CHGBR100
00697 ***                                       **SELF-MAILERS**        CHGBR100
00698      MOVE ZEROS TO WRK-TOTAL-PAGES                                CHGBR100
00699                    WRK-CURR-PAGE.                                 CHGBR100
00700                                                                   CHGBR100
00701      DIVIDE CHG-TAB-LEN BY 34                                     CHGBR100
00702             GIVING WRK-TOTAL-PAGES                                CHGBR100
00703             REMAINDER REMAINDER-CNT                               CHGBR100
00704      END-DIVIDE.                                                  CHGBR100
00705                                                                   CHGBR100
00706      IF REMAINDER-CNT > 0                                         CHGBR100
00707         ADD +1 TO WRK-TOTAL-PAGES.                                CHGBR100
00708                                                                   CHGBR100
00709      PERFORM P3500-PRINT-ADDRESS                                  CHGBR100
00710         THRU P3500-EXIT.                                          CHGBR100
00711                                                                   CHGBR100
00712      PERFORM P3100-PRINT-HEADER   THRU P3100-EXIT.                CHGBR100
00713                                                                   CHGBR100
00714      MOVE +0                   TO CHG-TAB-SUB.                    CHGBR100
00715      SET WRK-PRINT-COMPLETE-NO-88 TO TRUE.                        CHGBR100
00716      PERFORM P3200-PRINT-LINES THRU P3200-EXIT                    CHGBR100
00717         UNTIL WRK-PRINT-COMPLETE-YES-88.                          CHGBR100
00718                                                                   CHGBR100
00719  P3000-EXIT.                                                      CHGBR100
00720      EXIT.                                                        CHGBR100
00721                                                                   CHGBR100
00722  P3100-PRINT-HEADER.                                              CHGBR100
00723      MOVE +0                TO  WRK-CURR-LINE.                    CHGBR100
00724                                                                   CHGBR100
00725      ADD +1                 TO  WRK-SELF-MAILER-CNT.              CHGBR100
00726                                                                   CHGBR100
00727      MOVE SPACES            TO  VSCA-DATA.                        CHGBR100
00728 *    WRITE RATED-PRINT-REC FROM VSCA-DATA                         CHGBR100
00729 *        AFTER ADVANCING TOP-OF-PAGE.                             CHGBR100
00730                                                                   CHGBR100
00731      WRITE RATED-PRINT-REC FROM PAGE-HEAD01                       CHGBR100
00732          AFTER ADVANCING 26 LINES.                                CHGBR100
00733 *        AFTER ADVANCING 28 LINES.                                CHGBR100
00734                                                                   CHGBR100
00735      MOVE SPACES            TO  VSCA-DATA.                        CHGBR100
00736      WRITE RATED-PRINT-REC FROM VSCA-DATA                         CHGBR100
00737          AFTER ADVANCING 9  LINES.                                CHGBR100
00738                                                                   CHGBR100
00739  P3100-EXIT.                                                      CHGBR100
00740      EXIT.                                                        CHGBR100
00741                                                                   CHGBR100
00742  P3200-PRINT-LINES.                                               CHGBR100
00743      ADD +1 TO CHG-TAB-SUB.                                       CHGBR100
00744      IF CHG-TAB-SUB > CHG-TAB-LEN                                 CHGBR100
00745         PERFORM P3210-FINAL-FOOTER   THRU P3210-EXIT              CHGBR100
00746         SET WRK-PRINT-COMPLETE-YES-88 TO TRUE                     CHGBR100
00747         GO TO P3200-EXIT.                                         CHGBR100
00748                                                                   CHGBR100
00749      ADD +1 TO WRK-CURR-LINE.                                     CHGBR100
00750      MOVE CHG-TAB-NAME (CHG-TAB-SUB) TO  L071-NAM.                CHGBR100
00751      PERFORM S071-NAME-CONVERSION THRU S071-EXIT.                 CHGBR100
00752      MOVE L071-NAM                   TO  PRT-CHARGE-NAME.         CHGBR100
00753      MOVE CHG-TAB-SSN (CHG-TAB-SUB)  TO  WS-SSN.                  CHGBR100
00754      MOVE WS-SSN1                    TO  PRT-WS-SSN1.             CHGBR100
00755      MOVE WS-SSN2                    TO  PRT-WS-SSN2.             CHGBR100
00756      MOVE WS-SSN3                    TO  PRT-WS-SSN3.             CHGBR100
00757      MOVE CHG-TAB-AMT (CHG-TAB-SUB)  TO  PRT-CHARGE-CURR-AMT.     CHGBR100
00758      ADD  CHG-TAB-AMT (CHG-TAB-SUB)  TO  WRK-EMP-TOT-AMT.         CHGBR100
00759 *RW1                                                              CHGBR100
00760      MOVE SPACES  TO PRT-PRT-SOURCE-TYPE.                         CHGBR100
00761      IF CHG-TAB-PRED (CHG-TAB-SUB) > 0                            CHGBR100
00762         IF CHG-TAB-PRED (CHG-TAB-SUB) = WRK-CURRENT-EMP           CHGBR100
00763            MOVE CHG-TAB-SUCC (CHG-TAB-SUB) TO                     CHGBR100
00764                                      PRT-SUCC-PRED-EMP-NO         CHGBR100
00765            MOVE 'TRANSFERRED TO '      TO PRT-PRINT-MSG           CHGBR100
00766         ELSE                                                      CHGBR100
00767            MOVE CHG-TAB-PRED (CHG-TAB-SUB) TO                     CHGBR100
00768                                      PRT-SUCC-PRED-EMP-NO         CHGBR100
00769            MOVE 'TRANSFERRED FROM '    TO PRT-PRINT-MSG           CHGBR100
00770         END-IF                                                    CHGBR100
00771      END-IF.                                                      CHGBR100
00772 *RW2                                                              CHGBR100
00773      WRITE RATED-PRINT-REC  FROM  EMPLOYER-DETAIL-LINE AFTER 1.   CHGBR100
00774                                                                   CHGBR100
00775      IF WRK-CURR-LINE < WRK-MAX-LINES-PER-PAGE                    CHGBR100
00776         NEXT SENTENCE                                             CHGBR100
00777      ELSE                                                         CHGBR100
00778         IF CHG-TAB-SUB < CHG-TAB-LEN                              CHGBR100
00779            PERFORM P3220-CONTINUED-FOOTER THRU P3220-EXIT         CHGBR100
00780            PERFORM P3500-PRINT-ADDRESS THRU P3500-EXIT            CHGBR100
00781            PERFORM P3100-PRINT-HEADER   THRU P3100-EXIT.          CHGBR100
00782                                                                   CHGBR100
00783  P3200-EXIT.                                                      CHGBR100
00784      EXIT.                                                        CHGBR100
00785                                                                   CHGBR100
00786  P3210-FINAL-FOOTER.                                              CHGBR100
00787      ADD 1                 TO WRK-CURR-PAGE.                      CHGBR100
00788      MOVE WRK-CURR-PAGE    TO PAGE-NO.                            CHGBR100
00789      MOVE WRK-TOTAL-PAGES  TO TOTAL-PAGE-NO.                      CHGBR100
00790                                                                   CHGBR100
00791      COMPUTE ADVANCE-LINE-CNT = 37 - WRK-CURR-LINE.               CHGBR100
00792                                                                   CHGBR100
00793      MOVE '*** TOTAL CHARGE OR CREDIT: '                          CHGBR100
00794                            TO PRT-MESSAGE.                        CHGBR100
00795      MOVE WRK-EMP-TOT-AMT   TO  PRT-TOTAL-EMPLOYER-CHARGES.       CHGBR100
00796      COMPUTE WRK-RATED-TOT-AMT =                                  CHGBR100
00797              WRK-RATED-TOT-AMT +                                  CHGBR100
00798              WRK-EMP-TOT-AMT.                                     CHGBR100
00799                                                                   CHGBR100
00800      WRITE RATED-PRINT-REC FROM FINAL-FOOTER                      CHGBR100
00801               AFTER ADVANCING ADVANCE-LINE-CNT.                   CHGBR100
00802                                                                   CHGBR100
00803      WRITE RATED-PRINT-REC FROM VSCA-DATA                         CHGBR100
00804          AFTER ADVANCING TOP-OF-PAGE.                             CHGBR100
00805 *    PERFORM P3500-PRINT-ADDRESS                                  CHGBR100
00806 *       THRU P3500-EXIT.                                          CHGBR100
00807                                                                   CHGBR100
00808  P3210-EXIT.                                                      CHGBR100
00809      EXIT.                                                        CHGBR100
00810                                                                   CHGBR100
00811  P3220-CONTINUED-FOOTER.                                          CHGBR100
00812      ADD 1                 TO WRK-CURR-PAGE.                      CHGBR100
00813      MOVE WRK-CURR-PAGE    TO PAGE-NOC.                           CHGBR100
00814      MOVE WRK-TOTAL-PAGES  TO TOTAL-PAGE-NOC.                     CHGBR100
00815                                                                   CHGBR100
00816      COMPUTE ADVANCE-LINE-CNT = 37 - WRK-CURR-LINE.               CHGBR100
00817                                                                   CHGBR100
00818      MOVE '*** CONTINUED IN SEPARATE MAILING ***' TO PRT-MESSAGEC.CHGBR100
00819                                                                   CHGBR100
00820      WRITE RATED-PRINT-REC FROM CONTINUED-FOOTER                  CHGBR100
00821               AFTER ADVANCING ADVANCE-LINE-CNT.                   CHGBR100
00822                                                                   CHGBR100
00823      MOVE SPACES            TO  VSCA-DATA.                        CHGBR100
00824      WRITE RATED-PRINT-REC FROM VSCA-DATA                         CHGBR100
00825          AFTER ADVANCING TOP-OF-PAGE.                             CHGBR100
00826  P3220-EXIT.                                                      CHGBR100
00827      EXIT.                                                        CHGBR100
00828                                                                   CHGBR100
00829  P3500-PRINT-ADDRESS.                                             CHGBR100
00830      MOVE SPACES            TO  VSCA-DATA.                        CHGBR100
00831      WRITE RATED-PRINT-REC FROM VSCA-DATA                         CHGBR100
00832          AFTER ADVANCING TOP-OF-PAGE.                             CHGBR100
00833                                                                   CHGBR100
00834      WRITE RATED-PRINT-REC FROM EMPL-ADDR-LINE (1)                CHGBR100
00835          AFTER ADVANCING 12 LINES.                                CHGBR100
00836                                                                   CHGBR100
00837      PERFORM                                                      CHGBR100
00838        VARYING ADDR-SUB     FROM 2 BY 1                           CHGBR100
00839          UNTIL ADDR-SUB     > 5                                   CHGBR100
00840           WRITE RATED-PRINT-REC FROM EMPL-ADDR-LINE (ADDR-SUB)    CHGBR100
00841                  AFTER ADVANCING 1 LINE                           CHGBR100
00842      END-PERFORM.                                                 CHGBR100
00843                                                                   CHGBR100
00844  P3500-EXIT.                                                      CHGBR100
00845      EXIT.                                                        CHGBR100
00846      EJECT                                                        CHGBR100
00847  P4000-FISCAL-AGENT.                                              CHGBR100
00848 ***                                       **FISC.AGNT FILE**      CHGBR100
00849      IF CHG4-EMP-NO NOT = WRK-CURR-FISC-AGNT-EMP                  CHGBR100
00850         ADD +1                   TO WRK-FISCAL-AGNT-EMP-CNT       CHGBR100
00851         MOVE CHG4-EMP-NO         TO WRK-CURR-FISC-AGNT-EMP        CHGBR100
00852      END-IF.                                                      CHGBR100
00853                                                                   CHGBR100
00854      MOVE CHG4-FISCAL-AGENT-CD   TO CHG8-FISCAL-AGENT-CD.         CHGBR100
00855      MOVE CHG4-EMP-NO            TO CHG8-EMP-NO.                  CHGBR100
00856      MOVE CHG4-BYE               TO CHG8-BYE.                     CHGBR100
00857      MOVE CHG4-SSN               TO CHG8-SSN.                     CHGBR100
00858      MOVE CHG4-CLMNT-NAME        TO CHG8-CLMNT-NAME.              CHGBR100
00859      COMPUTE WRK-CHG8-TOT-CHG-AMT = CHG4-CURR-BEN-AMT +           CHGBR100
00860          CHG4-CURR-ADJ-AMT.                                       CHGBR100
00861      MOVE WRK-CHG8-TOT-CHG-AMT   TO CHG8-TOT-CHG-AMT.             CHGBR100
00862      MOVE CHG-LINK1-PERIOD-BEGIN TO CHG8-START-DATE.              CHGBR100
00863      MOVE CHG-LINK1-PERIOD-END   TO CHG8-END-DATE.                CHGBR100
00864      MOVE SPACES                 TO FILLER1.                      CHGBR100
00865      WRITE CHG8-REC.                                              CHGBR100
00866      ADD 1                       TO CHG8-REC-CNT.                 CHGBR100
00867      COMPUTE WRK-FISCAL-TOT-AMT =                                 CHGBR100
00868              WRK-FISCAL-TOT-AMT +                                 CHGBR100
00869              WRK-CHG8-TOT-CHG-AMT.                                CHGBR100
00870                                                                   CHGBR100
00871      INITIALIZE CHG8-REC.                                         CHGBR100
00872      MOVE ZEROS                  TO WRK-CHG8-TOT-CHG-AMT.         CHGBR100
00873                                                                   CHGBR100
00874  P4000-EXIT.                                                      CHGBR100
00875      EXIT.                                                        CHGBR100
00876      EJECT                                                        CHGBR100
00877                                                                   CHGBR100
00878  P5000-PROCESS.                                                   CHGBR100
00879 ***                                       **DETAIL REPORT**       CHGBR100
00880      PERFORM P5500-CHK-FOR-NEW-PAGE THRU P5500-EXIT               CHGBR100
00881                                                                   CHGBR100
00882      EVALUATE TRUE                                                CHGBR100
00883        WHEN CHG4-PROG-UI                                          CHGBR100
00884          MOVE WRK-REG-BEN-PAYMENT   TO WRK-PRT-SOURCE-TYPE        CHGBR100
00885                                        DAT-PRT-SOURCE-TYPE           CL**3
00886                                                                   CHGBR100
00887        WHEN CHG4-PROG-EB                                          CHGBR100
00888          MOVE WRK-EXT-BEN-PAYMENT   TO WRK-PRT-SOURCE-TYPE        CHGBR100
00889                                        DAT-PRT-SOURCE-TYPE           CL**3
00890                                                                   CHGBR100
00891        WHEN CHG4-PROG-TEUC                                        CHGBR100
00892          MOVE WRK-TEUC-BEN-PAYMENT  TO WRK-PRT-SOURCE-TYPE        CHGBR100
00893                                        DAT-PRT-SOURCE-TYPE           CL**3
00894                                                                   CHGBR100
00895        WHEN CHG4-PROG-TEUCA                                       CHGBR100
00896          MOVE WRK-TEUCA-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE        CHGBR100
00897                                        DAT-PRT-SOURCE-TYPE           CL**3
00898                                                                   CHGBR100
00899        WHEN CHG4-PROG-FAC                                         CHGBR100
00900          MOVE WRK-FAC-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE          CHGBR100
00901                                        DAT-PRT-SOURCE-TYPE           CL**3
00902                                                                   CHGBR100
00903        WHEN OTHER                                                 CHGBR100
00904          MOVE ' UNKNOWN '           TO WRK-PRT-SOURCE-TYPE        CHGBR100
00905                                        DAT-PRT-SOURCE-TYPE           CL**3
00906      END-EVALUATE.                                                CHGBR100
00907                                                                   CHGBR100
00908      IF CHG4-PRED-EMP-NO > 0                                      CHGBR100
00909         MOVE SPACES  TO WRK-PRT-SOURCE-TYPE                       CHGBR100
00910         COMPUTE WRK-PERCENT = CHG4-PERCENT-XFER * 100             CHGBR100
00911         MOVE WRK-PERCENT       TO WRK-PRED-PERCENT                CHGBR100
00912                                   DAT-PRED-PERCENT                   CL**3
00913         MOVE '%'               TO WRK-PERCENT-SIGN                CHGBR100
00914                                   DAT-PERCENT-SIGN                   CL**3
00915         IF CHG4-PRED-EMP-NO = CHG4-EMP-NO                         CHGBR100
00916            MOVE CHG4-SUCC-EMP-NO  TO WRK-SUCC-PRED-EMP-NO         CHGBR100
00917                                      DAT-SUCC-PRED-EMP-NO            CL**3
00918            MOVE 'TRNSFR TO:'      TO WRK-PRINT-MSG                CHGBR100
00919                                      DAT-PRINT-MSG                   CL**3
00920         ELSE                                                      CHGBR100
00921            MOVE CHG4-PRED-EMP-NO  TO WRK-SUCC-PRED-EMP-NO         CHGBR100
00922                                      DAT-SUCC-PRED-EMP-NO            CL**3
00923            MOVE 'TRNSFR FROM:'    TO WRK-PRINT-MSG                CHGBR100
00924                                      DAT-PRINT-MSG                   CL**3
00925         END-IF                                                    CHGBR100
00926      END-IF.                                                      CHGBR100
00927      MOVE WRK-PRT-HDR-EMP           TO DAT-EMP-NO                    CL*20
00928                                        WRK-PRT-ACCT-EAN.             CL*20
00929      MOVE CHG4-SSN                  TO WRK-SSN.                   CHGBR100
00930      MOVE WRK-SSN1                  TO WRK-PRT-SSN1                  CL**3
00931      MOVE 'XXX'                     TO DAT-PRT-SSN1.                 CL*15
00932      MOVE WRK-SSN2                  TO WRK-PRT-SSN2                  CL**3
00933      MOVE 'XX'                      TO DAT-PRT-SSN2.                 CL*15
00934      MOVE WRK-SSN3                  TO WRK-PRT-SSN3                  CL**3
00935                                        DAT-PRT-SSN3.                 CL**3
00936      MOVE CHG4-BYE                  TO L001-FED-8-DATE-9.         CHGBR100
00937      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               CHGBR100
00938      MOVE L001-SLASH-8-DATE         TO WRK-PRT-BYE-DATE              CL**3
00939                                        DAT-PRT-BYE-DATE.             CL**3
00940      MOVE CHG4-CLMNT-NAME           TO WRK-PRT-CLMNT-NAME         CHGBR100
00941                                        DAT-PRT-CLMNT-NAME.           CL**3
00942                                                                   CHGBR100
00943      COMPUTE WRK-TOT-AMT =                                        CHGBR100
00944         CHG4-TOT-BEN-AMT + CHG4-TOT-ADJ-AMT                       CHGBR100
00945      MOVE WRK-TOT-AMT               TO WRK-PRT-TOT-AMT               CL**3
00946 *                                      DAT-PRT-TOT-AMT.              CL*19
00947                                                                   CHGBR100
00948      COMPUTE WRK-CURR-AMT =                                       CHGBR100
00949      CHG4-CURR-BEN-AMT + CHG4-CURR-ADJ-AMT                        CHGBR100
00950      MOVE WRK-CURR-AMT              TO WRK-PRT-CURR-AMT              CL**3
00951                                        DAT-PRT-CURR-AMT.             CL**6
00952                                                                   CHGBR100
00953      IF WRK-CURR-AMT NOT = ZERO                                   CHGBR100
00954         WRITE RATED-DAT    FROM DAT-PRINT-LINE                       CL*18
00955         WRITE RATED-REPORT FROM WRK-PRINT-LINE                       CL**3
00956                                AFTER ADVANCING 1 LINE             CHGBR100
00957         ADD +1                      TO WRK-LINE-CNT               CHGBR100
00958         PERFORM P8000-TOTALS      THRU P8000-EXIT                 CHGBR100
00959      END-IF.                                                      CHGBR100
00960                                                                   CHGBR100
00961  P5000-EXIT.                                                      CHGBR100
00962      EXIT.                                                        CHGBR100
00963                                                                   CHGBR100
00964  P5500-CHK-FOR-NEW-PAGE.                                          CHGBR100
00965      IF CHG4-EMP-NO NOT = WRK-CURR-EMP                            CHGBR100
00966 ***                                                  1ST EMPLYR   CHGBR100
00967         IF WRK-CURR-EMP = ZERO                                    CHGBR100
00968            MOVE CHG4-EMP-NO           TO WRK-CURR-EMP             CHGBR100
00969                                          WRK-PRT-HDR-EMP          CHGBR100
00970            MOVE CHG4-EMP-TYPE         TO WRK-PRT-EMP-TYPE         CHGBR100
00971            PERFORM P6000-PRINT-HEADER THRU P6000-EXIT             CHGBR100
00972            ADD    +1                  TO WRK-EMPLYR-CNT           CHGBR100
00973         ELSE                                                      CHGBR100
00974 ***                                                  NEW EMPLYR   CHGBR100
00975            PERFORM P6500-PRINT-FOOTER THRU P6500-EXIT             CHGBR100
00976            MOVE CHG4-EMP-NO           TO WRK-CURR-EMP             CHGBR100
00977                                          WRK-PRT-HDR-EMP          CHGBR100
00978            MOVE CHG4-EMP-TYPE         TO WRK-PRT-EMP-TYPE         CHGBR100
00979            PERFORM P6000-PRINT-HEADER THRU P6000-EXIT             CHGBR100
00980            ADD    +1                  TO WRK-EMPLYR-CNT           CHGBR100
00981      ELSE                                                         CHGBR100
00982 ***                                                 SAME EMPLYR   CHGBR100
00983         IF WRK-LINE-CNT > +54                                     CHGBR100
00984            PERFORM P6000-PRINT-HEADER THRU P6000-EXIT             CHGBR100
00985         END-IF                                                    CHGBR100
00986      END-IF.                                                      CHGBR100
00987                                                                   CHGBR100
00988  P5500-EXIT.                                                      CHGBR100
00989      EXIT.                                                        CHGBR100
00990                                                                   CHGBR100
00991  P6000-PRINT-HEADER.                                              CHGBR100
00992      MOVE ZERO TO WRK-LINE-CNT                                    CHGBR100
00993      ADD    1  TO WRK-PAGE-CNT.                                   CHGBR100
00994      MOVE WRK-PAGE-CNT TO WRK-PRT-PAGE-CNT.                       CHGBR100
00995                                                                   CHGBR100
00996       MOVE HEAD01 TO WS-REC                                       CHGBR100
00997      WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING TOP-OF-PAGE   CHGBR100
00998       MOVE HEAD02 TO WS-REC                                       CHGBR100
00999      WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE        CHGBR100
01000       MOVE HEAD03 TO WS-REC                                       CHGBR100
01001      WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE        CHGBR100
01002       MOVE SPACES TO WS-REC                                       CHGBR100
01003      WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE        CHGBR100
01004       MOVE HEAD04 TO WS-REC                                       CHGBR100
01005      WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE        CHGBR100
01006       MOVE SPACES TO WS-REC                                       CHGBR100
01007      WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE        CHGBR100
01008       MOVE HEAD05 TO WS-REC                                       CHGBR100
01009      WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE        CHGBR100
01010       MOVE SPACES TO WS-REC                                       CHGBR100
01011      WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE        CHGBR100
01012       MOVE HEAD06 TO WS-REC                                       CHGBR100
01013      WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE        CHGBR100
01014       MOVE SPACES TO WS-REC                                       CHGBR100
01015      WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE.       CHGBR100
01016                                                                   CHGBR100
01017      MOVE +10 TO WRK-LINE-CNT.                                    CHGBR100
01018  P6000-EXIT.                                                      CHGBR100
01019      EXIT.                                                        CHGBR100
01020                                                                   CHGBR100
01021  P6500-PRINT-FOOTER.                                              CHGBR100
01022 ***                                              JUST IN CASE     CHGBR100
01023      IF WRK-LINE-CNT > +48                                        CHGBR100
01024         PERFORM P6000-PRINT-HEADER THRU P6000-EXIT                CHGBR100
01025      END-IF                                                       CHGBR100
01026                                                                   CHGBR100
01027      MOVE WRK-TOTAL-BENEFITS           TO WRK-PRT-TOT-BEN.        CHGBR100
01028      MOVE WRK-ACCT-TOTAL               TO WRK-PRT-ACCT-TOT.       CHGBR100
01029                                                                   CHGBR100
01030      MOVE SPACES        TO   DAT-TOTAL-LINE                          CL*12
01031      MOVE ';    '           TO FILLEX                                CL*13
01032      MOVE WRK-PRT-HDR-EMP           TO DAT-TOT-EMP-NO.               CL*12
01033      MOVE WRK-ACCT-TOTAL            TO DAT-TOT-CURR-AMT.             CL*12
01034                                                                      CL**9
01035      WRITE RATED-DAT    FROM DAT-TOTAL-LINE                          CL*12
01036      WRITE RATED-REPORT FROM WRK-PRINT-TOTAL                      CHGBR100
01037                              AFTER ADVANCING 4 LINE.              CHGBR100
01038      WRITE RATED-REPORT FROM WRK-PRINT-TOTAL-ACCT                 CHGBR100
01039                              AFTER ADVANCING 2 LINE.              CHGBR100
01040                                                                   CHGBR100
01041      ADD WRK-TOTAL-BENEFITS TO   WRK-GRAND-TOTAL-BENEFITS.        CHGBR100
01042      ADD WRK-ACCT-TOTAL     TO   WRK-GRAND-TOTAL-CHARGED.         CHGBR100
01043                                                                   CHGBR100
01044      MOVE ZERO                         TO WRK-TOTAL-BENEFITS      CHGBR100
01045                                           WRK-ACCT-TOTAL.         CHGBR100
01046  P6500-EXIT.                                                      CHGBR100
01047      EXIT.                                                        CHGBR100
01048                                                                   CHGBR100
01049  P8000-TOTALS.                                                    CHGBR100
01050      COMPUTE WRK-TOTAL-BENEFITS = WRK-TOTAL-BENEFITS              CHGBR100
01051         + CHG4-TOT-BEN-AMT                                        CHGBR100
01052         + CHG4-TOT-ADJ-AMT.                                       CHGBR100
01053                                                                   CHGBR100
01054      COMPUTE WRK-ACCT-TOTAL     = WRK-ACCT-TOTAL                  CHGBR100
01055         + CHG4-CURR-BEN-AMT                                       CHGBR100
01056         + CHG4-CURR-ADJ-AMT.                                      CHGBR100
01057                                                                   CHGBR100
01058  P8000-EXIT.                                                      CHGBR100
01059      EXIT.                                                        CHGBR100
01060                                                                   CHGBR100
01061  T0000-TERMINATE.                                                 CHGBR100
01062      IF NOT CHG-LINK1-RUN-TYPE-AGTS-88                            CHGBR100
01063         PERFORM T1000-FOOTER-AND-TOTALS     THRU T1000-EXIT       CHGBR100
01064      END-IF.                                                      CHGBR100
01065                                                                   CHGBR100
01066      IF CHG-LINK1-RUN-TYPE-SPC-88                                 CHGBR100
01067      OR CHG-LINK1-RUN-TYPE-AGTS-88                                CHGBR100
01068         NEXT SENTENCE                                             CHGBR100
01069      ELSE                                                         CHGBR100
01070         PERFORM P3000-PRINT-FORMS THRU P3000-EXIT                 CHGBR100
01071      END-IF.                                                      CHGBR100
01072                                                                   CHGBR100
01073      DISPLAY '********************************************'.      CHGBR100
01074      DISPLAY '***         CHGBR100 COUNTS              ***'.      CHGBR100
01075      DISPLAY '***'.                                               CHGBR100
01076      DISPLAY '*** EMPLOYERS RECEIVING PRINTED FORMS:    '         CHGBR100
01077              WRK-PRINTED-FORM-EMP-CNT.                            CHGBR100
01078      DISPLAY '*** EMPLOYERS USING FISCAL AGENTS:        '         CHGBR100
01079              WRK-FISCAL-AGNT-EMP-CNT.                             CHGBR100
01080      DISPLAY '*** FISCAL AGENT RECORDS WRITTEN:         '         CHGBR100
01081              CHG8-REC-CNT.                                        CHGBR100
01082      DISPLAY '*** SELF MAILERS PRINTED:                 '         CHGBR100
01083              WRK-SELF-MAILER-CNT.                                 CHGBR100
01084      MOVE WRK-RATED-TOT-AMT TO WRK-RATED-TOT-DISP.                CHGBR100
01085      DISPLAY '*** TOTAL CURR CHARGED TO ALL RATED EMPLOYERS: '    CHGBR100
01086              WRK-RATED-TOT-DISP.                                  CHGBR100
01087      MOVE WRK-FISCAL-TOT-AMT TO WRK-RATED-TOT-DISP.               CHGBR100
01088      DISPLAY '*** GRAND TOTAL CHARGED TO ALL FISCAL AGENTS:  '    CHGBR100
01089              WRK-RATED-TOT-DISP.                                  CHGBR100
01090      DISPLAY '***'.                                               CHGBR100
01091      DISPLAY '********************************************'.      CHGBR100
01092                                                                   CHGBR100
01093      IF CHG-LINK1-RUN-TYPE-QTRLY-88                               CHGBR100
01094      OR CHG-LINK1-RUN-TYPE-AGTS-88                                CHGBR100
01095         CLOSE RATED-FILE1                                         CHGBR100
01096               FISCAL-AGENT-FILE                                   CHGBR100
01097               RATED-RPT                                           CHGBR100
01098               RATED-DATA                                             CL**5
01099      ELSE                                                         CHGBR100
01100         IF CHG-LINK1-RUN-TYPE-ANN-88                              CHGBR100
01101            CLOSE RATED-FILE1                                      CHGBR100
01102                  RATED-RPT                                        CHGBR100
01103                  RATED-DATA                                          CL**5
01104         ELSE                                                      CHGBR100
01105            CLOSE RATED-RPT                                        CHGBR100
01106            CLOSE RATED-DATA                                          CL**5
01107         END-IF                                                    CHGBR100
01108      END-IF.                                                      CHGBR100
01109                                                                   CHGBR100
01110  T0000-EXIT.                                                      CHGBR100
01111      EXIT.                                                        CHGBR100
01112                                                                   CHGBR100
01113  T1000-FOOTER-AND-TOTALS.                                         CHGBR100
01114       IF WRK-EMPLYR-CNT > +0                                      CHGBR100
01115           PERFORM P6500-PRINT-FOOTER       THRU P6500-EXIT.       CHGBR100
01116                                                                   CHGBR100
01117       IF WRK-EMPLYR-CNT > +1                                      CHGBR100
01118           PERFORM T1100-PRINT-GRAND-TOTALS THRU T1100-EXIT        CHGBR100
01119       END-IF.                                                     CHGBR100
01120                                                                   CHGBR100
01121  T1000-EXIT.                                                      CHGBR100
01122      EXIT.                                                        CHGBR100
01123                                                                   CHGBR100
01124  T1100-PRINT-GRAND-TOTALS.                                        CHGBR100
01125 ***                             DO NOT NEED EMPLYR NO. ANYMORE    CHGBR100
01126      MOVE   SPACE   TO   HEAD04.                                  CHGBR100
01127      PERFORM P6000-PRINT-HEADER THRU P6000-EXIT                   CHGBR100
01128                                                                   CHGBR100
01129      MOVE WRK-GRAND-TOTAL-BENEFITS   TO WRK-PRT-GRAND-TOT-BEN.    CHGBR100
01130      MOVE WRK-GRAND-TOTAL-CHARGED    TO WRK-PRT-GRAND-TOT-CHG.    CHGBR100
01131                                                                   CHGBR100
01132      WRITE RATED-REPORT FROM WRK-PRINT-GRAND-PERIOD               CHGBR100
01133                          AFTER ADVANCING 3.                       CHGBR100
01134      WRITE RATED-REPORT FROM WRK-PRINT-GRAND                      CHGBR100
01135                          AFTER ADVANCING 2.                       CHGBR100
01136  T1100-EXIT.                                                      CHGBR100
01137      EXIT.                                                        CHGBR100
01138                                                                   CHGBR100
01139  S001-FROM-FED-8.                                                 CHGBR100
01140      SET L001-FROM-FED-8 TO TRUE.                                 CHGBR100
01141      GO TO S001-DATE.                                             CHGBR100
01142                                                                   CHGBR100
01143  S001-DATE.                                                       CHGBR100
01144      CALL 'DTSBU001' USING L001-LINK-AREA.                        CHGBR100
01145                                                                   CHGBR100
01146  S001-EXIT.                                                       CHGBR100
01147      EXIT.                                                        CHGBR100
01148                                                                   CHGBR100
01149  S071-NAME-CONVERSION.                                            CHGBR100
01150      SET L071-FROM-LAST-NAME-FIRST TO TRUE.                       CHGBR100
01151                                                                   CHGBR100
01152      CALL 'DTSBU071' USING L071-LINK-AREA.                        CHGBR100
01153                                                                   CHGBR100
01154  S071-EXIT.                                                       CHGBR100
01155      EXIT.                                                        CHGBR100
01156                                                                   CHGBR100
01157  S999-ABEND.                                                      CHGBR100
01158      DISPLAY '****  CHGBR100 ABENDING '                           CHGBR100
01159         ABEND-MSG.                                                CHGBR100
01160                                                                   CHGBR100
01161      CALL 'DTSBU999' USING WRK-ABEND-CODE.                        CHGBR100
01162                                                                   CHGBR100
01163  S999-EXIT.                                                       CHGBR100
01164      EXIT.                                                        CHGBR100
