751 lines
59 KiB
COBOL
751 lines
59 KiB
COBOL
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
|