241 lines
19 KiB
COBOL
241 lines
19 KiB
COBOL
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
|