00001 IDENTIFICATION DIVISION. 05/25/10 00002 PROGRAM-ID. CHGBD101. CHGBD101 00003 *AUTHOR. TCL. LV009 00004 *DATE-WRITTEN. FEBRUARY 1999. CHGBD101 00005 DATE-COMPILED. CHGBD101 00006 SKIP3 CHGBD101 00007 ***** CHGBD101 00008 * CHGBD101 00009 * FUNCTION: CHGBD101 00010 * CHGBD101 00011 * BENEFIT CHARGE CONVERSION STEP 1 CHGBD101 00012 * (1) READ DATA FROM TAPE AND CREATE CHGIM001 RECORDS CHGBD101 00013 * CHGBD101 00014 ***** CHGBD101 00015 * *** NOTE NOTE NOTE NOTE NOTE NOTE NOTE *** CHGBD101 00016 * *** *** CHGBD101 00017 * *** IF THE BENEFITS SYSTEM BEGINS PRODUCING *** CHGBD101 00018 * *** CHARGE RECORDS FOR A NEW BENEFIT PROGRAM *** CHGBD101 00019 * *** MODIFY THE FOLLOWING CHARGE SYSTEM *** CHGBD101 00020 * *** COMPONENTS: *** CHGBD101 00021 * *** *** CHGBD101 00022 * *** ADD NEW LEVEL-88S TO: *** CHGBD101 00023 * *** CHG1-CHARGE-PROGRAM IN CHGIM001 *** CHGBD101 00024 * *** WRK-PROGRAM IN CHGBD101 *** CHGBD101 00025 * *** CHG2-PROGRAM IN CHGIM002 *** CHGBD101 00026 * *** CHG4-PROGRAM IN CHGIM004 *** CHGBD101 00027 * *** CHG30-PROGRAM IN CHGIM030 *** CHGBD101 00028 * *** *** CHGBD101 00029 * *** MODIFY P1500 IN CHGBD101 *** CHGBD101 00030 * *** *** CHGBD101 00031 ***** CHGBD101 00032 * CHGBD101 00033 * INPUT: CHGBD101 00034 * CHGBD101 00035 * CHGFILE - CHARGE RECORDS GENERATED BY CHGBD101 00036 * BENEFITS SYSTEM. CHGBD101 00037 * CHGBD101 00038 * OUTPUT: CHGBD101 00039 * CHGBD101 00040 * BD100CHG - REFORMATTED CHARGE RECORD WITHIN CHGBD101 00041 * REPORTING PERIOD READY FOR SORT. CHGBD101 00042 ***** CHGBD101 00043 CHGBD101 00044 ******************************************************************CHGBD101 00045 * MODIFICATION HISTORY: *CHGBD101 00046 * *CHGBD101 00047 * 02-02-1999 MODIFIED FROM MT CHG100D *CHGBD101 00048 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD101 00049 * *CHGBD101 00050 * 04-09-2001 ELIMINATED THE CURRENT PARAMETER FILE BY USING THE *CHGBD101 00051 * LINKAGE SECTION TO RECEIVE THE START AND END DATES *CHGBD101 00052 * FROM JCL PARM. *CHGBD101 00053 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *CHGBD101 00054 * *CHGBD101 00055 * 02-24-2002 ELIMINATED THE LINKAGE-SECTION TO RECEIVE THE START *CHGBD101 00056 * AND END DATES FROM JCL PARM. THE CONVRSION SHOULD *CHGBD101 00057 * NOT HAVE ANY DATE PARAMETERS. IT HAS TO CONVERT ALL *CHGBD101 00058 * RECORDS ON EACH TAPE REGARLESS OF DATE. *CHGBD101 00059 * FOR THOSE EMPLOYERS WITH ACCOUNT NUMBER < 1, WRITE *CHGBD101 00060 * THE CHARGE RECORDS TO A SEPERATE OUTPUT FILE. *CHGBD101 00061 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *CHGBD101 00062 * *CHGBD101 00063 * 06-29-2004 ADD EMP-TYPE 17 - DOMESTIC VIOLENCE. *CHGBD101 00064 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD101 00065 * *CHGBD101 00066 * *CHGBD101 00067 * 05-04-2010 RECOMPILE NEW VERSION OF CHGIM001 *CHGBD101 00068 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD101 00069 * *CHGBD101 00070 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD101 00071 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD101 00072 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBD101 00073 * *CHGBD101 00074 ******************************************************************CHGBD101 00075 CHGBD101 00076 SKIP3 CHGBD101 00077 ENVIRONMENT DIVISION. CHGBD101 00078 SKIP3 CHGBD101 00079 INPUT-OUTPUT SECTION. CHGBD101 00080 SKIP3 CHGBD101 00081 FILE-CONTROL. CHGBD101 00082 CHGBD101 00083 SELECT CHARGE-IN-FILE ASSIGN TO CHGFILE CHGBD101 00084 FILE STATUS IS CHARGE-IN-STATUS. CHGBD101 00085 CHGBD101 00086 *& SELECT BD100-CHG-FILE ASSIGN TO BD100CHG CHGBD101 00087 * FILE STATUS IS BD100-CHG-STATUS. CHGBD101 00088 CHGBD101 00089 *& SELECT BD100-EMPL-ZERO-FILE ASSIGN TO BD100ZRO CHGBD101 00090 * FILE STATUS IS BD100-ZRO-STATUS. CHGBD101 00091 CHGBD101 00092 EJECT CHGBD101 00093 DATA DIVISION. CHGBD101 00094 SKIP3 CHGBD101 00095 FILE SECTION. CHGBD101 00096 SKIP3 CHGBD101 00097 FD CHARGE-IN-FILE CHGBD101 00098 RECORDING MODE IS V CHGBD101 00099 BLOCK CONTAINS 0 CHARACTERS CHGBD101 00100 LABEL RECORDS ARE STANDARD. CHGBD101 00101 CHGBD101 00102 01 CHARGE-IN-REC PIC X(136). CHGBD101 00103 CHGBD101 00104 *FD BD100-CHG-FILE CHGBD101 00105 * LABEL RECORDS ARE STANDARD CHGBD101 00106 * RECORDING MODE IS F CHGBD101 00107 * BLOCK CONTAINS 0 CHARACTERS. CHGBD101 00108 * CHGBD101 00109 *01 SORT-CHG-REC. CHGBD101 00110 ***INCLUDE CHGIM001 CHGBD101 00111 CHGBD101 00112 *FD BD100-EMPL-ZERO-FILE CHGBD101 00113 * RECORDING MODE IS V CHGBD101 00114 * BLOCK CONTAINS 0 CHARACTERS CHGBD101 00115 * LABEL RECORDS ARE STANDARD. CHGBD101 00116 * CHGBD101 00117 *01 ZERO-CHG-REC PIC X(136). CHGBD101 00118 CHGBD101 00119 EJECT CHGBD101 00120 WORKING-STORAGE SECTION. CHGBD101 001205 77 PAN-VALET PICTURE X(24) VALUE '009CHGBD101 05/25/10'. CHGBD101 00121 CHGBD101 00122 01 SORT-CHG-REC. CHGBD101 00123 ++INCLUDE CHGIM001 CHGBD101 00124 CHGBD101 00125 01 WRK-AREA. CHGBD101 00126 05 AMT-DISP PIC Z(06)9.99-. CHGBD101 00127 05 AMT-DISP1 PIC Z(06)9.99-. CHGBD101 00128 05 ABEND-CODE PIC S9(04) COMP CHGBD101 00129 VALUE +100. CHGBD101 00130 05 ABEND-MSG PIC X(60). CHGBD101 00131 05 ABEND-MOD PIC X(08) VALUE 'DTSBU999'. CHGBD101 00132 CHGBD101 00133 05 CHARGE-IN-STATUS PIC X(02) VALUE SPACES. CHGBD101 00134 88 CHARGE-FILE-OK-88 VALUE ZERO. CHGBD101 00135 88 CHARGE-FILE-EOF-88 VALUE '10'. CHGBD101 00136 CHGBD101 00137 05 BD100-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD101 00138 88 BD100-FILE-OK-88 VALUE ZERO. CHGBD101 00139 CHGBD101 00140 05 BD100-ZRO-STATUS PIC X(02) VALUE SPACES. CHGBD101 00141 88 BD100-ZERO-OK-88 VALUE ZERO. CHGBD101 00142 CHGBD101 00143 05 WRK-CHG-LENGTH PIC S9(05) COMP. CHGBD101 00144 CHGBD101 00145 05 WRK-ERROR-IND PIC X(01). CHGBD101 00146 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD101 00147 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD101 00148 CHGBD101 00149 05 WRK-EDIT-ERROR-IND PIC X(01). CHGBD101 00150 88 WRK-EDIT-ERROR-YES-88 VALUE 'Y'. CHGBD101 00151 88 WRK-EDIT-ERROR-NO-88 VALUE 'N'. CHGBD101 00152 CHGBD101 00153 05 WRK-START-DATE PIC S9(09) COMP-3. CHGBD101 00154 05 WRK-END-DATE PIC S9(09) COMP-3. CHGBD101 00155 05 WRK-CHARGE-DATE PIC S9(09) COMP-3. CHGBD101 00156 05 WRK-BYE PIC S9(09) COMP-3. CHGBD101 00157 05 WRK-KEY-X PIC X(10). CHGBD101 00158 05 WRK-KEY-N REDEFINES WRK-KEY-X CHGBD101 00159 PIC 9(10). CHGBD101 00160 05 WRK-EMP-NO-TOT-AMT PIC S9(9)V99 VALUE +0. CHGBD101 00161 05 WRK-AMT-DISP PIC ZZZ,ZZZ,ZZ9.99-. CHGBD101 00162 05 TOT-CHARGE-CURR-AMT PIC S9(9)V99 VALUE +0. CHGBD101 00163 05 DIS-CHARGE-CURR-AMT PIC ZZZ,ZZZ,ZZZ.99. CHGBD101 00164 05 INV-EMP-NO-CURR-AMT PIC S9(9)V99 VALUE +0. CHGBD101 00165 05 DIS-INV-EMP-NO-CURR-AMT PIC ZZZ,ZZZ,ZZZ.99. CHGBD101 00166 ************************************************************* CHGBD101 00167 * WRK-PROGRAM DEFINES VALUES FOR VALID BENEFIT PROGRAMS. CHGBD101 00168 * IT IS SET BASED ON CHARGE-SUPP-CODE IN THE DUCAS ESPRPT04 CHGBD101 00169 * RECORD. IF AN NEW BENEFIT PROGRAM IS ESTABLISHED, ADD CHGBD101 00170 * AN ADDITIONAL LEVEL-88 AND MODIFY THE CODE IN P1500. CHGBD101 00171 ************************************************************* CHGBD101 00172 05 WRK-PROGRAM PIC 9(01). CHGBD101 00173 88 WRK-PROG-UI-88 VALUE 1. CHGBD101 00174 88 WRK-PROG-EB-88 VALUE 2. CHGBD101 00175 88 WRK-PROG-TEUC-88 VALUE 3. CHGBD101 00176 88 WRK-PROG-TEUCA-88 VALUE 4. CHGBD101 00177 *RW1 CHGBD101 00178 05 WRK-CHARGE-IN-READ PIC 9(09) COMP-3. CHGBD101 00179 05 WRK-SORT-CHG-WRITTEN PIC 9(09) COMP-3. CHGBD101 00180 CHGBD101 00181 05 WRK-CHG-DT-ERR-CNT PIC 9(09) COMP-3. CHGBD101 00182 05 WRK-BYE-ERR-CNT PIC 9(09) COMP-3. CHGBD101 00183 05 WRK-EMP-TYPE-ERR-CNT PIC 9(09) COMP-3. CHGBD101 00184 05 WRK-CHG-AMT-ERR-CNT PIC 9(09) COMP-3. CHGBD101 00185 05 WRK-SUPP-CD-ERR-CNT PIC 9(09) COMP-3. CHGBD101 00186 05 WRK-EMP-NO-ERR-CNT PIC 9(09) COMP-3. CHGBD101 00187 05 WRK-SSN-ERR-CNT PIC 9(09) COMP-3. CHGBD101 00188 CHGBD101 00189 05 WRK-EMP-ACCT PIC 9(06). CHGBD101 00190 88 WRK-EMP-ACCT-FED-88 VALUE 000001 THRU 001999. CHGBD101 00191 88 WRK-EMP-ACCT-CWC-88 VALUE 110000 THRU 119999. CHGBD101 00192 CHGBD101 00193 05 WRK-EMP-TYPE PIC 9(02). CHGBD101 00194 88 WRK-EMP-TYPE-RATED-88 VALUE 00. CHGBD101 00195 88 WRK-EMP-TYPE-SELF-INS-88 VALUE 08. CHGBD101 00196 88 WRK-EMP-TYPE-CWC-88 VALUE 04. CHGBD101 00197 88 WRK-EMP-TYPE-FED-88 VALUE 01, 02. CHGBD101 00198 88 WRK-EMP-TYPE-VALID-88 VALUE 00, 01, 02, 03 CHGBD101 00199 04, 05, 06 CHGBD101 00200 07, 08, 09 CHGBD101 00201 10, 11, 12, 26 CHGBD101 00202 13, 15, 16, 17 CHGBD101 00203 18, 19, 20, 21 CHGBD101 00204 22, 23, 24, 25 CHGBD101 00205 26, 27. CHGBD101 00206 ** ADD ERROR MSG TABLE SET UP CHGBD101 00207 01 MSG-TABLE. CHGBD101 00208 05 MSG1-EMP-TYPE. CHGBD101 00209 10 MSG1-ID. CHGBD101 00210 15 MSG1-ID1 PIC X(08) VALUE 'CHGBD101'. CHGBD101 00211 15 MSG1-ID2 PIC X(03) VALUE '101'. CHGBD101 00212 10 MSG1-SHORT-TEXT PIC X(20) CHGBD101 00213 VALUE 'INVALID EMP TYPE : '. CHGBD101 00214 10 MSG1-LONG-TEXT. CHGBD101 00215 15 FILLER PIC X(29) CHGBD101 00216 VALUE 'INVALID EMPLOYER TYPE '. CHGBD101 00217 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD101 00218 15 MSG1-SSN PIC 9(10). CHGBD101 00219 15 FILLER PIC X(13) VALUE ' EMP TYPE = '. CHGBD101 00220 15 MSG1-EMP-TYPE PIC 9(02). CHGBD101 00221 CHGBD101 00222 05 MSG2-BYE-DATE. CHGBD101 00223 10 MSG2-ID. CHGBD101 00224 15 MSG2-ID1 PIC X(08) VALUE 'CHGBD101'. CHGBD101 00225 15 MSG2-ID2 PIC X(03) VALUE '101'. CHGBD101 00226 10 MSG2-SHORT-TEXT PIC X(20) CHGBD101 00227 VALUE 'INVALID BYE DATE : '. CHGBD101 00228 10 MSG2-LONG-TEXT. CHGBD101 00229 15 FILLER PIC X(29) CHGBD101 00230 VALUE 'INVALID BYE DATE ACCEPTED '. CHGBD101 00231 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD101 00232 15 MSG2-SSN PIC 9(10). CHGBD101 00233 15 FILLER PIC X(13) VALUE ' BYE DATE = '. CHGBD101 00234 15 MSG2-BYE PIC 9(08). CHGBD101 00235 CHGBD101 00236 05 MSG3-CHARGE-DATE. CHGBD101 00237 10 MSG3-ID. CHGBD101 00238 15 MSG3-ID1 PIC X(08) VALUE 'CHGBD101'. CHGBD101 00239 15 MSG3-ID2 PIC X(03) VALUE '101'. CHGBD101 00240 10 MSG3-SHORT-TEXT PIC X(20) CHGBD101 00241 VALUE 'INVALID CHG DATE : '. CHGBD101 00242 10 MSG3-LONG-TEXT. CHGBD101 00243 15 FILLER PIC X(29) CHGBD101 00244 VALUE 'INVALID CHARGE DATE '. CHGBD101 00245 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD101 00246 15 MSG3-SSN PIC 9(10). CHGBD101 00247 15 FILLER PIC X(13) VALUE ' CHG DATE = '. CHGBD101 00248 15 MSG3-CHG-DATE PIC 9(08). CHGBD101 00249 CHGBD101 00250 05 MSG4-CHARGE-AMT. CHGBD101 00251 10 MSG4-ID. CHGBD101 00252 15 MSG4-ID1 PIC X(08) VALUE 'CHGBD101'. CHGBD101 00253 15 MSG4-ID2 PIC X(03) VALUE '101'. CHGBD101 00254 10 MSG4-SHORT-TEXT PIC X(20) CHGBD101 00255 VALUE 'INVALID CHG AMOUNT :'. CHGBD101 00256 10 MSG4-LONG-TEXT. CHGBD101 00257 15 FILLER PIC X(29) CHGBD101 00258 VALUE 'INVALID CHARGE AMOUNT '. CHGBD101 00259 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD101 00260 15 MSG4-SSN PIC 9(10). CHGBD101 00261 15 FILLER PIC X(15) VALUE ' CHG AMOUNT = '.CHGBD101 00262 15 MSG4-CURR-AMT PIC S9(08)V99. CHGBD101 00263 CHGBD101 00264 05 MSG5-SUPP-CODE. CHGBD101 00265 10 MSG5-ID. CHGBD101 00266 15 MSG5-ID1 PIC X(08) VALUE 'CHGBD101'. CHGBD101 00267 15 MSG5-ID2 PIC X(03) VALUE '101'. CHGBD101 00268 10 MSG5-SHORT-TEXT PIC X(20) CHGBD101 00269 VALUE 'INVALID SUPP CODE :'. CHGBD101 00270 10 MSG5-LONG-TEXT. CHGBD101 00271 15 FILLER PIC X(29) CHGBD101 00272 VALUE 'INVALID SUPP CODE '. CHGBD101 00273 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD101 00274 15 MSG5-SSN PIC 9(10). CHGBD101 00275 15 FILLER PIC X(14) VALUE ' SUPP CODE = '. CHGBD101 00276 15 MSG5-SUPP-CD PIC X(01). CHGBD101 00277 CHGBD101 00278 05 MSG6-EMP-NO. CHGBD101 00279 10 MSG6-ID. CHGBD101 00280 15 MSG6-ID1 PIC X(08) VALUE 'CHGBD101'. CHGBD101 00281 15 MSG6-ID2 PIC X(03) VALUE '101'. CHGBD101 00282 10 MSG6-SHORT-TEXT PIC X(20) CHGBD101 00283 VALUE 'EMP NUMBER = ZERO :'. CHGBD101 00284 10 MSG6-LONG-TEXT. CHGBD101 00285 15 FILLER PIC X(29) CHGBD101 00286 VALUE 'EMPLOYER NUMBER = ZERO '. CHGBD101 00287 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD101 00288 15 MSG6-SSN PIC 9(10). CHGBD101 00289 15 FILLER PIC X(15) VALUE SPACES. CHGBD101 00290 CHGBD101 00291 05 MSG7-SSN-ERR. CHGBD101 00292 10 MSG6-ID. CHGBD101 00293 15 MSG7-ID1 PIC X(08) VALUE 'CHGBD101'. CHGBD101 00294 15 MSG7-ID2 PIC X(03) VALUE '101'. CHGBD101 00295 10 MSG7-SHORT-TEXT PIC X(20) CHGBD101 00296 VALUE 'SSN = ZERO :'. CHGBD101 00297 10 MSG7-LONG-TEXT. CHGBD101 00298 15 FILLER PIC X(29) CHGBD101 00299 VALUE 'SSN = ZERT '. CHGBD101 00300 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD101 00301 15 MSG7-SSN PIC 9(10). CHGBD101 00302 15 FILLER PIC X(15) VALUE SPACES. CHGBD101 00303 CHGBD101 00304 ** ADD ERROR MSG OUTPUT RECORD. CHGBD101 00305 01 R907-REC. CHGBD101 00306 ++INCLUDE DTSIR907 CHGBD101 00307 CHGBD101 00308 *** BENEFITS CHARGE RECORD *** CHGBD101 00309 ++INCLUDE ESPRPT04 CHGBD101 00310 CHGBD101 00311 01 FILLER REDEFINES CHARGE-REC. CHGBD101 00312 **** 05 FILLER PIC X(04). CHGBD101 00313 05 WRK-CHARGE-REC PIC X(140). CHGBD101 00314 CHGBD101 00315 01 L001-LINK-AREA. CHGBD101 00316 ++INCLUDE DTSIL001 CHGBD101 00317 CHGBD101 00318 01 L004-LINK-AREA. CHGBD101 00319 ++INCLUDE DTSIL004 CHGBD101 00320 CHGBD101 00321 *LINKAGE SECTION. CHGBD101 00322 *01 PARM-AREA. CHGBD101 00323 * 05 PARM-LENGTH PIC S9(04) COMP. CHGBD101 00324 * 05 PARM-START-DATE PIC X(06). CHGBD101 00325 * 05 FILLER PIC X(01). CHGBD101 00326 * 05 PARM-END-DATE PIC X(06). CHGBD101 00327 EJECT CHGBD101 00328 PROCEDURE DIVISION. CHGBD101 00329 SKIP2 CHGBD101 00330 CHGBD101-MAIN. CHGBD101 00331 MOVE ZERO TO WRK-CHARGE-IN-READ CHGBD101 00332 WRK-SORT-CHG-WRITTEN CHGBD101 00333 WRK-CHG-DT-ERR-CNT CHGBD101 00334 WRK-BYE-ERR-CNT CHGBD101 00335 WRK-EMP-TYPE-ERR-CNT CHGBD101 00336 WRK-CHG-AMT-ERR-CNT CHGBD101 00337 WRK-SUPP-CD-ERR-CNT CHGBD101 00338 WRK-EMP-NO-ERR-CNT CHGBD101 00339 WRK-SSN-ERR-CNT. CHGBD101 00340 CHGBD101 00341 SET WRK-ERROR-NO-88 TO TRUE. CHGBD101 00342 CHGBD101 00343 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD101 00344 IF WRK-ERROR-YES-88 CHGBD101 00345 GO TO CHGBD101-EXIT. CHGBD101 00346 CHGBD101 00347 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD101 00348 CHGBD101 00349 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD101 00350 CHGBD101 00351 MOVE +0 TO RETURN-CODE. CHGBD101 00352 CHGBD101 00353 CHGBD101-EXIT. CHGBD101 00354 STOP RUN. CHGBD101 00355 EJECT CHGBD101 00356 I0000-INITIATE. CHGBD101 00357 MOVE MSG1-ID1 TO R907-MODULE-NAME. CHGBD101 00358 MOVE LENGTH OF R907-REC TO R907-LENGTH. CHGBD101 00359 CHGBD101 00360 * PERFORM I1000-READ-PARM THRU I1000-EXIT. CHGBD101 00361 CHGBD101 00362 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CHGBD101 00363 CHGBD101 00364 I0000-EXIT. CHGBD101 00365 EXIT. CHGBD101 00366 CHGBD101 00367 *I1000-READ-PARM. CHGBD101 00368 * IF PARM-LENGTH NOT = +13 CHGBD101 00369 * DISPLAY 'INVALID PARM LENGTH' CHGBD101 00370 * PERFORM S999-ABEND THRU S999-EXIT. CHGBD101 00371 * CHGBD101 00372 * IF PARM-START-DATE NOT NUMERIC CHGBD101 00373 * DISPLAY 'START DATE NOT NUMERIC' CHGBD101 00374 * PERFORM S999-ABEND THRU S999-EXIT. CHGBD101 00375 * CHGBD101 00376 * MOVE PARM-START-DATE TO L001-CAL-6-DATE-X. CHGBD101 00377 * PERFORM S001-FROM-CAL-6 THRU S001-EXIT. CHGBD101 00378 * IF L001-VALID-DATE CHGBD101 00379 * MOVE L001-FED-8-DATE-9 TO WRK-START-DATE CHGBD101 00380 * ELSE CHGBD101 00381 * DISPLAY 'INVALID-START-DATE' CHGBD101 00382 * PERFORM S999-ABEND THRU S999-EXIT. CHGBD101 00383 * CHGBD101 00384 * IF PARM-END-DATE NOT NUMERIC CHGBD101 00385 * DISPLAY 'END DATE NOT NUMERIC' CHGBD101 00386 * PERFORM S999-ABEND THRU S999-EXIT. CHGBD101 00387 * CHGBD101 00388 * MOVE PARM-END-DATE TO L001-CAL-6-DATE-X. CHGBD101 00389 * PERFORM S001-FROM-CAL-6 THRU S001-EXIT. CHGBD101 00390 * IF L001-VALID-DATE CHGBD101 00391 * MOVE L001-FED-8-DATE-9 TO WRK-END-DATE CHGBD101 00392 * ELSE CHGBD101 00393 * DISPLAY 'INVALID-END-DATE' CHGBD101 00394 * PERFORM S999-ABEND THRU S999-EXIT. CHGBD101 00395 * CHGBD101 00396 * DISPLAY '****************************************'. CHGBD101 00397 * DISPLAY '** **'. CHGBD101 00398 * DISPLAY '** START DATE ' WRK-START-DATE CHGBD101 00399 * ' **'. CHGBD101 00400 * DISPLAY '** **'. CHGBD101 00401 * DISPLAY '** END DATE ' WRK-END-DATE CHGBD101 00402 * ' **'. CHGBD101 00403 * DISPLAY '****************************************'. CHGBD101 00404 * CHGBD101 00405 *I1000-EXIT. CHGBD101 00406 * EXIT. CHGBD101 00407 CHGBD101 00408 I2000-OPEN-FILES. CHGBD101 00409 OPEN INPUT CHARGE-IN-FILE. CHGBD101 00410 IF NOT CHARGE-FILE-OK-88 CHGBD101 00411 DISPLAY 'CHARGE FILE OPEN ERROR: ' CHARGE-IN-STATUS CHGBD101 00412 SET WRK-ERROR-YES-88 TO TRUE CHGBD101 00413 GO TO I2000-EXIT. CHGBD101 00414 CHGBD101 00415 *& OPEN OUTPUT BD100-CHG-FILE. CHGBD101 00416 * IF NOT BD100-FILE-OK-88 CHGBD101 00417 * DISPLAY 'SORT FILE OPEN ERROR: ' BD100-CHG-STATUS CHGBD101 00418 * SET WRK-ERROR-YES-88 TO TRUE CHGBD101 00419 * GO TO I2000-EXIT. CHGBD101 00420 CHGBD101 00421 *& OPEN OUTPUT BD100-EMPL-ZERO-FILE. CHGBD101 00422 * IF NOT BD100-ZERO-OK-88 CHGBD101 00423 * DISPLAY 'EMPL-ZERO-FILE OPEN ERROR: ' BD100-ZRO-STATUS CHGBD101 00424 * SET WRK-ERROR-YES-88 TO TRUE CHGBD101 00425 * GO TO I2000-EXIT. CHGBD101 00426 CHGBD101 00427 I2000-EXIT. CHGBD101 00428 EXIT. CHGBD101 00429 CHGBD101 00430 P0000-PROCESS. CHGBD101 00431 READ CHARGE-IN-FILE INTO WRK-CHARGE-REC CHGBD101 00432 IF NOT CHARGE-FILE-OK-88 CHGBD101 00433 DISPLAY 'CHARGE FILE EMPTY: ' CHARGE-IN-STATUS CHGBD101 00434 SET WRK-ERROR-YES-88 TO TRUE CHGBD101 00435 GO TO P0000-EXIT CHGBD101 00436 ELSE CHGBD101 00437 ADD 1 TO WRK-CHARGE-IN-READ. CHGBD101 00438 CHGBD101 00439 PERFORM P1000-SELECT-CHARGES THRU P1000-EXIT CHGBD101 00440 **** UNTIL WRK-SORT-CHG-WRITTEN > 1000. CHGBD101 00441 UNTIL CHARGE-FILE-EOF-88. CHGBD101 00442 CHGBD101 00443 P0000-EXIT. CHGBD101 00444 EXIT. CHGBD101 00445 CHGBD101 00446 P1000-SELECT-CHARGES. CHGBD101 00447 SET WRK-EDIT-ERROR-NO-88 TO TRUE. CHGBD101 00448 ***** CHGBD101 00449 ***** CHGBD101 00450 PERFORM P1100-EDIT-CHARGE-DATE THRU P1100-EXIT. CHGBD101 00451 IF WRK-EDIT-ERROR-YES-88 CHGBD101 00452 GO TO P1000-READ-NEXT. CHGBD101 00453 CHGBD101 00454 PERFORM P1200-EDIT-CWC THRU P1200-EXIT. CHGBD101 00455 CHGBD101 00456 PERFORM P1300-EDIT-BYE-DATE THRU P1300-EXIT. CHGBD101 00457 CHGBD101 00458 PERFORM P1400-EDIT-CHG-AMT THRU P1400-EXIT. CHGBD101 00459 CHGBD101 00460 PERFORM P1500-EDIT-SUPP-CODE THRU P1500-EXIT. CHGBD101 00461 CHGBD101 00462 PERFORM P1600-EDIT-EMP-NO THRU P1600-EXIT. CHGBD101 00463 CHGBD101 00464 PERFORM P1700-EDIT-SSN THRU P1700-EXIT. CHGBD101 00465 CHGBD101 00466 IF WRK-EDIT-ERROR-YES-88 CHGBD101 00467 GO TO P1000-READ-NEXT. CHGBD101 00468 CHGBD101 00469 PERFORM P2000-WRITE-SORT-REC THRU P2000-EXIT. CHGBD101 00470 CHGBD101 00471 P1000-READ-NEXT. CHGBD101 00472 READ CHARGE-IN-FILE INTO WRK-CHARGE-REC. CHGBD101 00473 IF CHARGE-FILE-OK-88 CHGBD101 00474 ADD 1 TO WRK-CHARGE-IN-READ CHGBD101 00475 ELSE CHGBD101 00476 IF CHARGE-FILE-EOF-88 CHGBD101 00477 NEXT SENTENCE CHGBD101 00478 ELSE CHGBD101 00479 DISPLAY 'CHARGE FILE READ ERROR: ' CHARGE-IN-STATUS CHGBD101 00480 SET WRK-ERROR-YES-88 TO TRUE CHGBD101 00481 SET CHARGE-FILE-EOF-88 TO TRUE. CHGBD101 00482 CHGBD101 00483 P1000-EXIT. CHGBD101 00484 EXIT. CHGBD101 00485 CHGBD101 00486 P1100-EDIT-CHARGE-DATE. CHGBD101 00487 MOVE CHARGE-DATE TO L001-FED-8-DATE-X. CHGBD101 00488 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBD101 00489 IF L001-VALID-DATE CHGBD101 00490 MOVE L001-FED-8-DATE-9 TO WRK-CHARGE-DATE CHGBD101 00491 ELSE CHGBD101 00492 SET WRK-EDIT-ERROR-YES-88 TO TRUE CHGBD101 00493 ADD +1 TO WRK-CHG-DT-ERR-CNT CHGBD101 00494 MOVE MSG3-ID2 TO R907-MSG-ID CHGBD101 00495 MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO CHGBD101 00496 MOVE CHARGE-SSN TO MSG3-SSN CHGBD101 00497 MOVE CHARGE-DATE TO MSG3-CHG-DATE CHGBD101 00498 MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT CHGBD101 00499 PERFORM S946-R907-WRITE THRU S946-EXIT. CHGBD101 00500 CHGBD101 00501 P1100-EXIT. CHGBD101 00502 EXIT. CHGBD101 00503 CHGBD101 00504 P1200-EDIT-CWC. CHGBD101 00505 MOVE CHARGE-EMPL-ACCT TO WRK-EMP-ACCT. CHGBD101 00506 MOVE CHARGE-EMPLOYER-TYPE TO WRK-EMP-TYPE. CHGBD101 00507 CHGBD101 00508 ************************************************************ CHGBD101 00509 * EMPLOYER TYPE NOT SET IN CHARGE RECORDS FOR CWC ACCOUNTS. CHGBD101 00510 * THE FOLLOWING CODE CORRECTS THE EMPLOYER TYPE ON THE CHGBD101 00511 * INPUT RECORDS. CHGBD101 00512 ************************************************************ CHGBD101 00513 IF WRK-EMP-ACCT-CWC-88 CHGBD101 00514 IF NOT WRK-EMP-TYPE-CWC-88 CHGBD101 00515 SET WRK-EMP-TYPE-CWC-88 TO TRUE CHGBD101 00516 MOVE WRK-EMP-TYPE TO CHARGE-EMPLOYER-TYPE. CHGBD101 00517 CHGBD101 00518 P1200-EXIT. CHGBD101 00519 EXIT. CHGBD101 00520 CHGBD101 00521 P1300-EDIT-BYE-DATE. CHGBD101 00522 MOVE CHARGE-BYE-DATE TO L001-FED-8-DATE-X. CHGBD101 00523 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBD101 00524 IF L001-VALID-DATE CHGBD101 00525 MOVE L001-FED-8-DATE-9 TO WRK-BYE CHGBD101 00526 ELSE CHGBD101 00527 ** CHGBD101 00528 * SET WRK-EDIT-ERROR-YES-88 TO TRUE CHGBD101 00529 ** CHGBD101 00530 ADD +1 TO WRK-BYE-ERR-CNT CHGBD101 00531 MOVE MSG2-ID2 TO R907-MSG-ID CHGBD101 00532 MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO CHGBD101 00533 MOVE CHARGE-SSN TO MSG2-SSN CHGBD101 00534 MOVE CHARGE-BYE-DATE TO MSG2-BYE CHGBD101 00535 MOVE MSG2-LONG-TEXT TO R907-MSG-TEXT CHGBD101 00536 PERFORM S946-R907-WRITE THRU S946-EXIT CHGBD101 00537 MOVE ZERO TO WRK-BYE. CHGBD101 00538 CHGBD101 00539 P1300-EXIT. CHGBD101 00540 EXIT. CHGBD101 00541 CHGBD101 00542 P1400-EDIT-CHG-AMT. CHGBD101 00543 IF CHARGE-CURR-AMT NOT NUMERIC CHGBD101 00544 SET WRK-EDIT-ERROR-YES-88 TO TRUE CHGBD101 00545 ADD +1 TO WRK-CHG-AMT-ERR-CNT CHGBD101 00546 MOVE MSG4-ID2 TO R907-MSG-ID CHGBD101 00547 MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO CHGBD101 00548 MOVE CHARGE-SSN TO MSG4-SSN CHGBD101 00549 MOVE CHARGE-CURR-AMT TO MSG4-CURR-AMT CHGBD101 00550 MOVE MSG4-LONG-TEXT TO R907-MSG-TEXT CHGBD101 00551 PERFORM S946-R907-WRITE THRU S946-EXIT. CHGBD101 00552 CHGBD101 00553 P1400-EXIT. CHGBD101 00554 EXIT. CHGBD101 00555 CHGBD101 00556 P1500-EDIT-SUPP-CODE. CHGBD101 00557 EVALUATE CHARGE-SUPP-CODE CHGBD101 00558 CHGBD101 00559 WHEN SPACE CHGBD101 00560 SET WRK-PROG-UI-88 TO TRUE CHGBD101 00561 CHGBD101 00562 WHEN 'T' CHGBD101 00563 SET WRK-PROG-TEUC-88 TO TRUE CHGBD101 00564 CHGBD101 00565 WHEN 'E' CHGBD101 00566 SET WRK-PROG-EB-88 TO TRUE CHGBD101 00567 CHGBD101 00568 WHEN 'A' CHGBD101 00569 SET WRK-PROG-TEUCA-88 TO TRUE CHGBD101 00570 CHGBD101 00571 WHEN OTHER CHGBD101 00572 SET WRK-EDIT-ERROR-YES-88 TO TRUE CHGBD101 00573 ADD +1 TO WRK-SUPP-CD-ERR-CNT CHGBD101 00574 MOVE MSG5-ID2 TO R907-MSG-ID CHGBD101 00575 MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO CHGBD101 00576 MOVE CHARGE-SSN TO MSG5-SSN CHGBD101 00577 MOVE CHARGE-SUPP-CODE TO MSG5-SUPP-CODE CHGBD101 00578 MOVE MSG5-LONG-TEXT TO R907-MSG-TEXT CHGBD101 00579 PERFORM S946-R907-WRITE THRU S946-EXIT CHGBD101 00580 CHGBD101 00581 END-EVALUATE. CHGBD101 00582 CHGBD101 00583 P1500-EXIT. CHGBD101 00584 EXIT. CHGBD101 00585 CHGBD101 00586 P1600-EDIT-EMP-NO. CHGBD101 00587 IF CHARGE-EMPL-ACCT < +1 CHGBD101 00588 SET WRK-EDIT-ERROR-YES-88 TO TRUE CHGBD101 00589 ADD CHARGE-CURR-AMT TO WRK-EMP-NO-TOT-AMT CHGBD101 00590 *& WRITE ZERO-CHG-REC FROM WRK-CHARGE-REC CHGBD101 00591 ADD +1 TO WRK-EMP-NO-ERR-CNT. CHGBD101 00592 CHGBD101 00593 * MOVE MSG6-ID2 TO R907-MSG-ID CHGBD101 00594 * MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO CHGBD101 00595 * MOVE CHARGE-SSN TO MSG6-SSN CHGBD101 00596 * MOVE MSG6-LONG-TEXT TO R907-MSG-TEXT CHGBD101 00597 * PERFORM S946-R907-WRITE THRU S946-EXIT. CHGBD101 00598 CHGBD101 00599 P1600-EXIT. CHGBD101 00600 EXIT. CHGBD101 00601 CHGBD101 00602 P1700-EDIT-SSN. CHGBD101 00603 MOVE CHARGE-KEY TO WRK-KEY-X. CHGBD101 00604 IF WRK-KEY-N NUMERIC CHGBD101 00605 IF WRK-KEY-N > ZERO CHGBD101 00606 NEXT SENTENCE CHGBD101 00607 ELSE CHGBD101 00608 PERFORM P1710-SSN-ERROR THRU P1710-EXIT CHGBD101 00609 ELSE CHGBD101 00610 PERFORM P1710-SSN-ERROR THRU P1710-EXIT. CHGBD101 00611 CHGBD101 00612 P1700-EXIT. CHGBD101 00613 EXIT. CHGBD101 00614 CHGBD101 00615 P1710-SSN-ERROR. CHGBD101 00616 SET WRK-EDIT-ERROR-YES-88 TO TRUE. CHGBD101 00617 ADD +1 TO WRK-SSN-ERR-CNT. CHGBD101 00618 MOVE MSG7-ID2 TO R907-MSG-ID. CHGBD101 00619 MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO. CHGBD101 00620 MOVE CHARGE-SSN TO MSG7-SSN. CHGBD101 00621 MOVE MSG7-LONG-TEXT TO R907-MSG-TEXT. CHGBD101 00622 PERFORM S946-R907-WRITE THRU S946-EXIT. CHGBD101 00623 CHGBD101 00624 P1710-EXIT. CHGBD101 00625 EXIT. CHGBD101 00626 CHGBD101 00627 P2000-WRITE-SORT-REC. CHGBD101 00628 *& CHGBD101 00629 IF CHARGE-SSN = 269700223 CHGBD101 00630 MOVE CHARGE-CURR-AMT TO AMT-DISP CHGBD101 00631 MOVE CHARGE-TOT-AMT TO AMT-DISP1 CHGBD101 00632 IF (WRK-CHARGE-DATE >= 20020501 CHGBD101 00633 AND WRK-CHARGE-DATE <= 20020531) CHGBD101 00634 DISPLAY SPACE CHGBD101 00635 DISPLAY '>> EMP ' CHARGE-EMPL-ACCT CHGBD101 00636 ' TYPE ' CHARGE-EMPLOYER-TYPE CHGBD101 00637 ' SSN ' CHARGE-KEY CHGBD101 00638 ' CD ' CHARGE-CODE CHGBD101 00639 ' DATE ' WRK-CHARGE-DATE CHGBD101 00640 DISPLAY ' BWE ' CHARGE-BWE-DATE CHGBD101 00641 ' BYE ' WRK-BYE CHGBD101 00642 ' AMT ' AMT-DISP CHGBD101 00643 ' TOT ' AMT-DISP1 CHGBD101 00644 ELSE CHGBD101 00645 DISPLAY SPACE CHGBD101 00646 DISPLAY ' EMP ' CHARGE-EMPL-ACCT CHGBD101 00647 ' TYPE ' CHARGE-EMPLOYER-TYPE CHGBD101 00648 ' SSN ' CHARGE-KEY CHGBD101 00649 ' CD ' CHARGE-CODE CHGBD101 00650 ' DATE ' WRK-CHARGE-DATE CHGBD101 00651 DISPLAY ' BWE ' CHARGE-BWE-DATE CHGBD101 00652 ' BYE ' WRK-BYE CHGBD101 00653 ' AMT ' AMT-DISP CHGBD101 00654 ' TOT ' AMT-DISP1. CHGBD101 00655 *& CHGBD101 00656 MOVE LOW-VALUES TO CHG1-SORT-KEY-AREA. CHGBD101 00657 MOVE WRK-KEY-N TO CHG1-SSN. CHGBD101 00658 MOVE CHARGE-EMPL-ACCT TO CHG1-EMP-NO. CHGBD101 00659 MOVE WRK-BYE TO CHG1-BYE. CHGBD101 00660 CHGBD101 00661 MOVE WRK-CHARGE-DATE TO CHG1-CHARGE-DATE. CHGBD101 00662 MOVE CHARGE-CODE TO CHG1-CHARGE-CODE. CHGBD101 00663 MOVE WRK-PROGRAM TO CHG1-CHARGE-PROGRAM. CHGBD101 00664 MOVE CHARGE-PAY-TYPE TO CHG1-CHARGE-PAY-TYPE. CHGBD101 00665 MOVE CHARGE-NAME TO CHG1-CHARGE-NAME. CHGBD101 00666 MOVE CHARGE-EMPLOYER-TYPE TO CHG1-CHARGE-EMP-TYPE. CHGBD101 00667 CHGBD101 00668 MOVE CHARGE-CURR-AMT TO CHG1-CHARGE-CURR-AMT. CHGBD101 00669 ADD CHARGE-CURR-AMT TO TOT-CHARGE-CURR-AMT. CHGBD101 00670 CHGBD101 00671 *& WRITE SORT-CHG-REC. CHGBD101 00672 ADD 1 TO WRK-SORT-CHG-WRITTEN. CHGBD101 00673 CHGBD101 00674 P2000-EXIT. CHGBD101 00675 EXIT. CHGBD101 00676 CHGBD101 00677 T0000-TERMINATE. CHGBD101 00678 CLOSE CHARGE-IN-FILE. CHGBD101 00679 *& BD100-CHG-FILE. CHGBD101 00680 *& BD100-EMPL-ZERO-FILE. CHGBD101 00681 CHGBD101 00682 DISPLAY ' CHGBD101 CHARGE RECORDS READ : ' CHGBD101 00683 WRK-CHARGE-IN-READ. CHGBD101 00684 DISPLAY ' CHARGE RECORDS WRITTEN: ' CHGBD101 00685 WRK-SORT-CHG-WRITTEN. CHGBD101 00686 DISPLAY ' BYE DATE ERRORS ACCEPTED: ' CHGBD101 00687 WRK-BYE-ERR-CNT. CHGBD101 00688 DISPLAY ' CHARGE DATE ERRORS: ' CHGBD101 00689 WRK-CHG-DT-ERR-CNT CHGBD101 00690 DISPLAY ' EMPLOYER TYPE ERRORS: ' CHGBD101 00691 WRK-EMP-TYPE-ERR-CNT. CHGBD101 00692 DISPLAY ' CHARGE AMOUNT ERRORS: ' CHGBD101 00693 WRK-CHG-AMT-ERR-CNT. CHGBD101 00694 DISPLAY ' SUPP CODE ERRORS: ' CHGBD101 00695 WRK-SUPP-CD-ERR-CNT. CHGBD101 00696 CHGBD101 00697 MOVE WRK-EMP-NO-TOT-AMT TO WRK-AMT-DISP. CHGBD101 00698 DISPLAY ' EMP NO ERRORS AND TOTAL AMOUNT: ' CHGBD101 00699 WRK-EMP-NO-ERR-CNT ' ' WRK-AMT-DISP. CHGBD101 00700 CHGBD101 00701 DISPLAY ' SSN ERRORS: ' CHGBD101 00702 WRK-SSN-ERR-CNT. CHGBD101 00703 CHGBD101 00704 DISPLAY ' '. CHGBD101 00705 MOVE INV-EMP-NO-CURR-AMT TO DIS-INV-EMP-NO-CURR-AMT. CHGBD101 00706 DISPLAY ' INVALID EMP-NO CHARGE-CURR AMTS: ' CHGBD101 00707 DIS-INV-EMP-NO-CURR-AMT. CHGBD101 00708 CHGBD101 00709 DISPLAY ' '. CHGBD101 00710 MOVE TOT-CHARGE-CURR-AMT TO DIS-CHARGE-CURR-AMT. CHGBD101 00711 DISPLAY ' TOTAL CHARGE CURRENT AMTS: ' CHGBD101 00712 DIS-CHARGE-CURR-AMT. CHGBD101 00713 CHGBD101 00714 T0000-EXIT. CHGBD101 00715 EXIT. CHGBD101 00716 EJECT CHGBD101 00717 CHGBD101 00718 S001-FROM-CAL-6. CHGBD101 00719 SET L001-FROM-CAL-6 TO TRUE. CHGBD101 00720 GO TO S001-DATE. CHGBD101 00721 CHGBD101 00722 S001-FROM-FED-8. CHGBD101 00723 SET L001-FROM-FED-8 TO TRUE. CHGBD101 00724 GO TO S001-DATE. CHGBD101 00725 CHGBD101 00726 S001-DATE. CHGBD101 00727 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBD101 00728 S001-EXIT. EXIT. CHGBD101 00729 CHGBD101 00730 S004-FROM-DATE. CHGBD101 00731 SET L004-FROM-DATE TO TRUE. CHGBD101 00732 GO TO S004-YRQ. CHGBD101 00733 CHGBD101 00734 S004-YRQ. CHGBD101 00735 CALL 'DTSBU004' USING L004-LINK-AREA. CHGBD101 00736 S004-EXIT. EXIT. CHGBD101 00737 CHGBD101 00738 ** ADD ERROR MSG PROCESS PARA. CHGBD101 00739 S946-R907-WRITE. CHGBD101 00740 CALL 'DTSBU946' USING R907-REC. CHGBD101 00741 S946-EXIT. EXIT. CHGBD101 00742 CHGBD101 00743 S999-ABEND. CHGBD101 00744 DISPLAY '**** CHGBD101 ABENDING ' CHGBD101 00745 ABEND-MSG. CHGBD101 00746 CALL ABEND-MOD USING ABEND-CODE. CHGBD101 00747 CHGBD101 00748 S999-EXIT. CHGBD101 00749 EXIT. CHGBD101