DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
240
Batch/CHGBU100.cob
Normal file
240
Batch/CHGBU100.cob
Normal file
@ -0,0 +1,240 @@
|
||||
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
|
||||
Reference in New Issue
Block a user