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