954 lines
75 KiB
COBOL
954 lines
75 KiB
COBOL
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
|