DUTAS re-platformed to Raincode - Initial Source Code

This commit is contained in:
Neeraj Kumar
2025-07-21 07:44:09 -04:00
commit ca3572c5df
2773 changed files with 798221 additions and 0 deletions

953
Batch/CHGBD110.cob Normal file
View File

@ -0,0 +1,953 @@
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