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