Files
DUTAS/Batch/CHGBD235.cob
2025-07-21 11:20:11 -04:00

383 lines
30 KiB
COBOL

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