00001  IDENTIFICATION DIVISION.                                         06/12/20
00002  PROGRAM-ID.             CHGBD210.                                CHGBD210
00003 *AUTHOR.                 TRW.                                        LV010
00004 *DATE-WRITTEN.           JUNE 2001.                               CHGBD210
00005  DATE-COMPILED.                                                   CHGBD210
00006      SKIP3                                                        CHGBD210
00007 *****                                                             CHGBD210
00008 *                                                                 CHGBD210
00009 *    FUNCTION:                                                    CHGBD210
00010 *                                                                 CHGBD210
00011 *           READ CHARGE RECORDS EXTRACTED BY CHGBD205.            CHGBD210
00012 *                                                                 CHGBD210
00013 *           FIND EMPLOYER ACCOUNT NUMBER OF SUCCESSOR, IF ANY,    CHGBD210
00014 *           AND REPLACE PREDECESSOR ACCOUNT NUMBER WITH ACCOUNT   CHGBD210
00015 *           NUMBER OF PREDECESSOR.                                CHGBD210
00016 *                                                                 CHGBD210
00017 *           FOR DC GOVERNMENT CHARGES UNDER ACCOUNT NUMBER 998888,CHGBD210
00018 *           READ DC WAGE FILE TO FIND THE AGENCY RESPONSIBLE FOR  CHGBD210
00019 *           THE CHARGES, AND WRITE CHARGE SEPARATE OUTPUT RECORDS CHGBD210
00020 *           FOR EACH AGENCY WITH BASE PERIOD WAGES.               CHGBD210
00021 *                                                                 CHGBD210
00022 *           READ MASTER FILE FOR ADDRESS AND FISCAL AGENT DATA    CHGBD210
00023 *                                                                 CHGBD210
00024 *           WRITE CHG4 OUTPUT RECORD.                             CHGBD210
00025 *                                                                 CHGBD210
00026 *        INPUT:                                                   CHGBD210
00027 *                                                                 CHGBD210
00028 *            BD205CHG - CHARGE REPORT RECORDS GENERATED BY        CHGBD210
00029 *                       CHGBD205.                                 CHGBD210
00030 *                                                                 CHGBD210
00031 *            CHGPARM  - PARAMETER DATA INPUT FROM CHGBD205        CHGBD210
00032 *                                                                 CHGBD210
00033 *        OUTPUT:                                                  CHGBD210
00034 *                                                                 CHGBD210
00035 *            BD210CHG - CHARGE RECORDS SELECTED IN                CHGBD210
00036 *                       CHGBD210.                                 CHGBD210
00037 *                                                                 CHGBD210
00038 *                                                                 CHGBD210
00039 *                                                                 CHGBD210
00040 *****                                                             CHGBD210
00041                                                                   CHGBD210
00042 ******************************************************************CHGBD210
00043 * MODIFICATION HISTORY:                                          *CHGBD210
00044 *                                                                *CHGBD210
00045 * 02-02-1999 INITIAL DEVELOPMENT                                 *CHGBD210
00046 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD210
00047 *                                                                *CHGBD210
00048 * 06-21-2001 MODIFIED FOR NEW CHARGE PROCESS                      CHGBD210
00049 *            REFERENCE RFP #****          AUTHOR OF CHANGE - GD  *CHGBD210
00050 *                                                                *CHGBD210
00051 * 04-23-2002 MODIFIED TO OUTPUT TEUC RPC150R1 REPORT              CHGBD210
00052 *            REFERENCE RFP #****          AUTHOR OF CHANGE - RW1 *CHGBD210
00053 *                                                                *CHGBD210
00054 * 09-04-2003 MODIFIED TO ALLOCATE DC GOVERNMENT CHARGES TO        CHGBD210
00055 *            THE SPECIFIC AGENCY RESPONSIBLE.                    *CHGBD210
00056 *            REFERENCE DIR 100            AUTHOR OF CHANGE - GD  *CHGBD210
00057 *                                                                *CHGBD210
00058 * 01-26-2004 ADDED TEST FOR ZERO WAGE AMOUNT IN CHG10 FILE.       CHGBD210
00059 *            CAUSED DIVISION BY ZERO ERROR.                      *CHGBD210
00060 *            REFERENCE                    AUTHOR OF CHANGE - GD  *CHGBD210
00061 *                                                                *CHGBD210
00062 * 06-29-2004 ADDED EMP-TYPE 17 - DOMESTIC VIOLENCE.               CHGBD210
00063 *            REFERENCE                    AUTHOR OF CHANGE - GD  *CHGBD210
00064 *                                                                *CHGBD210
00065 * 07-06-2004 CORRECTED PROBLEM WITH HANDLING SSN. THE PROGRAM    *CHGBD210
00066 *            WAS MOVING THE 10 DIGIT CHG2-SSN TO THE 9 DIGIT     *CHGBD210
00067 *            L081-CLAIMAINT-SSN.                                 *CHGBD210
00068 *            REFERENCE                    AUTHOR OF CHANGE - GD  *CHGBD210
00069 *                                                                *CHGBD210
00070 * 01-03-2008 MODIFIED FOR NEW VERSION OF CHGIM004.               *CHGBD210
00071 *            REFERENCE                    AUTHOR OF CHANGE - GD  *CHGBD210
00072 *                                                                *CHGBD210
00073 * 04-03-2009 RECOMPILED FOR NEW VERSIONS OF CHGIM002, CHGIM004.  *CHGBD210
00074 *            REFERENCE                    AUTHOR OF CHANGE - GD  *CHGBD210
00075 *                                                                *CHGBD210
00076 * 07-07-2009 ADDED P2120 TO HANDLE RELATIONSHIPS AMONG FEDRAL    *CHGBD210
00077 *            AGENCIES. CHARGES POSTED TO THE OLD ACCOUNT NUMBER  *CHGBD210
00078 *            WILL BE REPORTED UNDER THE NEW ACCOUNT NUMBER.      *CHGBD210
00079 *            REFERENCE                    AUTHOR OF CHANGE - GD  *CHGBD210
00080 *                                                                *CHGBD210
00081 *                                                                *CHGBD210
00082 * 05-04-2010 RECOMPILED FOR NEW VERSIONS OF CHGIM002, CHGIM004.  *CHGBD210
00083 *            REFERENCE                    AUTHOR OF CHANGE - ZL1 *CHGBD210
00084 *                                                                *CHGBD210
00085 *                                                                *CHGBD210
00086 * 09-26-2013 MODIFIED TO MERGE TWO FED ACCOUTS INTO ONE, REPORT  *CHGBD210
00087 *            ALL CHARGES FOR 000012 UNDER 000030 START 2013/3    *CHGBD210
00088 *            REFERENCE                    AUTHOR OF CHANGE - ZL1 *CHGBD210
00089 *                                                                *CHGBD210
00090 * 10-04-2014 RECOMPILED FOR NEW VERSIONS OF CHGIM002, CHGIM004.  *CHGBD210
00091 *            REFERENCE: UCPIA             AUTHOR OF CHANGE - ZL1 *CHGBD210
00092 *                                                                *CHGBD210
00093 *                                                                *CHGBD210
00094 * 08-16-2017 CHECK FOR THE PRESENCE OF A BENEFITS ADDRESS BEFORE *CHGBD210
00095 *            USING MAILING ADDRESS.                              *CHGBD210
00096 *            REFERENCE: KACE TICKET       AUTHOR OF CHANGE - ZL1 *CHGBD210
00097 *                                                                *CHGBD210
00098 *                                                                *   CL**2
00099 * 04-18-2020 RECOMPILED FOR NEW VERSIONS OF CHGIM002, CHGIM004.  *   CL**2
00100 *            REFERENCE: PUA FPUC FRUR     AUTHOR OF CHANGE - ZL1 *   CL**2
00101 *                                                                *   CL**2
00102 *                                                                *CHGBD210
00103 *                                                                *CHGBD210
00104 * 05-08-2019 MODIFIED TO MERGE TWO FED ACCOUTS INTO ONE, REPORT  *CHGBD210
00105 *            ALL CHARGES FOR 000913 UNDER 000914 START 2019/1    *CHGBD210
00106 *            REFERENCE                    AUTHOR OF CHANGE - ZL1 *CHGBD210
00107 *                                                                *CHGBD210
00108 *                                                                *   CL**7
00109 * 05-01-2020 RECOMPILED FOR NEW VERSIONS OF CHGIM002, CHGIM004.  *   CL**7
00110 *            REFERENCE: PUA FPUC FRUR FPUC          CHANGE - ZL1 *   CL**7
00111 *                                                                *   CL**7
00112 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD210
00113 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD210
00114 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBD210
00115 ******************************************************************CHGBD210
00116                                                                   CHGBD210
00117      SKIP3                                                        CHGBD210
00118  ENVIRONMENT DIVISION.                                            CHGBD210
00119      SKIP3                                                        CHGBD210
00120  INPUT-OUTPUT SECTION.                                            CHGBD210
00121      SKIP3                                                        CHGBD210
00122  FILE-CONTROL.                                                    CHGBD210
00123      SELECT CHG-PARM-FILE  ASSIGN TO CHGPARM                      CHGBD210
00124             FILE STATUS IS CHG-PARM-STATUS.                       CHGBD210
00125                                                                   CHGBD210
00126      SELECT BD205-CHG-FILE-IN ASSIGN TO BD205CHG                  CHGBD210
00127             FILE STATUS IS BD205-CHG-STATUS.                      CHGBD210
00128                                                                   CHGBD210
00129      SELECT BD210-CHG-FILE-OUT   ASSIGN TO BD210CHG               CHGBD210
00130             FILE STATUS IS BD210-CHG-STATUS.                      CHGBD210
00131                                                                   CHGBD210
00132      SELECT DC-WAGE-FILE         ASSIGN TO DTSWGHDC               CHGBD210
00133             ORGANIZATION IS INDEXED                               CHGBD210
00134             ACCESS MODE IS DYNAMIC                                CHGBD210
00135             RECORD KEY IS CHG10-KEY-AREA                          CHGBD210
00136             FILE STATUS IS DC-WAGE-STATUS.                        CHGBD210
00137                                                                   CHGBD210
00138      EJECT                                                        CHGBD210
00139  DATA DIVISION.                                                   CHGBD210
00140                                                                   CHGBD210
00141  FILE SECTION.                                                    CHGBD210
00142  FD  CHG-PARM-FILE                                                CHGBD210
00143      LABEL RECORDS ARE STANDARD                                   CHGBD210
00144      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD210
00145      SKIP1                                                        CHGBD210
00146  01  CHG-PARM-REC.                                                CHGBD210
00147  ++INCLUDE CHGIM003                                               CHGBD210
00148                                                                   CHGBD210
00149  FD  BD205-CHG-FILE-IN                                            CHGBD210
00150      RECORD CONTAINS 64 CHARACTERS                                CHGBD210
00151      DATA RECORD IS BD205-CHG-REC.                                CHGBD210
00152  01  BD205-CHG-REC.                                               CHGBD210
00153  ++INCLUDE CHGIM002                                               CHGBD210
00154                                                                   CHGBD210
00155  FD  BD210-CHG-FILE-OUT                                           CHGBD210
00156      LABEL RECORDS ARE STANDARD                                   CHGBD210
00157      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD210
00158      SKIP1                                                        CHGBD210
00159  01  BD210-CHG-REC.                                               CHGBD210
00160  ++INCLUDE CHGIM004                                               CHGBD210
00161                                                                   CHGBD210
00162  FD  DC-WAGE-FILE                                                 CHGBD210
00163      RECORD CONTAINS 20 CHARACTERS                                CHGBD210
00164      DATA RECORD IS DC-WAGE-REC.                                  CHGBD210
00165      SKIP1                                                        CHGBD210
00166  01  DC-WAGE-REC.                                                 CHGBD210
00167  ++INCLUDE CHGIM010                                               CHGBD210
00168                                                                   CHGBD210
00169      EJECT                                                        CHGBD210
00170  WORKING-STORAGE SECTION.                                         CHGBD210
001705 77  PAN-VALET PICTURE X(24) VALUE '010CHGBD210  06/12/20'.       CHGBD210
00171  77  PAN-VALET PICTURE X(24) VALUE '163CHGBD210  05/15/19'.       CHGBD210
00172  77  PAN-VALET PICTURE X(24) VALUE '006CHGBD210  05/13/19'.       CHGBD210
00173  77  PAN-VALET PICTURE X(24) VALUE '161CHGBD210  10/08/13'.       CHGBD210
00174  77  PAN-VALET PICTURE X(24) VALUE '002CHGBD210  09/26/13'.       CHGBD210
00175  77  PAN-VALET PICTURE X(24) VALUE '159CHGBD210  05/25/10'.       CHGBD210
00176                                                                   CHGBD210
00177  01  WRK-AREA.                                                    CHGBD210
00178 *&                                                                CHGBD210
00179      05  WRK-DISP-AREA.                                           CHGBD210
00180          10  WRK-DATE                PIC 9999B99B99.              CHGBD210
00181          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD210
00182          10  WRK-EMP-DISP            PIC 9(06).                   CHGBD210
00183          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD210
00184          10  WRK-SSN-DISP            PIC 9(10).                   CHGBD210
00185          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD210
00186          10  WRK-CHG-AMT-DISP        PIC  Z(08)9.99-.             CHGBD210
00187                                                                   CHGBD210
00188      05  WRK-TOT-CHG                 PIC S9(09)V99 COMP-3         CHGBD210
00189                                  VALUE +0.                        CHGBD210
00190      05  WRK-TOT-CHG-DISP            PIC  Z(08)9.99-.             CHGBD210
00191      05  WRK-CHG-AMT                 PIC S9(09)V99 COMP-3.        CHGBD210
00192 *&                                                                CHGBD210
00193      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD210
00194                                  VALUE +210.                      CHGBD210
00195      05  ABEND-MOD                   PIC  X(08)                   CHGBD210
00196                                  VALUE 'DTSBU999'.                CHGBD210
00197      05  ABEND-MSG                   PIC  X(60).                  CHGBD210
00198                                                                   CHGBD210
00199      05  CHG-PARM-STATUS             PIC  X(02) VALUE SPACES.     CHGBD210
00200          88  CHG-PARM-FILE-OK-88   VALUE ZERO.                    CHGBD210
00201          88  CHG-PARM-FILE-EOF-88  VALUE '10'.                    CHGBD210
00202                                                                   CHGBD210
00203      05  BD205-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD210
00204          88  BD205-FILE-OK-88    VALUE ZERO.                      CHGBD210
00205          88  BD205-FILE-EOF-88   VALUE '10'.                      CHGBD210
00206                                                                   CHGBD210
00207      05  BD210-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD210
00208          88  BD210-FILE-OK-88    VALUE ZERO.                      CHGBD210
00209          88  BD210-FILE-EOF-88   VALUE '10'.                      CHGBD210
00210                                                                   CHGBD210
00211      05  DC-WAGE-STATUS              PIC  X(02) VALUE SPACES.     CHGBD210
00212          88  DC-WAGE-FILE-OK-88    VALUE ZERO.                    CHGBD210
00213          88  DC-WAGE-FILE-EOF-88   VALUE '10'.                    CHGBD210
00214                                                                   CHGBD210
00215      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD210
00216          88  WRK-ERROR-YES-88    VALUE 'Y'.                       CHGBD210
00217          88  WRK-ERROR-NO-88     VALUE 'N'.                       CHGBD210
00218                                                                   CHGBD210
00219      05  WRK-EMP-VALID-IND           PIC  X(01).                  CHGBD210
00220          88  WRK-EMP-VALID-YES-88  VALUE 'Y'.                     CHGBD210
00221          88  WRK-EMP-VALID-NO-88   VALUE 'N'.                     CHGBD210
00222                                                                   CHGBD210
00223                                                                   CHGBD210
00224      05  WRK-REC-SELECTED-IND        PIC  X(01).                  CHGBD210
00225          88  WRK-REC-SELECTED-YES-88  VALUE 'Y'.                  CHGBD210
00226          88  WRK-REC-SELECTED-NO-88   VALUE 'N'.                  CHGBD210
00227                                                                   CHGBD210
00228      05  WRK-DEFAULT-DC-ACCT-IND     PIC  X(01).                  CHGBD210
00229          88  WRK-DEFAULT-DC-ACCT-YES-88  VALUE 'Y'.               CHGBD210
00230          88  WRK-DEFAULT-DC-ACCT-NO-88   VALUE 'N'.               CHGBD210
00231                                                                   CHGBD210
00232      05  WRK-KEY                     PIC  9(10).                  CHGBD210
00233      05  FILLER REDEFINES WRK-KEY.                                CHGBD210
00234          10  WRK-SSN                 PIC  9(09).                  CHGBD210
00235          10  WRK-SSN-SEQ             PIC  9(01).                  CHGBD210
00236                                                                   CHGBD210
00237      05  WRK-LAST-DC-SSN             PIC  9(09) VALUE ZERO.       CHGBD210
00238      05  WRK-DC-GOV-ACCT             PIC S9(07) COMP-3            CHGBD210
00239                                       VALUE +998888.              CHGBD210
00240      05  WRK-LAST-EMP-CHECKED        PIC S9(07) COMP-3            CHGBD210
00241                                       VALUE +0.                   CHGBD210
00242      05  WRK-BP-START                PIC S9(09) COMP-3.           CHGBD210
00243      05  WRK-BP-END                  PIC S9(09) COMP-3.           CHGBD210
00244                                                                   CHGBD210
00245      05  WRK-RPT-TYPE                PIC  9(02) VALUE ZERO.       CHGBD210
00246          88  WRK-RPT-TYPE-RATED-88     VALUE 00.                  CHGBD210
00247          88  WRK-RPT-TYPE-FED-88       VALUE 01, 02.              CHGBD210
00248          88  WRK-RPT-TYPE-CWC-88       VALUE 04.                  CHGBD210
00249          88  WRK-RPT-TYPE-SELF-INS-88  VALUE 08.                  CHGBD210
00250          88  WRK-RPT-TYPE-DC-88        VALUE 10.                  CHGBD210
00251          88  WRK-RPT-TYPE-TEUC-88      VALUE 16.                  CHGBD210
00252          88  WRK-RPT-TYPE-FPUC-88      VALUE 29, 32, 33, 34, 35.     CL*10
00253                                                                   CHGBD210
00254      05  WRK-EMPLOYER-DATA-AREA.                                  CHGBD210
00255          10  WRK-FISCAL-AGENT-CD        PIC X(03).                CHGBD210
00256              88  WRK-FISC-AG-NONE-88     VALUE SPACES.            CHGBD210
00257          10  WRK-FMT-ADDR.                                        CHGBD210
00258              15  WRK-FMT-LINE OCCURS 5 TIMES                      CHGBD210
00259                                         PIC X(40).                CHGBD210
00260              15  WRK-ZIP                PIC X(10).                CHGBD210
00261              15  WRK-ADVANCED-BARCODE   PIC X(14).                CHGBD210
00262          10  WRK-EMP-NAME-CHK           PIC X(04).                CHGBD210
00263                                                                   CHGBD210
00264      05  WRK-CHG2-CURR-BEN-AMT       PIC S9(08)V99 COMP-3         CHGBD210
00265                                        VALUE 0.                   CHGBD210
00266      05  WRK-CHG2-CURR-ADJ-AMT       PIC S9(08)V99 COMP-3         CHGBD210
00267                                        VALUE 0.                   CHGBD210
00268      05  WRK-BD205-CHG-READ          PIC  9(09) COMP-3            CHGBD210
00269                                        VALUE 0.                   CHGBD210
00270      05  WRK-BD210-WRITE             PIC  9(09) COMP-3            CHGBD210
00271                                        VALUE 0.                   CHGBD210
00272      05  WRK-BD205-CHG-DELETE        PIC  9(09) COMP-3            CHGBD210
00273                                        VALUE 0.                   CHGBD210
00274      05  WRK-BD205-NOT-LIAB-CNT      PIC  9(09) COMP-3            CHGBD210
00275                                        VALUE 0.                   CHGBD210
00276      05  WRK-BD205-NOT-SELECTED      PIC  9(09) COMP-3            CHGBD210
00277                                        VALUE 0.                   CHGBD210
00278      05  WRK-DC-GOV-INPUT-CNT        PIC  9(09) COMP-3            CHGBD210
00279                                        VALUE 0.                   CHGBD210
00280      05  WRK-DC-DEFAULT-CNT          PIC  9(09) COMP-3            CHGBD210
00281                                        VALUE 0.                   CHGBD210
00282      05  WRK-DC-WRITE-CNT            PIC  9(09) COMP-3            CHGBD210
00283                                        VALUE 0.                   CHGBD210
00284                                                                   CHGBD210
00285      05  WRK-DC-TOT-WAGE-AMT         PIC  9(11) COMP-3            CHGBD210
00286                                        VALUE 0.                   CHGBD210
00287                                                                   CHGBD210
00288  01  WRK-DC-AGENCY-TBL-AREA.                                      CHGBD210
00289      05  WRK-DC-TBL-MAX              PIC S9(04) COMP  VALUE +32.  CHGBD210
00290      05  WRK-DC-TBL-LAST             PIC S9(04) COMP.             CHGBD210
00291      05  DC-SUB                      PIC S9(04) COMP.             CHGBD210
00292      05  DC-NDX                      PIC S9(04) COMP.             CHGBD210
00293      05  WRK-DC-AGENCY  OCCURS 32 TIMES.                          CHGBD210
00294          10  WRK-DC-CODE             PIC  X(02).                  CHGBD210
00295          10  WRK-DC-EMP-NO           PIC  S9(07)    COMP-3.       CHGBD210
00296          10  WRK-DC-WAGE-AMT         PIC S9(09)V99  COMP-3.       CHGBD210
00297          10  WRK-DC-PCT              PIC S99V9999   COMP-3.       CHGBD210
00298                                                                   CHGBD210
00299 ** ADD ERROR MSG TABLE SET UP                                     CHGBD210
00300  01  MSG-TABLE.                                                   CHGBD210
00301      05  MSG1-NO-MPRF.                                            CHGBD210
00302          10  MSG1-ID.                                             CHGBD210
00303              15  MSG1-ID1      PIC X(08)  VALUE 'CHGBD210'.       CHGBD210
00304              15  MSG1-ID2      PIC X(03)  VALUE '210'.            CHGBD210
00305          10  MSG1-SHORT-TEXT   PIC X(20)                          CHGBD210
00306                    VALUE 'EMP NOT ON FILE  :  '.                  CHGBD210
00307          10  MSG1-LONG-TEXT.                                      CHGBD210
00308              15  FILLER        PIC X(29)                          CHGBD210
00309                    VALUE 'EMPLOYER NOT ON MASTER FILE  '.         CHGBD210
00310              15  FILLER        PIC X(32)  VALUE SPACES.           CHGBD210
00311                                                                   CHGBD210
00312      05  MSG2-NOT-LIABLE.                                         CHGBD210
00313          10  MSG2-ID.                                             CHGBD210
00314              15  MSG2-ID1      PIC X(08)  VALUE 'CHGBD210'.       CHGBD210
00315              15  MSG2-ID2      PIC X(03)  VALUE '210'.            CHGBD210
00316          10  MSG2-SHORT-TEXT   PIC X(20)                          CHGBD210
00317                    VALUE 'EMP NOT LIABLE   :  '.                  CHGBD210
00318          10  MSG2-LONG-TEXT.                                      CHGBD210
00319              15  FILLER        PIC X(29)                          CHGBD210
00320                    VALUE 'EMPLOYER IS NOT LIABLE       '.         CHGBD210
00321              15  FILLER        PIC X(32)  VALUE SPACES.           CHGBD210
00322                                                                   CHGBD210
00323      05  MSG4-PRINTING-TURNED-OFF.                                CHGBD210
00324          10  MSG4-ID.                                             CHGBD210
00325              15  MSG4-ID1      PIC X(08)  VALUE 'CHGBD210'.       CHGBD210
00326              15  MSG4-ID2      PIC X(03)  VALUE '210'.            CHGBD210
00327          10  MSG4-SHORT-TEXT   PIC X(20)                          CHGBD210
00328                    VALUE 'CHG STMT PRINT OFF: '.                  CHGBD210
00329          10  MSG4-LONG-TEXT.                                      CHGBD210
00330              15  FILLER        PIC X(36)                          CHGBD210
00331                    VALUE 'CHARGE STATEMENT PRINTING TURNED OFF'.  CHGBD210
00332              15  FILLER        PIC X(25)  VALUE SPACES.           CHGBD210
00333                                                                   CHGBD210
00334      05  MSG5-NO-ADDRESS.                                         CHGBD210
00335          10  MSG5-ID.                                             CHGBD210
00336              15  MSG5-ID1      PIC X(08)  VALUE 'CHGBD210'.       CHGBD210
00337              15  MSG5-ID2      PIC X(03)  VALUE '210'.            CHGBD210
00338          10  MSG5-SHORT-TEXT   PIC X(20)                          CHGBD210
00339                    VALUE 'NO ADDRESS FOUND:   '.                  CHGBD210
00340          10  MSG5-LONG-TEXT.                                      CHGBD210
00341              15  FILLER        PIC X(29)                          CHGBD210
00342                    VALUE 'ADDRESS NOT FOUND            '.         CHGBD210
00343              15  FILLER        PIC X(25)                          CHGBD210
00344                    VALUE '  MPRF EMPLOYER NUMBER = '.             CHGBD210
00345              15  MSG5-EMP-NO   PIC 9(07).                         CHGBD210
00346                                                                   CHGBD210
00347      05  MSG6-INVALID-EMP-NO.                                     CHGBD210
00348          10  MSG6-ID.                                             CHGBD210
00349              15  MSG6-ID1      PIC X(08)  VALUE 'CHGBD210'.       CHGBD210
00350              15  MSG6-ID2      PIC X(03)  VALUE '210'.            CHGBD210
00351          10  MSG6-SHORT-TEXT   PIC X(20)                          CHGBD210
00352                    VALUE 'INVALID EMP NO:     '.                  CHGBD210
00353          10  MSG6-LONG-TEXT.                                      CHGBD210
00354              15  FILLER        PIC X(29)                          CHGBD210
00355                    VALUE 'INVALID EMPLOYER NUMBER: '.             CHGBD210
00356              15  MSG6-EMP-NO   PIC 9(07).                         CHGBD210
00357              15  FILLER        PIC X(25)                          CHGBD210
00358                    VALUE '  EMP TYPE = '.                         CHGBD210
00359              15  MSG6-EMP-TYPE PIC 9(02).                         CHGBD210
00360                                                                   CHGBD210
00361 ** REPORT I-O SKELETAL RECORD                                     CHGBD210
00362  01  RSKL-REC.                                                    CHGBD210
00363  ++INCLUDE DTSIRSK1                                               CHGBD210
00364                                                                   CHGBD210
00365 ** MAILING LABEL RECORD                                           CHGBD210
00366  01  R901-REC.                                                    CHGBD210
00367  ++INCLUDE DTSIR901                                               CHGBD210
00368                                                                   CHGBD210
00369 ** ERROR MSG OUTPUT RECORD                                        CHGBD210
00370  01  R907-REC.                                                    CHGBD210
00371  ++INCLUDE DTSIR907                                               CHGBD210
00372                                                                   CHGBD210
00373  01  L910-LINK-AREA.                                              CHGBD210
00374  ++INCLUDE DTSIL910                                               CHGBD210
00375                                                                   CHGBD210
00376  01  MSKL-REC.                                                    CHGBD210
00377  ++INCLUDE DTSIMSKL                                               CHGBD210
00378                                                                   CHGBD210
00379  01  MHDR-REC.                                                    CHGBD210
00380  ++INCLUDE DTSIMHDR                                               CHGBD210
00381                                                                   CHGBD210
00382  01  MFAE-REC.                                                    CHGBD210
00383  ++INCLUDE DTSIMFAE                                               CHGBD210
00384                                                                   CHGBD210
00385  01  MPRF-REC.                                                    CHGBD210
00386  ++INCLUDE DTSIMPRF                                               CHGBD210
00387                                                                   CHGBD210
00388  01  L921-LINK-AREA.                                              CHGBD210
00389  ++INCLUDE DTSIL921                                               CHGBD210
00390                                                                   CHGBD210
00391  01  ISKL-REC.                                                    CHGBD210
00392  ++INCLUDE DTSIISKL                                               CHGBD210
00393                                                                   CHGBD210
00394  01  L001-LINK-AREA.                                              CHGBD210
00395  ++INCLUDE DTSIL001                                               CHGBD210
00396                                                                   CHGBD210
00397  01  L004-LINK-AREA.                                              CHGBD210
00398  ++INCLUDE DTSIL004                                               CHGBD210
00399                                                                   CHGBD210
00400  01  L081-LINK-AREA.                                              CHGBD210
00401  ++INCLUDE DTSIL081                                               CHGBD210
00402                                                                   CHGBD210
00403  01  L100-LINK-AREA.                                              CHGBD210
00404  ++INCLUDE CHGIL100                                               CHGBD210
00405                                                                   CHGBD210
00406  01  L111-LINK-AREA.                                              CHGBD210
00407  ++INCLUDE DTSIL111                                               CHGBD210
00408                                                                   CHGBD210
00409  01  L112-LINK-AREA.                                              CHGBD210
00410  ++INCLUDE DTSIL112                                               CHGBD210
00411                                                                   CHGBD210
00412      EJECT                                                        CHGBD210
00413  PROCEDURE DIVISION.                                              CHGBD210
00414      SKIP2                                                        CHGBD210
00415  CHGBD210-MAIN.                                                   CHGBD210
00416      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD210
00417      IF WRK-ERROR-YES-88                                          CHGBD210
00418         GO TO CHGBD210-EXIT.                                      CHGBD210
00419                                                                   CHGBD210
00420      PERFORM P0000-PROCESS THRU P0000-EXIT.                       CHGBD210
00421                                                                   CHGBD210
00422      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD210
00423                                                                   CHGBD210
00424  CHGBD210-EXIT.                                                   CHGBD210
00425      STOP RUN.                                                    CHGBD210
00426      EJECT                                                        CHGBD210
00427  I0000-INITIATE.                                                  CHGBD210
00428      SET WRK-ERROR-NO-88 TO TRUE.                                 CHGBD210
00429                                                                   CHGBD210
00430      MOVE LENGTH OF R901-REC TO R901-LENGTH.                      CHGBD210
00431                                                                   CHGBD210
00432      MOVE MSG1-ID1 TO R907-MODULE-NAME.                           CHGBD210
00433      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      CHGBD210
00434                                                                   CHGBD210
00435      PERFORM I1000-OPEN-FILES THRU I1000-EXIT.                    CHGBD210
00436                                                                   CHGBD210
00437                                                                   CHGBD210
00438  I0000-EXIT.                                                      CHGBD210
00439      EXIT.                                                        CHGBD210
00440                                                                   CHGBD210
00441  I1000-OPEN-FILES.                                                CHGBD210
00442      OPEN INPUT CHG-PARM-FILE.                                    CHGBD210
00443      IF NOT CHG-PARM-FILE-OK-88                                   CHGBD210
00444         DISPLAY 'PARM5 FILE OPEN ERROR: ' CHG-PARM-STATUS         CHGBD210
00445         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD210
00446                                                                   CHGBD210
00447      READ CHG-PARM-FILE.                                          CHGBD210
00448      IF NOT CHG-PARM-FILE-OK-88                                   CHGBD210
00449         DISPLAY 'PARM FILE READ ERROR: ' CHG-PARM-STATUS          CHGBD210
00450         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD210
00451                                                                   CHGBD210
00452      OPEN INPUT BD205-CHG-FILE-IN.                                CHGBD210
00453      IF NOT BD205-FILE-OK-88                                      CHGBD210
00454         DISPLAY 'BD205 FILE OPEN ERROR: ' BD205-CHG-STATUS        CHGBD210
00455         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD210
00456                                                                   CHGBD210
00457      OPEN OUTPUT BD210-CHG-FILE-OUT.                              CHGBD210
00458      IF NOT BD210-FILE-OK-88                                      CHGBD210
00459         DISPLAY 'BD210 FILE OPEN ERROR: ' BD210-CHG-STATUS        CHGBD210
00460         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD210
00461                                                                   CHGBD210
00462      OPEN INPUT DC-WAGE-FILE.                                     CHGBD210
00463      IF NOT DC-WAGE-FILE-OK-88                                    CHGBD210
00464         DISPLAY 'DC WAGE FILE OPEN ERROR: ' DC-WAGE-STATUS        CHGBD210
00465         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD210
00466                                                                   CHGBD210
00467      PERFORM S910-OPEN-READ THRU S910-EXIT.                       CHGBD210
00468                                                                   CHGBD210
00469      PERFORM S921-OPEN-READ THRU S921-EXIT.                       CHGBD210
00470                                                                   CHGBD210
00471  I1000-EXIT.                                                      CHGBD210
00472      EXIT.                                                        CHGBD210
00473                                                                   CHGBD210
00474  P0000-PROCESS.                                                   CHGBD210
00475      PERFORM P1000-READ-CHARGES THRU P1000-EXIT                   CHGBD210
00476         UNTIL BD205-FILE-EOF-88                                   CHGBD210
00477         OR    WRK-ERROR-YES-88.                                   CHGBD210
00478                                                                   CHGBD210
00479  P0000-EXIT.                                                      CHGBD210
00480      EXIT.                                                        CHGBD210
00481                                                                   CHGBD210
00482  P1000-READ-CHARGES.                                              CHGBD210
00483      READ BD205-CHG-FILE-IN.                                      CHGBD210
00484                                                                   CHGBD210
00485      IF BD205-FILE-EOF-88                                         CHGBD210
00486         GO TO P1000-EXIT                                          CHGBD210
00487      ELSE                                                         CHGBD210
00488         IF NOT BD205-FILE-OK-88                                   CHGBD210
00489            DISPLAY 'BD205 FILE READ ERROR: ' BD205-CHG-STATUS     CHGBD210
00490            SET WRK-ERROR-YES-88 TO TRUE                           CHGBD210
00491            GO TO P1000-EXIT.                                      CHGBD210
00492                                                                   CHGBD210
00493      ADD 1 TO WRK-BD205-CHG-READ.                                 CHGBD210
00494                                                                   CHGBD210
00495                                                                   CHGBD210
00496      MOVE CHG2-SSN TO WRK-KEY.                                    CHGBD210
00497      IF WRK-SSN = 162564856                                          CL**8
00498         MOVE CHG2-CHARGE-DATE TO WRK-DATE                         CHGBD210
00499         MOVE CHG2-EMP-NO TO WRK-EMP-DISP                          CHGBD210
00500         MOVE CHG2-SSN    TO WRK-SSN-DISP                          CHGBD210
00501         COMPUTE WRK-CHG-AMT-DISP =                                CHGBD210
00502            CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT                  CHGBD210
00503         DISPLAY 'P1000 ' WRK-DISP-AREA.                           CHGBD210
00504                                                                   CHGBD210
00505                                                                   CHGBD210
00506      IF CHG2-EMP-NO = WRK-DC-GOV-ACCT                             CHGBD210
00507         ADD +1 TO WRK-DC-GOV-INPUT-CNT                            CHGBD210
00508         SET WRK-REC-SELECTED-NO-88    TO TRUE                     CHGBD210
00509         PERFORM P4000-SELECT          THRU P4000-EXIT             CHGBD210
00510         IF WRK-REC-SELECTED-YES-88                                CHGBD210
00511            PERFORM P6000-DC-CHARGES   THRU P6000-EXIT             CHGBD210
00512            GO TO P1000-EXIT                                       CHGBD210
00513         ELSE                                                      CHGBD210
00514            ADD +1    TO WRK-BD205-NOT-SELECTED                    CHGBD210
00515            GO TO P1000-EXIT                                       CHGBD210
00516         END-IF                                                    CHGBD210
00517      ELSE                                                         CHGBD210
00518         IF CHG2-EMP-NO NOT = WRK-LAST-EMP-CHECKED                 CHGBD210
00519            PERFORM P2000-EDIT-EMP        THRU P2000-EXIT          CHGBD210
00520         ELSE                                                      CHGBD210
00521            PERFORM P3000-UPDATE-EMP-DATA THRU P3000-EXIT.         CHGBD210
00522                                                                   CHGBD210
00523      IF WRK-EMP-VALID-NO-88                                       CHGBD210
00524         ADD +1 TO WRK-BD205-CHG-DELETE                            CHGBD210
00525         GO TO P1000-EXIT.                                         CHGBD210
00526                                                                   CHGBD210
00527      SET WRK-REC-SELECTED-NO-88 TO TRUE.                          CHGBD210
00528      PERFORM P4000-SELECT              THRU P4000-EXIT.           CHGBD210
00529                                                                   CHGBD210
00530      IF WRK-REC-SELECTED-YES-88                                   CHGBD210
00531         PERFORM P5000-BUILD-CHG4-REC   THRU P5000-EXIT            CHGBD210
00532         PERFORM S1100-WRITE-BD210  THRU S1100-EXIT                CHGBD210
00533      ELSE                                                         CHGBD210
00534         ADD +1    TO WRK-BD205-NOT-SELECTED.                      CHGBD210
00535                                                                   CHGBD210
00536  P1000-EXIT.                                                      CHGBD210
00537      EXIT.                                                        CHGBD210
00538                                                                   CHGBD210
00539  P2000-EDIT-EMP.                                                  CHGBD210
00540      MOVE CHG2-EMP-NO            TO WRK-LAST-EMP-CHECKED.         CHGBD210
00541                                                                   CHGBD210
00542      PERFORM P2100-CHECK-STATUS  THRU P2100-EXIT.                 CHGBD210
00543      IF L100-NO-REC-FOUND-88                                      CHGBD210
00544         PERFORM P2010-NO-EMP-ERR THRU P2010-EXIT                  CHGBD210
00545         GO TO P2000-EXIT                                          CHGBD210
00546      ELSE                                                         CHGBD210
00547         IF WRK-EMP-VALID-NO-88                                    CHGBD210
00548            GO TO P2000-EXIT.                                      CHGBD210
00549                                                                   CHGBD210
00550      PERFORM P2300-GET-ADDRESS  THRU P2300-EXIT.                  CHGBD210
00551                                                                   CHGBD210
00552  P2000-EXIT.                                                      CHGBD210
00553      EXIT.                                                        CHGBD210
00554                                                                   CHGBD210
00555  P2010-NO-EMP-ERR.                                                CHGBD210
00556      MOVE MSG1-ID2               TO R907-MSG-ID.                  CHGBD210
00557      MOVE CHG2-EMP-NO            TO R907-EMP-NO.                  CHGBD210
00558      MOVE MSG1-LONG-TEXT         TO R907-MSG-TEXT.                CHGBD210
00559      MOVE R907-REC               TO RSKL-REC.                     CHGBD210
00560      PERFORM S946-RPT-REC-O      THRU S946-EXIT.                  CHGBD210
00561                                                                   CHGBD210
00562  P2010-EXIT.                                                      CHGBD210
00563      EXIT.                                                        CHGBD210
00564                                                                   CHGBD210
00565  P2100-CHECK-STATUS.                                              CHGBD210
00566      SET WRK-EMP-VALID-NO-88           TO TRUE.                   CHGBD210
00567      SET WRK-FISC-AG-NONE-88           TO TRUE.                   CHGBD210
00568      MOVE CHG2-EMP-NO                  TO L100-EMP-NO.            CHGBD210
00569      PERFORM S100-CALL-CHGBU100        THRU S100-EXIT.            CHGBD210
00570      IF L100-OK-88                                                CHGBD210
00571         IF L100-NOT-LIABLE-88                                     CHGBD210
00572            ADD 1                     TO WRK-BD205-NOT-LIAB-CNT    CHGBD210
00573         ELSE                                                      CHGBD210
00574            MOVE L100-EMP-TYPE          TO CHG2-EMP-TYPE           CHGBD210
00575            MOVE L100-FISCAL-AGENT-CD   TO WRK-FISCAL-AGENT-CD     CHGBD210
00576            SET WRK-EMP-VALID-YES-88    TO TRUE                    CHGBD210
00577         END-IF                                                    CHGBD210
00578      ELSE                                                         CHGBD210
00579         SET WRK-EMP-VALID-NO-88        TO TRUE                    CHGBD210
00580         PERFORM P2110-INVALID-EMP      THRU P2110-EXIT            CHGBD210
00581      END-IF.                                                      CHGBD210
00582                                                                   CHGBD210
00583 *    IF CHG2-EMP-TYPE-UCX-88                                      CHGBD210
00584 *    OR CHG2-EMP-TYPE-UCFE-88                                     CHGBD210
00585 *       PERFORM P2120-CHG-TRANSFER     THRU P2120-EXIT            CHGBD210
00586 *    END-IF.                                                      CHGBD210
00587                                                                   CHGBD210
00588  P2100-EXIT.                                                      CHGBD210
00589      EXIT.                                                        CHGBD210
00590                                                                   CHGBD210
00591  P2110-INVALID-EMP.                                               CHGBD210
00592      MOVE MSG6-ID2               TO R907-MSG-ID.                  CHGBD210
00593      MOVE CHG2-EMP-NO            TO R907-EMP-NO                   CHGBD210
00594                                     MSG6-EMP-NO.                  CHGBD210
00595      MOVE CHG2-EMP-TYPE          TO MSG6-EMP-TYPE.                CHGBD210
00596      MOVE MSG6-LONG-TEXT         TO R907-MSG-TEXT.                CHGBD210
00597      MOVE R907-REC               TO RSKL-REC.                     CHGBD210
00598      PERFORM S946-RPT-REC-O      THRU S946-EXIT.                  CHGBD210
00599                                                                   CHGBD210
00600  P2110-EXIT.                                                      CHGBD210
00601      EXIT.                                                        CHGBD210
00602                                                                   CHGBD210
00603 *P2120-CHG-TRANSFER.                                              CHGBD210
00604 *    IF CHG2-EMP-NO = 000467 OR 000579                            CHGBD210
00605 *       DISPLAY 'P2120 - 1 ' CHG2-EMP-NO                          CHGBD210
00606 *    END-IF.                                                      CHGBD210
00607 *                                                                 CHGBD210
00608 *    EVALUATE TRUE                                                CHGBD210
00609 *      WHEN CHG2-EMP-NO = 000467                                  CHGBD210
00610 *        MOVE 000380                 TO CHG2-EMP-NO               CHGBD210
00611 *                                                                 CHGBD210
00612 *      WHEN CHG2-EMP-NO = 000579                                  CHGBD210
00613 *        MOVE 000380                 TO CHG2-EMP-NO               CHGBD210
00614 *                                                                 CHGBD210
00615 *    END-EVALUATE.                                                CHGBD210
00616 *                                                                 CHGBD210
00617 *    IF CHG2-EMP-NO = 000380                                      CHGBD210
00618 *       DISPLAY 'P2120 - 2 ' CHG2-EMP-NO                          CHGBD210
00619 *    END-IF.                                                      CHGBD210
00620 *P2120-EXIT.                                                      CHGBD210
00621 *    EXIT.                                                        CHGBD210
00622                                                                   CHGBD210
00623                                                                   CHGBD210
00624  P2300-GET-ADDRESS.                                               CHGBD210
00625      PERFORM P2320-FIND-ADDRESS      THRU P2320-EXIT              CHGBD210
00626      IF WRK-EMP-VALID-YES-88                                      CHGBD210
00627         PERFORM P2330-FORMAT-ADDRESS THRU P2330-EXIT.             CHGBD210
00628                                                                   CHGBD210
00629  P2300-EXIT.                                                      CHGBD210
00630      EXIT.                                                        CHGBD210
00631                                                                   CHGBD210
00632                                                                   CHGBD210
00633  P2320-FIND-ADDRESS.                                              CHGBD210
00634      MOVE CHG2-EMP-NO                TO L111-EMP-NO.              CHGBD210
00635      SET L111-LOOKUP-BAA-88          TO TRUE.                     CHGBD210
00636      SET L111-ID-NO-BAA-PRIM-88      TO TRUE.                     CHGBD210
00637      PERFORM S111-LOOKUP-ADDRESS     THRU S111-EXIT.              CHGBD210
00638      IF L111-ADDR-NOT-FOUND-88                                    CHGBD210
00639         SET L111-LOOKUP-TAD-88       TO TRUE                      CHGBD210
00640         SET L111-ID-NO-TAD-MAIL-88   TO TRUE                      CHGBD210
00641         PERFORM S111-LOOKUP-ADDRESS  THRU S111-EXIT               CHGBD210
00642         IF L111-ADDR-NOT-FOUND-88                                 CHGBD210
00643            SET WRK-EMP-VALID-NO-88   TO TRUE                      CHGBD210
00644            MOVE MSG5-ID2             TO R907-MSG-ID               CHGBD210
00645            MOVE CHG2-EMP-NO          TO MSG5-EMP-NO               CHGBD210
00646                                         R907-EMP-NO               CHGBD210
00647            MOVE MSG5-LONG-TEXT       TO R907-MSG-TEXT             CHGBD210
00648            MOVE R907-REC             TO RSKL-REC                  CHGBD210
00649            PERFORM S946-RPT-REC-O    THRU S946-EXIT               CHGBD210
00650         END-IF                                                    CHGBD210
00651       ELSE                                                        CHGBD210
00652         DISPLAY ' BUSINESS ADDRESS FOUND - ' CHG2-EMP-NO          CHGBD210
00653      END-IF.                                                      CHGBD210
00654                                                                   CHGBD210
00655  P2320-EXIT.                                                      CHGBD210
00656      EXIT.                                                        CHGBD210
00657                                                                   CHGBD210
00658  P2330-FORMAT-ADDRESS.                                            CHGBD210
00659      SET L112-TAD-ADDR-88         TO TRUE.                        CHGBD210
00660      SET L112-ANCHOR-LAST-88      TO TRUE.                        CHGBD210
00661      MOVE L111-RETURN-AREA        TO L112-NAME-ADDRESS-AREA.      CHGBD210
00662      MOVE L100-PRIMARY-NAME       TO L112-PRIMARY-NAME            CHGBD210
00663                                      WRK-EMP-NAME-CHK.            CHGBD210
00664      PERFORM S112-FORMAT-ADDRESS  THRU S112-EXIT.                 CHGBD210
00665                                                                   CHGBD210
00666      MOVE L112-MAILING-ADDRESS    TO WRK-FMT-ADDR.                CHGBD210
00667      MOVE L111-ZIP                TO WRK-ZIP.                     CHGBD210
00668      MOVE L111-ADVANCED-BARCODE   TO WRK-ADVANCED-BARCODE.        CHGBD210
00669                                                                   CHGBD210
00670  P2330-EXIT.                                                      CHGBD210
00671      EXIT.                                                        CHGBD210
00672                                                                   CHGBD210
00673  P3000-UPDATE-EMP-DATA.                                           CHGBD210
00674      MOVE L100-EMP-TYPE          TO CHG2-EMP-TYPE.                CHGBD210
00675      MOVE L100-FISCAL-AGENT-CD   TO WRK-FISCAL-AGENT-CD.          CHGBD210
00676                                                                   CHGBD210
00677  P3000-EXIT.                                                      CHGBD210
00678      EXIT.                                                        CHGBD210
00679                                                                   CHGBD210
00680  P4000-SELECT.                                                    CHGBD210
00681      DISPLAY 'P4000 CHG3 RUN TYPE: ' CHG3-RUN-TYPE.                  CL**9
00682      EVALUATE TRUE                                                CHGBD210
00683         WHEN CHG3-RUN-TYPE-EMP-88                                 CHGBD210
00684            PERFORM P4100-SELECT-BY-EMP        THRU P4100-EXIT     CHGBD210
00685                                                                   CHGBD210
00686         WHEN CHG3-RUN-TYPE-MON-EMP-88                             CHGBD210
00687            PERFORM P4100-SELECT-BY-EMP        THRU P4100-EXIT     CHGBD210
00688                                                                   CHGBD210
00689         WHEN CHG3-RUN-TYPE-WK-EMP-88                              CHGBD210
00690            PERFORM P4100-SELECT-BY-EMP        THRU P4100-EXIT     CHGBD210
00691                                                                   CHGBD210
00692         WHEN CHG3-RUN-TYPE-RPTS-88                                CHGBD210
00693            PERFORM P4200-SELECT-BY-RPT        THRU P4200-EXIT     CHGBD210
00694                                                                   CHGBD210
00695         WHEN CHG3-RUN-TYPE-TEUC-88                                CHGBD210
00696            PERFORM P4200-SELECT-BY-RPT        THRU P4200-EXIT     CHGBD210
00697                                                                   CHGBD210
00698         WHEN CHG3-RUN-TYPE-QTR-88                                 CHGBD210
00699            PERFORM P4300-SELECT-QTR           THRU P4300-EXIT     CHGBD210
00700                                                                   CHGBD210
00701         WHEN CHG3-RUN-TYPE-ANNUAL-88                              CHGBD210
00702            PERFORM P4400-SELECT-ANNUAL        THRU P4400-EXIT     CHGBD210
00703                                                                   CHGBD210
00704         WHEN CHG3-RUN-TYPE-AGENT-88                               CHGBD210
00705             PERFORM P4500-SELECT-AGENTS       THRU P4500-EXIT     CHGBD210
00706                                                                      CL**6
00707         WHEN CHG3-RUN-TYPE-FPUC-88                                   CL**6
00708            PERFORM P4200-SELECT-BY-RPT        THRU P4200-EXIT        CL**6
00709                                                                   CHGBD210
00710      END-EVALUATE.                                                CHGBD210
00711                                                                   CHGBD210
00712  P4000-EXIT.                                                      CHGBD210
00713      EXIT.                                                        CHGBD210
00714                                                                   CHGBD210
00715  P4100-SELECT-BY-EMP.                                             CHGBD210
00716      DISPLAY 'P4100 CHG2-EMP: ' CHG2-EMP-NO                          CL**8
00717      DISPLAY 'P4100 CHG3-EMP: ' CHG3-EMP-NO                          CL**8
00718      IF CHG2-EMP-NO = CHG3-EMP-NO                                    CL**8
00719         SET WRK-REC-SELECTED-YES-88 TO TRUE                       CHGBD210
00720      END-IF.                                                      CHGBD210
00721                                                                   CHGBD210
00722  P4100-EXIT.                                                      CHGBD210
00723      EXIT.                                                        CHGBD210
00724                                                                   CHGBD210
00725  P4200-SELECT-BY-RPT.                                             CHGBD210
00726      MOVE CHG2-EMP-TYPE      TO WRK-RPT-TYPE.                     CHGBD210
00727                                                                   CHGBD210
00728      IF (CHG3-RPT-TYPE-RATED-88                                   CHGBD210
00729      AND WRK-RPT-TYPE-RATED-88)                                   CHGBD210
00730         SET WRK-REC-SELECTED-YES-88 TO TRUE                       CHGBD210
00731      ELSE                                                         CHGBD210
00732         IF (CHG3-RPT-TYPE-FED-88                                  CHGBD210
00733         AND WRK-RPT-TYPE-FED-88)                                  CHGBD210
00734            SET WRK-REC-SELECTED-YES-88 TO TRUE                    CHGBD210
00735         ELSE                                                      CHGBD210
00736            IF (CHG3-RPT-TYPE-CWC-88                               CHGBD210
00737            AND WRK-RPT-TYPE-CWC-88)                               CHGBD210
00738               SET WRK-REC-SELECTED-YES-88 TO TRUE                 CHGBD210
00739            ELSE                                                   CHGBD210
00740               IF (CHG3-RPT-TYPE-SELF-INS-88                       CHGBD210
00741               AND WRK-RPT-TYPE-SELF-INS-88)                       CHGBD210
00742                  SET WRK-REC-SELECTED-YES-88 TO TRUE              CHGBD210
00743               ELSE                                                CHGBD210
00744                  IF (CHG3-RPT-TYPE-TEUC-88                        CHGBD210
00745                  AND WRK-RPT-TYPE-TEUC-88)                        CHGBD210
00746                     SET WRK-REC-SELECTED-YES-88 TO TRUE           CHGBD210
00747                  ELSE                                             CHGBD210
00748                     IF (CHG3-RPT-TYPE-DC-88                       CHGBD210
00749                     AND WRK-RPT-TYPE-DC-88)                       CHGBD210
00750                        SET WRK-REC-SELECTED-YES-88 TO TRUE           CL**4
00751               ELSE                                                   CL**4
00752                  IF (CHG3-RPT-TYPE-FPUC-88                           CL**4
00753                  AND WRK-RPT-TYPE-FPUC-88)                           CL**4
00754                     SET WRK-REC-SELECTED-YES-88 TO TRUE.             CL**4
00755                                                                   CHGBD210
00756  P4200-EXIT.                                                      CHGBD210
00757      EXIT.                                                        CHGBD210
00758                                                                   CHGBD210
00759  P4300-SELECT-QTR.                                                CHGBD210
00760      MOVE CHG2-EMP-TYPE      TO WRK-RPT-TYPE.                     CHGBD210
00761                                                                   CHGBD210
00762      IF (WRK-RPT-TYPE-RATED-88                                    CHGBD210
00763      OR  WRK-RPT-TYPE-FED-88                                      CHGBD210
00764      OR  WRK-RPT-TYPE-CWC-88                                      CHGBD210
00765      OR  WRK-RPT-TYPE-SELF-INS-88                                 CHGBD210
00766      OR  WRK-RPT-TYPE-DC-88                                          CL**5
00767      OR  WRK-RPT-TYPE-FPUC-88)                                       CL**4
00768         SET WRK-REC-SELECTED-YES-88 TO TRUE.                      CHGBD210
00769                                                                   CHGBD210
00770  P4300-EXIT.                                                      CHGBD210
00771      EXIT.                                                        CHGBD210
00772                                                                   CHGBD210
00773  P4400-SELECT-ANNUAL.                                             CHGBD210
00774      MOVE CHG2-EMP-TYPE      TO WRK-RPT-TYPE.                     CHGBD210
00775                                                                   CHGBD210
00776      IF WRK-RPT-TYPE-RATED-88                                     CHGBD210
00777         IF CHG3-RUN-TYPE-ANN-EMP-88                               CHGBD210
00778            PERFORM P4410-SELECT-EMP  THRU P4410-EXIT              CHGBD210
00779         ELSE                                                      CHGBD210
00780            SET WRK-REC-SELECTED-YES-88 TO TRUE.                   CHGBD210
00781                                                                   CHGBD210
00782  P4400-EXIT.                                                      CHGBD210
00783      EXIT.                                                        CHGBD210
00784                                                                   CHGBD210
00785  P4410-SELECT-EMP.                                                CHGBD210
00786      DISPLAY 'P4410 CHG2-EMP: ' CHG2-EMP-NO                          CL**8
00787      DISPLAY 'P4410 CHG3-EMP: ' CHG3-EMP-NO                          CL**8
00788      IF CHG2-EMP-NO = CHG3-EMP-NO                                    CL**8
00789         SET WRK-REC-SELECTED-YES-88 TO TRUE.                      CHGBD210
00790                                                                   CHGBD210
00791  P4410-EXIT.                                                      CHGBD210
00792      EXIT.                                                        CHGBD210
00793                                                                   CHGBD210
00794  P4500-SELECT-AGENTS.                                             CHGBD210
00795      MOVE CHG2-EMP-TYPE      TO WRK-RPT-TYPE.                     CHGBD210
00796                                                                   CHGBD210
00797      IF WRK-RPT-TYPE-RATED-88                                     CHGBD210
00798         SET WRK-REC-SELECTED-YES-88 TO TRUE.                      CHGBD210
00799                                                                   CHGBD210
00800  P4500-EXIT.                                                      CHGBD210
00801      EXIT.                                                        CHGBD210
00802                                                                   CHGBD210
00803  P5000-BUILD-CHG4-REC.                                            CHGBD210
00804 **   IF CHG2-EMP-NO = 000467 OR 000579                            CHGBD210
00805 *       DISPLAY 'P5000 - 1 ' CHG2-EMP-NO                          CHGBD210
00806 **   END-IF.                                                      CHGBD210
00807                                                                   CHGBD210
00808 *&                                                                CHGBD210
00809      COMPUTE WRK-TOT-CHG = WRK-TOT-CHG                            CHGBD210
00810      + CHG2-CURR-BEN-AMT                                          CHGBD210
00811      + CHG2-CURR-ADJ-AMT.                                         CHGBD210
00812 *&                                                                CHGBD210
00813      MOVE CHG2-EMP-TYPE           TO WRK-RPT-TYPE.                CHGBD210
00814                                                                   CHGBD210
00815      EVALUATE TRUE                                                CHGBD210
00816         WHEN WRK-RPT-TYPE-RATED-88                                CHGBD210
00817            MOVE '1'                  TO CHG4-REPORT-TYPE          CHGBD210
00818                                                                   CHGBD210
00819         WHEN WRK-RPT-TYPE-SELF-INS-88                             CHGBD210
00820            MOVE '2'                  TO CHG4-REPORT-TYPE          CHGBD210
00821                                                                   CHGBD210
00822         WHEN WRK-RPT-TYPE-FED-88                                  CHGBD210
00823            MOVE '4'                  TO CHG4-REPORT-TYPE          CHGBD210
00824                                                                   CHGBD210
00825         WHEN WRK-RPT-TYPE-TEUC-88                                 CHGBD210
00826            MOVE '5'                  TO CHG4-REPORT-TYPE          CHGBD210
00827                                                                   CHGBD210
00828         WHEN WRK-RPT-TYPE-CWC-88                                  CHGBD210
00829            MOVE '3'                  TO CHG4-REPORT-TYPE          CHGBD210
00830                                                                   CHGBD210
00831         WHEN WRK-RPT-TYPE-DC-88                                   CHGBD210
00832            MOVE '6'                  TO CHG4-REPORT-TYPE          CHGBD210
00833                                                                      CL**4
00834         WHEN WRK-RPT-TYPE-FPUC-88                                    CL**4
00835            MOVE '7'                  TO CHG4-REPORT-TYPE             CL**4
00836                                                                   CHGBD210
00837      END-EVALUATE.                                                CHGBD210
00838                                                                   CHGBD210
00839      MOVE CHG2-EMP-NO             TO CHG4-EMP-NO.                 CHGBD210
00840                                                                   CHGBD210
00841      EVALUATE TRUE                                                CHGBD210
00842        WHEN CHG4-EMP-NO = 000467                                  CHGBD210
00843          MOVE 000380                 TO CHG4-EMP-NO               CHGBD210
00844                                                                   CHGBD210
00845        WHEN CHG4-EMP-NO = 000579                                  CHGBD210
00846          MOVE 000380                 TO CHG4-EMP-NO               CHGBD210
00847                                                                   CHGBD210
00848        WHEN CHG4-EMP-NO = 000012                                  CHGBD210
00849          MOVE 000030                 TO CHG4-EMP-NO               CHGBD210
00850                                                                   CHGBD210
00851        WHEN CHG4-EMP-NO = 000913                                  CHGBD210
00852          MOVE 000914                 TO CHG4-EMP-NO               CHGBD210
00853                                                                   CHGBD210
00854      END-EVALUATE.                                                CHGBD210
00855                                                                   CHGBD210
00856      IF CHG2-EMP-NO = 005029                                         CL**6
00857         DISPLAY 'P5000 - 2 ' CHG2-EMP-NO                             CL**6
00858      END-IF.                                                         CL**6
00859                                                                      CL**6
00860      MOVE CHG2-SSN                TO WRK-KEY.                     CHGBD210
00861      MOVE WRK-SSN                 TO CHG4-SSN.                    CHGBD210
00862      MOVE CHG2-BYE                TO CHG4-BYE.                    CHGBD210
00863      MOVE CHG2-PROGRAM            TO CHG4-PROGRAM.                CHGBD210
00864                                                                   CHGBD210
00865      MOVE WRK-SSN                 TO L081-CLAIMANT-SSN.           CHGBD210
00866      PERFORM S081-CLAIMANT-NAME   THRU S081-EXIT.                 CHGBD210
00867 *    DISPLAY ' S081 RETURN CODE ' L081-RESULT-IND                 CHGBD210
00868 *    DISPLAY ' S081 MSG AREA    ' L081-MSG-AREA                   CHGBD210
00869 *    DISPLAY ' S081 NAME        ' L081-CLAIMANT-NAME              CHGBD210
00870      IF L081-NAME-FOUND                                           CHGBD210
00871         MOVE L081-CLAIMANT-NAME   TO CHG4-CLMNT-NAME              CHGBD210
00872      ELSE                                                         CHGBD210
00873         PERFORM S083-IB6-CLMNT-NAME  THRU S083-EXIT               CHGBD210
00874 *    DISPLAY ' S083 RETURN CODE ' L081-RESULT-IND                 CHGBD210
00875 *    DISPLAY ' S083 MSG AREA    ' L081-MSG-AREA                   CHGBD210
00876 *    DISPLAY ' S083 NAME        ' L081-CLAIMANT-NAME              CHGBD210
00877         MOVE L081-CLAIMANT-NAME   TO CHG4-CLMNT-NAME.             CHGBD210
00878                                                                   CHGBD210
00879      MOVE CHG2-EMP-TYPE           TO CHG4-EMP-TYPE.               CHGBD210
00880      MOVE CHG2-CURR-BEN-AMT       TO CHG4-CURR-BEN-AMT.           CHGBD210
00881      MOVE CHG2-CURR-ADJ-AMT       TO CHG4-CURR-ADJ-AMT.           CHGBD210
00882      MOVE CHG2-TOT-BEN-AMT        TO CHG4-TOT-BEN-AMT.            CHGBD210
00883      MOVE CHG2-TOT-ADJ-AMT        TO CHG4-TOT-ADJ-AMT.            CHGBD210
00884      MOVE CHG2-OP-RECOVER-AMT     TO CHG4-OP-RECOVER-AMT.         CHGBD210
00885      MOVE CHG2-OP-RECOVER-AMT     TO CHG4-OP-RECOVER-AMT.         CHGBD210
00886                                                                   CHGBD210
00887      MOVE WRK-FISCAL-AGENT-CD     TO CHG4-FISCAL-AGENT-CD.        CHGBD210
00888      MOVE WRK-FMT-ADDR            TO CHG4-FMT-ADDR.               CHGBD210
00889      MOVE WRK-ZIP                 TO CHG4-ZIP.                    CHGBD210
00890      MOVE WRK-ADVANCED-BARCODE    TO CHG4-ADVANCED-BARCODE.       CHGBD210
00891      MOVE WRK-EMP-NAME-CHK        TO CHG4-EMP-NAME-CHK.           CHGBD210
00892                                                                   CHGBD210
00893      MOVE ZERO                    TO CHG4-SUCC-EMP-NO             CHGBD210
00894                                      CHG4-PRED-EMP-NO             CHGBD210
00895                                      CHG4-PERCENT-XFER.           CHGBD210
00896                                                                   CHGBD210
00897      MOVE SPACE                   TO CHG4-DATA-FILLER.            CHGBD210
00898                                                                   CHGBD210
00899 *&                                                                CHGBD210
00900 *    MOVE CHG2-SSN TO WRK-KEY.                                    CHGBD210
00901 *    IF WRK-SSN = 220947300                                       CHGBD210
00902 *       MOVE CHG2-CHARGE-DATE TO WRK-DATE                         CHGBD210
00903 *       MOVE CHG2-EMP-NO TO WRK-EMP-DISP                          CHGBD210
00904 *       MOVE CHG2-SSN    TO WRK-SSN-DISP                          CHGBD210
00905 *       COMPUTE WRK-CHG-AMT-DISP =                                CHGBD210
00906 *          CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT                  CHGBD210
00907 *       DISPLAY 'P5000 ' WRK-DISP-AREA.                           CHGBD210
00908 *&                                                                CHGBD210
00909  P5000-EXIT.                                                      CHGBD210
00910      EXIT.                                                        CHGBD210
00911                                                                   CHGBD210
00912  P6000-DC-CHARGES.                                                CHGBD210
00913      SET WRK-DEFAULT-DC-ACCT-NO-88      TO TRUE.                  CHGBD210
00914                                                                   CHGBD210
00915      MOVE CHG2-SSN                      TO WRK-KEY.               CHGBD210
00916      IF WRK-SSN = WRK-LAST-DC-SSN                                 CHGBD210
00917         PERFORM P6300-ALLOCATE-CHARGES  THRU P6300-EXIT           CHGBD210
00918      ELSE                                                         CHGBD210
00919         PERFORM P6100-CALC-BASE-PERIOD  THRU P6100-EXIT           CHGBD210
00920         PERFORM P6200-BUILD-DC-TABLE    THRU P6200-EXIT           CHGBD210
00921         PERFORM P6300-ALLOCATE-CHARGES  THRU P6300-EXIT           CHGBD210
00922      END-IF.                                                      CHGBD210
00923                                                                   CHGBD210
00924  P6000-EXIT.                                                      CHGBD210
00925      EXIT.                                                        CHGBD210
00926                                                                   CHGBD210
00927  P6100-CALC-BASE-PERIOD.                                          CHGBD210
00928      MOVE CHG2-BYE               TO L001-FED-8-DATE-9.            CHGBD210
00929      PERFORM S001-FROM-FED-8     THRU S001-EXIT.                  CHGBD210
00930      IF L001-INVALID-DATE                                         CHGBD210
00931         SET WRK-DEFAULT-DC-ACCT-YES-88  TO TRUE                   CHGBD210
00932         GO TO P6100-EXIT                                          CHGBD210
00933      ELSE                                                         CHGBD210
00934         SUBTRACT +363            FROM L001-JUL-ABS-DAY            CHGBD210
00935         PERFORM S001-FROM-ABS    THRU S001-EXIT                   CHGBD210
00936         IF NOT L001-SATURDAY                                      CHGBD210
00937            SUBTRACT +1           FROM L001-JUL-ABS-DAY            CHGBD210
00938            PERFORM S001-FROM-ABS THRU S001-EXIT                   CHGBD210
00939         END-IF                                                    CHGBD210
00940      END-IF.                                                      CHGBD210
00941                                                                   CHGBD210
00942 *  NOTE: THIS PROCESS IGNORES LAG QUARTER WAGES                   CHGBD210
00943 *        USED IN ALTERNATE BASE CLAIMS                            CHGBD210
00944      MOVE L001-FED-8-DATE-9   TO L004-DATE.                       CHGBD210
00945      PERFORM S004-FROM-DATE   THRU S004-EXIT.                     CHGBD210
00946      SUBTRACT +3 FROM L004-ABS-QTR.                               CHGBD210
00947      PERFORM S004-FROM-ABS    THRU S004-EXIT.                     CHGBD210
00948      MOVE L004-QTR-5-9        TO WRK-BP-END.                      CHGBD210
00949      SUBTRACT +2 FROM L004-ABS-QTR.                               CHGBD210
00950      PERFORM S004-FROM-ABS    THRU S004-EXIT.                     CHGBD210
00951      MOVE L004-QTR-5-9        TO WRK-BP-START.                    CHGBD210
00952                                                                   CHGBD210
00953  P6100-EXIT.                                                      CHGBD210
00954      EXIT.                                                        CHGBD210
00955                                                                   CHGBD210
00956  P6200-BUILD-DC-TABLE.                                            CHGBD210
00957      PERFORM P6210-INIT-TABLE  THRU P6210-EXIT.                   CHGBD210
00958                                                                   CHGBD210
00959      IF WRK-DEFAULT-DC-ACCT-YES-88                                CHGBD210
00960         PERFORM P6220-DEFAULT-ACCT  THRU P6220-EXIT               CHGBD210
00961         GO TO P6200-EXIT.                                         CHGBD210
00962                                                                   CHGBD210
00963      MOVE WRK-SSN       TO CHG10-SSN                              CHGBD210
00964                            WRK-LAST-DC-SSN.                       CHGBD210
00965      MOVE WRK-BP-START  TO CHG10-YRQ.                             CHGBD210
00966      MOVE SPACES        TO CHG10-DC-AGENCY-CD.                    CHGBD210
00967      START DC-WAGE-FILE                                           CHGBD210
00968         KEY IS >= CHG10-KEY-AREA.                                 CHGBD210
00969                                                                   CHGBD210
00970      IF NOT DC-WAGE-FILE-OK-88                                    CHGBD210
00971         PERFORM P6220-DEFAULT-ACCT  THRU P6220-EXIT               CHGBD210
00972         GO TO P6200-EXIT                                          CHGBD210
00973      ELSE                                                         CHGBD210
00974         READ DC-WAGE-FILE NEXT                                    CHGBD210
00975         IF CHG10-SSN NOT = WRK-SSN                                CHGBD210
00976         OR CHG10-YRQ > WRK-BP-END                                 CHGBD210
00977            PERFORM P6220-DEFAULT-ACCT  THRU P6220-EXIT            CHGBD210
00978            GO TO P6200-EXIT                                       CHGBD210
00979         END-IF                                                    CHGBD210
00980      END-IF.                                                      CHGBD210
00981                                                                   CHGBD210
00982 *&                                                                CHGBD210
00983 *    DISPLAY 'NO DEFAULT ' WRK-SSN '  ' CHG2-EMP-NO '  '          CHGBD210
00984 *       CHG2-CURR-BEN-AMT '  ' CHG2-CURR-ADJ-AMT.                 CHGBD210
00985 *&                                                                CHGBD210
00986      PERFORM                                                      CHGBD210
00987         UNTIL CHG10-SSN NOT = WRK-SSN                             CHGBD210
00988         OR CHG10-YRQ > WRK-BP-END                                 CHGBD210
00989         OR DC-WAGE-FILE-EOF-88                                    CHGBD210
00990            IF CHG10-WAGES NOT = ZERO                              CHGBD210
00991               PERFORM P6230-FIND-INDEX   THRU P6230-EXIT          CHGBD210
00992               IF DC-NDX > ZERO                                    CHGBD210
00993                  PERFORM P6240-ADD-WAGES THRU P6240-EXIT          CHGBD210
00994               ELSE                                                CHGBD210
00995                  IF WRK-DC-TBL-LAST < WRK-DC-TBL-MAX              CHGBD210
00996                     ADD +1 TO WRK-DC-TBL-LAST                     CHGBD210
00997                  ELSE                                             CHGBD210
00998                     DISPLAY 'DC TBL LENGTH EXCEEDED ' CHG2-SSN    CHGBD210
00999                     PERFORM S999-ABEND THRU S999-EXIT             CHGBD210
01000                  END-IF                                           CHGBD210
01001                  MOVE WRK-DC-TBL-LAST TO DC-NDX                   CHGBD210
01002                  PERFORM P6240-ADD-WAGES THRU P6240-EXIT          CHGBD210
01003               END-IF                                              CHGBD210
01004            END-IF                                                 CHGBD210
01005            READ DC-WAGE-FILE NEXT                                 CHGBD210
01006      END-PERFORM.                                                 CHGBD210
01007                                                                   CHGBD210
01008      PERFORM P6250-CALC-PCT   THRU P6250-EXIT.                    CHGBD210
01009      IF WRK-DC-TOT-WAGE-AMT = ZERO                                CHGBD210
01010         PERFORM P6220-DEFAULT-ACCT  THRU P6220-EXIT               CHGBD210
01011         GO TO P6200-EXIT                                          CHGBD210
01012      END-IF.                                                      CHGBD210
01013                                                                   CHGBD210
01014  P6200-EXIT.                                                      CHGBD210
01015      EXIT.                                                        CHGBD210
01016                                                                   CHGBD210
01017  P6210-INIT-TABLE.                                                CHGBD210
01018      MOVE +0            TO WRK-DC-TBL-LAST                        CHGBD210
01019                            DC-NDX.                                CHGBD210
01020      PERFORM                                                      CHGBD210
01021        VARYING DC-SUB FROM +1 BY +1                               CHGBD210
01022        UNTIL DC-SUB > WRK-DC-TBL-MAX                              CHGBD210
01023           MOVE SPACES      TO WRK-DC-CODE (DC-SUB)                CHGBD210
01024           MOVE +0          TO WRK-DC-EMP-NO (DC-SUB)              CHGBD210
01025                               WRK-DC-WAGE-AMT (DC-SUB)            CHGBD210
01026                               WRK-DC-PCT (DC-SUB)                 CHGBD210
01027      END-PERFORM.                                                 CHGBD210
01028                                                                   CHGBD210
01029  P6210-EXIT.                                                      CHGBD210
01030      EXIT.                                                        CHGBD210
01031                                                                   CHGBD210
01032  P6220-DEFAULT-ACCT.                                              CHGBD210
01033 *&                                                                CHGBD210
01034 *    DISPLAY 'DC DEFAULT ' WRK-SSN '  '                           CHGBD210
01035 *       CHG2-CURR-BEN-AMT '  ' CHG2-CURR-ADJ-AMT.                 CHGBD210
01036 *&                                                                CHGBD210
01037      ADD +1                TO WRK-DC-DEFAULT-CNT.                 CHGBD210
01038      MOVE WRK-DC-GOV-ACCT  TO WRK-DC-EMP-NO (1).                  CHGBD210
01039      MOVE +1               TO WRK-DC-PCT (1).                     CHGBD210
01040      MOVE +1               TO WRK-DC-TBL-LAST.                    CHGBD210
01041                                                                   CHGBD210
01042  P6220-EXIT.                                                      CHGBD210
01043      EXIT.                                                        CHGBD210
01044                                                                   CHGBD210
01045  P6230-FIND-INDEX.                                                CHGBD210
01046      MOVE +0          TO DC-NDX.                                  CHGBD210
01047      PERFORM                                                      CHGBD210
01048         VARYING DC-SUB FROM +1 BY +1                              CHGBD210
01049         UNTIL DC-SUB > WRK-DC-TBL-LAST                            CHGBD210
01050         OR DC-NDX > ZERO                                          CHGBD210
01051            IF WRK-DC-CODE (DC-SUB) = CHG10-DC-AGENCY-CD           CHGBD210
01052               MOVE DC-SUB           TO DC-NDX                     CHGBD210
01053            END-IF                                                 CHGBD210
01054      END-PERFORM.                                                 CHGBD210
01055                                                                   CHGBD210
01056  P6230-EXIT.                                                      CHGBD210
01057      EXIT.                                                        CHGBD210
01058                                                                   CHGBD210
01059  P6240-ADD-WAGES.                                                 CHGBD210
01060 *&                                                                CHGBD210
01061 *    DISPLAY 'P6240 ' WRK-SSN '  ' CHG10-EMP-NO '  '              CHGBD210
01062 *       CHG10-WAGES '  ' DC-NDX.                                  CHGBD210
01063 *&                                                                CHGBD210
01064      MOVE CHG10-EMP-NO           TO WRK-DC-EMP-NO (DC-NDX).       CHGBD210
01065      ADD CHG10-WAGES             TO WRK-DC-WAGE-AMT (DC-NDX).     CHGBD210
01066                                                                   CHGBD210
01067  P6240-EXIT.                                                      CHGBD210
01068      EXIT.                                                        CHGBD210
01069                                                                   CHGBD210
01070  P6250-CALC-PCT.                                                  CHGBD210
01071      PERFORM P6251-TOTAL-WAGE   THRU P6251-EXIT.                  CHGBD210
01072      PERFORM P6252-PERCENT      THRU P6252-EXIT.                  CHGBD210
01073                                                                   CHGBD210
01074  P6250-EXIT.                                                      CHGBD210
01075      EXIT.                                                        CHGBD210
01076                                                                   CHGBD210
01077  P6251-TOTAL-WAGE.                                                CHGBD210
01078      MOVE ZERO TO WRK-DC-TOT-WAGE-AMT.                            CHGBD210
01079      PERFORM                                                      CHGBD210
01080        VARYING DC-SUB FROM +1 BY +1                               CHGBD210
01081        UNTIL DC-SUB > WRK-DC-TBL-LAST                             CHGBD210
01082           COMPUTE WRK-DC-TOT-WAGE-AMT = WRK-DC-TOT-WAGE-AMT +     CHGBD210
01083               WRK-DC-WAGE-AMT (DC-SUB)                            CHGBD210
01084      END-PERFORM.                                                 CHGBD210
01085                                                                   CHGBD210
01086  P6251-EXIT.                                                      CHGBD210
01087      EXIT.                                                        CHGBD210
01088                                                                   CHGBD210
01089  P6252-PERCENT.                                                   CHGBD210
01090      IF WRK-DC-TOT-WAGE-AMT = ZERO                                CHGBD210
01091         DISPLAY 'CHGBD210: TOT WAGE = ZERO, USING DEFAULT '       CHGBD210
01092            WRK-SSN                                                CHGBD210
01093      ELSE                                                         CHGBD210
01094         PERFORM                                                   CHGBD210
01095           VARYING DC-SUB FROM +1 BY +1                            CHGBD210
01096           UNTIL DC-SUB > WRK-DC-TBL-LAST                          CHGBD210
01097              COMPUTE WRK-DC-PCT (DC-SUB) =                        CHGBD210
01098                 (WRK-DC-WAGE-AMT (DC-SUB) / WRK-DC-TOT-WAGE-AMT)  CHGBD210
01099        END-PERFORM                                                CHGBD210
01100      END-IF.                                                      CHGBD210
01101                                                                   CHGBD210
01102  P6252-EXIT.                                                      CHGBD210
01103      EXIT.                                                        CHGBD210
01104                                                                   CHGBD210
01105  P6300-ALLOCATE-CHARGES.                                          CHGBD210
01106      MOVE CHG2-CURR-BEN-AMT TO WRK-CHG2-CURR-BEN-AMT.             CHGBD210
01107      MOVE CHG2-CURR-ADJ-AMT TO WRK-CHG2-CURR-ADJ-AMT.             CHGBD210
01108                                                                   CHGBD210
01109      PERFORM                                                      CHGBD210
01110        VARYING DC-SUB FROM +1 BY +1                               CHGBD210
01111        UNTIL DC-SUB > WRK-DC-TBL-LAST                             CHGBD210
01112           COMPUTE CHG2-CURR-BEN-AMT =                             CHGBD210
01113              (WRK-CHG2-CURR-BEN-AMT * WRK-DC-PCT (DC-SUB))        CHGBD210
01114           COMPUTE CHG2-CURR-ADJ-AMT =                             CHGBD210
01115              (WRK-CHG2-CURR-ADJ-AMT * WRK-DC-PCT (DC-SUB))        CHGBD210
01116           MOVE WRK-DC-EMP-NO (DC-SUB)      TO CHG2-EMP-NO         CHGBD210
01117           PERFORM P5000-BUILD-CHG4-REC   THRU P5000-EXIT          CHGBD210
01118           PERFORM S1100-WRITE-BD210  THRU S1100-EXIT              CHGBD210
01119           ADD +1 TO WRK-DC-WRITE-CNT                              CHGBD210
01120 *&                                                                CHGBD210
01121 *    DISPLAY 'P6300 ' WRK-SSN '  ' CHG2-EMP-NO                    CHGBD210
01122 *       '  ' CHG2-CURR-BEN-AMT '  ' CHG2-CURR-ADJ-AMT             CHGBD210
01123 *&                                                                CHGBD210
01124      END-PERFORM.                                                 CHGBD210
01125  P6300-EXIT.                                                      CHGBD210
01126      EXIT.                                                        CHGBD210
01127                                                                   CHGBD210
01128  S1100-WRITE-BD210.                                               CHGBD210
01129      WRITE BD210-CHG-REC.                                         CHGBD210
01130      IF BD210-FILE-OK-88                                          CHGBD210
01131         ADD 1 TO WRK-BD210-WRITE.                                 CHGBD210
01132                                                                   CHGBD210
01133  S1100-EXIT.                                                      CHGBD210
01134      EXIT.                                                        CHGBD210
01135                                                                   CHGBD210
01136  S001-FROM-FED-8.                                                 CHGBD210
01137      SET L001-FROM-FED-8 TO TRUE.                                 CHGBD210
01138      GO TO S001-DATE.                                             CHGBD210
01139                                                                   CHGBD210
01140  S001-FROM-ABS.                                                   CHGBD210
01141      SET L001-FROM-ABS-DAY  TO TRUE.                              CHGBD210
01142      GO TO S001-DATE.                                             CHGBD210
01143                                                                   CHGBD210
01144  S001-DATE.                                                       CHGBD210
01145      CALL 'DTSBU001' USING L001-LINK-AREA.                        CHGBD210
01146  S001-EXIT. EXIT.                                                 CHGBD210
01147                                                                   CHGBD210
01148  S004-FROM-DATE.                                                  CHGBD210
01149      SET L004-FROM-DATE TO TRUE.                                  CHGBD210
01150      GO TO S004-YRQ.                                              CHGBD210
01151                                                                   CHGBD210
01152  S004-FROM-ABS.                                                   CHGBD210
01153      SET L004-FROM-ABS  TO TRUE.                                  CHGBD210
01154      GO TO S004-YRQ.                                              CHGBD210
01155                                                                   CHGBD210
01156  S004-YRQ.                                                        CHGBD210
01157      CALL 'DTSBU004' USING L004-LINK-AREA.                        CHGBD210
01158  S004-EXIT. EXIT.                                                 CHGBD210
01159                                                                   CHGBD210
01160  S081-CLAIMANT-NAME.                                              CHGBD210
01161      CALL 'DTSBU081' USING L081-LINK-AREA.                        CHGBD210
01162  S081-EXIT. EXIT.                                                 CHGBD210
01163                                                                   CHGBD210
01164  S083-IB6-CLMNT-NAME.                                             CHGBD210
01165      CALL 'DTSBU083' USING L081-LINK-AREA.                        CHGBD210
01166  S083-EXIT. EXIT.                                                 CHGBD210
01167                                                                   CHGBD210
01168  S100-CALL-CHGBU100.                                              CHGBD210
01169      CALL 'CHGBU100' USING L100-LINK-AREA.                        CHGBD210
01170  S100-EXIT. EXIT.                                                 CHGBD210
01171                                                                   CHGBD210
01172  S111-LOOKUP-ADDRESS.                                             CHGBD210
01173      CALL 'DTSBU111' USING L111-LINK-AREA.                        CHGBD210
01174  S111-EXIT. EXIT.                                                 CHGBD210
01175                                                                   CHGBD210
01176  S112-FORMAT-ADDRESS.                                             CHGBD210
01177      CALL 'DTSBU112' USING L112-LINK-AREA.                        CHGBD210
01178  S112-EXIT. EXIT.                                                 CHGBD210
01179                                                                   CHGBD210
01180  S910-OPEN-READ.                                                  CHGBD210
01181      SET L910-OPEN-READ-88 TO TRUE.                               CHGBD210
01182      GO TO S910-MSTR-IO.                                          CHGBD210
01183                                                                   CHGBD210
01184 *S910-READ.                                                       CHGBD210
01185 **   SET L910-READ-88 TO TRUE.                                    CHGBD210
01186 **   GO TO S910-MSTR-IO.                                          CHGBD210
01187 **                                                                CHGBD210
01188  S910-CLOSE.                                                      CHGBD210
01189      SET L910-CLOSE-88 TO TRUE.                                   CHGBD210
01190      GO TO S910-MSTR-IO.                                          CHGBD210
01191                                                                   CHGBD210
01192  S910-MSTR-IO.                                                    CHGBD210
01193      CALL 'DTSBU910' USING L910-LINK-AREA                         CHGBD210
01194                            MSKL-REC.                              CHGBD210
01195                                                                   CHGBD210
01196  S910-EXIT.                                                       CHGBD210
01197      EXIT.                                                        CHGBD210
01198                                                                   CHGBD210
01199  S921-OPEN-READ.                                                  CHGBD210
01200      SET L921-OPEN-READ-88 TO TRUE.                               CHGBD210
01201      GO TO S921-AIX-IO.                                           CHGBD210
01202                                                                   CHGBD210
01203  S921-CLOSE.                                                      CHGBD210
01204      SET L921-CLOSE-88 TO TRUE.                                   CHGBD210
01205      GO TO S921-AIX-IO.                                           CHGBD210
01206                                                                   CHGBD210
01207  S921-AIX-IO.                                                     CHGBD210
01208      CALL 'DTSBU921' USING L921-LINK-AREA                         CHGBD210
01209                            ISKL-REC.                              CHGBD210
01210                                                                   CHGBD210
01211  S921-EXIT.                                                       CHGBD210
01212      EXIT.                                                        CHGBD210
01213                                                                   CHGBD210
01214 ** REPORT RECORD I-O                                              CHGBD210
01215  S946-RPT-REC-O.                                                  CHGBD210
01216      CALL 'DTSBU946' USING RSKL-REC.                              CHGBD210
01217                                                                   CHGBD210
01218  S946-EXIT.                                                       CHGBD210
01219      EXIT.                                                        CHGBD210
01220                                                                   CHGBD210
01221  T0000-TERMINATE.                                                 CHGBD210
01222      IF CHG3-RUN-TYPE-EMP-88                                      CHGBD210
01223      IF CHG3-RUN-TYPE-MON-EMP-88                                  CHGBD210
01224      IF CHG3-RUN-TYPE-WK-EMP-88                                   CHGBD210
01225         IF WRK-BD210-WRITE = ZERO                                 CHGBD210
01226            PERFORM T1000-WRITE-DUMMY THRU T1000-EXIT              CHGBD210
01227         END-IF                                                    CHGBD210
01228      END-IF.                                                      CHGBD210
01229                                                                   CHGBD210
01230      CLOSE BD205-CHG-FILE-IN                                      CHGBD210
01231            BD210-CHG-FILE-OUT                                     CHGBD210
01232            DC-WAGE-FILE.                                          CHGBD210
01233                                                                   CHGBD210
01234      PERFORM S910-CLOSE     THRU S910-EXIT.                       CHGBD210
01235                                                                   CHGBD210
01236      PERFORM S921-CLOSE     THRU S921-EXIT.                       CHGBD210
01237                                                                   CHGBD210
01238      DISPLAY '***********************************************'.   CHGBD210
01239      DISPLAY '***             CHGBD210 COUNTS             *** '.  CHGBD210
01240      DISPLAY '***'.                                               CHGBD210
01241                                                                   CHGBD210
01242      DISPLAY ' CHGBD210 CHARGE RECORD READ:        '              CHGBD210
01243         WRK-BD205-CHG-READ.                                       CHGBD210
01244                                                                   CHGBD210
01245      DISPLAY ' CHGBD210 CHARGE RECORDS WRITTEN:    '              CHGBD210
01246         WRK-BD210-WRITE.                                          CHGBD210
01247                                                                   CHGBD210
01248      DISPLAY ' CHGBD210 CHARGE RECORDS BYPASSED:   '              CHGBD210
01249         WRK-BD205-CHG-DELETE.                                     CHGBD210
01250                                                                   CHGBD210
01251      DISPLAY ' CHGBD210 CHARGE REC NOT SELECTED:   '              CHGBD210
01252         WRK-BD205-NOT-SELECTED.                                   CHGBD210
01253                                                                   CHGBD210
01254      DISPLAY SPACE.                                               CHGBD210
01255                                                                   CHGBD210
01256      DISPLAY ' CHGBD210 NOT LIABLE RECORDS PASSED: '              CHGBD210
01257         WRK-BD205-NOT-LIAB-CNT.                                   CHGBD210
01258                                                                   CHGBD210
01259      DISPLAY SPACE.                                               CHGBD210
01260                                                                   CHGBD210
01261      DISPLAY ' DC GOV CHARGE RECORDS FOUND       : '              CHGBD210
01262         WRK-DC-GOV-INPUT-CNT.                                     CHGBD210
01263                                                                   CHGBD210
01264      DISPLAY ' DC GOV DEFAULT ACCT USED          : '              CHGBD210
01265         WRK-DC-DEFAULT-CNT.                                       CHGBD210
01266                                                                   CHGBD210
01267      DISPLAY ' DC GOV AGENCY RECORDS WRITTEN     : '              CHGBD210
01268         WRK-DC-WRITE-CNT.                                         CHGBD210
01269                                                                   CHGBD210
01270      MOVE WRK-TOT-CHG   TO WRK-TOT-CHG-DISP.                      CHGBD210
01271      DISPLAY SPACE.                                               CHGBD210
01272      DISPLAY 'CHGBD210 TOT CHG   ' WRK-TOT-CHG-DISP.              CHGBD210
01273      DISPLAY '***********************************************'.   CHGBD210
01274                                                                   CHGBD210
01275  T0000-EXIT.                                                      CHGBD210
01276      EXIT.                                                        CHGBD210
01277                                                                   CHGBD210
01278  T1000-WRITE-DUMMY.                                               CHGBD210
01279                                                                   CHGBD210
01280      INITIALIZE BD210-CHG-REC.                                    CHGBD210
01281      SET CHG4-RPT-TYPE-NULL-88   TO TRUE.                         CHGBD210
01282      MOVE CHG3-EMP-NO            TO CHG4-EMP-NO.                  CHGBD210
01283                                                                   CHGBD210
01284      WRITE BD210-CHG-REC.                                         CHGBD210
01285      ADD 1                       TO WRK-BD210-WRITE.              CHGBD210
01286                                                                   CHGBD210
01287  T1000-EXIT.                                                      CHGBD210
01288      EXIT.                                                        CHGBD210
01289                                                                   CHGBD210
01290  S999-ABEND.                                                      CHGBD210
01291      DISPLAY '****  CHGBD210 ABENDING '                           CHGBD210
01292         ABEND-MSG.                                                CHGBD210
01293      CALL ABEND-MOD USING ABEND-CODE.                             CHGBD210
01294                                                                   CHGBD210
01295  S999-EXIT.                                                       CHGBD210
01296      EXIT.                                                        CHGBD210
01297                                                                   CHGBD210
