00001 IDENTIFICATION DIVISION. 06/26/20 00002 PROGRAM-ID. CHGBD235. CHGBD235 00003 *AUTHOR. TRW. LV005 00004 *DATE-WRITTEN. AUGUST 2002. CHGBD235 00005 DATE-COMPILED. CHGBD235 00006 SKIP3 CHGBD235 00007 ***** CHGBD235 00008 * CHGBD235 00009 * FUNCTION: CHGBD235 00010 * CHGBD235 00011 * FIND TOTAL BENEFITS PAID TO A GIVEN SSN CHGBD235 00012 * WITHIN A RANGE OF DATES FROM CHGM030 FILE. CHGBD235 00013 * CHGBD235 00014 * CHGBD235 00015 * INPUT: CHGBD235 00016 * CHGBD235 00017 * BD200CHG - CHARGE REPORT RECORDS GENERATED BY CHGBD235 00018 * CHGBD200. CHGBD235 00019 * DTSIL030 - LINKAGE FROM CALLING PROGRAM CHGBD235 00020 * CHGBD235 00021 * OUTPUT: CHGBD235 00022 * CHGBD235 00023 * CG-L030-TOT-CHG - TOTAL CHARGES FOR SSN/BYE CHGBD235 00024 * CHGBD235 00025 * CHGBD235 00026 * CHGBD235 00027 ***** CHGBD235 00028 CHGBD235 00029 ******************************************************************CHGBD235 00030 * MODIFICATION HISTORY: *CHGBD235 00031 * *CHGBD235 00032 * 08-21-2002 INITIAL DEVELOPMENT *CHGBD235 00033 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD235 00034 * *CHGBD235 00035 * 03-09-2009 CHANGED PROGRAM CODE FROM NUMERIC TO CHARACTER. *CHGBD235 00036 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD235 00037 * *CHGBD235 00038 * *CHGBD235 00039 * 08-05-2009 ADDED PROGRAM CODE FOR TRAINING,DEPENDENTS,AND AB *CHGBD235 00040 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD235 00041 * *CHGBD235 00042 * *CHGBD235 00043 * 05-14-2010 RECOMPILE FOR NEW VERISON OF COPYBOOK CHGIM030 *CHGBD235 00044 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD235 00045 * *CHGBD235 00046 * * CL**2 00047 * 10-04-2014 RECOMPILE FOR NEW VERISON OF COPYBOOK CHGIM030 * CL**2 00048 * REFERENCE RFP # UCPIA AUTHOR OF CHANGE - ZL1 * CL**2 00049 * * CL**2 00050 * * CL**3 00051 * 06-11-2020 RECOMPILE FOR NEW VERISON OF COPYBOOK CHGIM030 * CL**3 00052 * PUC FPUC FRUC REUC AUTHOR OF CHANGE - ZL1 * CL**3 00053 * * CL**3 00054 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD235 00055 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD235 00056 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBD235 00057 ******************************************************************CHGBD235 00058 CHGBD235 00059 SKIP3 CHGBD235 00060 ENVIRONMENT DIVISION. CHGBD235 00061 SKIP3 CHGBD235 00062 INPUT-OUTPUT SECTION. CHGBD235 00063 SKIP3 CHGBD235 00064 FILE-CONTROL. CHGBD235 00065 SELECT BD230-CHG-FILE-IN ASSIGN TO BD230CHG CHGBD235 00066 ORGANIZATION IS INDEXED CHGBD235 00067 ACCESS MODE IS DYNAMIC CHGBD235 00068 RECORD KEY IS CHG30-KEY-AREA CHGBD235 00069 FILE STATUS IS BD230-CHG-STATUS. CHGBD235 00070 CHGBD235 00071 EJECT CHGBD235 00072 DATA DIVISION. CHGBD235 00073 CHGBD235 00074 FILE SECTION. CHGBD235 00075 CHGBD235 00076 FD BD230-CHG-FILE-IN CHGBD235 00077 RECORD CONTAINS 22 CHARACTERS CHGBD235 00078 DATA RECORD IS BD230-CHG-REC. CHGBD235 00079 01 BD230-CHG-REC. CHGBD235 00080 ++INCLUDE CHGIM030 CHGBD235 00081 CHGBD235 00082 EJECT CHGBD235 00083 WORKING-STORAGE SECTION. CHGBD235 000835 77 PAN-VALET PICTURE X(24) VALUE '005CHGBD235 06/26/20'. CHGBD235 00084 77 PAN-VALET PICTURE X(24) VALUE '011CHGBD235 05/25/10'. CHGBD235 00085 CHGBD235 00086 01 WRK-AREA. CHGBD235 00087 *& CHGBD235 00088 05 WRK-DISP-AREA. CHGBD235 00089 10 WRK-CHG-DATE PIC 9999B99B99. CHGBD235 00090 10 FILLER PIC X(02) VALUE SPACES. CHGBD235 00091 10 WRK-SSN-DISP PIC 9(09). CHGBD235 00092 10 FILLER PIC X(02) VALUE SPACES. CHGBD235 00093 10 WRK-CHG-AMT-DISP PIC Z(07)9.99-. CHGBD235 00094 10 FILLER PIC X(02) VALUE SPACES. CHGBD235 00095 10 WRK-BYE-DISP PIC 9999B99B99. CHGBD235 00096 10 FILLER PIC X(02) VALUE SPACES. CHGBD235 00097 10 WRK-PROG PIC X. CHGBD235 00098 CHGBD235 00099 05 WRK-TOT-CHG PIC S9(08)V99 COMP-3 CHGBD235 00100 VALUE +0. CHGBD235 00101 05 WRK-TOT-CHG-DISP PIC Z(07)9.99-. CHGBD235 00102 CHGBD235 00103 05 ABEND-CODE PIC S9(04) COMP CHGBD235 00104 VALUE +235. CHGBD235 00105 05 ABEND-MOD PIC X(08) CHGBD235 00106 VALUE 'DTSBU999'. CHGBD235 00107 CHGBD235 00108 05 BD230-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD235 00109 88 BD230-FILE-OK-88 VALUE ZERO. CHGBD235 00110 88 BD230-FILE-EOF-88 VALUE '10'. CHGBD235 00111 CHGBD235 00112 05 WRK-SSN PIC 9(09). CHGBD235 00113 05 WRK-BEGIN-DATE PIC S9(09) COMP-3. CHGBD235 00114 05 WRK-END-DATE PIC S9(09) COMP-3. CHGBD235 00115 05 WRK-BYE PIC S9(09) COMP-3. CHGBD235 00116 05 WRK-PROGRAM PIC X(01). CHGBD235 00117 88 WRK-PROG-UI-88 VALUE '1'. CL**4 00118 88 WRK-PROG-EB-88 VALUE '2'. CL**4 00119 88 WRK-PROG-TEUC-88 VALUE '3'. CL**4 00120 88 WRK-PROG-TEUCA-88 VALUE '4'. CL**4 00121 88 WRK-PROG-FAC-88 VALUE '5'. CL**4 00122 88 WRK-PROG-FSB-88 VALUE '6'. CL**4 00123 88 WRK-PROG-FSC-88 VALUE '7'. CL**4 00124 88 WRK-PROG-DUA-88 VALUE '8'. CL**4 00125 88 WRK-PROG-TR2-88 VALUE '9'. CL**4 00126 88 WRK-PROG-TRA-88 VALUE '0'. CL**4 00127 88 WRK-PROG-STEPLDR-88 VALUE 'A'. CL**4 00128 88 WRK-PROG-AB-88 VALUE 'B'. CL**4 00129 88 WRK-PROG-TRAINING-88 VALUE 'C'. CL**5 00130 88 WRK-PROG-DEPENDENTS-88 VALUE 'D'. CL**4 00131 88 WRK-PROG-EUC08-2PLUS-88 VALUE 'E'. CL**4 00132 88 WRK-PROG-EUC08-TIER3-88 VALUE 'F'. CL**4 00133 88 WRK-PROG-EUC08-TIER4-88 VALUE 'G'. CL**4 00134 88 WRK-PROG-SPECIAL-PAY-88 VALUE 'H'. CL**4 00135 88 WRK-PROG-UCPIA-88 VALUE 'I'. CL**4 00136 88 WRK-PROG-GPA-88 VALUE 'J'. CL**4 00137 88 WRK-PROG-PUA-88 VALUE 'U'. CL**4 00138 88 WRK-PROG-FPUC-88 VALUE 'L'. CL**4 00139 88 WRK-PROG-FRUR-88 VALUE 'M'. CL**4 00140 88 WRK-PROG-PEUC-88 VALUE 'N'. CL**5 00141 88 WRK-PROG-REUR-88 VALUE 'Y'. CL**5 00142 88 WRK-PROG-VALID VALUE '1' '2' '3' '4' '5' CL**4 00143 '6' '7' '8' '9' '0' CHGBD235 00144 'A' 'B' 'C' 'D' 'E' CL**4 00145 'F' 'G' 'H' 'I' 'J' CL**4 00146 'U' 'L' 'M' 'N' 'Y'. CL**5 00147 CHGBD235 00148 CL**4 00149 05 WRK-BEGIN-DATE-DISP PIC 9(08). CHGBD235 00150 05 FILLER REDEFINES WRK-BEGIN-DATE-DISP. CHGBD235 00151 10 WRK-BEGIN-YR PIC 9(04). CHGBD235 00152 10 WRK-BEGIN-MO PIC 9(02). CHGBD235 00153 10 WRK-BEGIN-DA PIC 9(02). CHGBD235 00154 CHGBD235 00155 05 WRK-END-DATE-DISP PIC 9(08). CHGBD235 00156 05 FILLER REDEFINES WRK-END-DATE-DISP. CHGBD235 00157 10 WRK-END-YR PIC 9(04). CHGBD235 00158 10 WRK-END-MO PIC 9(02). CHGBD235 00159 10 WRK-END-DA PIC 9(02). CHGBD235 00160 CHGBD235 00161 CHGBD235 00162 01 L001-LINK-AREA. CHGBD235 00163 ++INCLUDE DTSIL001 CHGBD235 00164 CHGBD235 00165 01 L004-LINK-AREA. CHGBD235 00166 ++INCLUDE DTSIL004 CHGBD235 00167 CHGBD235 00168 LINKAGE SECTION. CHGBD235 00169 01 CG030-LINK-AREA. CHGBD235 00170 ++INCLUDE CHGIL030 CHGBD235 00171 CHGBD235 00172 EJECT CHGBD235 00173 PROCEDURE DIVISION USING CG030-LINK-AREA. CHGBD235 00174 SKIP2 CHGBD235 00175 CHGBD235-MAIN. CHGBD235 00176 EVALUATE TRUE CHGBD235 00177 WHEN CG-L030-CMND-INIT-88 CHGBD235 00178 PERFORM I0000-OPEN-FILES THRU I0000-EXIT CHGBD235 00179 CHGBD235 00180 WHEN CG-L030-CMND-PROCESS-88 CHGBD235 00181 PERFORM P0000-PROCESS THRU P0000-EXIT CHGBD235 00182 CHGBD235 00183 WHEN CG-L030-CMND-TERM-88 CHGBD235 00184 PERFORM T0000-TERMINATE THRU T0000-EXIT CHGBD235 00185 CHGBD235 00186 END-EVALUATE. CHGBD235 00187 CHGBD235 00188 CHGBD235-EXIT. CHGBD235 00189 GOBACK. CHGBD235 00190 EJECT CHGBD235 00191 I0000-OPEN-FILES. CHGBD235 00192 CHGBD235 00193 OPEN INPUT BD230-CHG-FILE-IN. CHGBD235 00194 IF NOT BD230-FILE-OK-88 CHGBD235 00195 DISPLAY 'BD230 FILE OPEN ERROR: ' BD230-CHG-STATUS CHGBD235 00196 PERFORM S999-ABEND THRU S999-EXIT. CHGBD235 00197 CHGBD235 00198 I0000-EXIT. CHGBD235 00199 EXIT. CHGBD235 00200 CHGBD235 00201 P0000-PROCESS. CHGBD235 00202 CHGBD235 00203 PERFORM P1000-EDIT-INPUT THRU P1000-EXIT. CHGBD235 00204 MOVE WRK-SSN TO CHG30-SSN. CHGBD235 00205 MOVE WRK-BEGIN-DATE TO CHG30-CHARGE-DATE. CHGBD235 00206 MOVE ZERO TO CHG30-BYE CHGBD235 00207 CHG30-PROGRAM CHGBD235 00208 CG-L030-TOT-CHG CHGBD235 00209 WRK-TOT-CHG. CHGBD235 00210 CHGBD235 00211 START BD230-CHG-FILE-IN CHGBD235 00212 KEY IS >= CHG30-KEY-AREA. CHGBD235 00213 CHGBD235 00214 IF NOT BD230-FILE-OK-88 CHGBD235 00215 DISPLAY 'BD230: NO RECS ON CHGM030 ' BD230-CHG-STATUS CHGBD235 00216 ' ' WRK-SSN ' ' WRK-BEGIN-DATE CHGBD235 00217 GO TO P0000-EXIT. CHGBD235 00218 *& PERFORM S999-ABEND THRU S999-EXIT. CHGBD235 00219 CHGBD235 00220 PERFORM P2000-READ-CHARGES THRU P2000-EXIT CHGBD235 00221 UNTIL BD230-FILE-EOF-88. CHGBD235 00222 CHGBD235 00223 MOVE WRK-TOT-CHG TO CG-L030-TOT-CHG. CHGBD235 00224 CHGBD235 00225 P0000-EXIT. CHGBD235 00226 EXIT. CHGBD235 00227 CHGBD235 00228 P1000-EDIT-INPUT. CHGBD235 00229 CHGBD235 00230 PERFORM P1100-EDIT-SSN THRU P1100-EXIT. CHGBD235 00231 CHGBD235 00232 PERFORM P1200-EDIT-DATES THRU P1200-EXIT. CHGBD235 00233 CHGBD235 00234 PERFORM P1300-EDIT-BYE THRU P1300-EXIT. CHGBD235 00235 CHGBD235 00236 PERFORM P1400-EDIT-PROGRAM THRU P1400-EXIT. CHGBD235 00237 CHGBD235 00238 P1000-EXIT. CHGBD235 00239 EXIT. CHGBD235 00240 CHGBD235 00241 P1100-EDIT-SSN. CHGBD235 00242 IF CG-L030-SSN NUMERIC CHGBD235 00243 MOVE CG-L030-SSN TO WRK-SSN CHGBD235 00244 ELSE CHGBD235 00245 DISPLAY 'PARM SSN INVALID ' CG-L030-SSN CHGBD235 00246 PERFORM S999-ABEND THRU S999-EXIT. CHGBD235 00247 CHGBD235 00248 P1100-EXIT. CHGBD235 00249 EXIT. CHGBD235 00250 CHGBD235 00251 P1200-EDIT-DATES. CHGBD235 00252 MOVE ZERO TO WRK-BEGIN-DATE CHGBD235 00253 WRK-END-DATE. CHGBD235 00254 CHGBD235 00255 PERFORM P1210-BEGIN-DATE THRU P1210-EXIT CHGBD235 00256 PERFORM P1220-END-DATE THRU P1220-EXIT. CHGBD235 00257 CHGBD235 00258 IF WRK-END-DATE < WRK-BEGIN-DATE CHGBD235 00259 DISPLAY 'PERIOD END LESS THAN PERIOD BEGIN' CHGBD235 00260 ' ' WRK-BEGIN-DATE CHGBD235 00261 ' ' WRK-END-DATE CHGBD235 00262 PERFORM S999-ABEND THRU S999-EXIT. CHGBD235 00263 CHGBD235 00264 CHGBD235 00265 P1200-EXIT. CHGBD235 00266 EXIT. CHGBD235 00267 CHGBD235 00268 P1210-BEGIN-DATE. CHGBD235 00269 MOVE CG-L030-START-DATE TO L001-FED-8-DATE-9. CHGBD235 00270 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBD235 00271 IF L001-VALID-DATE CHGBD235 00272 MOVE L001-FED-8-DATE-9 TO WRK-BEGIN-DATE CHGBD235 00273 ELSE CHGBD235 00274 DISPLAY 'INVALID PERIOD BEGIN DATE' CHGBD235 00275 ' ' CG-L030-START-DATE CHGBD235 00276 PERFORM S999-ABEND THRU S999-EXIT. CHGBD235 00277 CHGBD235 00278 P1210-EXIT. CHGBD235 00279 EXIT. CHGBD235 00280 CHGBD235 00281 P1220-END-DATE. CHGBD235 00282 MOVE CG-L030-END-DATE TO L001-FED-8-DATE-9. CHGBD235 00283 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBD235 00284 IF L001-VALID-DATE CHGBD235 00285 MOVE L001-FED-8-DATE-9 TO WRK-END-DATE CHGBD235 00286 ELSE CHGBD235 00287 DISPLAY 'INVALID PERIOD END DATE' CHGBD235 00288 ' ' CG-L030-END-DATE CHGBD235 00289 PERFORM S999-ABEND THRU S999-EXIT. CHGBD235 00290 CHGBD235 00291 P1220-EXIT. CHGBD235 00292 EXIT. CHGBD235 00293 CHGBD235 00294 P1300-EDIT-BYE. CHGBD235 00295 IF CG-L030-BYE = ZERO CHGBD235 00296 MOVE CG-L030-BYE TO WRK-BYE CHGBD235 00297 GO TO P1300-EXIT. CHGBD235 00298 CHGBD235 00299 MOVE CG-L030-BYE TO L001-FED-8-DATE-9. CHGBD235 00300 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBD235 00301 IF L001-VALID-DATE CHGBD235 00302 MOVE L001-FED-8-DATE-9 TO WRK-BYE CHGBD235 00303 ELSE CHGBD235 00304 DISPLAY 'INVALID BYE DATE ' CG-L030-BYE CHGBD235 00305 PERFORM S999-ABEND THRU S999-EXIT. CHGBD235 00306 CHGBD235 00307 P1300-EXIT. CHGBD235 00308 EXIT. CHGBD235 00309 CHGBD235 00310 P1400-EDIT-PROGRAM. CHGBD235 00311 MOVE CG-L030-PROGRAM TO WRK-PROGRAM. CHGBD235 00312 IF WRK-PROG-VALID CHGBD235 00313 NEXT SENTENCE CHGBD235 00314 ELSE CHGBD235 00315 DISPLAY 'INVALID PROGRAM ' CG-L030-PROGRAM CHGBD235 00316 PERFORM S999-ABEND THRU S999-EXIT. CHGBD235 00317 CHGBD235 00318 P1400-EXIT. CHGBD235 00319 EXIT. CHGBD235 00320 CHGBD235 00321 P2000-READ-CHARGES. CHGBD235 00322 READ BD230-CHG-FILE-IN NEXT. CHGBD235 00323 CHGBD235 00324 IF BD230-FILE-EOF-88 CHGBD235 00325 OR CHG30-SSN NOT = WRK-SSN CHGBD235 00326 OR CHG30-CHARGE-DATE > WRK-END-DATE CHGBD235 00327 SET BD230-FILE-EOF-88 TO TRUE CHGBD235 00328 GO TO P2000-EXIT CHGBD235 00329 ELSE CHGBD235 00330 IF BD230-FILE-EOF-88 CHGBD235 00331 GO TO P2000-EXIT CHGBD235 00332 ELSE CHGBD235 00333 IF NOT BD230-FILE-OK-88 CHGBD235 00334 DISPLAY 'BD230 FILE READ ERROR: ' CHGBD235 00335 BD230-CHG-STATUS CHGBD235 00336 SET BD230-FILE-EOF-88 TO TRUE CHGBD235 00337 GO TO P2000-EXIT. CHGBD235 00338 CHGBD235 00339 IF CHG30-SSN = WRK-SSN CHGBD235 00340 AND CHG30-BYE = WRK-BYE CHGBD235 00341 AND CHG30-PROGRAM = WRK-PROGRAM CHGBD235 00342 COMPUTE WRK-TOT-CHG = WRK-TOT-CHG + CHG30-TOT-CHG-AMT. CHGBD235 00343 CHGBD235 00344 CHGBD235 00345 P2000-EXIT. CHGBD235 00346 EXIT. CHGBD235 00347 CHGBD235 00348 S001-FROM-FED-8. CHGBD235 00349 SET L001-FROM-FED-8 TO TRUE. CHGBD235 00350 GO TO S001-DATE. CHGBD235 00351 CHGBD235 00352 *S001-FROM-ABS. CHGBD235 00353 ** SET L001-FROM-ABS-DAY TO TRUE. CHGBD235 00354 ** GO TO S001-DATE. CHGBD235 00355 CHGBD235 00356 S001-DATE. CHGBD235 00357 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBD235 00358 S001-EXIT. EXIT. CHGBD235 00359 CHGBD235 00360 *S004-FROM-DATE. CHGBD235 00361 ** SET L004-FROM-DATE TO TRUE. CHGBD235 00362 ** GO TO S004-YRQ. CHGBD235 00363 CHGBD235 00364 *S004-YRQ. CHGBD235 00365 * CALL 'DTSBU004' USING L004-LINK-AREA. CHGBD235 00366 *S004-EXIT. EXIT. CHGBD235 00367 CHGBD235 00368 T0000-TERMINATE. CHGBD235 00369 CLOSE BD230-CHG-FILE-IN. CHGBD235 00370 CHGBD235 00371 CHGBD235 00372 T0000-EXIT. CHGBD235 00373 EXIT. CHGBD235 00374 EJECT CHGBD235 00375 CHGBD235 00376 S999-ABEND. CHGBD235 00377 CALL ABEND-MOD USING ABEND-CODE. CHGBD235 00378 CHGBD235 00379 S999-EXIT. CHGBD235 00380 EXIT. CHGBD235 00381 CHGBD235