DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
953
Batch/CHGBD110.cob
Normal file
953
Batch/CHGBD110.cob
Normal file
@ -0,0 +1,953 @@
|
||||
00001 IDENTIFICATION DIVISION. 05/25/10
|
||||
00002 PROGRAM-ID. CHGBD110. CHGBD110
|
||||
00003 *AUTHOR. TCL. LV007
|
||||
00004 *DATE-WRITTEN. FEBRUARY 1999. CHGBD110
|
||||
00005 DATE-COMPILED. CHGBD110
|
||||
00006 SKIP3 CHGBD110
|
||||
00007 ***** CHGBD110
|
||||
00008 * CHGBD110
|
||||
00009 * FUNCTION: CHGBD110
|
||||
00010 * CHGBD110
|
||||
00011 * *** SPECIAL VERSION *** CHGBD110
|
||||
00012 * CHGBD110
|
||||
00013 * DRIVER FOR BENEFIT CHARGE FUNCTIONS : CHGBD110
|
||||
00014 * (1) GENERATE CHARGE STATEMENTS FOR RATED AND SELF- CHGBD110
|
||||
00015 * INSURANE EMPLOYERS CHGBD110
|
||||
00016 * (2) GENERATE THE FISCAL AGENT FILES FOR FISCAL AGENTS CHGBD110
|
||||
00017 * (3) RUN QUARTERLY/ANNUAL/SPECIAL EXTRACT CHARGE PRO- CHGBD110
|
||||
00018 * CESSES FOR RATED, SELF-INSURANCE, CWC, AND FEDERAL.CHGBD110
|
||||
00019 * CHGBD110
|
||||
00020 ***** CHGBD110
|
||||
00021 * *** NOTE NOTE NOTE NOTE NOTE NOTE NOTE *** CHGBD110
|
||||
00022 * *** *** CHGBD110
|
||||
00023 * *** IF THE BENEFITS SYSTEM BEGINS PRODUCING *** CHGBD110
|
||||
00024 * *** CHARGE RECORDS FOR A NEW BENEFIT PROGRAM *** CHGBD110
|
||||
00025 * *** MODIFY THE FOLLOWING CHARGE SYSTEM *** CHGBD110
|
||||
00026 * *** COMPONENTS: *** CHGBD110
|
||||
00027 * *** *** CHGBD110
|
||||
00028 * *** ADD NEW LEVEL-88S TO: *** CHGBD110
|
||||
00029 * *** CHG1-CHARGE-PROGRAM IN CHGIM001 *** CHGBD110
|
||||
00030 * *** WRK-PROGRAM IN CHGBD100 *** CHGBD110
|
||||
00031 * *** CHG2-PROGRAM IN CHGIM002 *** CHGBD110
|
||||
00032 * *** CHG4-PROGRAM IN CHGIM004 *** CHGBD110
|
||||
00033 * *** CHG30-PROGRAM IN CHGIM030 *** CHGBD110
|
||||
00034 * *** *** CHGBD110
|
||||
00035 * *** MODIFY P1500 IN CHGBD100 *** CHGBD110
|
||||
00036 * *** *** CHGBD110
|
||||
00037 ***** CHGBD110
|
||||
00038 * CHGBD110
|
||||
00039 * INPUT: CHGBD110
|
||||
00040 * CHGBD110
|
||||
00041 * CHGFILE - CHARGE RECORDS GENERATED BY CHGBD110
|
||||
00042 * BENEFITS SYSTEM. CHGBD110
|
||||
00043 * CHGBD110
|
||||
00044 * SYSIN - RUN TYPE: Q = QUARTERLY, A = ANNUAL CHGBD110
|
||||
00045 * S = SPECIAL CHGBD110
|
||||
00046 * PERIOD BEGIN DATE (MMDDYY) CHGBD110
|
||||
00047 * PERIOD END DATE (MMDDYY) CHGBD110
|
||||
00048 * PARM-EXP-TRN-EFF-DATE (MMDDY) CHGBD110
|
||||
00049 * CHGBD110
|
||||
00050 * CHGPARM - PARAMETER DATA INPUT TO CHGBD100 CHGBD110
|
||||
00051 * AND PASSED OTHER PROGRAMS IN THE CHGBD110
|
||||
00052 * SYSTEM. CHGBD110
|
||||
00053 * CHGBD110
|
||||
00054 * OUTPUT: CHGBD110
|
||||
00055 * CHGBD110
|
||||
00056 * BD100CHG - REFORMATTED CHARGE RECORD WITHIN CHGBD110
|
||||
00057 * REPORTING PERIOD READY FOR SORT. CHGBD110
|
||||
00058 * CHGBD110
|
||||
00059 * CHGPARM - PARAMETER DATA INPUT TO CHGBD100 AND CHGBD110
|
||||
00060 * PASSED TO OTHER PROGRAMS IN THE SYSTEM. CHGBD110
|
||||
00061 ***** CHGBD110
|
||||
00062 CHGBD110
|
||||
00063 ******************************************************************CHGBD110
|
||||
00064 * MODIFICATION HISTORY: *CHGBD110
|
||||
00065 * *CHGBD110
|
||||
00066 * 02-02-1999 MODIFIED FROM MT CHG100D *CHGBD110
|
||||
00067 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD110
|
||||
00068 * *CHGBD110
|
||||
00069 * 06-29-2004 ADDED EMP TYPE 17 (DOMESTIC VIOLENCE) *CHGBD110
|
||||
00070 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD110
|
||||
00071 * *CHGBD110
|
||||
00072 * *CHGBD110
|
||||
00073 * 05-04-2010 RECOMPILED FOR NEW VERSION OF CHGIM001 COPYBOOK *CHGBD110
|
||||
00074 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD110
|
||||
00075 * *CHGBD110
|
||||
00076 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD110
|
||||
00077 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD110
|
||||
00078 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBD110
|
||||
00079 * *CHGBD110
|
||||
00080 ******************************************************************CHGBD110
|
||||
00081 CHGBD110
|
||||
00082 SKIP3 CHGBD110
|
||||
00083 ENVIRONMENT DIVISION. CHGBD110
|
||||
00084 SKIP3 CHGBD110
|
||||
00085 INPUT-OUTPUT SECTION. CHGBD110
|
||||
00086 SKIP3 CHGBD110
|
||||
00087 FILE-CONTROL. CHGBD110
|
||||
00088 SELECT PARM-FILE ASSIGN TO SYSIN CHGBD110
|
||||
00089 FILE STATUS IS PARM-STATUS. CHGBD110
|
||||
00090 CHGBD110
|
||||
00091 *& SELECT CHG-PARM-FILE ASSIGN TO CHGPARM CHGBD110
|
||||
00092 * FILE STATUS IS CHG-PARM-STATUS. CHGBD110
|
||||
00093 CHGBD110
|
||||
00094 SELECT CHARGE-IN-FILE ASSIGN TO CHGFILE CHGBD110
|
||||
00095 FILE STATUS IS CHARGE-IN-STATUS. CHGBD110
|
||||
00096 CHGBD110
|
||||
00097 *& SELECT BD100-CHG-FILE ASSIGN TO BD100CHG CHGBD110
|
||||
00098 * FILE STATUS IS BD100-CHG-STATUS. CHGBD110
|
||||
00099 EJECT CHGBD110
|
||||
00100 DATA DIVISION. CHGBD110
|
||||
00101 SKIP3 CHGBD110
|
||||
00102 FILE SECTION. CHGBD110
|
||||
00103 SKIP3 CHGBD110
|
||||
00104 ************************************************************ CHGBD110
|
||||
00105 * PARAMETER RECORD CHGBD110
|
||||
00106 * PARM-RUN-TYPE : Q = QUARTERLY, A = ANNUAL CHGBD110
|
||||
00107 * : S = SPECIAL REPORTING PERIOD CHGBD110
|
||||
00108 * PARM-PERIOD-BEGIN: START OF REPORTING PERIOD MMDDYY CHGBD110
|
||||
00109 * PARM-PERIOD-END : END OF REPORTING PERIOD MMDDYY CHGBD110
|
||||
00110 * CHGBD110
|
||||
00111 * PARM-EXP-TRN-EFF-DATE CHGBD110
|
||||
00112 * : CUTOFF DATE FOR TRANSFERS OF CHGBD110
|
||||
00113 * EXPERIENCE. THIS DATE IS NORMALLY SET TO ALL NINES. CHGBD110
|
||||
00114 * IT IS USED ONLY WHEN RECREATING CHARGES FOR A PAST CHGBD110
|
||||
00115 * REPORTING PERIOD. WHEN SET, THE SYSTEM WILL TRANSFER CHGBD110
|
||||
00116 * CHARGES TO THE SUCCESSOR EMPLOYER ONLY WHEN THE CHGBD110
|
||||
00117 * CHANGE OF OWNERSHIP OCCURRED PRIOR TO PARM-EXPER-EFF-DATE.CHGBD110
|
||||
00118 * CHGBD110
|
||||
00119 * EXAMPLE: Q,010199,033199,999999 CHGBD110
|
||||
00120 ************************************************************ CHGBD110
|
||||
00121 FD PARM-FILE CHGBD110
|
||||
00122 RECORDING MODE IS F CHGBD110
|
||||
00123 BLOCK CONTAINS 0 CHARACTERS. CHGBD110
|
||||
00124 SKIP1 CHGBD110
|
||||
00125 01 PARM-REC. CHGBD110
|
||||
00126 05 PARM-RUN-TYPE PIC X(01). CHGBD110
|
||||
00127 88 PARM-RUN-TYPE-QTRLY-88 VALUE 'Q'. CHGBD110
|
||||
00128 88 PARM-RUN-TYPE-ANNUAL-88 VALUE 'A'. CHGBD110
|
||||
00129 88 PARM-RUN-TYPE-SPECIAL-88 VALUE 'S'. CHGBD110
|
||||
00130 05 FILLER PIC X(01). CHGBD110
|
||||
00131 05 PARM-PERIOD-BEGIN PIC X(06). CHGBD110
|
||||
00132 05 FILLER PIC X(01). CHGBD110
|
||||
00133 05 PARM-PERIOD-END PIC X(06). CHGBD110
|
||||
00134 05 FILLER PIC X(01). CHGBD110
|
||||
00135 05 PARM-EXP-TRN-EFF-DATE PIC X(06). CHGBD110
|
||||
00136 05 FILLER PIC X(58). CHGBD110
|
||||
00137 CHGBD110
|
||||
00138 *FD CHG-PARM-FILE CHGBD110
|
||||
00139 * RECORDING MODE IS F CHGBD110
|
||||
00140 * BLOCK CONTAINS 0 CHARACTERS. CHGBD110
|
||||
00141 * SKIP1 CHGBD110
|
||||
00142 *01 CHG-PARM-REC. CHGBD110
|
||||
00143 ***INCLUDE CHGIM003 CHGBD110
|
||||
00144 CHGBD110
|
||||
00145 FD CHARGE-IN-FILE CHGBD110
|
||||
00146 RECORDING MODE IS V CHGBD110
|
||||
00147 LABEL RECORDS ARE STANDARD CHGBD110
|
||||
00148 BLOCK CONTAINS 0 CHARACTERS. CHGBD110
|
||||
00149 SKIP1 CHGBD110
|
||||
00150 01 CHARGE-IN-REC PIC X(136). CHGBD110
|
||||
00151 CHGBD110
|
||||
00152 *FD BD100-CHG-FILE CHGBD110
|
||||
00153 * LABEL RECORDS ARE STANDARD CHGBD110
|
||||
00154 * BLOCK CONTAINS 0 CHARACTERS. CHGBD110
|
||||
00155 * SKIP1 CHGBD110
|
||||
00156 *01 SORT-CHG-REC. CHGBD110
|
||||
00157 ***INCLUDE CHGIM001 CHGBD110
|
||||
00158 CHGBD110
|
||||
00159 EJECT CHGBD110
|
||||
00160 WORKING-STORAGE SECTION. CHGBD110
|
||||
001605 77 PAN-VALET PICTURE X(24) VALUE '007CHGBD110 05/25/10'. CHGBD110
|
||||
00161 CHGBD110
|
||||
00162 01 WRK-AREA. CHGBD110
|
||||
00163 05 AMT-DISP PIC Z(06)9.99-. CHGBD110
|
||||
00164 05 ABEND-CODE PIC S9(04) COMP CHGBD110
|
||||
00165 VALUE +100. CHGBD110
|
||||
00166 05 ABEND-MSG PIC X(60). CHGBD110
|
||||
00167 05 ABEND-MOD PIC X(08) VALUE 'DTSBU999'. CHGBD110
|
||||
00168 05 DISP-AMT PIC Z(06)9.99-. CHGBD110
|
||||
00169 05 WRK-CHG PIC S9(09)V99 COMP-3 CHGBD110
|
||||
00170 VALUE +0. CHGBD110
|
||||
00171 05 WRK-DAILY-CHG PIC S9(09)V99 COMP-3 CHGBD110
|
||||
00172 VALUE +0. CHGBD110
|
||||
00173 05 WRK-CURR-DATE PIC S9(09) COMP-3 CHGBD110
|
||||
00174 VALUE +0. CHGBD110
|
||||
00175 05 WRK-DAY-CNT PIC S9(04) COMP CHGBD110
|
||||
00176 VALUE +0. CHGBD110
|
||||
00177 05 DISP-AMT1 PIC Z(08)9.99-. CHGBD110
|
||||
00178 CHGBD110
|
||||
00179 05 PARM-STATUS PIC X(02) VALUE SPACES. CHGBD110
|
||||
00180 88 PARM-FILE-OK-88 VALUE ZERO. CHGBD110
|
||||
00181 88 PARM-FILE-EOF-88 VALUE '10'. CHGBD110
|
||||
00182 05 CHG-PARM-STATUS PIC X(02) VALUE SPACES. CHGBD110
|
||||
00183 88 CHG-PARM-FILE-OK-88 VALUE ZERO. CHGBD110
|
||||
00184 05 CHARGE-IN-STATUS PIC X(02) VALUE SPACES. CHGBD110
|
||||
00185 88 CHARGE-FILE-OK-88 VALUE ZERO. CHGBD110
|
||||
00186 88 CHARGE-FILE-EOF-88 VALUE '10'. CHGBD110
|
||||
00187 05 BD100-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD110
|
||||
00188 88 BD100-FILE-OK-88 VALUE ZERO. CHGBD110
|
||||
00189 CHGBD110
|
||||
00190 05 WRK-ERROR-IND PIC X(01). CHGBD110
|
||||
00191 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD110
|
||||
00192 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD110
|
||||
00193 CHGBD110
|
||||
00194 05 WRK-EDIT-ERROR-IND PIC X(01). CHGBD110
|
||||
00195 88 WRK-EDIT-ERROR-YES-88 VALUE 'Y'. CHGBD110
|
||||
00196 88 WRK-EDIT-ERROR-NO-88 VALUE 'N'. CHGBD110
|
||||
00197 CHGBD110
|
||||
00198 05 WRK-BEGIN-DATE PIC S9(09) COMP-3. CHGBD110
|
||||
00199 05 WRK-END-DATE PIC S9(09) COMP-3. CHGBD110
|
||||
00200 05 WRK-EXP-TRN-EFF-DATE PIC S9(09) COMP-3. CHGBD110
|
||||
00201 05 WRK-CHARGE-DATE PIC S9(09) COMP-3. CHGBD110
|
||||
00202 05 WRK-BYE PIC S9(09) COMP-3. CHGBD110
|
||||
00203 ************************************************************* CHGBD110
|
||||
00204 * WRK-PROGRAM DEFINES VALUES FOR VALID BENEFIT PROGRAMS. CHGBD110
|
||||
00205 * IT IS SET BASED ON CHARGE-SUPP-CODE IN THE DUCAS ESPRPT04 CHGBD110
|
||||
00206 * RECORD. IF AN NEW BENEFIT PROGRAM IS ESTABLISHED, ADD CHGBD110
|
||||
00207 * AN ADDITIONAL LEVEL-88 AND MODIFY THE CODE IN P1500. CHGBD110
|
||||
00208 ************************************************************* CHGBD110
|
||||
00209 05 WRK-PROGRAM PIC 9(01). CHGBD110
|
||||
00210 88 WRK-PROG-UI-88 VALUE 1. CHGBD110
|
||||
00211 88 WRK-PROG-EB-88 VALUE 2. CHGBD110
|
||||
00212 88 WRK-PROG-TEUC-88 VALUE 3. CHGBD110
|
||||
00213 88 WRK-PROG-TEUCA-88 VALUE 4. CHGBD110
|
||||
00214 05 WRK-CHARGE-IN-READ PIC 9(07) COMP-3. CHGBD110
|
||||
00215 05 WRK-SORT-CHG-WRITTEN PIC 9(07) COMP-3. CHGBD110
|
||||
00216 CHGBD110
|
||||
00217 05 WRK-CHG-DT-ERR-CNT PIC 9(07) COMP-3. CHGBD110
|
||||
00218 05 WRK-BYE-ERR-CNT PIC 9(07) COMP-3. CHGBD110
|
||||
00219 05 WRK-EMP-TYPE-ERR-CNT PIC 9(07) COMP-3. CHGBD110
|
||||
00220 05 WRK-CHG-AMT-ERR-CNT PIC 9(07) COMP-3. CHGBD110
|
||||
00221 05 WRK-SUPP-CD-ERR-CNT PIC 9(07) COMP-3. CHGBD110
|
||||
00222 CHGBD110
|
||||
00223 05 WRK-EMP-ACCT PIC 9(06). CHGBD110
|
||||
00224 88 WRK-EMP-ACCT-FED-88 VALUE 000001 THRU 001999. CHGBD110
|
||||
00225 88 WRK-EMP-ACCT-CWC-88 VALUE 110000 THRU 119999. CHGBD110
|
||||
00226 CHGBD110
|
||||
00227 05 WRK-EMP-TYPE PIC 9(02). CHGBD110
|
||||
00228 88 WRK-EMP-TYPE-RATED-88 VALUE 00. CHGBD110
|
||||
00229 88 WRK-EMP-TYPE-SELF-INS-88 VALUE 08. CHGBD110
|
||||
00230 88 WRK-EMP-TYPE-CWC-88 VALUE 04. CHGBD110
|
||||
00231 88 WRK-EMP-TYPE-FED-88 VALUE 01, 02. CHGBD110
|
||||
00232 88 WRK-EMP-TYPE-VALID-88 VALUE 00, 01, 02, 03 CHGBD110
|
||||
00233 04, 05, 06 CHGBD110
|
||||
00234 07, 08, 09 CHGBD110
|
||||
00235 10, 11, 12 CHGBD110
|
||||
00236 13, 15, 16, 17. CHGBD110
|
||||
00237 ** ADD ERROR MSG TABLE SET UP CHGBD110
|
||||
00238 01 MSG-TABLE. CHGBD110
|
||||
00239 05 MSG1-TOT-CREDIT-AMT. CHGBD110
|
||||
00240 10 MSG1-ID. CHGBD110
|
||||
00241 15 MSG1-ID1 PIC X(08) VALUE 'CHGBD100'. CHGBD110
|
||||
00242 15 MSG1-ID2 PIC X(03) VALUE '101'. CHGBD110
|
||||
00243 10 MSG1-SHORT-TEXT PIC X(20) CHGBD110
|
||||
00244 VALUE 'INVALID EMP TYPE : '. CHGBD110
|
||||
00245 10 MSG1-LONG-TEXT. CHGBD110
|
||||
00246 15 FILLER PIC X(29) CHGBD110
|
||||
00247 VALUE 'INVALID EMPLOYER TYPE '. CHGBD110
|
||||
00248 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD110
|
||||
00249 15 TBL-SSN PIC 9(09). CHGBD110
|
||||
00250 15 FILLER PIC X(13) VALUE ' EMP TYPE = '. CHGBD110
|
||||
00251 15 TBL-EMP-TYPE PIC 9(02). CHGBD110
|
||||
00252 CHGBD110
|
||||
00253 05 MSG2-TOT-CREDIT-AMT. CHGBD110
|
||||
00254 10 MSG2-ID. CHGBD110
|
||||
00255 15 MSG2-ID1 PIC X(08) VALUE 'CHGBD100'. CHGBD110
|
||||
00256 15 MSG2-ID2 PIC X(03) VALUE '101'. CHGBD110
|
||||
00257 10 MSG2-SHORT-TEXT PIC X(20) CHGBD110
|
||||
00258 VALUE 'INVALID EMP TYPE : '. CHGBD110
|
||||
00259 10 MSG2-LONG-TEXT. CHGBD110
|
||||
00260 15 FILLER PIC X(29) CHGBD110
|
||||
00261 VALUE 'INVALID BYE DATE ACCEPTED '. CHGBD110
|
||||
00262 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD110
|
||||
00263 15 TBL-SSN2 PIC 9(09). CHGBD110
|
||||
00264 15 FILLER PIC X(13) VALUE ' BYE DATE = '. CHGBD110
|
||||
00265 15 TBL-BYE-DATE2 PIC 9(08). CHGBD110
|
||||
00266 CHGBD110
|
||||
00267 05 MSG3-TOT-CREDIT-AMT. CHGBD110
|
||||
00268 10 MSG3-ID. CHGBD110
|
||||
00269 15 MSG3-ID1 PIC X(08) VALUE 'CHGBD100'. CHGBD110
|
||||
00270 15 MSG3-ID2 PIC X(03) VALUE '101'. CHGBD110
|
||||
00271 10 MSG3-SHORT-TEXT PIC X(20) CHGBD110
|
||||
00272 VALUE 'INVALID CHG DATE : '. CHGBD110
|
||||
00273 10 MSG3-LONG-TEXT. CHGBD110
|
||||
00274 15 FILLER PIC X(29) CHGBD110
|
||||
00275 VALUE 'INVALID CHARGE DATE '. CHGBD110
|
||||
00276 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD110
|
||||
00277 15 TBL-SSN3 PIC 9(09). CHGBD110
|
||||
00278 15 FILLER PIC X(13) VALUE ' CHG DATE = '. CHGBD110
|
||||
00279 15 TBL-CHG-DATE PIC 9(08). CHGBD110
|
||||
00280 CHGBD110
|
||||
00281 05 MSG4-TOT-CREDIT-AMT. CHGBD110
|
||||
00282 10 MSG4-ID. CHGBD110
|
||||
00283 15 MSG4-ID1 PIC X(08) VALUE 'CHGBD100'. CHGBD110
|
||||
00284 15 MSG4-ID2 PIC X(03) VALUE '101'. CHGBD110
|
||||
00285 10 MSG4-SHORT-TEXT PIC X(20) CHGBD110
|
||||
00286 VALUE 'INVALID CHG AMOUNT :'. CHGBD110
|
||||
00287 10 MSG4-LONG-TEXT. CHGBD110
|
||||
00288 15 FILLER PIC X(29) CHGBD110
|
||||
00289 VALUE 'INVALID CHARGE AMOUNT '. CHGBD110
|
||||
00290 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD110
|
||||
00291 15 TBL-SSN4 PIC 9(09). CHGBD110
|
||||
00292 15 FILLER PIC X(15) VALUE ' CHG AMOUNT = '.CHGBD110
|
||||
00293 15 TBL-CURR-AMT PIC S9(08)V99. CHGBD110
|
||||
00294 CHGBD110
|
||||
00295 05 MSG5-TOT-CREDIT-AMT. CHGBD110
|
||||
00296 10 MSG5-ID. CHGBD110
|
||||
00297 15 MSG5-ID1 PIC X(08) VALUE 'CHGBD100'. CHGBD110
|
||||
00298 15 MSG5-ID2 PIC X(03) VALUE '101'. CHGBD110
|
||||
00299 10 MSG5-SHORT-TEXT PIC X(20) CHGBD110
|
||||
00300 VALUE 'INVALID SUPP CODE :'. CHGBD110
|
||||
00301 10 MSG5-LONG-TEXT. CHGBD110
|
||||
00302 15 FILLER PIC X(29) CHGBD110
|
||||
00303 VALUE 'INVALID SUPP CODE '. CHGBD110
|
||||
00304 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD110
|
||||
00305 15 TBL-SSN5 PIC 9(09). CHGBD110
|
||||
00306 15 FILLER PIC X(14) VALUE ' SUPP CODE = '. CHGBD110
|
||||
00307 15 TBL-SUPP-CODE PIC X(01). CHGBD110
|
||||
00308 CHGBD110
|
||||
00309 05 MSG6-NOT-LIABLE. CHGBD110
|
||||
00310 10 MSG6-ID. CHGBD110
|
||||
00311 15 MSG6-ID1 PIC X(08) VALUE 'CHGBD100'. CHGBD110
|
||||
00312 15 MSG6-ID2 PIC X(03) VALUE '102'. CHGBD110
|
||||
00313 10 MSG6-SHORT-TEXT PIC X(20) CHGBD110
|
||||
00314 VALUE 'EMPLOYER NOT LIABLE:'. CHGBD110
|
||||
00315 10 MSG6-LONG-TEXT. CHGBD110
|
||||
00316 15 FILLER PIC X(29) CHGBD110
|
||||
00317 VALUE 'EMPLOYER NOT LIABLE '. CHGBD110
|
||||
00318 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD110
|
||||
00319 15 TBL-SSN6 PIC 9(09). CHGBD110
|
||||
00320 15 FILLER PIC X(15) VALUE SPACES. CHGBD110
|
||||
00321 CHGBD110
|
||||
00322 ** ADD ERROR MSG OUTPUT RECORD. CHGBD110
|
||||
00323 01 R907-REC. CHGBD110
|
||||
00324 ++INCLUDE DTSIR907 CHGBD110
|
||||
00325 CHGBD110
|
||||
00326 *** BENEFITS CHARGE RECORD *** CHGBD110
|
||||
00327 ++INCLUDE ESPRPT04 CHGBD110
|
||||
00328 CHGBD110
|
||||
00329 01 FILLER REDEFINES CHARGE-REC. CHGBD110
|
||||
00330 **** 05 FILLER PIC X(04). CHGBD110
|
||||
00331 05 WRK-CHARGE-REC PIC X(140). CHGBD110
|
||||
00332 CHGBD110
|
||||
00333 01 L001-LINK-AREA. CHGBD110
|
||||
00334 ++INCLUDE DTSIL001 CHGBD110
|
||||
00335 CHGBD110
|
||||
00336 01 L004-LINK-AREA. CHGBD110
|
||||
00337 ++INCLUDE DTSIL004 CHGBD110
|
||||
00338 CHGBD110
|
||||
00339 01 L910-LINK-AREA. CHGBD110
|
||||
00340 ++INCLUDE DTSIL910 CHGBD110
|
||||
00341 CHGBD110
|
||||
00342 01 MSKL-REC. CHGBD110
|
||||
00343 ++INCLUDE DTSIMSKL CHGBD110
|
||||
00344 CHGBD110
|
||||
00345 01 MHDR-REC. CHGBD110
|
||||
00346 ++INCLUDE DTSIMHDR CHGBD110
|
||||
00347 CHGBD110
|
||||
00348 01 L921-LINK-AREA. CHGBD110
|
||||
00349 ++INCLUDE DTSIL921 CHGBD110
|
||||
00350 CHGBD110
|
||||
00351 01 ISKL-REC. CHGBD110
|
||||
00352 ++INCLUDE DTSIISKL CHGBD110
|
||||
00353 CHGBD110
|
||||
00354 01 L100-LINK-AREA. CHGBD110
|
||||
00355 ++INCLUDE CHGIL100 CHGBD110
|
||||
00356 CHGBD110
|
||||
00357 EJECT CHGBD110
|
||||
00358 PROCEDURE DIVISION. CHGBD110
|
||||
00359 SKIP2 CHGBD110
|
||||
00360 CHGBD100-MAIN. CHGBD110
|
||||
00361 MOVE ZERO TO WRK-CHARGE-IN-READ CHGBD110
|
||||
00362 WRK-SORT-CHG-WRITTEN CHGBD110
|
||||
00363 WRK-CHG-DT-ERR-CNT CHGBD110
|
||||
00364 WRK-BYE-ERR-CNT CHGBD110
|
||||
00365 WRK-EMP-TYPE-ERR-CNT CHGBD110
|
||||
00366 WRK-CHG-AMT-ERR-CNT CHGBD110
|
||||
00367 WRK-SUPP-CD-ERR-CNT. CHGBD110
|
||||
00368 CHGBD110
|
||||
00369 SET WRK-ERROR-NO-88 TO TRUE. CHGBD110
|
||||
00370 CHGBD110
|
||||
00371 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD110
|
||||
00372 IF WRK-ERROR-YES-88 CHGBD110
|
||||
00373 PERFORM S910-CLOSE THRU S910-EXIT CHGBD110
|
||||
00374 PERFORM S921-CLOSE THRU S921-EXIT CHGBD110
|
||||
00375 GO TO CHGBD100-EXIT. CHGBD110
|
||||
00376 CHGBD110
|
||||
00377 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD110
|
||||
00378 CHGBD110
|
||||
00379 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD110
|
||||
00380 CHGBD110
|
||||
00381 MOVE +0 TO RETURN-CODE. CHGBD110
|
||||
00382 CHGBD110
|
||||
00383 CHGBD100-EXIT. CHGBD110
|
||||
00384 STOP RUN. CHGBD110
|
||||
00385 EJECT CHGBD110
|
||||
00386 I0000-INITIATE. CHGBD110
|
||||
00387 MOVE MSG1-ID1 TO R907-MODULE-NAME. CHGBD110
|
||||
00388 MOVE LENGTH OF R907-REC TO R907-LENGTH. CHGBD110
|
||||
00389 CHGBD110
|
||||
00390 PERFORM I0100-OPEN-MASTER THRU I0100-EXIT. CHGBD110
|
||||
00391 CHGBD110
|
||||
00392 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. CHGBD110
|
||||
00393 CHGBD110
|
||||
00394 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CHGBD110
|
||||
00395 CHGBD110
|
||||
00396 I0000-EXIT. CHGBD110
|
||||
00397 EXIT. CHGBD110
|
||||
00398 CHGBD110
|
||||
00399 I0100-OPEN-MASTER. CHGBD110
|
||||
00400 PERFORM S910-OPEN-READ THRU S910-EXIT. CHGBD110
|
||||
00401 PERFORM S921-OPEN-READ THRU S921-EXIT. CHGBD110
|
||||
00402 CHGBD110
|
||||
00403 I0100-EXIT. CHGBD110
|
||||
00404 EXIT. CHGBD110
|
||||
00405 CHGBD110
|
||||
00406 I1000-PROCESS-PARMS. CHGBD110
|
||||
00407 OPEN INPUT PARM-FILE. CHGBD110
|
||||
00408 IF NOT PARM-FILE-OK-88 CHGBD110
|
||||
00409 DISPLAY 'PARM FILE OPEN ERROR: ' PARM-STATUS CHGBD110
|
||||
00410 SET WRK-ERROR-YES-88 TO TRUE CHGBD110
|
||||
00411 GO TO I1000-EXIT. CHGBD110
|
||||
00412 CHGBD110
|
||||
00413 READ PARM-FILE. CHGBD110
|
||||
00414 IF NOT PARM-FILE-OK-88 CHGBD110
|
||||
00415 DISPLAY 'PARM FILE READ ERROR: ' PARM-STATUS CHGBD110
|
||||
00416 SET WRK-ERROR-YES-88 TO TRUE CHGBD110
|
||||
00417 GO TO I1000-EXIT. CHGBD110
|
||||
00418 CHGBD110
|
||||
00419 DISPLAY '***** CHGBD100 PARM RECORD *****'. CHGBD110
|
||||
00420 DISPLAY PARM-REC. CHGBD110
|
||||
00421 DISPLAY SPACE. CHGBD110
|
||||
00422 DISPLAY '***** CHGBD100 EDITED PARMS ****'. CHGBD110
|
||||
00423 DISPLAY SPACE. CHGBD110
|
||||
00424 CHGBD110
|
||||
00425 PERFORM I1100-RUN-TYPE THRU I1100-EXIT. CHGBD110
|
||||
00426 CHGBD110
|
||||
00427 PERFORM I1200-DATE-RANGE THRU I1200-EXIT. CHGBD110
|
||||
00428 CHGBD110
|
||||
00429 PERFORM I1300-EXP-TRN-DATE THRU I1300-EXIT. CHGBD110
|
||||
00430 CHGBD110
|
||||
00431 *& PERFORM I1400-WRITE-CHG-PARM THRU I1400-EXIT. CHGBD110
|
||||
00432 CHGBD110
|
||||
00433 CLOSE PARM-FILE. CHGBD110
|
||||
00434 CHGBD110
|
||||
00435 I1000-EXIT. CHGBD110
|
||||
00436 EXIT. CHGBD110
|
||||
00437 CHGBD110
|
||||
00438 I1100-RUN-TYPE. CHGBD110
|
||||
00439 IF PARM-RUN-TYPE = SPACES OR LOW-VALUES CHGBD110
|
||||
00440 MOVE 'Q' TO PARM-RUN-TYPE CHGBD110
|
||||
00441 ELSE CHGBD110
|
||||
00442 IF PARM-RUN-TYPE = 'Q' OR 'A' OR 'S' CHGBD110
|
||||
00443 NEXT SENTENCE CHGBD110
|
||||
00444 ELSE CHGBD110
|
||||
00445 MOVE 'INVALID RUN TYPE' TO ABEND-MSG CHGBD110
|
||||
00446 PERFORM S999-ABEND THRU S999-EXIT CHGBD110
|
||||
00447 GO TO I1100-EXIT. CHGBD110
|
||||
00448 CHGBD110
|
||||
00449 IF PARM-RUN-TYPE = 'Q' CHGBD110
|
||||
00450 DISPLAY 'RUN TYPE: QUARTERLY' CHGBD110
|
||||
00451 ELSE CHGBD110
|
||||
00452 IF PARM-RUN-TYPE = 'A' CHGBD110
|
||||
00453 DISPLAY 'RUN TYPE: ANNUAL' CHGBD110
|
||||
00454 ELSE CHGBD110
|
||||
00455 IF PARM-RUN-TYPE = 'S' CHGBD110
|
||||
00456 DISPLAY 'RUN TYPE: SPECIAL' CHGBD110
|
||||
00457 END-IF CHGBD110
|
||||
00458 END-IF CHGBD110
|
||||
00459 END-IF. CHGBD110
|
||||
00460 CHGBD110
|
||||
00461 DISPLAY SPACE. CHGBD110
|
||||
00462 CHGBD110
|
||||
00463 I1100-EXIT. CHGBD110
|
||||
00464 EXIT. CHGBD110
|
||||
00465 CHGBD110
|
||||
00466 I1200-DATE-RANGE. CHGBD110
|
||||
00467 MOVE ZERO TO WRK-BEGIN-DATE CHGBD110
|
||||
00468 WRK-END-DATE. CHGBD110
|
||||
00469 CHGBD110
|
||||
00470 IF (PARM-PERIOD-BEGIN = SPACES OR LOW-VALUES) CHGBD110
|
||||
00471 AND (PARM-PERIOD-END = SPACES OR LOW-VALUES) CHGBD110
|
||||
00472 IF PARM-RUN-TYPE-SPECIAL-88 CHGBD110
|
||||
00473 MOVE 'DATES REQUIRED FOR SPECIAL RUN' CHGBD110
|
||||
00474 TO ABEND-MSG CHGBD110
|
||||
00475 PERFORM S999-ABEND THRU S999-EXIT CHGBD110
|
||||
00476 ELSE CHGBD110
|
||||
00477 PERFORM I1230-DEFAULT-DATES THRU I1230-EXIT CHGBD110
|
||||
00478 GO TO I1200-DISPLAY-DATES. CHGBD110
|
||||
00479 CHGBD110
|
||||
00480 PERFORM I1210-BEGIN-DATE THRU I1210-EXIT. CHGBD110
|
||||
00481 CHGBD110
|
||||
00482 PERFORM I1220-END-DATE THRU I1220-EXIT. CHGBD110
|
||||
00483 CHGBD110
|
||||
00484 IF WRK-END-DATE < WRK-BEGIN-DATE CHGBD110
|
||||
00485 MOVE 'PERIOD END LESS THAN PERIOD BEGIN' CHGBD110
|
||||
00486 TO ABEND-MSG CHGBD110
|
||||
00487 PERFORM S999-ABEND THRU S999-EXIT. CHGBD110
|
||||
00488 CHGBD110
|
||||
00489 I1200-DISPLAY-DATES. CHGBD110
|
||||
00490 DISPLAY 'START DATE : ' WRK-BEGIN-DATE. CHGBD110
|
||||
00491 DISPLAY 'END DATE : ' WRK-END-DATE. CHGBD110
|
||||
00492 DISPLAY SPACE. CHGBD110
|
||||
00493 CHGBD110
|
||||
00494 I1200-EXIT. CHGBD110
|
||||
00495 EXIT. CHGBD110
|
||||
00496 CHGBD110
|
||||
00497 I1210-BEGIN-DATE. CHGBD110
|
||||
00498 MOVE PARM-PERIOD-BEGIN TO L001-CAL-6-DATE-X. CHGBD110
|
||||
00499 PERFORM S001-FROM-CAL-6 THRU S001-EXIT. CHGBD110
|
||||
00500 IF L001-VALID-DATE CHGBD110
|
||||
00501 MOVE L001-FED-8-DATE-9 TO WRK-BEGIN-DATE CHGBD110
|
||||
00502 ELSE CHGBD110
|
||||
00503 MOVE 'INVALID PERIOD BEGIN DATE' TO ABEND-MSG CHGBD110
|
||||
00504 PERFORM S999-ABEND THRU S999-EXIT CHGBD110
|
||||
00505 GO TO I1210-EXIT. CHGBD110
|
||||
00506 CHGBD110
|
||||
00507 IF PARM-RUN-TYPE-SPECIAL-88 CHGBD110
|
||||
00508 NEXT SENTENCE CHGBD110
|
||||
00509 ELSE CHGBD110
|
||||
00510 MOVE WRK-BEGIN-DATE TO L004-DATE CHGBD110
|
||||
00511 PERFORM S004-FROM-DATE THRU S004-EXIT CHGBD110
|
||||
00512 IF WRK-BEGIN-DATE NOT = L004-QTR-START-DATE CHGBD110
|
||||
00513 MOVE 'PERIOD BEGIN NOT START OF QTR' CHGBD110
|
||||
00514 TO ABEND-MSG CHGBD110
|
||||
00515 PERFORM S999-ABEND THRU S999-EXIT CHGBD110
|
||||
00516 END-IF CHGBD110
|
||||
00517 END-IF. CHGBD110
|
||||
00518 CHGBD110
|
||||
00519 I1210-EXIT. CHGBD110
|
||||
00520 EXIT. CHGBD110
|
||||
00521 CHGBD110
|
||||
00522 I1220-END-DATE. CHGBD110
|
||||
00523 MOVE PARM-PERIOD-END TO L001-CAL-6-DATE-X. CHGBD110
|
||||
00524 PERFORM S001-FROM-CAL-6 THRU S001-EXIT. CHGBD110
|
||||
00525 IF L001-VALID-DATE CHGBD110
|
||||
00526 MOVE L001-FED-8-DATE-9 TO WRK-END-DATE CHGBD110
|
||||
00527 ELSE CHGBD110
|
||||
00528 MOVE 'INVALID PERIOD END DATE' TO ABEND-MSG CHGBD110
|
||||
00529 PERFORM S999-ABEND THRU S999-EXIT CHGBD110
|
||||
00530 GO TO I1220-EXIT. CHGBD110
|
||||
00531 CHGBD110
|
||||
00532 IF PARM-RUN-TYPE-SPECIAL-88 CHGBD110
|
||||
00533 NEXT SENTENCE CHGBD110
|
||||
00534 ELSE CHGBD110
|
||||
00535 MOVE WRK-END-DATE TO L004-DATE CHGBD110
|
||||
00536 PERFORM S004-FROM-DATE THRU S004-EXIT CHGBD110
|
||||
00537 IF WRK-END-DATE NOT = L004-QTR-END-DATE CHGBD110
|
||||
00538 MOVE 'PERIOD END NOT END OF QTR' CHGBD110
|
||||
00539 TO ABEND-MSG CHGBD110
|
||||
00540 PERFORM S999-ABEND THRU S999-EXIT CHGBD110
|
||||
00541 END-IF CHGBD110
|
||||
00542 END-IF. CHGBD110
|
||||
00543 CHGBD110
|
||||
00544 I1220-EXIT. CHGBD110
|
||||
00545 EXIT. CHGBD110
|
||||
00546 CHGBD110
|
||||
00547 I1230-DEFAULT-DATES. CHGBD110
|
||||
00548 MOVE LOW-VALUES TO MSKL-KEY-AREA. CHGBD110
|
||||
00549 MOVE +0 TO MSKL-EMP-NO. CHGBD110
|
||||
00550 SET MSKL-HDR-88 TO TRUE. CHGBD110
|
||||
00551 PERFORM S910-READ THRU S910-EXIT. CHGBD110
|
||||
00552 CHGBD110
|
||||
00553 IF L910-NO-REC-88 CHGBD110
|
||||
00554 MOVE 'MHDR RECORD IS MISSING' CHGBD110
|
||||
00555 TO ABEND-MSG CHGBD110
|
||||
00556 PERFORM S999-ABEND THRU S999-EXIT. CHGBD110
|
||||
00557 CHGBD110
|
||||
00558 MOVE MSKL-REC TO MHDR-REC. CHGBD110
|
||||
00559 MOVE MHDR-CMPL-QTR-BEGIN-DATE CHGBD110
|
||||
00560 TO WRK-BEGIN-DATE. CHGBD110
|
||||
00561 MOVE MHDR-CMPL-QTR-END-DATE CHGBD110
|
||||
00562 TO WRK-END-DATE. CHGBD110
|
||||
00563 CHGBD110
|
||||
00564 CHGBD110
|
||||
00565 I1230-EXIT. CHGBD110
|
||||
00566 EXIT. CHGBD110
|
||||
00567 CHGBD110
|
||||
00568 I1300-EXP-TRN-DATE. CHGBD110
|
||||
00569 IF PARM-EXP-TRN-EFF-DATE = '999999' CHGBD110
|
||||
00570 MOVE 99999999 TO WRK-EXP-TRN-EFF-DATE CHGBD110
|
||||
00571 ELSE CHGBD110
|
||||
00572 MOVE PARM-EXP-TRN-EFF-DATE TO L001-CAL-6-DATE-X CHGBD110
|
||||
00573 PERFORM S001-FROM-CAL-6 THRU S001-EXIT CHGBD110
|
||||
00574 IF L001-VALID-DATE CHGBD110
|
||||
00575 MOVE L001-FED-8-DATE-9 TO WRK-EXP-TRN-EFF-DATE CHGBD110
|
||||
00576 ELSE CHGBD110
|
||||
00577 MOVE 'INVALID EXP TRN EFF DATE' TO ABEND-MSG CHGBD110
|
||||
00578 PERFORM S999-ABEND THRU S999-EXIT CHGBD110
|
||||
00579 END-IF CHGBD110
|
||||
00580 END-IF. CHGBD110
|
||||
00581 CHGBD110
|
||||
00582 DISPLAY 'EXPERIENCE TRANSFER CUTOFF DATE: ' CHGBD110
|
||||
00583 WRK-EXP-TRN-EFF-DATE. CHGBD110
|
||||
00584 DISPLAY SPACE. CHGBD110
|
||||
00585 CHGBD110
|
||||
00586 I1300-EXIT. CHGBD110
|
||||
00587 EXIT. CHGBD110
|
||||
00588 CHGBD110
|
||||
00589 *I1400-WRITE-CHG-PARM. CHGBD110
|
||||
00590 *& OPEN I-O CHG-PARM-FILE. CHGBD110
|
||||
00591 * OPEN OUTPUT CHG-PARM-FILE. CHGBD110
|
||||
00592 * IF NOT CHG-PARM-FILE-OK-88 CHGBD110
|
||||
00593 * DISPLAY 'CHARGE PARM FILE OPEN ERROR: ' CHG-PARM-STATUS CHGBD110
|
||||
00594 * SET WRK-ERROR-YES-88 TO TRUE CHGBD110
|
||||
00595 * GO TO I1400-EXIT. CHGBD110
|
||||
00596 * CHGBD110
|
||||
00597 * MOVE PARM-RUN-TYPE TO BD100-RUN-TYPE. CHGBD110
|
||||
00598 * MOVE WRK-BEGIN-DATE TO BD100-PERIOD-BEGIN. CHGBD110
|
||||
00599 * MOVE WRK-END-DATE TO BD100-PERIOD-END. CHGBD110
|
||||
00600 * MOVE WRK-EXP-TRN-EFF-DATE TO BD100-EXP-TRN-EFF-DATE. CHGBD110
|
||||
00601 * CHGBD110
|
||||
00602 * MOVE ZERO TO BD200-RECS-READ CHGBD110
|
||||
00603 * BD200-RECS-WRITTEN CHGBD110
|
||||
00604 * BD300-SELECT-EMP. CHGBD110
|
||||
00605 * CHGBD110
|
||||
00606 * MOVE SPACES TO BD300-RPT-TYPES CHGBD110
|
||||
00607 * BD100-FILLER CHGBD110
|
||||
00608 * BD200-FILLER CHGBD110
|
||||
00609 * BD300-FILLER. CHGBD110
|
||||
00610 * CHGBD110
|
||||
00611 * WRITE CHG-PARM-REC. CHGBD110
|
||||
00612 * CLOSE CHG-PARM-FILE. CHGBD110
|
||||
00613 * CHGBD110
|
||||
00614 *I1400-EXIT. CHGBD110
|
||||
00615 * EXIT. CHGBD110
|
||||
00616 CHGBD110
|
||||
00617 I2000-OPEN-FILES. CHGBD110
|
||||
00618 OPEN INPUT CHARGE-IN-FILE. CHGBD110
|
||||
00619 IF NOT CHARGE-FILE-OK-88 CHGBD110
|
||||
00620 DISPLAY 'CHARGE FILE OPEN ERROR: ' CHARGE-IN-STATUS CHGBD110
|
||||
00621 SET WRK-ERROR-YES-88 TO TRUE CHGBD110
|
||||
00622 GO TO I2000-EXIT. CHGBD110
|
||||
00623 CHGBD110
|
||||
00624 * OPEN OUTPUT BD100-CHG-FILE. CHGBD110
|
||||
00625 * IF NOT BD100-FILE-OK-88 CHGBD110
|
||||
00626 * DISPLAY 'SORT FILE OPEN ERROR: ' BD100-CHG-STATUS CHGBD110
|
||||
00627 * SET WRK-ERROR-YES-88 TO TRUE CHGBD110
|
||||
00628 * GO TO I2000-EXIT. CHGBD110
|
||||
00629 CHGBD110
|
||||
00630 I2000-EXIT. CHGBD110
|
||||
00631 EXIT. CHGBD110
|
||||
00632 CHGBD110
|
||||
00633 CHGBD110
|
||||
00634 P0000-PROCESS. CHGBD110
|
||||
00635 READ CHARGE-IN-FILE INTO WRK-CHARGE-REC CHGBD110
|
||||
00636 IF NOT CHARGE-FILE-OK-88 CHGBD110
|
||||
00637 DISPLAY 'CHARGE FILE EMPTY: ' CHARGE-IN-STATUS CHGBD110
|
||||
00638 SET WRK-ERROR-YES-88 TO TRUE CHGBD110
|
||||
00639 GO TO P0000-EXIT CHGBD110
|
||||
00640 ELSE CHGBD110
|
||||
00641 ADD 1 TO WRK-CHARGE-IN-READ. CHGBD110
|
||||
00642 CHGBD110
|
||||
00643 PERFORM P1000-SELECT-CHARGES THRU P1000-EXIT CHGBD110
|
||||
00644 UNTIL WRK-DAY-CNT > +1 CHGBD110
|
||||
00645 OR CHARGE-FILE-EOF-88. CHGBD110
|
||||
00646 CHGBD110
|
||||
00647 P0000-EXIT. CHGBD110
|
||||
00648 EXIT. CHGBD110
|
||||
00649 CHGBD110
|
||||
00650 P1000-SELECT-CHARGES. CHGBD110
|
||||
00651 SET WRK-EDIT-ERROR-NO-88 TO TRUE. CHGBD110
|
||||
00652 ***** CHGBD110
|
||||
00653 IF CHARGE-EMPL-ACCT < +1 CHGBD110
|
||||
00654 IF CHARGE-SSN = 220947300 CHGBD110
|
||||
00655 DISPLAY 'EMPL: ', CHARGE-EMPL-ACCT, CHGBD110
|
||||
00656 ' SSN: ', CHARGE-SSN, CHGBD110
|
||||
00657 ' CHG-DATE: ', CHARGE-DATE, CHGBD110
|
||||
00658 ' TRAN-ID: ', CHARGE-TRAN-ID, CHGBD110
|
||||
00659 ' OPER-ID: ', CHARGE-OPER-ID. CHGBD110
|
||||
00660 ***** CHGBD110
|
||||
00661 PERFORM P1100-EDIT-CHARGE-DATE THRU P1100-EXIT. CHGBD110
|
||||
00662 IF WRK-EDIT-ERROR-YES-88 CHGBD110
|
||||
00663 GO TO P1000-READ-NEXT. CHGBD110
|
||||
00664 CHGBD110
|
||||
00665 IF (WRK-CHARGE-DATE < WRK-BEGIN-DATE) CHGBD110
|
||||
00666 OR CHGBD110
|
||||
00667 (WRK-CHARGE-DATE > WRK-END-DATE) CHGBD110
|
||||
00668 GO TO P1000-READ-NEXT. CHGBD110
|
||||
00669 CHGBD110
|
||||
00670 PERFORM P1200-EDIT-CWC THRU P1200-EXIT. CHGBD110
|
||||
00671 CHGBD110
|
||||
00672 PERFORM P1300-EDIT-BYE-DATE THRU P1300-EXIT. CHGBD110
|
||||
00673 CHGBD110
|
||||
00674 PERFORM P1400-EDIT-CHG-AMT THRU P1400-EXIT. CHGBD110
|
||||
00675 CHGBD110
|
||||
00676 PERFORM P1500-EDIT-SUPP-CODE THRU P1500-EXIT. CHGBD110
|
||||
00677 CHGBD110
|
||||
00678 PERFORM P1600-CHK-EMP-MASTER THRU P1600-EXIT. CHGBD110
|
||||
00679 CHGBD110
|
||||
00680 IF WRK-EDIT-ERROR-YES-88 CHGBD110
|
||||
00681 GO TO P1000-READ-NEXT. CHGBD110
|
||||
00682 CHGBD110
|
||||
00683 PERFORM P2000-WRITE-SORT-REC THRU P2000-EXIT. CHGBD110
|
||||
00684 CHGBD110
|
||||
00685 P1000-READ-NEXT. CHGBD110
|
||||
00686 READ CHARGE-IN-FILE INTO WRK-CHARGE-REC. CHGBD110
|
||||
00687 IF CHARGE-FILE-OK-88 CHGBD110
|
||||
00688 ADD 1 TO WRK-CHARGE-IN-READ CHGBD110
|
||||
00689 ELSE CHGBD110
|
||||
00690 IF CHARGE-FILE-EOF-88 CHGBD110
|
||||
00691 NEXT SENTENCE CHGBD110
|
||||
00692 ELSE CHGBD110
|
||||
00693 DISPLAY 'CHARGE FILE READ ERROR: ' CHARGE-IN-STATUS CHGBD110
|
||||
00694 SET WRK-ERROR-YES-88 TO TRUE CHGBD110
|
||||
00695 SET CHARGE-FILE-EOF-88 TO TRUE. CHGBD110
|
||||
00696 CHGBD110
|
||||
00697 P1000-EXIT. CHGBD110
|
||||
00698 EXIT. CHGBD110
|
||||
00699 CHGBD110
|
||||
00700 P1100-EDIT-CHARGE-DATE. CHGBD110
|
||||
00701 MOVE CHARGE-DATE TO L001-FED-8-DATE-X. CHGBD110
|
||||
00702 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBD110
|
||||
00703 IF L001-VALID-DATE CHGBD110
|
||||
00704 MOVE L001-FED-8-DATE-9 TO WRK-CHARGE-DATE CHGBD110
|
||||
00705 ELSE CHGBD110
|
||||
00706 SET WRK-EDIT-ERROR-YES-88 TO TRUE CHGBD110
|
||||
00707 ADD +1 TO WRK-CHG-DT-ERR-CNT CHGBD110
|
||||
00708 MOVE MSG3-ID2 TO R907-MSG-ID CHGBD110
|
||||
00709 MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO CHGBD110
|
||||
00710 MOVE CHARGE-SSN TO TBL-SSN3 CHGBD110
|
||||
00711 MOVE CHARGE-DATE TO TBL-CHG-DATE CHGBD110
|
||||
00712 MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT CHGBD110
|
||||
00713 PERFORM S946-R907-WRITE THRU S946-EXIT. CHGBD110
|
||||
00714 CHGBD110
|
||||
00715 P1100-EXIT. CHGBD110
|
||||
00716 EXIT. CHGBD110
|
||||
00717 CHGBD110
|
||||
00718 P1200-EDIT-CWC. CHGBD110
|
||||
00719 MOVE CHARGE-EMPL-ACCT TO WRK-EMP-ACCT. CHGBD110
|
||||
00720 MOVE CHARGE-EMPLOYER-TYPE TO WRK-EMP-TYPE. CHGBD110
|
||||
00721 CHGBD110
|
||||
00722 ************************************************************ CHGBD110
|
||||
00723 * EMPLOYER TYPE NOT SET IN CHARGE RECORDS FOR CWC ACCOUNTS. CHGBD110
|
||||
00724 * THE FOLLOWING CODE CORRECTS THE EMPLOYER TYPE ON THE CHGBD110
|
||||
00725 * INPUT RECORDS. CHGBD110
|
||||
00726 ************************************************************ CHGBD110
|
||||
00727 IF WRK-EMP-ACCT-CWC-88 CHGBD110
|
||||
00728 IF NOT WRK-EMP-TYPE-CWC-88 CHGBD110
|
||||
00729 SET WRK-EMP-TYPE-CWC-88 TO TRUE CHGBD110
|
||||
00730 MOVE WRK-EMP-TYPE TO CHARGE-EMPLOYER-TYPE. CHGBD110
|
||||
00731 CHGBD110
|
||||
00732 CHGBD110
|
||||
00733 P1200-EXIT. CHGBD110
|
||||
00734 EXIT. CHGBD110
|
||||
00735 CHGBD110
|
||||
00736 P1300-EDIT-BYE-DATE. CHGBD110
|
||||
00737 MOVE CHARGE-BYE-DATE TO L001-FED-8-DATE-X. CHGBD110
|
||||
00738 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBD110
|
||||
00739 IF L001-VALID-DATE CHGBD110
|
||||
00740 MOVE L001-FED-8-DATE-9 TO WRK-BYE CHGBD110
|
||||
00741 ELSE CHGBD110
|
||||
00742 ADD +1 TO WRK-BYE-ERR-CNT CHGBD110
|
||||
00743 MOVE MSG2-ID2 TO R907-MSG-ID CHGBD110
|
||||
00744 MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO CHGBD110
|
||||
00745 MOVE CHARGE-SSN TO TBL-SSN2 CHGBD110
|
||||
00746 MOVE CHARGE-BYE-DATE TO TBL-BYE-DATE2 CHGBD110
|
||||
00747 MOVE MSG2-LONG-TEXT TO R907-MSG-TEXT CHGBD110
|
||||
00748 PERFORM S946-R907-WRITE THRU S946-EXIT CHGBD110
|
||||
00749 MOVE ZERO TO WRK-BYE. CHGBD110
|
||||
00750 CHGBD110
|
||||
00751 P1300-EXIT. CHGBD110
|
||||
00752 EXIT. CHGBD110
|
||||
00753 CHGBD110
|
||||
00754 P1400-EDIT-CHG-AMT. CHGBD110
|
||||
00755 IF CHARGE-CURR-AMT NOT NUMERIC CHGBD110
|
||||
00756 SET WRK-EDIT-ERROR-YES-88 TO TRUE CHGBD110
|
||||
00757 ADD +1 TO WRK-CHG-AMT-ERR-CNT CHGBD110
|
||||
00758 MOVE MSG4-ID2 TO R907-MSG-ID CHGBD110
|
||||
00759 MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO CHGBD110
|
||||
00760 MOVE CHARGE-SSN TO TBL-SSN2 CHGBD110
|
||||
00761 MOVE CHARGE-CURR-AMT TO TBL-CURR-AMT CHGBD110
|
||||
00762 MOVE MSG4-LONG-TEXT TO R907-MSG-TEXT CHGBD110
|
||||
00763 PERFORM S946-R907-WRITE THRU S946-EXIT. CHGBD110
|
||||
00764 CHGBD110
|
||||
00765 P1400-EXIT. CHGBD110
|
||||
00766 EXIT. CHGBD110
|
||||
00767 CHGBD110
|
||||
00768 P1500-EDIT-SUPP-CODE. CHGBD110
|
||||
00769 EVALUATE CHARGE-SUPP-CODE CHGBD110
|
||||
00770 CHGBD110
|
||||
00771 WHEN SPACE CHGBD110
|
||||
00772 SET WRK-PROG-UI-88 TO TRUE CHGBD110
|
||||
00773 CHGBD110
|
||||
00774 WHEN 'T' CHGBD110
|
||||
00775 SET WRK-PROG-TEUC-88 TO TRUE CHGBD110
|
||||
00776 CHGBD110
|
||||
00777 WHEN 'E' CHGBD110
|
||||
00778 SET WRK-PROG-EB-88 TO TRUE CHGBD110
|
||||
00779 CHGBD110
|
||||
00780 WHEN 'A' CHGBD110
|
||||
00781 SET WRK-PROG-TEUCA-88 TO TRUE CHGBD110
|
||||
00782 CHGBD110
|
||||
00783 WHEN OTHER CHGBD110
|
||||
00784 SET WRK-EDIT-ERROR-YES-88 TO TRUE CHGBD110
|
||||
00785 ADD +1 TO WRK-SUPP-CD-ERR-CNT CHGBD110
|
||||
00786 MOVE MSG5-ID2 TO R907-MSG-ID CHGBD110
|
||||
00787 MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO CHGBD110
|
||||
00788 MOVE CHARGE-SSN TO TBL-SSN5 CHGBD110
|
||||
00789 MOVE CHARGE-SUPP-CODE TO TBL-SUPP-CODE CHGBD110
|
||||
00790 MOVE MSG5-LONG-TEXT TO R907-MSG-TEXT CHGBD110
|
||||
00791 PERFORM S946-R907-WRITE THRU S946-EXIT CHGBD110
|
||||
00792 CHGBD110
|
||||
00793 END-EVALUATE. CHGBD110
|
||||
00794 CHGBD110
|
||||
00795 P1500-EXIT. CHGBD110
|
||||
00796 EXIT. CHGBD110
|
||||
00797 CHGBD110
|
||||
00798 P1600-CHK-EMP-MASTER. CHGBD110
|
||||
00799 MOVE CHARGE-EMPL-ACCT TO L100-EMP-NO. CHGBD110
|
||||
00800 MOVE WRK-EXP-TRN-EFF-DATE TO L100-EXP-TRN-EFF-DATE. CHGBD110
|
||||
00801 PERFORM S100-CALL-CHGBU100 THRU S100-EXIT. CHGBD110
|
||||
00802 IF L100-OK-88 CHGBD110
|
||||
00803 MOVE L100-EMP-TYPE TO CHARGE-EMPLOYER-TYPE CHGBD110
|
||||
00804 IF L100-SUCCESSOR NOT = ZERO CHGBD110
|
||||
00805 MOVE L100-SUCCESSOR TO CHARGE-EMPL-ACCT CHGBD110
|
||||
00806 END-IF CHGBD110
|
||||
00807 END-IF. CHGBD110
|
||||
00808 CHGBD110
|
||||
00809 CHGBD110
|
||||
00810 P1600-EXIT. CHGBD110
|
||||
00811 EXIT. CHGBD110
|
||||
00812 CHGBD110
|
||||
00813 P2000-WRITE-SORT-REC. CHGBD110
|
||||
00814 IF CHARGE-SSN = 220947300 CHGBD110
|
||||
00815 MOVE CHARGE-CURR-AMT TO DISP-AMT CHGBD110
|
||||
00816 DISPLAY ' => ' CHARGE-EMPL-ACCT CHGBD110
|
||||
00817 ' ' DISP-AMT CHGBD110
|
||||
00818 ' ' CHARGE-EMPLOYER-TYPE CHGBD110
|
||||
00819 ' ' CHARGE-DATE CHGBD110
|
||||
00820 ' ' WRK-BYE CHGBD110
|
||||
00821 ' ' CHARGE-CODE CHGBD110
|
||||
00822 ADD CHARGE-CURR-AMT TO WRK-CHG CHGBD110
|
||||
00823 IF WRK-CURR-DATE = ZERO CHGBD110
|
||||
00824 MOVE CHARGE-DATE TO WRK-CURR-DATE CHGBD110
|
||||
00825 ADD CHARGE-CURR-AMT TO WRK-DAILY-CHG CHGBD110
|
||||
00826 ELSE CHGBD110
|
||||
00827 IF CHARGE-DATE = WRK-CURR-DATE CHGBD110
|
||||
00828 ADD CHARGE-CURR-AMT TO WRK-DAILY-CHG CHGBD110
|
||||
00829 ELSE CHGBD110
|
||||
00830 ADD +1 TO WRK-DAY-CNT CHGBD110
|
||||
00831 MOVE WRK-DAILY-CHG TO DISP-AMT CHGBD110
|
||||
00832 MOVE ZERO TO WRK-DAILY-CHG CHGBD110
|
||||
00833 MOVE CHARGE-DATE TO WRK-CURR-DATE CHGBD110
|
||||
00834 DISPLAY SPACE CHGBD110
|
||||
00835 DISPLAY '*** CHG FOR ' WRK-CURR-DATE CHGBD110
|
||||
00836 ' ' DISP-AMT. CHGBD110
|
||||
00837 * MOVE LOW-VALUES TO CHG1-SORT-KEY-AREA. CHGBD110
|
||||
00838 * MOVE CHARGE-SSN TO CHG1-SSN. CHGBD110
|
||||
00839 * MOVE CHARGE-EMPL-ACCT TO CHG1-EMP-NO. CHGBD110
|
||||
00840 * MOVE WRK-BYE TO CHG1-BYE. CHGBD110
|
||||
00841 * CHGBD110
|
||||
00842 * MOVE WRK-CHARGE-DATE TO CHG1-CHARGE-DATE. CHGBD110
|
||||
00843 * MOVE CHARGE-CODE TO CHG1-CHARGE-CODE. CHGBD110
|
||||
00844 * MOVE WRK-PROGRAM TO CHG1-CHARGE-PROGRAM. CHGBD110
|
||||
00845 * MOVE CHARGE-PAY-TYPE TO CHG1-CHARGE-PAY-TYPE. CHGBD110
|
||||
00846 * MOVE CHARGE-NAME TO CHG1-CHARGE-NAME. CHGBD110
|
||||
00847 * MOVE CHARGE-EMPLOYER-TYPE TO CHG1-CHARGE-EMP-TYPE. CHGBD110
|
||||
00848 * CHGBD110
|
||||
00849 * MOVE CHARGE-CURR-AMT TO CHG1-CHARGE-CURR-AMT. CHGBD110
|
||||
00850 CHGBD110
|
||||
00851 *& WRITE SORT-CHG-REC. CHGBD110
|
||||
00852 ADD 1 TO WRK-SORT-CHG-WRITTEN. CHGBD110
|
||||
00853 CHGBD110
|
||||
00854 P2000-EXIT. CHGBD110
|
||||
00855 EXIT. CHGBD110
|
||||
00856 CHGBD110
|
||||
00857 T0000-TERMINATE. CHGBD110
|
||||
00858 CLOSE CHARGE-IN-FILE. CHGBD110
|
||||
00859 *& BD100-CHG-FILE. CHGBD110
|
||||
00860 CHGBD110
|
||||
00861 PERFORM S910-CLOSE THRU S910-EXIT. CHGBD110
|
||||
00862 PERFORM S921-CLOSE THRU S921-EXIT. CHGBD110
|
||||
00863 CHGBD110
|
||||
00864 MOVE WRK-CHG TO DISP-AMT1. CHGBD110
|
||||
00865 DISPLAY ' TOTAL CHARGE TO 027554 : ' CHGBD110
|
||||
00866 DISP-AMT1. CHGBD110
|
||||
00867 DISPLAY ' CHGBD100 CHARGE RECORDS READ : ' CHGBD110
|
||||
00868 WRK-CHARGE-IN-READ. CHGBD110
|
||||
00869 DISPLAY ' CHARGE RECORDS WRITTEN: ' CHGBD110
|
||||
00870 WRK-SORT-CHG-WRITTEN. CHGBD110
|
||||
00871 DISPLAY ' BYE DATE ERRORS ACCEPTED: ' CHGBD110
|
||||
00872 WRK-BYE-ERR-CNT. CHGBD110
|
||||
00873 DISPLAY ' CHARGE DATE ERRORS: ' CHGBD110
|
||||
00874 WRK-CHG-DT-ERR-CNT CHGBD110
|
||||
00875 DISPLAY ' EMPLOYER TYPE ERRORS: ' CHGBD110
|
||||
00876 WRK-EMP-TYPE-ERR-CNT. CHGBD110
|
||||
00877 DISPLAY ' CHARGE AMOUNT ERRORS: ' CHGBD110
|
||||
00878 WRK-CHG-AMT-ERR-CNT. CHGBD110
|
||||
00879 DISPLAY ' SUPP CODE ERRORS: ' CHGBD110
|
||||
00880 WRK-SUPP-CD-ERR-CNT. CHGBD110
|
||||
00881 T0000-EXIT. CHGBD110
|
||||
00882 EXIT. CHGBD110
|
||||
00883 EJECT CHGBD110
|
||||
00884 CHGBD110
|
||||
00885 S001-FROM-CAL-6. CHGBD110
|
||||
00886 SET L001-FROM-CAL-6 TO TRUE. CHGBD110
|
||||
00887 GO TO S001-DATE. CHGBD110
|
||||
00888 CHGBD110
|
||||
00889 S001-FROM-FED-8. CHGBD110
|
||||
00890 SET L001-FROM-FED-8 TO TRUE. CHGBD110
|
||||
00891 GO TO S001-DATE. CHGBD110
|
||||
00892 CHGBD110
|
||||
00893 S001-DATE. CHGBD110
|
||||
00894 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBD110
|
||||
00895 S001-EXIT. EXIT. CHGBD110
|
||||
00896 CHGBD110
|
||||
00897 S004-FROM-DATE. CHGBD110
|
||||
00898 SET L004-FROM-DATE TO TRUE. CHGBD110
|
||||
00899 GO TO S004-YRQ. CHGBD110
|
||||
00900 CHGBD110
|
||||
00901 S004-YRQ. CHGBD110
|
||||
00902 CALL 'DTSBU004' USING L004-LINK-AREA. CHGBD110
|
||||
00903 S004-EXIT. EXIT. CHGBD110
|
||||
00904 CHGBD110
|
||||
00905 S100-CALL-CHGBU100. CHGBD110
|
||||
00906 CALL 'CHGBU100' USING L100-LINK-AREA. CHGBD110
|
||||
00907 S100-EXIT. EXIT. CHGBD110
|
||||
00908 CHGBD110
|
||||
00909 S910-OPEN-READ. CHGBD110
|
||||
00910 SET L910-OPEN-READ-88 TO TRUE. CHGBD110
|
||||
00911 GO TO S910-MSTR-IO. CHGBD110
|
||||
00912 CHGBD110
|
||||
00913 S910-READ. CHGBD110
|
||||
00914 SET L910-READ-88 TO TRUE CHGBD110
|
||||
00915 GO TO S910-MSTR-IO. CHGBD110
|
||||
00916 CHGBD110
|
||||
00917 S910-CLOSE. CHGBD110
|
||||
00918 SET L910-CLOSE-88 TO TRUE. CHGBD110
|
||||
00919 GO TO S910-MSTR-IO. CHGBD110
|
||||
00920 CHGBD110
|
||||
00921 S910-MSTR-IO. CHGBD110
|
||||
00922 CALL 'DTSBU910' USING L910-LINK-AREA CHGBD110
|
||||
00923 MSKL-REC. CHGBD110
|
||||
00924 CHGBD110
|
||||
00925 S910-EXIT. EXIT. CHGBD110
|
||||
00926 CHGBD110
|
||||
00927 S921-OPEN-READ. CHGBD110
|
||||
00928 SET L921-OPEN-READ-88 TO TRUE. CHGBD110
|
||||
00929 GO TO S921-AIX-IO. CHGBD110
|
||||
00930 CHGBD110
|
||||
00931 S921-CLOSE. CHGBD110
|
||||
00932 SET L921-CLOSE-88 TO TRUE. CHGBD110
|
||||
00933 GO TO S921-AIX-IO. CHGBD110
|
||||
00934 CHGBD110
|
||||
00935 S921-AIX-IO. CHGBD110
|
||||
00936 CALL 'DTSBU921' USING L921-LINK-AREA CHGBD110
|
||||
00937 ISKL-REC. CHGBD110
|
||||
00938 CHGBD110
|
||||
00939 S921-EXIT. EXIT. CHGBD110
|
||||
00940 CHGBD110
|
||||
00941 ** ADD ERROR MSG PROCESS PARA. CHGBD110
|
||||
00942 S946-R907-WRITE. CHGBD110
|
||||
00943 CALL 'DTSBU946' USING R907-REC. CHGBD110
|
||||
00944 S946-EXIT. EXIT. CHGBD110
|
||||
00945 CHGBD110
|
||||
00946 S999-ABEND. CHGBD110
|
||||
00947 DISPLAY '**** CHGBD100 ABENDING ' CHGBD110
|
||||
00948 ABEND-MSG. CHGBD110
|
||||
00949 CALL ABEND-MOD USING ABEND-CODE. CHGBD110
|
||||
00950 CHGBD110
|
||||
00951 S999-EXIT. CHGBD110
|
||||
00952 EXIT. CHGBD110
|
||||
Reference in New Issue
Block a user