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