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