539 lines
43 KiB
COBOL
539 lines
43 KiB
COBOL
00001 IDENTIFICATION DIVISION. 12/08/20
|
|
00002 PROGRAM-ID. CHGBD230. CHGBD230
|
|
00003 *AUTHOR. TRW. LV005
|
|
00004 *DATE-WRITTEN. JUNE 2001. CHGBD230
|
|
00005 DATE-COMPILED. CHGBD230
|
|
00006 SKIP3 CHGBD230
|
|
00007 ***** CHGBD230
|
|
00008 * CHGBD230
|
|
00009 * FUNCTION: CHGBD230
|
|
00010 * CHGBD230
|
|
00011 * EXTRACT BENEFIT CHARGE RECORDS FROM SUMMARY CHARGE CHGBD230
|
|
00012 * FILE, BASED ON SELECTION PARAMETERS. CHGBD230
|
|
00013 * CHGBD230
|
|
00014 * WRITE CHG2 OUTPUT RECORD. CHGBD230
|
|
00015 * CHGBD230
|
|
00016 * INPUT: CHGBD230
|
|
00017 * CHGBD230
|
|
00018 * BD200CHG - CHARGE REPORT RECORDS GENERATED BY CHGBD230
|
|
00019 * CHGBD200. CHGBD230
|
|
00020 * CHGPARM - EXTRACT PARAMETERS CHGBD230
|
|
00021 * CHGBD230
|
|
00022 * OUTPUT: CHGBD230
|
|
00023 * CHGBD230
|
|
00024 * BD2-5CHG - CHARGE RECORDS SELECTED IN CHGBD230
|
|
00025 * CHGBD205. CHGBD230
|
|
00026 * CHGBD230
|
|
00027 * CHGBD230
|
|
00028 * PARAMETERS: CHGBD230
|
|
00029 * CHGBD230
|
|
00030 * RUN TYPE - CHGBD230
|
|
00031 * QUARTERLY ('QTR') - REGULAR QUARTERLY REPORTING CHGBD230
|
|
00032 * ANNUAL ('ANN') - ANNUAL REPORTING CHGBD230
|
|
00033 * EMPLOYER ('EMP') - SPECIAL REPORT FOR A SINGLE CHGBD230
|
|
00034 * EMPLOYER CHGBD230
|
|
00035 * REPORTS ('RPT') - SPECIAL REPORT TO REPRINT CHGBD230
|
|
00036 * REPORTS. USE THE REPORT TYPE CHGBD230
|
|
00037 * PARM TO INDICATE WHICH TYPES CHGBD230
|
|
00038 * OF REPORTS TO INCLUDE. CHGBD230
|
|
00039 * FISCAL AGENTS CHGBD230
|
|
00040 * ('AGT') - RERUN FISCAL AGENT TAPES. CHGBD230
|
|
00041 * CHGBD230
|
|
00042 * >> WHEN RUN TYPE IS 'QTR' THE SYSTEM WILL CHGBD230
|
|
00043 * >> GENERATE T026 BENEFIT CHARGE ACCOUNTING CHGBD230
|
|
00044 * >> TRANSACTIONS AND TPS RECORDS. CHGBD230
|
|
00045 * CHGBD230
|
|
00046 * BEGIN DATE - DATE FROM WHICH TO BEGIN SELECTION CHGBD230
|
|
00047 * OF CHARGE RECORDS. CHGBD230
|
|
00048 * REQUIRED FOR ALL RUN TYPES. CHGBD230
|
|
00049 * CHGBD230
|
|
00050 * END DATE - DATE AT WHICH TO END SELECTION CHGBD230
|
|
00051 * OF CHARGE RECORDS. CHGBD230
|
|
00052 * REQUIRED FOR ALL RUN TYPES. CHGBD230
|
|
00053 * CHGBD230
|
|
00054 * REPORT TYPES - YES/NO INDICATORS TO SPECIFY CHGBD230
|
|
00055 * WHICH TYPES OF REPORTS TO INCLUDE. CHGBD230
|
|
00056 * VALID ONLY WHEN THE RUN TYPE IS CHGBD230
|
|
00057 * 'RPT'. CHGBD230
|
|
00058 * THE INDICATORS ARE IN THE FOLLOWING CHGBD230
|
|
00059 * ORDER: CHGBD230
|
|
00060 * RATED CHGBD230
|
|
00061 * SELF-INSURED CHGBD230
|
|
00062 * CWC CHGBD230
|
|
00063 * FEDERAL CHGBD230
|
|
00064 * TEUC CHGBD230
|
|
00065 * CHGBD230
|
|
00066 * EMPLOYER - THE EMPLOYER ACCOUNT NUMBER TO CHGBD230
|
|
00067 * INCLUDE IN THE SELECTION. CHGBD230
|
|
00068 * VALID ONLY WHEN RUN TYPE IS 'EMP'. CHGBD230
|
|
00069 * CHGBD230
|
|
00070 ***** CHGBD230
|
|
00071 CHGBD230
|
|
00072 ******************************************************************CHGBD230
|
|
00073 * MODIFICATION HISTORY: *CHGBD230
|
|
00074 * *CHGBD230
|
|
00075 * 02-02-1999 INITIAL DEVELOPMENT *CHGBD230
|
|
00076 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD230
|
|
00077 * *CHGBD230
|
|
00078 * 06-21-2001 MODIFIED FOR NEW CHARGE PROCESS CHGBD230
|
|
00079 * REFERENCE RFP #**** AUTHOR OF CHANGE - GD *CHGBD230
|
|
00080 * *CHGBD230
|
|
00081 * 04-23-2002 MODIFIED TO OUTPUT TEUC RPC150R1 REPORT CHGBD230
|
|
00082 * REFERENCE RFP #**** AUTHOR OF CHANGE - RW1 *CHGBD230
|
|
00083 * *CHGBD230
|
|
00084 * 03-06-2009 MODIFIED FOR NEW FORMAT OF PROGRAM CODE - CHANGED *CHGBD230
|
|
00085 * FROM NUMERIC TO CHARACTER. *CHGBD230
|
|
00086 * UPDATED EMPLOYER TYPES. *CHGBD230
|
|
00087 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD230
|
|
00088 * CHGBD230
|
|
00089 * *CHGBD230
|
|
00090 * 05-04-2010 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND *CHGBD230
|
|
00091 * CHGIM004 *CHGBD230
|
|
00092 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD230
|
|
00093 * CHGBD230
|
|
00094 * 07-07-2014 MODIFIED TO ADD CHECK FOR EMPLOYER NUMBER IN THE *CHGBD230
|
|
00095 * P1000-READ-CHARGES PARAGRAPH * CHGBD230
|
|
00096 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD230
|
|
00097 * *CHGBD230
|
|
00098 * 09-26-2014 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND *CHGBD230
|
|
00099 * CHGIM004 *CHGBD230
|
|
00100 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD230
|
|
00101 * 04-15-2020 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND * CL**2
|
|
00102 * CHGIM004 (PUA, FPUC,FRUR) * CL**2
|
|
00103 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL**2
|
|
00104 * CL**3
|
|
00105 * 04-24-2020 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND * CL**3
|
|
00106 * CHGIM004 (PEUC) * CL**3
|
|
00107 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL**3
|
|
00108 * CL**4
|
|
00109 * 09-18-2020 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND * CL**4
|
|
00110 * CHGIM004 (LWA) * CL**4
|
|
00111 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL**4
|
|
00112 * CL**5
|
|
00113 * 12-08-2020 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND * CL**5
|
|
00114 * CHGIM004 (PUA) * CL**5
|
|
00115 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL**5
|
|
00116 * CHGBD230
|
|
00117 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD230
|
|
00118 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD230
|
|
00119 ******************************************************************CHGBD230
|
|
00120 CHGBD230
|
|
00121 SKIP3 CHGBD230
|
|
00122 ENVIRONMENT DIVISION. CHGBD230
|
|
00123 SKIP3 CHGBD230
|
|
00124 INPUT-OUTPUT SECTION. CHGBD230
|
|
00125 SKIP3 CHGBD230
|
|
00126 FILE-CONTROL. CHGBD230
|
|
00127 SELECT BD200-CHG-FILE-IN ASSIGN TO BD200CHG CHGBD230
|
|
00128 FILE STATUS IS BD200-CHG-STATUS. CHGBD230
|
|
00129 CHGBD230
|
|
00130 SELECT BD230-CHG-FILE-OUT ASSIGN TO BD230CHG CHGBD230
|
|
00131 FILE STATUS IS BD230-CHG-STATUS. CHGBD230
|
|
00132 CHGBD230
|
|
00133 EJECT CHGBD230
|
|
00134 DATA DIVISION. CHGBD230
|
|
00135 CHGBD230
|
|
00136 FILE SECTION. CHGBD230
|
|
00137 FD BD200-CHG-FILE-IN CHGBD230
|
|
00138 LABEL RECORDS ARE STANDARD CHGBD230
|
|
00139 BLOCK CONTAINS 0 CHARACTERS. CHGBD230
|
|
00140 01 BD200-CHG-REC. CHGBD230
|
|
00141 ++INCLUDE CHGIM002 CHGBD230
|
|
00142 CHGBD230
|
|
00143 FD BD230-CHG-FILE-OUT CHGBD230
|
|
00144 LABEL RECORDS ARE STANDARD CHGBD230
|
|
00145 BLOCK CONTAINS 0 CHARACTERS. CHGBD230
|
|
00146 SKIP1 CHGBD230
|
|
00147 01 BD230-CHG-REC. CHGBD230
|
|
00148 ++INCLUDE CHGIM030 CHGBD230
|
|
00149 CHGBD230
|
|
00150 EJECT CHGBD230
|
|
00151 WORKING-STORAGE SECTION. CHGBD230
|
|
001515 77 PAN-VALET PICTURE X(24) VALUE '005CHGBD230 12/08/20'. CHGBD230
|
|
00152 77 PAN-VALET PICTURE X(24) VALUE '019CHGBD230 10/01/14'. CHGBD230
|
|
00153 77 PAN-VALET PICTURE X(24) VALUE '002CHGBD230 09/26/14'. CHGBD230
|
|
00154 77 PAN-VALET PICTURE X(24) VALUE '017CHGBD230 07/07/14'. CHGBD230
|
|
00155 77 PAN-VALET PICTURE X(24) VALUE '018CHGBD230 07/07/14'. CHGBD230
|
|
00156 77 PAN-VALET PICTURE X(24) VALUE '015CHGBD230 05/25/10'. CHGBD230
|
|
00157 CHGBD230
|
|
00158 01 WRK-AREA. CHGBD230
|
|
00159 *& CHGBD230
|
|
00160 05 WRK-DISP-AREA. CHGBD230
|
|
00161 10 WRK-DATE PIC 9999B99B99. CHGBD230
|
|
00162 10 FILLER PIC X(02) VALUE SPACES. CHGBD230
|
|
00163 10 WRK-BYE-DISP PIC 9999B99B99. CHGBD230
|
|
00164 10 FILLER PIC X(02) VALUE SPACES. CHGBD230
|
|
00165 10 WRK-SSN-DISP PIC 9(10). CHGBD230
|
|
00166 10 FILLER PIC X(02) VALUE SPACES. CHGBD230
|
|
00167 10 WRK-CHG-AMT-DISP PIC Z(07)9.99-. CHGBD230
|
|
00168 10 FILLER PIC X(02) VALUE SPACES. CHGBD230
|
|
00169 10 WRK-PROG PIC X(01). CHGBD230
|
|
00170 CHGBD230
|
|
00171 05 WRK-SSN PIC 9(10). CHGBD230
|
|
00172 05 FILLER REDEFINES WRK-SSN. CHGBD230
|
|
00173 10 WRK-SSN9 PIC 9(09). CHGBD230
|
|
00174 10 WRK-SSN0 PIC 9(01). CHGBD230
|
|
00175 CHGBD230
|
|
00176 05 WRK-TOT-CHG PIC S9(09)V99 COMP-3 CHGBD230
|
|
00177 VALUE +0. CHGBD230
|
|
00178 05 WRK-TOT-CHG-DISP PIC S9(09)V99 COMP-3. CHGBD230
|
|
00179 05 WRK-CHG-DISP PIC S9(09)V99 COMP-3 CHGBD230
|
|
00180 VALUE +0. CHGBD230
|
|
00181 05 WRK-CURR-DATE PIC S9(09) COMP-3. CHGBD230
|
|
00182 05 WRK-CURR-SSN PIC 9(10). CHGBD230
|
|
00183 05 FILLER REDEFINES WRK-CURR-SSN. CHGBD230
|
|
00184 10 WRK-CURR-SSN9 PIC 9(09). CHGBD230
|
|
00185 10 WRK-CURR-SSN0 PIC 9(01). CHGBD230
|
|
00186 05 WRK-CURR-BYE PIC S9(09) COMP-3. CHGBD230
|
|
00187 05 WRK-CURR-PROGRAM PIC X(01). CHGBD230
|
|
00188 05 WRK-CURR-EMP-NO PIC S9(07) COMP-3. CHGBD230
|
|
00189 05 WRK-TOT-BEN PIC S9(09)V99 COMP-3 CHGBD230
|
|
00190 VALUE +0. CHGBD230
|
|
00191 05 WRK-TOT-BEN-DISP PIC Z(08)9.99-. CHGBD230
|
|
00192 * CHGBD230
|
|
00193 05 ABEND-CODE PIC S9(04) COMP CHGBD230
|
|
00194 VALUE +205. CHGBD230
|
|
00195 05 ABEND-MOD PIC X(08) CHGBD230
|
|
00196 VALUE 'DTSBU999'. CHGBD230
|
|
00197 05 ABEND-MSG PIC X(60). CHGBD230
|
|
00198 CHGBD230
|
|
00199 05 BD200-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD230
|
|
00200 88 BD200-FILE-OK-88 VALUE ZERO. CHGBD230
|
|
00201 88 BD200-FILE-EOF-88 VALUE '10'. CHGBD230
|
|
00202 CHGBD230
|
|
00203 05 BD230-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD230
|
|
00204 88 BD230-FILE-OK-88 VALUE ZERO. CHGBD230
|
|
00205 88 BD230-FILE-DUP-88 VALUE '22'. CHGBD230
|
|
00206 CHGBD230
|
|
00207 05 WRK-ERROR-IND PIC X(01). CHGBD230
|
|
00208 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD230
|
|
00209 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD230
|
|
00210 CHGBD230
|
|
00211 05 WRK-BD200-CHG-READ PIC 9(09) COMP-3 VALUE 0. CHGBD230
|
|
00212 05 WRK-BD230-WRITE PIC 9(09) COMP-3 VALUE 0. CHGBD230
|
|
00213 05 WRK-BD230-DUP PIC 9(09) COMP-3 VALUE 0. CHGBD230
|
|
00214 05 WRK-CNT-DISP PIC Z(08)9. CHGBD230
|
|
00215 CHGBD230
|
|
00216 ** ADD ERROR MSG TABLE SET UP CHGBD230
|
|
00217 01 MSG-TABLE. CHGBD230
|
|
00218 05 MSG1-NO-MPRF. CHGBD230
|
|
00219 10 MSG1-ID. CHGBD230
|
|
00220 15 MSG1-ID1 PIC X(08) VALUE 'CHGBD205'. CHGBD230
|
|
00221 15 MSG1-ID2 PIC X(03) VALUE '205'. CHGBD230
|
|
00222 10 MSG1-SHORT-TEXT PIC X(20) CHGBD230
|
|
00223 VALUE 'EMP NOT ON FILE : '. CHGBD230
|
|
00224 10 MSG1-LONG-TEXT. CHGBD230
|
|
00225 15 FILLER PIC X(29) CHGBD230
|
|
00226 VALUE 'EMPLOYER NOT ON MASTER FILE '. CHGBD230
|
|
00227 15 FILLER PIC X(32) VALUE SPACES. CHGBD230
|
|
00228 CHGBD230
|
|
00229 05 MSG2-NOT-LIABLE. CHGBD230
|
|
00230 10 MSG2-ID. CHGBD230
|
|
00231 15 MSG2-ID1 PIC X(08) VALUE 'CHGBD205'. CHGBD230
|
|
00232 15 MSG2-ID2 PIC X(03) VALUE '205'. CHGBD230
|
|
00233 10 MSG2-SHORT-TEXT PIC X(20) CHGBD230
|
|
00234 VALUE 'EMP NOT LIABLE : '. CHGBD230
|
|
00235 10 MSG2-LONG-TEXT. CHGBD230
|
|
00236 15 FILLER PIC X(29) CHGBD230
|
|
00237 VALUE 'EMPLOYER IS NOT LIABLE '. CHGBD230
|
|
00238 15 FILLER PIC X(32) VALUE SPACES. CHGBD230
|
|
00239 CHGBD230
|
|
00240 05 MSG4-PRINTING-TURNED-OFF. CHGBD230
|
|
00241 10 MSG4-ID. CHGBD230
|
|
00242 15 MSG4-ID1 PIC X(08) VALUE 'CHGBD205'. CHGBD230
|
|
00243 15 MSG4-ID2 PIC X(03) VALUE '205'. CHGBD230
|
|
00244 10 MSG4-SHORT-TEXT PIC X(20) CHGBD230
|
|
00245 VALUE 'CHG STMT PRINT OFF: '. CHGBD230
|
|
00246 10 MSG4-LONG-TEXT. CHGBD230
|
|
00247 15 FILLER PIC X(36) CHGBD230
|
|
00248 VALUE 'CHARGE STATEMENT PRINTING TURNED OFF'. CHGBD230
|
|
00249 15 FILLER PIC X(25) VALUE SPACES. CHGBD230
|
|
00250 CHGBD230
|
|
00251 05 MSG5-NO-ADDRESS. CHGBD230
|
|
00252 10 MSG5-ID. CHGBD230
|
|
00253 15 MSG5-ID1 PIC X(08) VALUE 'CHGBD205'. CHGBD230
|
|
00254 15 MSG5-ID2 PIC X(03) VALUE '205'. CHGBD230
|
|
00255 10 MSG5-SHORT-TEXT PIC X(20) CHGBD230
|
|
00256 VALUE 'NO ADDRESS FOUND: '. CHGBD230
|
|
00257 10 MSG5-LONG-TEXT. CHGBD230
|
|
00258 15 FILLER PIC X(29) CHGBD230
|
|
00259 VALUE 'ADDRESS NOT FOUND '. CHGBD230
|
|
00260 15 FILLER PIC X(25) CHGBD230
|
|
00261 VALUE ' MPRF EMPLOYER NUMBER = '. CHGBD230
|
|
00262 15 MSG5-EMP-NO PIC 9(07). CHGBD230
|
|
00263 CHGBD230
|
|
00264 *& ADDED 02-21-2002 CHGBD230
|
|
00265 05 MSG8-TOT-CREDIT-AMT. CHGBD230
|
|
00266 10 MSG8-ID. CHGBD230
|
|
00267 15 MSG8-ID1 PIC X(08) VALUE 'CHGBD205'. CHGBD230
|
|
00268 15 MSG8-ID2 PIC X(03) VALUE '205'. CHGBD230
|
|
00269 10 MSG8-SHORT-TEXT PIC X(20) CHGBD230
|
|
00270 VALUE ' '. CHGBD230
|
|
00271 10 MSG8-LONG-TEXT. CHGBD230
|
|
00272 15 FILLER PIC X(15) CHGBD230
|
|
00273 VALUE 'BYE < 1/1/2001 '. CHGBD230
|
|
00274 15 FILLER PIC X(08) VALUE ' SSN = '. CHGBD230
|
|
00275 15 MSG8-SSN PIC 9(09)B9. CHGBD230
|
|
00276 15 FILLER PIC X(08) VALUE ' BYE = '. CHGBD230
|
|
00277 15 MSG8-BYE PIC 9999B99B99. CHGBD230
|
|
00278 15 FILLER PIC X(06) VALUE ' PGM '. CHGBD230
|
|
00279 15 MSG8-PGM PIC X(01). CHGBD230
|
|
00280 15 FILLER PIC X(12) VALUE ' CHG AMT = '. CHGBD230
|
|
00281 15 MSG8-AMT PIC Z(04)9.99-. CHGBD230
|
|
00282 15 FILLER PIC X(13) VALUE ' CHG DATE = '. CHGBD230
|
|
00283 15 MSG8-DATE PIC 9999B99B99. CHGBD230
|
|
00284 CHGBD230
|
|
00285 ** ERROR MSG OUTPUT RECORD CHGBD230
|
|
00286 01 R907-REC. CHGBD230
|
|
00287 ++INCLUDE DTSIR907 CHGBD230
|
|
00288 CHGBD230
|
|
00289 01 L001-LINK-AREA. CHGBD230
|
|
00290 ++INCLUDE DTSIL001 CHGBD230
|
|
00291 CHGBD230
|
|
00292 01 L004-LINK-AREA. CHGBD230
|
|
00293 ++INCLUDE DTSIL004 CHGBD230
|
|
00294 CHGBD230
|
|
00295 EJECT CHGBD230
|
|
00296 PROCEDURE DIVISION. CHGBD230
|
|
00297 SKIP2 CHGBD230
|
|
00298 CHGBD230-MAIN. CHGBD230
|
|
00299 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD230
|
|
00300 IF WRK-ERROR-YES-88 CHGBD230
|
|
00301 GO TO CHGBD230-EXIT. CHGBD230
|
|
00302 CHGBD230
|
|
00303 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD230
|
|
00304 CHGBD230
|
|
00305 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD230
|
|
00306 CHGBD230
|
|
00307 CHGBD230-EXIT. CHGBD230
|
|
00308 STOP RUN. CHGBD230
|
|
00309 EJECT CHGBD230
|
|
00310 I0000-INITIATE. CHGBD230
|
|
00311 CHGBD230
|
|
00312 MOVE ZERO TO WRK-BD200-CHG-READ CHGBD230
|
|
00313 WRK-BD230-WRITE. CHGBD230
|
|
00314 CHGBD230
|
|
00315 SET WRK-ERROR-NO-88 TO TRUE. CHGBD230
|
|
00316 CHGBD230
|
|
00317 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. CHGBD230
|
|
00318 CHGBD230
|
|
00319 I0000-EXIT. CHGBD230
|
|
00320 EXIT. CHGBD230
|
|
00321 CHGBD230
|
|
00322 I1000-OPEN-FILES. CHGBD230
|
|
00323 CHGBD230
|
|
00324 OPEN INPUT BD200-CHG-FILE-IN. CHGBD230
|
|
00325 IF NOT BD200-FILE-OK-88 CHGBD230
|
|
00326 DISPLAY 'BD200 FILE OPEN ERROR: ' BD200-CHG-STATUS CHGBD230
|
|
00327 PERFORM S999-ABEND THRU S999-EXIT. CHGBD230
|
|
00328 CHGBD230
|
|
00329 OPEN OUTPUT BD230-CHG-FILE-OUT. CHGBD230
|
|
00330 IF NOT BD230-FILE-OK-88 CHGBD230
|
|
00331 DISPLAY 'BD230 FILE OPEN ERROR: ' BD230-CHG-STATUS CHGBD230
|
|
00332 PERFORM S999-ABEND THRU S999-EXIT. CHGBD230
|
|
00333 CHGBD230
|
|
00334 I1000-EXIT. CHGBD230
|
|
00335 EXIT. CHGBD230
|
|
00336 CHGBD230
|
|
00337 CHGBD230
|
|
00338 P0000-PROCESS. CHGBD230
|
|
00339 CHGBD230
|
|
00340 READ BD200-CHG-FILE-IN NEXT. CHGBD230
|
|
00341 CHGBD230
|
|
00342 IF BD200-FILE-EOF-88 CHGBD230
|
|
00343 GO TO P0000-EXIT CHGBD230
|
|
00344 ELSE CHGBD230
|
|
00345 IF NOT BD200-FILE-OK-88 CHGBD230
|
|
00346 DISPLAY 'CANNOT READ FIRST REC: ' BD200-CHG-STATUS CHGBD230
|
|
00347 SET WRK-ERROR-YES-88 TO TRUE CHGBD230
|
|
00348 GO TO P0000-EXIT CHGBD230
|
|
00349 ELSE CHGBD230
|
|
00350 ADD 1 TO WRK-BD200-CHG-READ. CHGBD230
|
|
00351 CHGBD230
|
|
00352 MOVE CHG2-CHARGE-DATE TO WRK-CURR-DATE. CHGBD230
|
|
00353 MOVE CHG2-SSN TO WRK-CURR-SSN. CHGBD230
|
|
00354 MOVE CHG2-BYE TO WRK-CURR-BYE. CHGBD230
|
|
00355 MOVE CHG2-PROGRAM TO WRK-CURR-PROGRAM. CHGBD230
|
|
00356 MOVE CHG2-EMP-NO TO WRK-CURR-EMP-NO CHGBD230
|
|
00357 MOVE ZERO TO WRK-TOT-CHG. CHGBD230
|
|
00358 CHGBD230
|
|
00359 PERFORM P1000-READ-CHARGES THRU P1000-EXIT CHGBD230
|
|
00360 UNTIL BD200-FILE-EOF-88 CHGBD230
|
|
00361 OR WRK-ERROR-YES-88. CHGBD230
|
|
00362 CHGBD230
|
|
00363 P0000-EXIT. CHGBD230
|
|
00364 EXIT. CHGBD230
|
|
00365 CHGBD230
|
|
00366 P1000-READ-CHARGES. CHGBD230
|
|
00367 MOVE CHG2-SSN TO WRK-SSN. CHGBD230
|
|
00368 CHGBD230
|
|
00369 *& CHGBD230
|
|
00370 *** IF WRK-SSN9 = 979280473 CHGBD230
|
|
00371 ** IF CHG2-SSN = 2166634031 CHGBD230
|
|
00372 ** AND CHG2-CHARGE-DATE >= 20020701 CHGBD230
|
|
00373 * MOVE CHG2-SSN TO WRK-SSN-DISP CHGBD230
|
|
00374 * MOVE CHG2-CHARGE-DATE TO WRK-DATE CHGBD230
|
|
00375 * MOVE CHG2-BYE TO WRK-BYE-DISP CHGBD230
|
|
00376 * COMPUTE WRK-TOT-CHG-DISP = CHGBD230
|
|
00377 * (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT) CHGBD230
|
|
00378 * MOVE WRK-TOT-CHG-DISP TO WRK-CHG-AMT-DISP CHGBD230
|
|
00379 * MOVE CHG2-PROGRAM TO WRK-PROG CHGBD230
|
|
00380 * ADD WRK-TOT-CHG-DISP TO WRK-CHG-DISP CHGBD230
|
|
00381 * DISPLAY 'P1000 ' WRK-DISP-AREA. CHGBD230
|
|
00382 *& CHGBD230
|
|
00383 CHGBD230
|
|
00384 * DISPLAY 'CHG2-CHARGE-DATE ' CHG2-CHARGE-DATE CHGBD230
|
|
00385 * DISPLAY 'WRK-CURR-DATE ' WRK-CURR-DATE CHGBD230
|
|
00386 * DISPLAY 'WRK-SSN9 ' WRK-SSN9 CHGBD230
|
|
00387 * DISPLAY 'WRK-CURR-SSN9 ' WRK-CURR-SSN9 CHGBD230
|
|
00388 * DISPLAY 'CHG2-BYE ' CHG2-BYE CHGBD230
|
|
00389 * DISPLAY 'WRK-CURR-BYE ' WRK-CURR-BYE CHGBD230
|
|
00390 * DISPLAY 'CHG2-PROGRAM ' CHG2-PROGRAM CHGBD230
|
|
00391 * DISPLAY 'WRK-CURR-PROGRAM ' WRK-CURR-PROGRAM CHGBD230
|
|
00392 IF CHG2-CHARGE-DATE = WRK-CURR-DATE CHGBD230
|
|
00393 AND WRK-SSN9 = WRK-CURR-SSN9 CHGBD230
|
|
00394 AND CHG2-BYE = WRK-CURR-BYE CHGBD230
|
|
00395 AND CHG2-PROGRAM = WRK-CURR-PROGRAM CHGBD230
|
|
00396 AND CHG2-EMP-NO = WRK-CURR-EMP-NO CHGBD230
|
|
00397 NEXT SENTENCE CHGBD230
|
|
00398 ELSE CHGBD230
|
|
00399 PERFORM S1100-WRITE-BD230 THRU S1100-EXIT CHGBD230
|
|
00400 PERFORM P1100-INIT-REC THRU P1100-EXIT. CHGBD230
|
|
00401 CHGBD230
|
|
00402 COMPUTE WRK-TOT-CHG = WRK-TOT-CHG + CHGBD230
|
|
00403 (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT). CHGBD230
|
|
00404 DISPLAY 'WRK-SSN9 ' WRK-SSN9 CHGBD230
|
|
00405 DISPLAY 'WRK-TOT-CHG ' WRK-TOT-CHG CHGBD230
|
|
00406 DISPLAY 'CHG2-CURR-BEN-AMT ' CHG2-CURR-BEN-AMT CHGBD230
|
|
00407 DISPLAY 'CHG2-CURR-ADJ-AMT ' CHG2-CURR-ADJ-AMT CHGBD230
|
|
00408 CHGBD230
|
|
00409 READ BD200-CHG-FILE-IN NEXT. CHGBD230
|
|
00410 CHGBD230
|
|
00411 IF BD200-FILE-EOF-88 CHGBD230
|
|
00412 GO TO P1000-EXIT CHGBD230
|
|
00413 ELSE CHGBD230
|
|
00414 IF NOT BD200-FILE-OK-88 CHGBD230
|
|
00415 DISPLAY 'BD200 FILE READ ERROR: ' BD200-CHG-STATUS CHGBD230
|
|
00416 SET WRK-ERROR-YES-88 TO TRUE CHGBD230
|
|
00417 GO TO P1000-EXIT CHGBD230
|
|
00418 ELSE CHGBD230
|
|
00419 ADD 1 TO WRK-BD200-CHG-READ. CHGBD230
|
|
00420 CHGBD230
|
|
00421 P1000-EXIT. CHGBD230
|
|
00422 EXIT. CHGBD230
|
|
00423 CHGBD230
|
|
00424 P1100-INIT-REC. CHGBD230
|
|
00425 MOVE CHG2-CHARGE-DATE TO WRK-CURR-DATE. CHGBD230
|
|
00426 MOVE CHG2-SSN TO WRK-CURR-SSN. CHGBD230
|
|
00427 MOVE CHG2-BYE TO WRK-CURR-BYE. CHGBD230
|
|
00428 MOVE CHG2-PROGRAM TO WRK-CURR-PROGRAM. CHGBD230
|
|
00429 MOVE ZERO TO WRK-TOT-CHG. CHGBD230
|
|
00430 CHGBD230
|
|
00431 P1100-EXIT. CHGBD230
|
|
00432 EXIT. CHGBD230
|
|
00433 CHGBD230
|
|
00434 S1100-WRITE-BD230. CHGBD230
|
|
00435 *& CHGBD230
|
|
00436 * IF WRK-CURR-SSN9 = 979280473 CHGBD230
|
|
00437 * MOVE WRK-CURR-SSN TO WRK-SSN-DISP CHGBD230
|
|
00438 * MOVE WRK-CURR-DATE TO WRK-DATE CHGBD230
|
|
00439 * MOVE WRK-CURR-BYE TO WRK-BYE-DISP CHGBD230
|
|
00440 * MOVE WRK-TOT-CHG TO WRK-CHG-AMT-DISP CHGBD230
|
|
00441 * MOVE WRK-CURR-PROGRAM TO WRK-PROG CHGBD230
|
|
00442 * DISPLAY 'S1100 ' WRK-DISP-AREA. CHGBD230
|
|
00443 *& CHGBD230
|
|
00444 DISPLAY 'WRK-CURR-SSN9' WRK-CURR-SSN9 CHGBD230
|
|
00445 DISPLAY 'WRK-TOT-CHG ' WRK-TOT-CHG CHGBD230
|
|
00446 IF WRK-TOT-CHG = ZERO CHGBD230
|
|
00447 GO TO S1100-EXIT. CHGBD230
|
|
00448 CHGBD230
|
|
00449 MOVE WRK-CURR-SSN9 TO CHG30-SSN. CHGBD230
|
|
00450 MOVE WRK-CURR-BYE TO CHG30-BYE. CHGBD230
|
|
00451 MOVE WRK-CURR-PROGRAM TO CHG30-PROGRAM. CHGBD230
|
|
00452 MOVE WRK-CURR-DATE TO CHG30-CHARGE-DATE. CHGBD230
|
|
00453 MOVE WRK-TOT-CHG TO CHG30-TOT-CHG-AMT. CHGBD230
|
|
00454 CHGBD230
|
|
00455 WRITE BD230-CHG-REC. CHGBD230
|
|
00456 IF BD230-FILE-OK-88 CHGBD230
|
|
00457 ADD 1 TO WRK-BD230-WRITE CHGBD230
|
|
00458 COMPUTE WRK-TOT-BEN = WRK-TOT-BEN + WRK-TOT-CHG CHGBD230
|
|
00459 ELSE CHGBD230
|
|
00460 IF BD230-FILE-DUP-88 CHGBD230
|
|
00461 ADD 1 TO WRK-BD230-DUP. CHGBD230
|
|
00462 CHGBD230
|
|
00463 S1100-EXIT. CHGBD230
|
|
00464 EXIT. CHGBD230
|
|
00465 CHGBD230
|
|
00466 *S001-FROM-CAL-6. CHGBD230
|
|
00467 ** SET L001-FROM-CAL-6 TO TRUE. CHGBD230
|
|
00468 ** GO TO S001-DATE. CHGBD230
|
|
00469 CHGBD230
|
|
00470 *S001-FROM-FED-8. CHGBD230
|
|
00471 ** SET L001-FROM-FED-8 TO TRUE. CHGBD230
|
|
00472 ** GO TO S001-DATE. CHGBD230
|
|
00473 CHGBD230
|
|
00474 *S001-FROM-ABS. CHGBD230
|
|
00475 ** SET L001-FROM-ABS-DAY TO TRUE. CHGBD230
|
|
00476 ** GO TO S001-DATE. CHGBD230
|
|
00477 CHGBD230
|
|
00478 *S001-DATE. CHGBD230
|
|
00479 * CALL 'DTSBU001' USING L001-LINK-AREA. CHGBD230
|
|
00480 *S001-EXIT. EXIT. CHGBD230
|
|
00481 CHGBD230
|
|
00482 *S004-FROM-DATE. CHGBD230
|
|
00483 ** SET L004-FROM-DATE TO TRUE. CHGBD230
|
|
00484 ** GO TO S004-YRQ. CHGBD230
|
|
00485 CHGBD230
|
|
00486 *S004-YRQ. CHGBD230
|
|
00487 ** CALL 'DTSBU004' USING L004-LINK-AREA. CHGBD230
|
|
00488 *S004-EXIT. EXIT. CHGBD230
|
|
00489 CHGBD230
|
|
00490 ** ADD ERROR MSG PROCESS PARA. CHGBD230
|
|
00491 *S946-R907-WRITE. CHGBD230
|
|
00492 ** CALL 'DTSBU946' USING R907-REC. CHGBD230
|
|
00493 *S946-EXIT. EXIT. CHGBD230
|
|
00494 CHGBD230
|
|
00495 T0000-TERMINATE. CHGBD230
|
|
00496 CHGBD230
|
|
00497 PERFORM S1100-WRITE-BD230 THRU S1100-EXIT. CHGBD230
|
|
00498 CHGBD230
|
|
00499 CLOSE BD200-CHG-FILE-IN CHGBD230
|
|
00500 BD230-CHG-FILE-OUT. CHGBD230
|
|
00501 CHGBD230
|
|
00502 DISPLAY '************** CHGBD230 COUNTS **************'. CHGBD230
|
|
00503 DISPLAY '*** ***'. CHGBD230
|
|
00504 CHGBD230
|
|
00505 MOVE WRK-BD200-CHG-READ TO WRK-CNT-DISP. CHGBD230
|
|
00506 DISPLAY 'CHARGE RECORDS READ: ' CHGBD230
|
|
00507 WRK-CNT-DISP. CHGBD230
|
|
00508 CHGBD230
|
|
00509 MOVE WRK-BD230-WRITE TO WRK-CNT-DISP. CHGBD230
|
|
00510 DISPLAY 'CHARGE RECORDS WRITTEN: ' CHGBD230
|
|
00511 WRK-CNT-DISP. CHGBD230
|
|
00512 CHGBD230
|
|
00513 MOVE WRK-BD230-DUP TO WRK-CNT-DISP. CHGBD230
|
|
00514 DISPLAY 'DUPLICATE RECS EXCLUDED: ' CHGBD230
|
|
00515 WRK-CNT-DISP. CHGBD230
|
|
00516 CHGBD230
|
|
00517 DISPLAY SPACE. CHGBD230
|
|
00518 MOVE WRK-TOT-BEN TO WRK-TOT-BEN-DISP. CHGBD230
|
|
00519 DISPLAY 'TOTAL BENEFIT CHARGE AMOUNTS: ' CHGBD230
|
|
00520 WRK-TOT-BEN-DISP. CHGBD230
|
|
00521 CHGBD230
|
|
00522 DISPLAY SPACE. CHGBD230
|
|
00523 CHGBD230
|
|
00524 DISPLAY '***********************************************'. CHGBD230
|
|
00525 CHGBD230
|
|
00526 T0000-EXIT. CHGBD230
|
|
00527 EXIT. CHGBD230
|
|
00528 EJECT CHGBD230
|
|
00529 CHGBD230
|
|
00530 S999-ABEND. CHGBD230
|
|
00531 DISPLAY '**** CHGBD230 ABENDING ' CHGBD230
|
|
00532 ABEND-MSG. CHGBD230
|
|
00533 CALL ABEND-MOD USING ABEND-CODE. CHGBD230
|
|
00534 CHGBD230
|
|
00535 S999-EXIT. CHGBD230
|
|
00536 EXIT. CHGBD230
|
|
00537 CHGBD230
|