00001  IDENTIFICATION DIVISION.                                         04/22/20
00002  PROGRAM-ID.             CHGBU100.                                CHGBU100
00003 *AUTHOR.                 TCL.                                        LV002
00004 *DATE-WRITTEN.           APRIL 1999.                              CHGBU100
00005  DATE-COMPILED.                                                   CHGBU100
00006      SKIP3                                                        CHGBU100
00007 *****                                                             CHGBU100
00008 *                                                                 CHGBU100
00009 *    FUNCTION:                                                    CHGBU100
00010 *                                                                 CHGBU100
00011 *        VERIFY EMPLOYER ACCOUNT NUMBER ON CHARGE RECORD          CHGBU100
00012 *        AGAINST EMPLOYER MASTER FILE.                            CHGBU100
00013 *        RETURN CORRECT ELIGIBILITY CODE.                         CHGBU100
00014 *        RETURN FISCAL AGENT CODE IF THERE IS A BENEFIT CHARGE    CHGBU100
00015 *        MFAE RECORD FOR THE EMPLOYER.                            CHGBU100
00016 *        RETURN THE SUCCESSOR ACCOUNT NUMBER, IF ANY.             CHGBU100
00017 *                                                                 CHGBU100
00018 *****                                                             CHGBU100
00019                                                                   CHGBU100
00020 ******************************************************************CHGBU100
00021 * MODIFICATION HISTORY:                                          *CHGBU100
00022 *                                                                *CHGBU100
00023 * 04-14-2000 INITIAL DEVELOPMENT                                 *CHGBU100
00024 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBU100
00025 *                                                                *CHGBU100
00026 * 05-15-2000 MODIFIED TO PASS L100-EXP-TRN-EFF-DATE TO DTSBU600. *CHGBU100
00027 *            SEE COMMENTS IN DTSBU600 FOR EXPLANATION.           *CHGBU100
00028 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBU100
00029 *                                                                *CHGBU100
00030 * 06-29-2004 RECOMPILED FOR NEW MPRF WITH ELIG CODE 17 (DOMESTIC *CHGBU100
00031 *            VIOLENCE)                                            CHGBU100
00032 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBU100
00033 *                                                                *CHGBU100
00034 * 02-26-2009 RECOMPILED FOR NEW MPRF WITH ELIG CODE 20 FAC       *CHGBU100
00035 *            REMOVED CALL TO DTSBU600 - TRANSFERS OR OWNERSHIP   *CHGBU100
00036 *            ARE NOW HANDLED IN THE REPORTING PROCESS.           *CHGBU100
00037 *            A PREVIOUS CHANGE ELIMINATED THE CODE THAT          *CHGBU100
00038 *            RETURNED THE SUCCESSOR NUMBER TO THE CALLING        *CHGBU100
00039 *            PROGRAM.                                            *CHGBU100
00040 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBU100
00041 *                                                                *CHGBU100
00042 * 04-21-2020 RECOMPILED FOR NEW MPRF WITH ELIG CODE 29 31 32 33  *   CL**2
00043 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**2
00044 *                                                                *   CL**2
00045 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBU100
00046 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBU100
00047 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBU100
00048 ******************************************************************CHGBU100
00049                                                                   CHGBU100
00050      SKIP3                                                        CHGBU100
00051  ENVIRONMENT DIVISION.                                            CHGBU100
00052      SKIP3                                                        CHGBU100
00053  DATA DIVISION.                                                   CHGBU100
00054      SKIP3                                                        CHGBU100
00055      EJECT                                                        CHGBU100
00056  WORKING-STORAGE SECTION.                                         CHGBU100
000565 77  PAN-VALET PICTURE X(24) VALUE '002CHGBU100  04/22/20'.       CHGBU100
00057  77  PAN-VALET PICTURE X(24) VALUE '009CHGBU100  02/26/09'.       CHGBU100
00058                                                                   CHGBU100
00059  01  WRK-AREA.                                                    CHGBU100
00060      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBU100
00061                                  VALUE +100.                      CHGBU100
00062      05  ABEND-MSG                   PIC  X(60).                  CHGBU100
00063                                                                   CHGBU100
00064      05  WRK-FIRST-TIME-IND          PIC  X(01) VALUE 'Y'.        CHGBU100
00065          88  WRK-FIRST-TIME-YES-88     VALUE 'Y'.                 CHGBU100
00066          88  WRK-FIRST-TIME-NO-88      VALUE 'N'.                 CHGBU100
00067                                                                   CHGBU100
00068      05  WRK-EXP-TRN-EFF-DATE        PIC S9(09)  COMP-3.          CHGBU100
00069                                                                   CHGBU100
00070      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          CHGBU100
00071          88  WRK-POOL-ACCT-88    VALUE 000000, 028411,            CHGBU100
00072                                        999000 THRU 999992.        CHGBU100
00073                                                                   CHGBU100
00074  01  L600-LINK-AREA.                                              CHGBU100
00075  ++INCLUDE DTSIL600                                               CHGBU100
00076                                                                   CHGBU100
00077  01  L910-LINK-AREA.                                              CHGBU100
00078  ++INCLUDE DTSIL910                                               CHGBU100
00079                                                                   CHGBU100
00080  01  MSKL-REC.                                                    CHGBU100
00081  ++INCLUDE DTSIMSKL                                               CHGBU100
00082                                                                   CHGBU100
00083  01  MFAE-REC.                                                    CHGBU100
00084  ++INCLUDE DTSIMFAE                                               CHGBU100
00085                                                                   CHGBU100
00086  01  MPRF-REC.                                                    CHGBU100
00087  ++INCLUDE DTSIMPRF                                               CHGBU100
00088                                                                   CHGBU100
00089  01  L921-LINK-AREA.                                              CHGBU100
00090  ++INCLUDE DTSIL921                                               CHGBU100
00091                                                                   CHGBU100
00092  01  ISKL-REC.                                                    CHGBU100
00093  ++INCLUDE DTSIISKL                                               CHGBU100
00094                                                                   CHGBU100
00095  LINKAGE SECTION.                                                 CHGBU100
00096  01  L100-LINK-AREA.                                              CHGBU100
00097  ++INCLUDE CHGIL100                                               CHGBU100
00098                                                                   CHGBU100
00099  PROCEDURE DIVISION USING L100-LINK-AREA.                         CHGBU100
00100      SKIP2                                                        CHGBU100
00101  CHGBU100-MAIN.                                                   CHGBU100
00102      IF WRK-FIRST-TIME-YES-88                                     CHGBU100
00103         PERFORM I0000-INITIATE THRU I0000-EXIT.                   CHGBU100
00104                                                                   CHGBU100
00105      PERFORM P0000-PROCESS THRU P0000-EXIT.                       CHGBU100
00106                                                                   CHGBU100
00107  CHGBU100-EXIT.                                                   CHGBU100
00108      GOBACK.                                                      CHGBU100
00109      EJECT                                                        CHGBU100
00110  I0000-INITIATE.                                                  CHGBU100
00111      SET WRK-FIRST-TIME-NO-88 TO TRUE.                            CHGBU100
00112                                                                   CHGBU100
00113      IF L100-EXP-TRN-EFF-DATE NOT NUMERIC                         CHGBU100
00114         MOVE 99999999 TO WRK-EXP-TRN-EFF-DATE                     CHGBU100
00115      ELSE                                                         CHGBU100
00116         MOVE L100-EXP-TRN-EFF-DATE TO WRK-EXP-TRN-EFF-DATE.       CHGBU100
00117  I0000-EXIT.                                                      CHGBU100
00118      EXIT.                                                        CHGBU100
00119                                                                   CHGBU100
00120  P0000-PROCESS.                                                   CHGBU100
00121      PERFORM P0100-INIT-RETURN THRU P0100-EXIT.                   CHGBU100
00122                                                                   CHGBU100
00123      PERFORM P1000-EDIT-EMP-NO THRU P1000-EXIT.                   CHGBU100
00124      IF L100-POOL-ACCT-88                                         CHGBU100
00125         GO TO P0000-EXIT.                                         CHGBU100
00126                                                                   CHGBU100
00127      PERFORM P3000-EDIT-MASTER THRU P3000-EXIT.                   CHGBU100
00128                                                                   CHGBU100
00129  P0000-EXIT.                                                      CHGBU100
00130      EXIT.                                                        CHGBU100
00131                                                                   CHGBU100
00132  P0100-INIT-RETURN.                                               CHGBU100
00133      SET L100-NO-REC-FOUND-88         TO TRUE.                    CHGBU100
00134      SET L100-EMP-TYPE-NULL-88        TO TRUE.                    CHGBU100
00135      MOVE SPACES                      TO L100-FISCAL-AGENT-CD     CHGBU100
00136                                          L100-PRIMARY-NAME.       CHGBU100
00137      MOVE ZERO                        TO L100-SUCCESSOR.          CHGBU100
00138                                                                   CHGBU100
00139  P0100-EXIT.                                                      CHGBU100
00140      EXIT.                                                        CHGBU100
00141                                                                   CHGBU100
00142  P1000-EDIT-EMP-NO.                                               CHGBU100
00143      MOVE L100-EMP-NO          TO WRK-EMP-NO.                     CHGBU100
00144      IF WRK-POOL-ACCT-88                                          CHGBU100
00145         SET L100-POOL-ACCT-88  TO TRUE.                           CHGBU100
00146                                                                   CHGBU100
00147  P1000-EXIT.                                                      CHGBU100
00148      EXIT.                                                        CHGBU100
00149                                                                   CHGBU100
00150  P3000-EDIT-MASTER.                                               CHGBU100
00151      PERFORM S1000-READ-MASTER   THRU S1000-EXIT.                 CHGBU100
00152      IF L100-NO-REC-FOUND-88                                      CHGBU100
00153         GO TO P3000-EXIT.                                         CHGBU100
00154                                                                   CHGBU100
00155 **   PERFORM P3100-SUCCESSOR    THRU P3100-EXIT.                  CHGBU100
00156 *    IF L100-NO-REC-FOUND-88                                      CHGBU100
00157 **      GO TO P3000-EXIT.                                         CHGBU100
00158                                                                   CHGBU100
00159      PERFORM P3200-MPRF-DATA    THRU P3200-EXIT.                  CHGBU100
00160                                                                   CHGBU100
00161      PERFORM P3300-FISCAL-AGENT THRU P3300-EXIT.                  CHGBU100
00162                                                                   CHGBU100
00163  P3000-EXIT.                                                      CHGBU100
00164      EXIT.                                                        CHGBU100
00165                                                                   CHGBU100
00166 *P3100-SUCCESSOR.                                                 CHGBU100
00167 *    MOVE WRK-EMP-NO                 TO L600-EMP-NO.              CHGBU100
00168 *    MOVE WRK-EXP-TRN-EFF-DATE       TO L600-EXP-TRN-EFF-DATE.    CHGBU100
00169 *    PERFORM S0600-CALL-BU600        THRU S0600-EXIT.             CHGBU100
00170 *    IF L600-SUCCESSOR-FOUND-88                                   CHGBU100
00171 *&                                                                CHGBU100
00172 *       DISPLAY 'CHGBU100 PRED ' L600-EMP-NO                      CHGBU100
00173 *          '  SUCC ' L600-ULTIMATE-SUCCESSOR                      CHGBU100
00174 *&                                                                CHGBU100
00175 *       MOVE L600-ULTIMATE-SUCCESSOR TO L100-SUCCESSOR            CHGBU100
00176 *                                       WRK-EMP-NO                CHGBU100
00177 *       PERFORM S1000-READ-MASTER    THRU S1000-EXIT.             CHGBU100
00178 *                                                                 CHGBU100
00179 *P3100-EXIT.                                                      CHGBU100
00180 *    EXIT.                                                        CHGBU100
00181                                                                   CHGBU100
00182                                                                   CHGBU100
00183  P3200-MPRF-DATA.                                                 CHGBU100
00184      MOVE MPRF-ELIGIBLE-CD         TO L100-EMP-TYPE.              CHGBU100
00185      MOVE MPRF-PRIMARY-NAME        TO L100-PRIMARY-NAME.          CHGBU100
00186                                                                   CHGBU100
00187  P3200-EXIT.                                                      CHGBU100
00188      EXIT.                                                        CHGBU100
00189                                                                   CHGBU100
00190  P3300-FISCAL-AGENT.                                              CHGBU100
00191      IF MPRF-CHRG-STMT-PRINT-NO-88                                CHGBU100
00192        GO TO P3300-EXIT.                                          CHGBU100
00193                                                                   CHGBU100
00194      MOVE LOW-VALUE                TO MFAE-KEY-AREA.              CHGBU100
00195      MOVE WRK-EMP-NO               TO MFAE-EMP-NO.                CHGBU100
00196      SET MFAE-FAE-88               TO TRUE.                       CHGBU100
00197      SET MFAE-SERVICE-BEN-CHG-88   TO TRUE.                       CHGBU100
00198      MOVE MFAE-KEY-AREA            TO MSKL-KEY-AREA.              CHGBU100
00199                                                                   CHGBU100
00200      PERFORM S910-READ             THRU S910-EXIT.                CHGBU100
00201      IF L910-NO-REC-88                                            CHGBU100
00202           GO TO P3300-EXIT                                        CHGBU100
00203      ELSE                                                         CHGBU100
00204         MOVE MSKL-REC              TO MFAE-REC                    CHGBU100
00205         MOVE MFAE-FISCAL-AGENT-CD  TO L100-FISCAL-AGENT-CD.       CHGBU100
00206                                                                   CHGBU100
00207  P3300-EXIT.                                                      CHGBU100
00208      EXIT.                                                        CHGBU100
00209                                                                   CHGBU100
00210  S0600-CALL-BU600.                                                CHGBU100
00211      CALL 'DTSBU600' USING L600-LINK-AREA.                        CHGBU100
00212  S0600-EXIT.                                                      CHGBU100
00213      EXIT.                                                        CHGBU100
00214                                                                   CHGBU100
00215  S910-READ.                                                       CHGBU100
00216      SET L910-READ-88 TO TRUE.                                    CHGBU100
00217      GO TO S910-MSTR-IO.                                          CHGBU100
00218                                                                   CHGBU100
00219  S910-MSTR-IO.                                                    CHGBU100
00220      CALL 'DTSBU910' USING L910-LINK-AREA                         CHGBU100
00221                            MSKL-REC.                              CHGBU100
00222                                                                   CHGBU100
00223  S910-EXIT.                                                       CHGBU100
00224      EXIT.                                                        CHGBU100
00225                                                                   CHGBU100
00226  S1000-READ-MASTER.                                               CHGBU100
00227      MOVE LOW-VALUES         TO MPRF-KEY-AREA.                    CHGBU100
00228      MOVE WRK-EMP-NO         TO MPRF-EMP-NO.                      CHGBU100
00229      SET MPRF-PRF-88         TO TRUE.                             CHGBU100
00230      MOVE MPRF-KEY-AREA      TO MSKL-KEY-AREA.                    CHGBU100
00231      PERFORM S910-READ       THRU S910-EXIT.                      CHGBU100
00232      IF L910-NO-REC-88                                            CHGBU100
00233         SET L100-NO-REC-FOUND-88 TO TRUE                          CHGBU100
00234      ELSE                                                         CHGBU100
00235         MOVE MSKL-REC TO MPRF-REC                                 CHGBU100
00236         SET L100-OK-88            TO TRUE.                        CHGBU100
00237                                                                   CHGBU100
00238  S1000-EXIT.                                                      CHGBU100
00239      EXIT.                                                        CHGBU100
