00001  IDENTIFICATION DIVISION.                                         04/21/20
00002  PROGRAM-ID.             CHGBD216.                                CHGBD216
00003 *AUTHOR.                 NGC.                                        LV003
00004 *DATE-WRITTEN.           NOVEMBER 2006.                           CHGBD216
00005  DATE-COMPILED.                                                   CHGBD216
00006      SKIP3                                                        CHGBD216
00007 *****                                                             CHGBD216
00008 *                                                                 CHGBD216
00009 *    FUNCTION:                                                    CHGBD216
00010 *                                                                 CHGBD216
00011 *           BUILD CHGIM004 RECORDS FOR CHARGE REPORTING PROCESS   CHGBD216
00012 *           FROM CHGIM005 RECORDS.                                CHGBD216
00013 *                                                                 CHGBD216
00014 *        INPUT:                                                   CHGBD216
00015 *                                                                 CHGBD216
00016 *            BD205CHG - CHARGE REPORT RECORDS GENERATED BY        CHGBD216
00017 *                       CHGBD205.                                 CHGBD216
00018 *                                                                 CHGBD216
00019 *        OUTPUT:                                                  CHGBD216
00020 *                                                                 CHGBD216
00021 *            DTSFC005 - CHGIM005 RECORDS                          CHGBD216
00022 *                                                                 CHGBD216
00023 *                                                                 CHGBD216
00024 *                                                                 CHGBD216
00025 *****                                                             CHGBD216
00026                                                                   CHGBD216
00027 ******************************************************************CHGBD216
00028 * MODIFICATION HISTORY:                                          *CHGBD216
00029 *                                                                *CHGBD216
00030 * 11-06-2006 INITIAL DEVELOPMENT                                 *CHGBD216
00031 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD216
00032 *                                                                *CHGBD216
00033 * 03-09-2009 RECOMPILED FOR NEW VERSIONS OF CHGIM004 AND         *CHGBD216
00034 *            CHGIM005.                                           *CHGBD216
00035 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD216
00036 *                                                                *CHGBD216
00037 * 05-14-2010 RECOMPILED FOR NEW VERSIONS OF CHGIM004 AND         *CHGBD216
00038 *            CHGIM005.                                           *CHGBD216
00039 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBD216
00040 *                                                                *   CL**2
00041 * 10-04-2014 RECOMPILED FOR NEW VERSIONS OF CHGIM004 AND         *   CL**2
00042 *            CHGIM005.                                           *   CL**2
00043 *            REFERENCE RFP # UCPIA        AUTHOR OF CHANGE - ZL1 *   CL**2
00044 *                                                                *CHGBD216
00045 * 04-17-2020 RECOMPILED FOR NEW VERSIONS OF CHGIM004 AND         *   CL**3
00046 *            CHGIM005.                                           *   CL**3
00047 *            REFERENCE RFP # PUA FPUC FRUR          CHANGE - ZL1 *   CL**3
00048 *                                                                *   CL**3
00049 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD216
00050 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD216
00051 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBD216
00052 ******************************************************************CHGBD216
00053                                                                   CHGBD216
00054      SKIP3                                                        CHGBD216
00055  ENVIRONMENT DIVISION.                                            CHGBD216
00056      SKIP3                                                        CHGBD216
00057  INPUT-OUTPUT SECTION.                                            CHGBD216
00058      SKIP3                                                        CHGBD216
00059  FILE-CONTROL.                                                    CHGBD216
00060      SELECT CHARGE-FILE-IN    ASSIGN TO DTSFCHG5                  CHGBD216
00061             FILE STATUS IS CHG5-STATUS.                           CHGBD216
00062                                                                   CHGBD216
00063      SELECT BD216-CHG-FILE-OUT   ASSIGN TO BD216CHG               CHGBD216
00064             FILE STATUS IS BD216-CHG-STATUS.                      CHGBD216
00065                                                                   CHGBD216
00066      SELECT CHG-PARM-FILE  ASSIGN TO CHGPARM                      CHGBD216
00067             FILE STATUS IS CHG-PARM-STATUS.                       CHGBD216
00068                                                                   CHGBD216
00069  DATA DIVISION.                                                   CHGBD216
00070                                                                   CHGBD216
00071  FILE SECTION.                                                    CHGBD216
00072  FD  CHARGE-FILE-IN                                               CHGBD216
00073      RECORDING MODE IS F                                          CHGBD216
00074      RECORD CONTAINS 41 CHARACTERS                                CHGBD216
00075      DATA RECORD IS CHG5-REC.                                     CHGBD216
00076  01  CHG5-REC.                                                    CHGBD216
00077  ++INCLUDE CHGIM005                                               CHGBD216
00078                                                                   CHGBD216
00079  FD  BD216-CHG-FILE-OUT                                           CHGBD216
00080      LABEL RECORDS ARE STANDARD                                   CHGBD216
00081      RECORDING MODE IS F                                          CHGBD216
00082      BLOCK CONTAINS 0 RECORDS.                                    CHGBD216
00083      SKIP1                                                        CHGBD216
00084  01  BD216-CHG-REC.                                               CHGBD216
00085  ++INCLUDE CHGIM004                                               CHGBD216
00086                                                                   CHGBD216
00087  FD  CHG-PARM-FILE                                                CHGBD216
00088      RECORDING MODE IS F                                          CHGBD216
00089      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD216
00090      SKIP1                                                        CHGBD216
00091  01  CHG-PARM-REC.                                                CHGBD216
00092  ++INCLUDE CHGIM003                                               CHGBD216
00093      EJECT                                                        CHGBD216
00094  WORKING-STORAGE SECTION.                                         CHGBD216
000945 77  PAN-VALET PICTURE X(24) VALUE '003CHGBD216  04/21/20'.       CHGBD216
00095  77  PAN-VALET PICTURE X(24) VALUE '007CHGBD216  05/25/10'.       CHGBD216
00096                                                                   CHGBD216
00097  01  WRK-AREA.                                                    CHGBD216
00098      05  WRK-DISP-AREA.                                           CHGBD216
00099          10  WRK-DATE                PIC 9999B99B99.              CHGBD216
00100          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD216
00101          10  WRK-EMP-DISP            PIC 9(06).                   CHGBD216
00102          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD216
00103          10  WRK-SSN-DISP            PIC 9(10).                   CHGBD216
00104          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD216
00105          10  WRK-CHG-AMT-DISP        PIC --------9.99.            CHGBD216
00106          10  WRK-CHG-AMT-DISP1       PIC --------9.99.            CHGBD216
00107          10  WRK-PCT                 PIC S9(03)V99 COMP-3.        CHGBD216
00108          10  WRK-PCT-DISP            PIC 999.99.                  CHGBD216
00109                                                                   CHGBD216
00110      05  WRK-KEY                     PIC  9(10).                  CHGBD216
00111      05  FILLER REDEFINES WRK-KEY.                                CHGBD216
00112          10  WRK-SSN                 PIC  9(09).                  CHGBD216
00113          10  WRK-SSN-SEQ             PIC  9(01).                  CHGBD216
00114                                                                   CHGBD216
00115      05  SUB                         PIC S9(04) COMP.             CHGBD216
00116      05  WRK-TOT-CHG                 PIC S9(11)V99 COMP-3         CHGBD216
00117                                  VALUE +0.                        CHGBD216
00118      05  WRK-EMP-TOT-CHG             PIC S9(09)V99 COMP-3         CHGBD216
00119                                  VALUE +0.                        CHGBD216
00120      05  WRK-EMP-SSN-CHG             PIC S9(09)V99 COMP-3         CHGBD216
00121                                  VALUE +0.                        CHGBD216
00122      05  WRK-TOT-CHG-DISP            PIC  Z(08)9.99-.             CHGBD216
00123      05  WRK-BYPASS-EMP              PIC S9(07)    COMP-3         CHGBD216
00124                                  VALUE +0.                        CHGBD216
00125      05  WRK-EMP-NO                  PIC S9(07)    COMP-3.        CHGBD216
00126                                                                   CHGBD216
00127      05  WRK-LAST-EMP-CHECKED        PIC S9(07) COMP-3            CHGBD216
00128                                  VALUE +0.                        CHGBD216
00129                                                                   CHGBD216
00130      05  WRK-SSN-CONV                PIC  9(10).                  CHGBD216
00131      05  FILLER REDEFINES WRK-SSN-CONV.                           CHGBD216
00132          10  WRK-SSN-9               PIC  9(09).                  CHGBD216
00133          10  FILLER                  PIC  X(01).                  CHGBD216
00134                                                                   CHGBD216
00135      05  WRK-CHG-AMT                 PIC S9(09)V99 COMP-3.        CHGBD216
00136                                                                   CHGBD216
00137      05  WRK-MOD-NAME                PIC  X(08)                   CHGBD216
00138                                  VALUE 'CHGBD216'.                CHGBD216
00139      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD216
00140                                  VALUE +216.                      CHGBD216
00141      05  ABEND-MOD                   PIC  X(08)                   CHGBD216
00142                                  VALUE 'DTSBU999'.                CHGBD216
00143      05  ABEND-MSG                   PIC  X(60).                  CHGBD216
00144                                                                   CHGBD216
00145      05  CHG5-STATUS                 PIC  X(02) VALUE SPACES.     CHGBD216
00146          88  CHG5-FILE-OK-88     VALUE '00'.                      CHGBD216
00147          88  CHG5-FILE-EOF-88    VALUE '10'.                      CHGBD216
00148                                                                   CHGBD216
00149      05  BD216-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD216
00150          88  BD216-FILE-OK-88    VALUE ZERO.                      CHGBD216
00151          88  BD216-FILE-EOF-88   VALUE '10'.                      CHGBD216
00152                                                                   CHGBD216
00153      05  CHG-PARM-STATUS             PIC  X(02) VALUE SPACES.     CHGBD216
00154          88  CHG-PARM-FILE-OK-88      VALUE ZERO.                 CHGBD216
00155          88  CHG-PARM-FILE-EOF-88     VALUE '10'.                 CHGBD216
00156                                                                   CHGBD216
00157      05  WRK-EMP-VALID-IND           PIC  X(01).                  CHGBD216
00158          88  WRK-EMP-VALID-YES-88  VALUE 'Y'.                     CHGBD216
00159          88  WRK-EMP-VALID-NO-88   VALUE 'N'.                     CHGBD216
00160                                                                   CHGBD216
00161      05  WRK-SELECT-IND              PIC  X(01).                  CHGBD216
00162          88  WRK-SELECT-YES-88     VALUE 'Y'.                     CHGBD216
00163          88  WRK-SELECT-NO-88      VALUE 'N'.                     CHGBD216
00164                                                                   CHGBD216
00165      05  WRK-EMPLOYER-DATA-AREA.                                  CHGBD216
00166          10  WRK-FISCAL-AGENT-CD        PIC X(03).                CHGBD216
00167              88  WRK-FISC-AG-NONE-88     VALUE SPACES.            CHGBD216
00168          10  WRK-FMT-ADDR.                                        CHGBD216
00169              15  WRK-FMT-LINE OCCURS 5 TIMES                      CHGBD216
00170                                         PIC X(40).                CHGBD216
00171              15  WRK-ZIP                PIC X(10).                CHGBD216
00172              15  WRK-ADVANCED-BARCODE   PIC X(14).                CHGBD216
00173          10  WRK-EMP-NAME               PIC X(40).                CHGBD216
00174          10  FILLER REDEFINES WRK-EMP-NAME.                       CHGBD216
00175              15  WRK-EMP-NAME-CHK       PIC X(04).                CHGBD216
00176              15  FILLER                 PIC X(36).                CHGBD216
00177                                                                   CHGBD216
00178      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD216
00179          88  WRK-ERROR-YES-88    VALUE 'Y'.                       CHGBD216
00180          88  WRK-ERROR-NO-88     VALUE 'N'.                       CHGBD216
00181                                                                   CHGBD216
00182 *    05  WRK-UPD-MASTER-IND    PIC  X(01).                        CHGBD216
00183 *        88  WRK-UPD-MASTER-YES-88  VALUE 'Y'.                    CHGBD216
00184 *        88  WRK-UPD-MASTER-NO-88   VALUE 'N'.                    CHGBD216
00185      05  WRK-RATE-YRQ             PIC S9(05)  COMP-3.             CHGBD216
00186 *    05  WRK-MRRA-ID              PIC S9(03)  COMP-3              CHGBD216
00187 *                                VALUE +0.                        CHGBD216
00188      05  WRK-CHG5-CNT             PIC  9(09) COMP-3               CHGBD216
00189                                        VALUE 0.                   CHGBD216
00190      05  WRK-SELECTED-CNT         PIC  9(09) COMP-3               CHGBD216
00191                                        VALUE 0.                   CHGBD216
00192      05  WRK-BYPASS-PRED-CNT      PIC  9(09) COMP-3               CHGBD216
00193                                        VALUE 0.                   CHGBD216
00194                                                                   CHGBD216
00195      05  WRK-BD216-NOT-LIAB-CNT   PIC  9(09) COMP-3               CHGBD216
00196                                        VALUE 0.                   CHGBD216
00197      05  WRK-BD216-WRITE          PIC  9(09) COMP-3               CHGBD216
00198                                        VALUE 0.                   CHGBD216
00199                                                                   CHGBD216
00200      05  WRK-057-TOT1             PIC S9(09)V99 COMP-3            CHGBD216
00201                                  VALUE +0.                        CHGBD216
00202      05  WRK-140-TOT1             PIC S9(09)V99 COMP-3            CHGBD216
00203                                  VALUE +0.                        CHGBD216
00204      05  WRK-142-TOT1             PIC S9(09)V99 COMP-3            CHGBD216
00205                                  VALUE +0.                        CHGBD216
00206      05  WRK-150-TOT1             PIC S9(09)V99 COMP-3            CHGBD216
00207                                  VALUE +0.                        CHGBD216
00208      05  WRK-057-TOT2             PIC S9(09)V99 COMP-3            CHGBD216
00209                                  VALUE +0.                        CHGBD216
00210      05  WRK-140-TOT2             PIC S9(09)V99 COMP-3            CHGBD216
00211                                  VALUE +0.                        CHGBD216
00212      05  WRK-142-TOT2             PIC S9(09)V99 COMP-3            CHGBD216
00213                                  VALUE +0.                        CHGBD216
00214      05  WRK-150-TOT2             PIC S9(09)V99 COMP-3            CHGBD216
00215                                  VALUE +0.                        CHGBD216
00216                                                                   CHGBD216
00217      05  DISPLAY-PARM-REC.                                        CHGBD216
00218          10  DISPLAY-RUN-TYPE                 PIC X(03).          CHGBD216
00219          10  FILLER                           PIC X(01).          CHGBD216
00220          10  DISPLAY-BEGIN-DATE               PIC 9(06).          CHGBD216
00221          10  FILLER                           PIC X(01).          CHGBD216
00222          10  DISPLAY-END-DATE                 PIC 9(06).          CHGBD216
00223          10  FILLER                           PIC X(01).          CHGBD216
00224          10  DISPLAY-REPORT-TYPES.                                CHGBD216
00225              15  DISPLAY-RPT-TYPE-RATED       PIC X(01).          CHGBD216
00226              15  DISPLAY-RPT-TYPE-SELF-IND    PIC X(01).          CHGBD216
00227              15  DISPLAY-RPT-TYPE-CWC         PIC X(01).          CHGBD216
00228              15  DISPLAY-RPT-TYPE-FED         PIC X(01).          CHGBD216
00229              15  DISPLAY-RPT-TYPE-TEUC        PIC X(01).          CHGBD216
00230          10  FILLER                           PIC X(01).          CHGBD216
00231          10  DISPLAY-EMP-NO                   PIC 9(06).          CHGBD216
00232          10  FILLER                           PIC X(50).          CHGBD216
00233                                                                   CHGBD216
00234 ** ADD ERROR MSG TABLE SET UP                                     CHGBD216
00235  01  MSG-TABLE.                                                   CHGBD216
00236      05  MSG1-NO-MPRF.                                            CHGBD216
00237          10  MSG1-ID.                                             CHGBD216
00238              15  MSG1-ID1      PIC X(08)  VALUE 'CHGBD216'.       CHGBD216
00239              15  MSG1-ID2      PIC X(03)  VALUE '216'.            CHGBD216
00240          10  MSG1-SHORT-TEXT   PIC X(20)                          CHGBD216
00241                    VALUE 'EMP NOT ON FILE  :  '.                  CHGBD216
00242          10  MSG1-LONG-TEXT.                                      CHGBD216
00243              15  FILLER        PIC X(29)                          CHGBD216
00244                    VALUE 'EMPLOYER NOT ON MASTER FILE  '.         CHGBD216
00245              15  FILLER        PIC X(32)  VALUE SPACES.           CHGBD216
00246                                                                   CHGBD216
00247      05  MSG2-NOT-LIABLE.                                         CHGBD216
00248          10  MSG2-ID.                                             CHGBD216
00249              15  MSG2-ID1      PIC X(08)  VALUE 'CHGBD210'.       CHGBD216
00250              15  MSG2-ID2      PIC X(03)  VALUE '210'.            CHGBD216
00251          10  MSG2-SHORT-TEXT   PIC X(20)                          CHGBD216
00252                    VALUE 'EMP NOT LIABLE   :  '.                  CHGBD216
00253          10  MSG2-LONG-TEXT.                                      CHGBD216
00254              15  FILLER        PIC X(29)                          CHGBD216
00255                    VALUE 'EMPLOYER IS NOT LIABLE       '.         CHGBD216
00256              15  FILLER        PIC X(32)  VALUE SPACES.           CHGBD216
00257                                                                   CHGBD216
00258      05  MSG4-PRINTING-TURNED-OFF.                                CHGBD216
00259          10  MSG4-ID.                                             CHGBD216
00260              15  MSG4-ID1      PIC X(08)  VALUE 'CHGBD216'.       CHGBD216
00261              15  MSG4-ID2      PIC X(03)  VALUE '216'.            CHGBD216
00262          10  MSG4-SHORT-TEXT   PIC X(20)                          CHGBD216
00263                    VALUE 'CHG STMT PRINT OFF: '.                  CHGBD216
00264          10  MSG4-LONG-TEXT.                                      CHGBD216
00265              15  FILLER        PIC X(36)                          CHGBD216
00266                    VALUE 'CHARGE STATEMENT PRINTING TURNED OFF'.  CHGBD216
00267              15  FILLER        PIC X(25)  VALUE SPACES.           CHGBD216
00268                                                                   CHGBD216
00269      05  MSG5-NO-ADDRESS.                                         CHGBD216
00270          10  MSG5-ID.                                             CHGBD216
00271              15  MSG5-ID1      PIC X(08)  VALUE 'CHGBD216'.       CHGBD216
00272              15  MSG5-ID2      PIC X(03)  VALUE '216'.            CHGBD216
00273          10  MSG5-SHORT-TEXT   PIC X(20)                          CHGBD216
00274                    VALUE 'NO ADDRESS FOUND:   '.                  CHGBD216
00275          10  MSG5-LONG-TEXT.                                      CHGBD216
00276              15  FILLER        PIC X(29)                          CHGBD216
00277                    VALUE 'ADDRESS NOT FOUND            '.         CHGBD216
00278              15  FILLER        PIC X(25)                          CHGBD216
00279                    VALUE '  MPRF EMPLOYER NUMBER = '.             CHGBD216
00280              15  MSG5-EMP-NO   PIC 9(07).                         CHGBD216
00281                                                                   CHGBD216
00282      05  MSG6-INVALID-EMP-NO.                                     CHGBD216
00283          10  MSG6-ID.                                             CHGBD216
00284              15  MSG6-ID1      PIC X(08)  VALUE 'CHGBD216'.       CHGBD216
00285              15  MSG6-ID2      PIC X(03)  VALUE '216'.            CHGBD216
00286          10  MSG6-SHORT-TEXT   PIC X(20)                          CHGBD216
00287                    VALUE 'INVALID EMP NO:     '.                  CHGBD216
00288          10  MSG6-LONG-TEXT.                                      CHGBD216
00289              15  FILLER        PIC X(29)                          CHGBD216
00290                    VALUE 'INVALID EMPLOYER NUMBER: '.             CHGBD216
00291              15  MSG6-EMP-NO   PIC 9(07).                         CHGBD216
00292              15  FILLER        PIC X(25)                          CHGBD216
00293                    VALUE '  EMP TYPE = '.                         CHGBD216
00294              15  MSG6-EMP-TYPE PIC 9(02).                         CHGBD216
00295 ** ERROR MSG OUTPUT RECORD                                        CHGBD216
00296                                                                   CHGBD216
00297  01  RSKL-REC.                                                    CHGBD216
00298  ++INCLUDE DTSIRSK1                                               CHGBD216
00299                                                                   CHGBD216
00300  01  R907-REC.                                                    CHGBD216
00301  ++INCLUDE DTSIR907                                               CHGBD216
00302                                                                   CHGBD216
00303  01  L001-LINK-AREA.                                              CHGBD216
00304  ++INCLUDE DTSIL001                                               CHGBD216
00305                                                                   CHGBD216
00306  01  L004-LINK-AREA.                                              CHGBD216
00307  ++INCLUDE DTSIL004                                               CHGBD216
00308                                                                   CHGBD216
00309  01  L005-LINK-AREA.                                              CHGBD216
00310  ++INCLUDE DTSIL005                                               CHGBD216
00311                                                                   CHGBD216
00312  01  L006-LINK-AREA.                                              CHGBD216
00313  ++INCLUDE DTSIL006                                               CHGBD216
00314 *RW1                                                              CHGBD216
00315  01  L081-LINK-AREA.                                              CHGBD216
00316  ++INCLUDE DTSIL081                                               CHGBD216
00317                                                                   CHGBD216
00318  01  L100-LINK-AREA.                                              CHGBD216
00319  ++INCLUDE CHGIL100                                               CHGBD216
00320                                                                   CHGBD216
00321  01  L111-LINK-AREA.                                              CHGBD216
00322  ++INCLUDE DTSIL111                                               CHGBD216
00323                                                                   CHGBD216
00324  01  L112-LINK-AREA.                                              CHGBD216
00325  ++INCLUDE DTSIL112                                               CHGBD216
00326 *RW2                                                              CHGBD216
00327  01  L910-LINK-AREA.                                              CHGBD216
00328  ++INCLUDE DTSIL910                                               CHGBD216
00329                                                                   CHGBD216
00330  01  MSKL-REC.                                                    CHGBD216
00331  ++INCLUDE DTSIMSKL                                               CHGBD216
00332                                                                   CHGBD216
00333  01  MHDR-REC.                                                    CHGBD216
00334  ++INCLUDE DTSIMHDR                                               CHGBD216
00335                                                                   CHGBD216
00336  01  MPRF-REC.                                                    CHGBD216
00337  ++INCLUDE DTSIMPRF                                               CHGBD216
00338                                                                   CHGBD216
00339  01  MREL-REC.                                                    CHGBD216
00340  ++INCLUDE DTSIMREL                                               CHGBD216
00341                                                                   CHGBD216
00342  01  MFAE-REC.                                                    CHGBD216
00343  ++INCLUDE DTSIMFAE                                               CHGBD216
00344                                                                   CHGBD216
00345  01  L921-LINK-AREA.                                              CHGBD216
00346  ++INCLUDE DTSIL921                                               CHGBD216
00347                                                                   CHGBD216
00348  01  ISKL-REC.                                                    CHGBD216
00349  ++INCLUDE DTSIISKL                                               CHGBD216
00350                                                                   CHGBD216
00351  PROCEDURE DIVISION.                                              CHGBD216
00352      SKIP2                                                        CHGBD216
00353  CHGBD216-MAIN.                                                   CHGBD216
00354      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD216
00355      IF WRK-ERROR-YES-88                                          CHGBD216
00356         GO TO CHGBD216-EXIT.                                      CHGBD216
00357                                                                   CHGBD216
00358      PERFORM P0000-PROCESS THRU P0000-EXIT.                       CHGBD216
00359                                                                   CHGBD216
00360      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD216
00361                                                                   CHGBD216
00362  CHGBD216-EXIT.                                                   CHGBD216
00363      STOP RUN.                                                    CHGBD216
00364      EJECT                                                        CHGBD216
00365  I0000-INITIATE.                                                  CHGBD216
00366      SET WRK-ERROR-NO-88        TO TRUE.                          CHGBD216
00367                                                                   CHGBD216
00368      MOVE MSG1-ID1              TO R907-MODULE-NAME.              CHGBD216
00369      MOVE LENGTH OF R907-REC    TO R907-LENGTH.                   CHGBD216
00370                                                                   CHGBD216
00371      PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT.                  CHGBD216
00372                                                                   CHGBD216
00373  I0000-EXIT.                                                      CHGBD216
00374      EXIT.                                                        CHGBD216
00375                                                                   CHGBD216
00376  I2000-OPEN-FILES-1.                                              CHGBD216
00377      OPEN INPUT CHARGE-FILE-IN.                                   CHGBD216
00378      IF NOT CHG5-FILE-OK-88                                       CHGBD216
00379         DISPLAY 'INPUT CHARGE FILE OPEN ERROR: ' CHG5-STATUS      CHGBD216
00380         SET WRK-ERROR-YES-88      TO TRUE                         CHGBD216
00381         GO TO I2000-EXIT                                          CHGBD216
00382      END-IF.                                                      CHGBD216
00383                                                                   CHGBD216
00384      OPEN OUTPUT BD216-CHG-FILE-OUT.                              CHGBD216
00385      IF NOT BD216-FILE-OK-88                                      CHGBD216
00386         MOVE 'BD216 FILE OPEN ERROR: ' TO ABEND-MSG               CHGBD216
00387         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD216
00388                                                                   CHGBD216
00389      OPEN INPUT CHG-PARM-FILE.                                    CHGBD216
00390      IF NOT CHG-PARM-FILE-OK-88                                   CHGBD216
00391         DISPLAY 'CHARGE PARM FILE OPEN ERROR: '                   CHGBD216
00392            CHG-PARM-STATUS                                        CHGBD216
00393         PERFORM S999-ABEND THRU S999-EXIT                         CHGBD216
00394      END-IF.                                                      CHGBD216
00395                                                                   CHGBD216
00396      READ CHG-PARM-FILE.                                          CHGBD216
00397      IF NOT CHG-PARM-FILE-OK-88                                   CHGBD216
00398         DISPLAY 'CHARGE PARM FILE READ ERROR: '                   CHGBD216
00399            CHG-PARM-STATUS                                        CHGBD216
00400         PERFORM S999-ABEND THRU S999-EXIT                         CHGBD216
00401      END-IF.                                                      CHGBD216
00402                                                                   CHGBD216
00403      DISPLAY '***** CHGBD216 PARM RECORD  *****'.                 CHGBD216
00404      MOVE CHG3-RUN-TYPE       TO DISPLAY-RUN-TYPE.                CHGBD216
00405      MOVE CHG3-BEGIN-DATE     TO DISPLAY-BEGIN-DATE.              CHGBD216
00406      MOVE CHG3-END-DATE       TO DISPLAY-END-DATE.                CHGBD216
00407      MOVE CHG3-RPT-TYPES      TO DISPLAY-REPORT-TYPES.            CHGBD216
00408      MOVE CHG3-EMP-NO         TO DISPLAY-EMP-NO.                  CHGBD216
00409      DISPLAY DISPLAY-PARM-REC.                                    CHGBD216
00410      DISPLAY SPACE.                                               CHGBD216
00411                                                                   CHGBD216
00412      PERFORM S910-OPEN-READ      THRU S910-EXIT.                  CHGBD216
00413                                                                   CHGBD216
00414      PERFORM S921-OPEN-READ THRU S921-EXIT.                       CHGBD216
00415                                                                   CHGBD216
00416  I2000-EXIT.                                                      CHGBD216
00417      EXIT.                                                        CHGBD216
00418                                                                   CHGBD216
00419  P0000-PROCESS.                                                   CHGBD216
00420      READ CHARGE-FILE-IN.                                         CHGBD216
00421                                                                   CHGBD216
00422      IF CHG5-FILE-EOF-88                                          CHGBD216
00423         DISPLAY 'CHARGE FILE EMPTY: ' CHG5-STATUS                 CHGBD216
00424         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD216
00425         GO TO P0000-EXIT                                          CHGBD216
00426      END-IF.                                                      CHGBD216
00427                                                                   CHGBD216
00428      PERFORM                                                      CHGBD216
00429         UNTIL CHG5-FILE-EOF-88                                    CHGBD216
00430         OR    WRK-ERROR-YES-88                                    CHGBD216
00431            ADD 1                     TO WRK-CHG5-CNT              CHGBD216
00432            PERFORM P1000-SELECT      THRU P1000-EXIT              CHGBD216
00433            IF WRK-SELECT-YES-88                                   CHGBD216
00434               ADD 1                  TO WRK-SELECTED-CNT          CHGBD216
00435               IF CHG5-EMP-NO NOT = WRK-LAST-EMP-CHECKED           CHGBD216
00436                  MOVE CHG5-EMP-NO TO WRK-LAST-EMP-CHECKED         CHGBD216
00437                  PERFORM P2000-GET-ADDRESS THRU P2000-EXIT        CHGBD216
00438                  PERFORM P2300-FISC-AGENT  THRU P2300-EXIT        CHGBD216
00439               END-IF                                              CHGBD216
00440               PERFORM P3000-BUILD-CHG4-REC THRU P3000-EXIT        CHGBD216
00441               PERFORM S1100-WRITE-BD216    THRU S1100-EXIT        CHGBD216
00442            END-IF                                                 CHGBD216
00443            READ CHARGE-FILE-IN                                    CHGBD216
00444      END-PERFORM.                                                 CHGBD216
00445                                                                   CHGBD216
00446                                                                   CHGBD216
00447  P0000-EXIT.                                                      CHGBD216
00448      EXIT.                                                        CHGBD216
00449                                                                   CHGBD216
00450  P1000-SELECT.                                                    CHGBD216
00451      SET WRK-SELECT-NO-88         TO TRUE.                        CHGBD216
00452                                                                   CHGBD216
00453      EVALUATE TRUE                                                CHGBD216
00454         WHEN CHG3-RUN-TYPE-QTRLY-88                               CHGBD216
00455            SET WRK-SELECT-YES-88  TO TRUE                         CHGBD216
00456                                                                   CHGBD216
00457         WHEN CHG3-RUN-TYPE-ANN-88                                 CHGBD216
00458            SET WRK-SELECT-YES-88  TO TRUE                         CHGBD216
00459                                                                   CHGBD216
00460         WHEN CHG3-RUN-TYPE-EMP-88                                 CHGBD216
00461            IF CHG5-EMP-NO = CHG3-EMP-NO                           CHGBD216
00462               SET WRK-SELECT-YES-88  TO TRUE                      CHGBD216
00463            END-IF                                                 CHGBD216
00464                                                                   CHGBD216
00465         WHEN CHG3-RUN-TYPE-AGENT-88                               CHGBD216
00466            SET WRK-SELECT-YES-88  TO TRUE                         CHGBD216
00467                                                                   CHGBD216
00468      END-EVALUATE.                                                CHGBD216
00469 ************************************************************      CHGBD216
00470 * THE PARAGRAPH BELOW WILL PREVENT PRINTING OF CHARGE DATA        CHGBD216
00471 * FOR 100% TRANSFERS.  IN SOME SITUATIONS (PARTIAL TRANSFER       CHGBD216
00472 * PRECEDING 100% TRANSFER) IT WILL SHOW THE PARTIALS              CHGBD216
00473 * BUT NOT THE 100% THAT CLOSES THE ACCOUNT.                       CHGBD216
00474 * THE PARAGRAPH WAS COMMENTED OUT ON 01/08/2008 BECAUSE IT        CHGBD216
00475 * IS PROBABLY BETTER TO SHOW THE COMPLETE PROCESS.                CHGBD216
00476 * PREDECESSORS INVOLVED IN A 100% TRANSFER WILL RECEIVE A         CHGBD216
00477 * REPORT SHOWING 0 CHARGES, DOCUMENTING THE TRANSFER TO           CHGBD216
00478 * THE SUCCESSOR.   GD                                             CHGBD216
00479 ************************************************************      CHGBD216
00480 *&   PERFORM P1100-BYPASS-PRED       THRU P1100-EXIT.             CHGBD216
00481                                                                   CHGBD216
00482  P1000-EXIT.                                                      CHGBD216
00483      EXIT.                                                        CHGBD216
00484                                                                   CHGBD216
00485  P1100-BYPASS-PRED.                                               CHGBD216
00486      IF CHG5-PERCENT-XFER = +1                                    CHGBD216
00487         IF CHG5-EMP-NO = CHG5-PRED-EMP-NO                         CHGBD216
00488            ADD +1                 TO WRK-BYPASS-PRED-CNT          CHGBD216
00489            SET WRK-SELECT-NO-88   TO TRUE                         CHGBD216
00490         END-IF                                                    CHGBD216
00491      END-IF.                                                      CHGBD216
00492                                                                   CHGBD216
00493  P1100-EXIT.                                                      CHGBD216
00494      EXIT.                                                        CHGBD216
00495                                                                   CHGBD216
00496  P2000-GET-ADDRESS.                                               CHGBD216
00497      MOVE SPACES                  TO WRK-FMT-ADDR                 CHGBD216
00498                                      WRK-ZIP                      CHGBD216
00499                                      WRK-ADVANCED-BARCODE.        CHGBD216
00500                                                                   CHGBD216
00501      PERFORM P2100-FIND-ADDRESS      THRU P2100-EXIT              CHGBD216
00502      IF L111-ADDR-FOUND-88                                        CHGBD216
00503         PERFORM P2200-FORMAT-ADDRESS THRU P2200-EXIT              CHGBD216
00504      ELSE                                                         CHGBD216
00505         DISPLAY 'P2000 NO ADDRESS ' CHG5-EMP-NO                   CHGBD216
00506      END-IF.                                                      CHGBD216
00507                                                                   CHGBD216
00508  P2000-EXIT.                                                      CHGBD216
00509      EXIT.                                                        CHGBD216
00510                                                                   CHGBD216
00511  P2100-FIND-ADDRESS.                                              CHGBD216
00512      MOVE CHG5-EMP-NO             TO L111-EMP-NO.                 CHGBD216
00513      SET L111-LOOKUP-TAD-88       TO TRUE.                        CHGBD216
00514      SET L111-ID-NO-TAD-MAIL-88   TO TRUE.                        CHGBD216
00515      PERFORM S111-LOOKUP-ADDRESS  THRU S111-EXIT.                 CHGBD216
00516      IF L111-ADDR-NOT-FOUND-88                                    CHGBD216
00517         SET WRK-EMP-VALID-NO-88   TO TRUE                         CHGBD216
00518         MOVE MSG5-ID2             TO R907-MSG-ID                  CHGBD216
00519         MOVE CHG5-EMP-NO          TO MSG5-EMP-NO                  CHGBD216
00520                                      R907-EMP-NO                  CHGBD216
00521         MOVE MSG5-LONG-TEXT       TO R907-MSG-TEXT                CHGBD216
00522         MOVE R907-REC             TO RSKL-REC                     CHGBD216
00523         PERFORM S946-RPT-REC-O    THRU S946-EXIT                  CHGBD216
00524      END-IF.                                                      CHGBD216
00525                                                                   CHGBD216
00526  P2100-EXIT.                                                      CHGBD216
00527      EXIT.                                                        CHGBD216
00528                                                                   CHGBD216
00529  P2200-FORMAT-ADDRESS.                                            CHGBD216
00530      MOVE LOW-VALUE                TO MPRF-KEY-AREA.              CHGBD216
00531      MOVE CHG5-EMP-NO              TO MPRF-EMP-NO.                CHGBD216
00532      SET MPRF-PRF-88               TO TRUE.                       CHGBD216
00533      MOVE MPRF-KEY-AREA            TO MSKL-KEY-AREA.              CHGBD216
00534                                                                   CHGBD216
00535      PERFORM S910-READ             THRU S910-EXIT.                CHGBD216
00536      IF L910-NO-REC-88                                            CHGBD216
00537         MOVE SPACES                TO WRK-EMP-NAME                CHGBD216
00538         GO TO P2200-EXIT                                          CHGBD216
00539      ELSE                                                         CHGBD216
00540         MOVE MSKL-REC              TO MPRF-REC                    CHGBD216
00541         MOVE MPRF-PRIMARY-NAME     TO WRK-EMP-NAME                CHGBD216
00542                                                                   CHGBD216
00543      END-IF.                                                      CHGBD216
00544                                                                   CHGBD216
00545      SET L112-TAD-ADDR-88         TO TRUE.                        CHGBD216
00546      SET L112-ANCHOR-LAST-88      TO TRUE.                        CHGBD216
00547      MOVE L111-RETURN-AREA        TO L112-NAME-ADDRESS-AREA.      CHGBD216
00548      MOVE WRK-EMP-NAME            TO L112-PRIMARY-NAME.           CHGBD216
00549      PERFORM S112-FORMAT-ADDRESS  THRU S112-EXIT.                 CHGBD216
00550                                                                   CHGBD216
00551      MOVE L112-MAILING-ADDRESS    TO WRK-FMT-ADDR.                CHGBD216
00552      MOVE L111-ZIP                TO WRK-ZIP.                     CHGBD216
00553      MOVE L111-ADVANCED-BARCODE   TO WRK-ADVANCED-BARCODE.        CHGBD216
00554                                                                   CHGBD216
00555  P2200-EXIT.                                                      CHGBD216
00556      EXIT.                                                        CHGBD216
00557                                                                   CHGBD216
00558  P2300-FISC-AGENT.                                                CHGBD216
00559      MOVE LOW-VALUE                TO MFAE-KEY-AREA.              CHGBD216
00560      MOVE CHG5-EMP-NO              TO MFAE-EMP-NO.                CHGBD216
00561      SET MFAE-FAE-88               TO TRUE.                       CHGBD216
00562      SET MFAE-SERVICE-BEN-CHG-88   TO TRUE.                       CHGBD216
00563      MOVE MFAE-KEY-AREA            TO MSKL-KEY-AREA.              CHGBD216
00564                                                                   CHGBD216
00565      PERFORM S910-READ             THRU S910-EXIT.                CHGBD216
00566      IF L910-NO-REC-88                                            CHGBD216
00567         MOVE SPACES                TO WRK-FISCAL-AGENT-CD         CHGBD216
00568         GO TO P2300-EXIT                                          CHGBD216
00569      ELSE                                                         CHGBD216
00570         MOVE MSKL-REC              TO MFAE-REC                    CHGBD216
00571         MOVE MFAE-FISCAL-AGENT-CD  TO WRK-FISCAL-AGENT-CD         CHGBD216
00572      END-IF.                                                      CHGBD216
00573                                                                   CHGBD216
00574  P2300-EXIT.                                                      CHGBD216
00575      EXIT.                                                        CHGBD216
00576                                                                   CHGBD216
00577  P3000-BUILD-CHG4-REC.                                            CHGBD216
00578                                                                   CHGBD216
00579      SET  CHG4-RPT-TYPE-RATED-88  TO TRUE.                        CHGBD216
00580      MOVE CHG5-EMP-NO             TO CHG4-EMP-NO.                 CHGBD216
00581      MOVE CHG5-SSN                TO CHG4-SSN.                    CHGBD216
00582      MOVE CHG5-BYE                TO CHG4-BYE.                    CHGBD216
00583      MOVE CHG5-PROGRAM            TO CHG4-PROGRAM.                CHGBD216
00584                                                                   CHGBD216
00585      MOVE CHG5-TOT-CHG-AMT        TO CHG4-CURR-BEN-AMT.           CHGBD216
00586      MOVE ZEROS                   TO CHG4-CURR-ADJ-AMT            CHGBD216
00587                                      CHG4-TOT-BEN-AMT             CHGBD216
00588                                      CHG4-TOT-ADJ-AMT             CHGBD216
00589                                      CHG4-OP-RECOVER-AMT.         CHGBD216
00590                                                                   CHGBD216
00591      MOVE CHG5-SUCC-EMP-NO        TO CHG4-SUCC-EMP-NO.            CHGBD216
00592      MOVE CHG5-PRED-EMP-NO        TO CHG4-PRED-EMP-NO.            CHGBD216
00593      MOVE CHG5-PERCENT-XFER       TO CHG4-PERCENT-XFER.           CHGBD216
00594                                                                   CHGBD216
00595      MOVE CHG5-SSN                TO L081-CLAIMANT-SSN.           CHGBD216
00596      PERFORM S081-CLAIMANT-NAME   THRU S081-EXIT.                 CHGBD216
00597      IF L081-NAME-FOUND                                           CHGBD216
00598         MOVE L081-CLAIMANT-NAME   TO CHG4-CLMNT-NAME              CHGBD216
00599      ELSE                                                         CHGBD216
00600         PERFORM S083-IB6-CLMNT-NAME  THRU S083-EXIT               CHGBD216
00601         MOVE L081-CLAIMANT-NAME   TO CHG4-CLMNT-NAME.             CHGBD216
00602                                                                   CHGBD216
00603      MOVE WRK-FISCAL-AGENT-CD     TO CHG4-FISCAL-AGENT-CD.        CHGBD216
00604      MOVE WRK-FMT-ADDR            TO CHG4-FMT-ADDR.               CHGBD216
00605      MOVE WRK-ZIP                 TO CHG4-ZIP.                    CHGBD216
00606      MOVE WRK-ADVANCED-BARCODE    TO CHG4-ADVANCED-BARCODE.       CHGBD216
00607      MOVE WRK-EMP-NAME-CHK        TO CHG4-EMP-NAME-CHK.           CHGBD216
00608                                                                   CHGBD216
00609      MOVE ZEROS                   TO CHG4-EMP-TYPE.               CHGBD216
00610      MOVE SPACES                  TO CHG4-DATA-FILLER.            CHGBD216
00611                                                                   CHGBD216
00612  P3000-EXIT.                                                      CHGBD216
00613      EXIT.                                                        CHGBD216
00614                                                                   CHGBD216
00615  S001-FROM-FED-8.                                                 CHGBD216
00616      SET L001-FROM-FED-8 TO TRUE.                                 CHGBD216
00617      GO TO S001-DATE.                                             CHGBD216
00618                                                                   CHGBD216
00619  S001-FROM-ABS.                                                   CHGBD216
00620      SET L001-FROM-ABS-DAY  TO TRUE.                              CHGBD216
00621      GO TO S001-DATE.                                             CHGBD216
00622                                                                   CHGBD216
00623  S001-DATE.                                                       CHGBD216
00624      CALL 'DTSBU001' USING L001-LINK-AREA.                        CHGBD216
00625  S001-EXIT. EXIT.                                                 CHGBD216
00626                                                                   CHGBD216
00627  S004-FROM-5.                                                     CHGBD216
00628      SET L004-FROM-5    TO TRUE.                                  CHGBD216
00629      GO TO S004-YRQ.                                              CHGBD216
00630                                                                   CHGBD216
00631  S004-FROM-3.                                                     CHGBD216
00632      SET L004-FROM-3    TO TRUE.                                  CHGBD216
00633      GO TO S004-YRQ.                                              CHGBD216
00634                                                                   CHGBD216
00635  S004-FROM-DATE.                                                  CHGBD216
00636      SET L004-FROM-DATE TO TRUE.                                  CHGBD216
00637      GO TO S004-YRQ.                                              CHGBD216
00638                                                                   CHGBD216
00639  S004-FROM-ABS.                                                   CHGBD216
00640      SET L004-FROM-ABS  TO TRUE.                                  CHGBD216
00641      GO TO S004-YRQ.                                              CHGBD216
00642                                                                   CHGBD216
00643  S004-YRQ.                                                        CHGBD216
00644      CALL 'DTSBU004' USING L004-LINK-AREA.                        CHGBD216
00645  S004-EXIT. EXIT.                                                 CHGBD216
00646                                                                   CHGBD216
00647  S005-SYSTEM-TIME.                                                CHGBD216
00648      CALL 'DTSBU005' USING L005-LINK-AREA.                        CHGBD216
00649  S005-EXIT.                                                       CHGBD216
00650      EXIT.                                                        CHGBD216
00651                                                                   CHGBD216
00652  S006-FROM-QTR.                                                   CHGBD216
00653      SET L006-FROM-QTR TO TRUE.                                   CHGBD216
00654      GO TO S006-UI-RATE-YEAR.                                     CHGBD216
00655                                                                   CHGBD216
00656  S006-UI-RATE-YEAR.                                               CHGBD216
00657      CALL 'DTSBU006' USING L006-LINK-AREA.                        CHGBD216
00658  S006-EXIT.                                                       CHGBD216
00659      EXIT.                                                        CHGBD216
00660                                                                   CHGBD216
00661  S081-CLAIMANT-NAME.                                              CHGBD216
00662      CALL 'DTSBU081' USING L081-LINK-AREA.                        CHGBD216
00663  S081-EXIT. EXIT.                                                 CHGBD216
00664                                                                   CHGBD216
00665  S083-IB6-CLMNT-NAME.                                             CHGBD216
00666      CALL 'DTSBU083' USING L081-LINK-AREA.                        CHGBD216
00667  S083-EXIT. EXIT.                                                 CHGBD216
00668                                                                   CHGBD216
00669  S100-CALL-CHGBU100.                                              CHGBD216
00670      CALL 'CHGBU100' USING L100-LINK-AREA.                        CHGBD216
00671  S100-EXIT. EXIT.                                                 CHGBD216
00672                                                                   CHGBD216
00673  S111-LOOKUP-ADDRESS.                                             CHGBD216
00674      CALL 'DTSBU111' USING L111-LINK-AREA.                        CHGBD216
00675  S111-EXIT. EXIT.                                                 CHGBD216
00676                                                                   CHGBD216
00677  S112-FORMAT-ADDRESS.                                             CHGBD216
00678      CALL 'DTSBU112' USING L112-LINK-AREA.                        CHGBD216
00679  S112-EXIT. EXIT.                                                 CHGBD216
00680                                                                   CHGBD216
00681  S1100-WRITE-BD216.                                               CHGBD216
00682      WRITE BD216-CHG-REC.                                         CHGBD216
00683      IF BD216-FILE-OK-88                                          CHGBD216
00684         ADD 1 TO WRK-BD216-WRITE                                  CHGBD216
00685      END-IF.                                                      CHGBD216
00686                                                                   CHGBD216
00687  S1100-EXIT.                                                      CHGBD216
00688      EXIT.                                                        CHGBD216
00689                                                                   CHGBD216
00690                                                                   CHGBD216
00691  S910-OPEN-READ.                                                  CHGBD216
00692      SET L910-OPEN-READ-88 TO TRUE.                               CHGBD216
00693      GO TO S910-MSTR-IO.                                          CHGBD216
00694                                                                   CHGBD216
00695  S910-OPEN-UPDATE.                                                CHGBD216
00696      SET L910-OPEN-UPDATE-88 TO TRUE.                             CHGBD216
00697      GO TO S910-MSTR-IO.                                          CHGBD216
00698                                                                   CHGBD216
00699  S910-READ.                                                       CHGBD216
00700      SET L910-READ-88 TO TRUE.                                    CHGBD216
00701      GO TO S910-MSTR-IO.                                          CHGBD216
00702                                                                   CHGBD216
00703  S910-START-BROWSE.                                               CHGBD216
00704      SET L910-START-BROWSE-88 TO TRUE.                            CHGBD216
00705      GO TO S910-MSTR-IO.                                          CHGBD216
00706                                                                   CHGBD216
00707  S910-READ-NEXT.                                                  CHGBD216
00708      SET L910-READ-NEXT-88    TO TRUE.                            CHGBD216
00709      GO TO S910-MSTR-IO.                                          CHGBD216
00710                                                                   CHGBD216
00711  S910-WRITE.                                                      CHGBD216
00712      SET L910-WRITE-88        TO TRUE.                            CHGBD216
00713      GO TO S910-MSTR-IO.                                          CHGBD216
00714                                                                   CHGBD216
00715  S910-CLOSE.                                                      CHGBD216
00716      SET L910-CLOSE-88 TO TRUE.                                   CHGBD216
00717      GO TO S910-MSTR-IO.                                          CHGBD216
00718                                                                   CHGBD216
00719  S910-MSTR-IO.                                                    CHGBD216
00720      CALL 'DTSBU910' USING L910-LINK-AREA                         CHGBD216
00721                            MSKL-REC.                              CHGBD216
00722                                                                   CHGBD216
00723  S910-EXIT.                                                       CHGBD216
00724      EXIT.                                                        CHGBD216
00725                                                                   CHGBD216
00726  S921-OPEN-READ.                                                  CHGBD216
00727      SET L921-OPEN-READ-88 TO TRUE.                               CHGBD216
00728      GO TO S921-AIX-IO.                                           CHGBD216
00729                                                                   CHGBD216
00730  S921-CLOSE.                                                      CHGBD216
00731      SET L921-CLOSE-88 TO TRUE.                                   CHGBD216
00732      GO TO S921-AIX-IO.                                           CHGBD216
00733                                                                   CHGBD216
00734  S921-AIX-IO.                                                     CHGBD216
00735      CALL 'DTSBU921' USING L921-LINK-AREA                         CHGBD216
00736                            ISKL-REC.                              CHGBD216
00737                                                                   CHGBD216
00738  S921-EXIT.                                                       CHGBD216
00739      EXIT.                                                        CHGBD216
00740                                                                   CHGBD216
00741 ** REPORT RECORD I-O                                              CHGBD216
00742  S946-RPT-REC-O.                                                  CHGBD216
00743      CALL 'DTSBU946' USING RSKL-REC.                              CHGBD216
00744                                                                   CHGBD216
00745  S946-EXIT.                                                       CHGBD216
00746      EXIT.                                                        CHGBD216
00747                                                                   CHGBD216
00748  T0000-TERMINATE.                                                 CHGBD216
00749      IF WRK-BD216-WRITE = ZERO                                    CHGBD216
00750         PERFORM T1000-WRITE-DUMMY THRU T1000-EXIT                 CHGBD216
00751      END-IF                                                       CHGBD216
00752                                                                   CHGBD216
00753      CLOSE CHARGE-FILE-IN BD216-CHG-FILE-OUT.                     CHGBD216
00754                                                                   CHGBD216
00755      PERFORM S910-CLOSE     THRU S910-EXIT.                       CHGBD216
00756      PERFORM S921-CLOSE     THRU S921-EXIT.                       CHGBD216
00757                                                                   CHGBD216
00758      DISPLAY '***********************************************'.   CHGBD216
00759      DISPLAY '***             CHGBD216 COUNTS             *** '.  CHGBD216
00760      DISPLAY '***'.                                               CHGBD216
00761                                                                   CHGBD216
00762      DISPLAY ' CHG5 RECORDS READ          :        '              CHGBD216
00763         WRK-CHG5-CNT.                                             CHGBD216
00764      DISPLAY ' CHG5 RECORDS SELECTED      :        '              CHGBD216
00765         WRK-SELECTED-CNT.                                         CHGBD216
00766      MOVE WRK-TOT-CHG         TO WRK-CHG-AMT-DISP.                CHGBD216
00767      DISPLAY 'TOTAL CHARGES       ' WRK-CHG-AMT-DISP.             CHGBD216
00768      DISPLAY '    '.                                              CHGBD216
00769      DISPLAY ' CHGBD216 NOT LIABLE RECORDS PASSED: '              CHGBD216
00770         WRK-BD216-NOT-LIAB-CNT.                                   CHGBD216
00771      DISPLAY ' 100% PREDECESSORS BYPASSED:         '              CHGBD216
00772         WRK-BYPASS-PRED-CNT.                                      CHGBD216
00773                                                                   CHGBD216
00774      DISPLAY ' CHGBD216 RECORDS WRITTEN :          '              CHGBD216
00775         WRK-BD216-WRITE.                                          CHGBD216
00776                                                                   CHGBD216
00777      DISPLAY '***********************************************'.   CHGBD216
00778                                                                   CHGBD216
00779  T0000-EXIT.                                                      CHGBD216
00780      EXIT.                                                        CHGBD216
00781 *                                                                 CHGBD216
00782  T1000-WRITE-DUMMY.                                               CHGBD216
00783      INITIALIZE BD216-CHG-REC.                                    CHGBD216
00784      SET CHG4-RPT-TYPE-NULL-88   TO TRUE.                         CHGBD216
00785      MOVE ZEROS                  TO CHG4-EMP-NO.                  CHGBD216
00786                                                                   CHGBD216
00787      WRITE BD216-CHG-REC.                                         CHGBD216
00788      ADD 1                       TO WRK-BD216-WRITE.              CHGBD216
00789                                                                   CHGBD216
00790  T1000-EXIT.                                                      CHGBD216
00791      EXIT.                                                        CHGBD216
00792                                                                   CHGBD216
00793  S999-ABEND.                                                      CHGBD216
00794      DISPLAY '****  CHGBD216 ABENDING '                           CHGBD216
00795         ABEND-MSG '  ' BD216-CHG-STATUS.                          CHGBD216
00796      CALL ABEND-MOD USING ABEND-CODE.                             CHGBD216
00797                                                                   CHGBD216
00798  S999-EXIT.                                                       CHGBD216
00799      EXIT.                                                        CHGBD216
00800                                                                   CHGBD216
