00001 IDENTIFICATION DIVISION. 05/25/10 00002 PROGRAM-ID. DTSBX346. DTSBX346 00003 AUTHOR. NGC. LV005 00004 DATE-WRITTEN. DECEMBER 2008. DTSBX346 00005 DATE-COMPILED. DTSBX346 00006 SKIP3 DTSBX346 00007 ***** DTSBX346 00008 * DTSBX346 00009 * FUNCTION: INTERNAL WEB MAINFRAME EXTRACT - BEN CHARGES DTSBX346 00010 * DTSBX346 00011 * DTSBX346 00012 * DTSBX346 00013 ***** DTSBX346 00014 ******************************************************************DTSBX346 00015 * MODIFICATION HISTORY: *DTSBX346 00016 * *DTSBX346 00017 * 12-16-2009 CORRECTED PROGRAM CODE - CHANGED TO PIC X. *DTSBX346 00018 * REFERENCE RFP # AUTHOR OF CHANGE - GD *DTSBX346 00019 * *DTSBX346 00020 * 05-14-2010 RECOMPILE FOR NEW VERSION OF CHGIM002 *DTSBX346 00021 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *DTSBX346 00022 * *DTSBX346 00023 ******************************************************************DTSBX346 00024 SKIP3 DTSBX346 00025 ENVIRONMENT DIVISION. DTSBX346 00026 SKIP2 DTSBX346 00027 INPUT-OUTPUT SECTION. DTSBX346 00028 DTSBX346 00029 FILE-CONTROL. DTSBX346 00030 SELECT CHRG-FILE-IN ASSIGN TO CHARGESI DTSBX346 00031 ORGANIZATION IS INDEXED DTSBX346 00032 ACCESS MODE IS SEQUENTIAL DTSBX346 00033 RECORD KEY IS CHG2-KEY-AREA DTSBX346 00034 FILE STATUS IS CHRG-FILE-IN-STATUS. DTSBX346 00035 DTSBX346 00036 SELECT CHRG-FILE-OUT ASSIGN TO CHARGESO DTSBX346 00037 FILE STATUS IS CHRG-FILE-OUT-STATUS. DTSBX346 00038 SKIP2 DTSBX346 00039 DATA DIVISION. DTSBX346 00040 SKIP3 DTSBX346 00041 FILE SECTION. DTSBX346 00042 FD CHRG-FILE-IN DTSBX346 00043 RECORD CONTAINS 64 CHARACTERS DTSBX346 00044 DATA RECORD IS CHRG-FILE-IN-REC. DTSBX346 00045 01 CHRG-FILE-IN-REC. DTSBX346 00046 ++INCLUDE CHGIM002 DTSBX346 00047 DTSBX346 00048 FD CHRG-FILE-OUT DTSBX346 00049 RECORDING MODE IS F DTSBX346 00050 BLOCK CONTAINS 0 CHARACTERS DTSBX346 00051 LABEL RECORDS ARE STANDARD. DTSBX346 00052 DTSBX346 00053 01 CHRG-FILE-OUT-REC PIC X(58). DTSBX346 00054 DTSBX346 00055 EJECT DTSBX346 00056 WORKING-STORAGE SECTION. DTSBX346 000565 77 PAN-VALET PICTURE X(24) VALUE '005DTSBX346 05/25/10'. DTSBX346 00057 DTSBX346 00058 01 WRK-AREA. DTSBX346 00059 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +346.DTSBX346 00060 DTSBX346 00061 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX346'.DTSBX346 00062 DTSBX346 00063 05 CHRG-FILE-IN-STATUS PIC X(02) VALUE SPACES. DTSBX346 00064 88 CHRG-FILE-IN-OK-88 VALUE ZERO. DTSBX346 00065 88 CHRG-FILE-IN-EOF-88 VALUE '10'. DTSBX346 00066 DTSBX346 00067 05 CHRG-FILE-OUT-STATUS PIC X(02) VALUE SPACES. DTSBX346 00068 88 CHRG-FILE-OUT-OK-88 VALUE ZERO. DTSBX346 00069 DTSBX346 00070 05 WRK-INPUT-FILE-EMPTY-IND PIC X(01) VALUE ' '. DTSBX346 00071 88 WRK-INPUT-FILE-EMPTY-YES VALUE 'Y'. DTSBX346 00072 88 WRK-INPUT-FILE-EMPTY-NO VALUE 'N'. DTSBX346 00073 DTSBX346 00074 05 WRK-START-DATE PIC S9(09) COMP-3 DTSBX346 00075 VALUE +20050101. DTSBX346 00076 05 WRK-END-DATE PIC S9(09) COMP-3 DTSBX346 00077 VALUE +99999999. DTSBX346 00078 DTSBX346 00079 05 WRK-TOT-CHG PIC S9(11)V99 COMP-3 DTSBX346 00080 VALUE +0. DTSBX346 00081 05 WRK-CHRG-READ-CNT PIC 9(07) COMP-3 VALUE 0. DTSBX346 00082 05 WRK-CHRG-WRITE-CNT PIC 9(07) COMP-3 VALUE 0. DTSBX346 00083 05 WRK-SSN PIC 9(10). DTSBX346 00084 05 WRK-SSN-X REDEFINES WRK-SSN. DTSBX346 00085 10 WRK-OUT-SSN PIC 9(09). DTSBX346 00086 10 WRK-OUT-SSN-ZERO PIC 9(01). DTSBX346 00087 05 WRK-CURR-AMT PIC S9(11)V99 COMP-3. DTSBX346 00088 *& DTSBX346 00089 05 WRK-EB PIC S9(11)V99 COMP-3 DTSBX346 00090 VALUE +0. DTSBX346 00091 05 WRK-AB PIC S9(11)V99 COMP-3 DTSBX346 00092 VALUE +0. DTSBX346 00093 05 WRK-TR2 PIC S9(11)V99 COMP-3 DTSBX346 00094 VALUE +0. DTSBX346 00095 05 WRK-TR2PLUS PIC S9(11)V99 COMP-3 DTSBX346 00096 VALUE +0. DTSBX346 00097 05 WRK-TR3 PIC S9(11)V99 COMP-3 DTSBX346 00098 VALUE +0. DTSBX346 00099 05 WRK-FAC PIC S9(11)V99 COMP-3 DTSBX346 00100 VALUE +0. DTSBX346 00101 *& DTSBX346 00102 DTSBX346 00103 01 WRK-OUT-REC. DTSBX346 00104 05 OUT-CHARGE-DATE PIC X(10). DTSBX346 00105 05 FILLER PIC X(01) VALUE ';'. DTSBX346 00106 05 OUT-EMP-NO PIC 9(06). DTSBX346 00107 05 FILLER PIC X(01) VALUE ';'. DTSBX346 00108 05 OUT-SSN PIC 9(09). DTSBX346 00109 05 FILLER PIC X(01) VALUE ';'. DTSBX346 00110 05 OUT-BYE PIC X(10). DTSBX346 00111 05 FILLER PIC X(01) VALUE ';'. DTSBX346 00112 05 OUT-PROGRAM PIC X(01). DTSBX346 00113 05 FILLER PIC X(01) VALUE ';'. DTSBX346 00114 05 OUT-EMP-TYPE PIC 9(02). DTSBX346 00115 05 FILLER PIC X(01) VALUE ';'. DTSBX346 00116 05 OUT-CURR-AMT PIC ----------9.99. DTSBX346 00117 EJECT DTSBX346 00118 01 L001-LINK-AREA. DTSBX346 00119 ++INCLUDE DTSIL001 DTSBX346 00120 EJECT DTSBX346 00121 *01 CHRG-REC. DTSBX346 00122 ****NCLUDE CHGIM002 DTSBX346 00123 EJECT DTSBX346 00124 LINKAGE SECTION. DTSBX346 00125 DTSBX346 00126 01 LX34-LINK-AREA. DTSBX346 00127 ++INCLUDE DTSILX34 DTSBX346 00128 DTSBX346 00129 01 MPRF-REC. DTSBX346 00130 ++INCLUDE DTSIMPRF DTSBX346 00131 DTSBX346 00132 PROCEDURE DIVISION USING LX34-LINK-AREA DTSBX346 00133 MPRF-REC. DTSBX346 00134 SKIP2 DTSBX346 00135 EVALUATE TRUE DTSBX346 00136 WHEN LX34-INITIALIZE-88 DTSBX346 00137 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBX346 00138 WHEN LX34-PROCESS-88 DTSBX346 00139 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX346 00140 WHEN LX34-TERMINATE-88 DTSBX346 00141 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX346 00142 END-EVALUATE. DTSBX346 00143 DTSBX346 00144 GOBACK. DTSBX346 00145 EJECT DTSBX346 00146 I0000-INITIATE. DTSBX346 00147 DISPLAY 'BX346 PRIOR RUN DT ' LX34-PRIOR-RUN-DATE. DTSBX346 00148 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX346 00149 DTSBX346 00150 I0000-EXIT. DTSBX346 00151 EXIT. DTSBX346 00152 I2000-OPEN-FILES. DTSBX346 00153 OPEN INPUT CHRG-FILE-IN. DTSBX346 00154 IF NOT CHRG-FILE-IN-OK-88 DTSBX346 00155 DISPLAY 'INPUT FILE OPEN ERROR: ' CHRG-FILE-IN-STATUS DTSBX346 00156 PERFORM S999-ABEND THRU S999-EXIT DTSBX346 00157 END-IF. DTSBX346 00158 DTSBX346 00159 OPEN OUTPUT CHRG-FILE-OUT. DTSBX346 00160 IF NOT CHRG-FILE-OUT-OK-88 DTSBX346 00161 DISPLAY 'OUTPUT FILE OPEN ERROR: ' DTSBX346 00162 CHRG-FILE-OUT-STATUS DTSBX346 00163 PERFORM S999-ABEND THRU S999-EXIT DTSBX346 00164 END-IF. DTSBX346 00165 DTSBX346 00166 I2000-EXIT. DTSBX346 00167 EXIT. DTSBX346 00168 DTSBX346 00169 P0000-PROCESS. DTSBX346 00170 MOVE LX34-PRIOR-RUN-DATE TO CHG2-CHARGE-DATE. DTSBX346 00171 MOVE +0 TO CHG2-EMP-NO DTSBX346 00172 CHG2-SSN DTSBX346 00173 CHG2-BYE. DTSBX346 00174 MOVE 0 TO CHG2-PROGRAM. DTSBX346 00175 START CHRG-FILE-IN DTSBX346 00176 KEY IS >= CHG2-KEY-AREA. DTSBX346 00177 DTSBX346 00178 IF NOT CHRG-FILE-IN-OK-88 DTSBX346 00179 DISPLAY 'BAD FIRST READ ' CHRG-FILE-IN-STATUS DTSBX346 00180 GO TO P0000-EXIT DTSBX346 00181 ELSE DTSBX346 00182 PERFORM P1000-BUILD-OUTPUT THRU P1000-EXIT DTSBX346 00183 UNTIL CHRG-FILE-IN-EOF-88 DTSBX346 00184 END-IF. DTSBX346 00185 DTSBX346 00186 DTSBX346 00187 P0000-EXIT. DTSBX346 00188 EXIT. DTSBX346 00189 DTSBX346 00190 P1000-BUILD-OUTPUT. DTSBX346 00191 READ CHRG-FILE-IN NEXT. DTSBX346 00192 IF CHRG-FILE-IN-OK-88 DTSBX346 00193 ADD 1 TO WRK-CHRG-READ-CNT DTSBX346 00194 ELSE DTSBX346 00195 IF CHRG-FILE-IN-EOF-88 DTSBX346 00196 GO TO P1000-EXIT DTSBX346 00197 ELSE DTSBX346 00198 DISPLAY 'BAD READ ' CHRG-FILE-IN-STATUS DTSBX346 00199 SET CHRG-FILE-IN-EOF-88 TO TRUE DTSBX346 00200 GO TO P1000-EXIT DTSBX346 00201 END-IF DTSBX346 00202 END-IF. DTSBX346 00203 DTSBX346 00204 IF CHG2-CHARGE-DATE > WRK-END-DATE DTSBX346 00205 GO TO P1000-EXIT DTSBX346 00206 END-IF. DTSBX346 00207 DTSBX346 00208 MOVE CHG2-EMP-NO TO OUT-EMP-NO. DTSBX346 00209 MOVE CHG2-CHARGE-DATE TO L001-FED-8-DATE-9. DTSBX346 00210 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX346 00211 MOVE L001-SLASH-8-DATE TO OUT-CHARGE-DATE. DTSBX346 00212 MOVE CHG2-SSN TO WRK-SSN. DTSBX346 00213 MOVE WRK-OUT-SSN TO OUT-SSN. DTSBX346 00214 MOVE CHG2-BYE TO L001-FED-8-DATE-9. DTSBX346 00215 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX346 00216 IF L001-INVALID-DATE DTSBX346 00217 MOVE '01/01/1930' TO OUT-BYE DTSBX346 00218 ELSE DTSBX346 00219 MOVE L001-SLASH-8-DATE TO OUT-BYE. DTSBX346 00220 MOVE CHG2-PROGRAM TO OUT-PROGRAM. DTSBX346 00221 MOVE CHG2-EMP-TYPE TO OUT-EMP-TYPE. DTSBX346 00222 COMPUTE WRK-CURR-AMT = CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT.DTSBX346 00223 MOVE WRK-CURR-AMT TO OUT-CURR-AMT. DTSBX346 00224 ADD WRK-CURR-AMT TO WRK-TOT-CHG. DTSBX346 00225 DTSBX346 00226 *& DTSBX346 00227 EVALUATE TRUE DTSBX346 00228 WHEN CHG2-PROG-EB DTSBX346 00229 ADD WRK-CURR-AMT TO WRK-EB DTSBX346 00230 WHEN CHG2-PROG-AB DTSBX346 00231 ADD WRK-CURR-AMT TO WRK-AB DTSBX346 00232 WHEN CHG2-PROG-TR2 DTSBX346 00233 ADD WRK-CURR-AMT TO WRK-TR2 DTSBX346 00234 WHEN CHG2-PROG-EUC08-2PLUS DTSBX346 00235 ADD WRK-CURR-AMT TO WRK-TR2PLUS DTSBX346 00236 WHEN CHG2-PROG-EUC08TR3 DTSBX346 00237 ADD WRK-CURR-AMT TO WRK-TR3 DTSBX346 00238 WHEN CHG2-PROG-FAC DTSBX346 00239 ADD WRK-CURR-AMT TO WRK-FAC DTSBX346 00240 END-EVALUATE. DTSBX346 00241 *& DTSBX346 00242 WRITE CHRG-FILE-OUT-REC FROM WRK-OUT-REC. DTSBX346 00243 IF CHRG-FILE-OUT-OK-88 DTSBX346 00244 ADD 1 TO WRK-CHRG-WRITE-CNT DTSBX346 00245 ELSE DTSBX346 00246 DISPLAY 'OUTPUT FILE WRITE ERROR: ' CHRG-FILE-OUT-STATUS DTSBX346 00247 PERFORM S999-ABEND THRU S999-EXIT. DTSBX346 00248 DTSBX346 00249 ** IF CHG2-EMP-NO = 017576 DTSBX346 00250 * IF CHG2-CHARGE-DATE >= 20070701 DTSBX346 00251 * DISPLAY OUT-SSN ' ' DTSBX346 00252 * OUT-EMP-NO ' ' DTSBX346 00253 * OUT-CHARGE-DATE ' ' DTSBX346 00254 * OUT-CURR-AMT DTSBX346 00255 * END-IF DTSBX346 00256 ** END-IF. DTSBX346 00257 DTSBX346 00258 P1000-EXIT. DTSBX346 00259 EXIT. DTSBX346 00260 DTSBX346 00261 T0000-TERMINATE. DTSBX346 00262 DTSBX346 00263 DISPLAY ' '. DTSBX346 00264 DTSBX346 00265 DISPLAY '*** DTSBX346 TERMINATION STATISTICS ***'. DTSBX346 00266 DTSBX346 00267 DISPLAY ' '. DTSBX346 00268 DTSBX346 00269 DISPLAY ' DTSBX346 TOTAL INPUT RECORDS READ : ' DTSBX346 00270 WRK-CHRG-READ-CNT. DTSBX346 00271 DTSBX346 00272 DISPLAY ' '. DTSBX346 00273 DTSBX346 00274 DISPLAY ' DTSBX346 TOTAL OUTPUT RECORDS WRITTEN : ' DTSBX346 00275 WRK-CHRG-WRITE-CNT. DTSBX346 00276 DTSBX346 00277 MOVE WRK-TOT-CHG TO OUT-CURR-AMT. DTSBX346 00278 DISPLAY ' TOTAL CHARGE : ' DTSBX346 00279 OUT-CURR-AMT. DTSBX346 00280 MOVE WRK-EB TO OUT-CURR-AMT. DTSBX346 00281 DISPLAY ' EB: ' OUT-CURR-AMT. DTSBX346 00282 MOVE WRK-AB TO OUT-CURR-AMT. DTSBX346 00283 DISPLAY ' AB: ' OUT-CURR-AMT. DTSBX346 00284 MOVE WRK-TR2 TO OUT-CURR-AMT. DTSBX346 00285 DISPLAY ' TR2: ' OUT-CURR-AMT. DTSBX346 00286 MOVE WRK-TR2PLUS TO OUT-CURR-AMT. DTSBX346 00287 DISPLAY ' TR2PLUS: ' OUT-CURR-AMT. DTSBX346 00288 MOVE WRK-TR3 TO OUT-CURR-AMT. DTSBX346 00289 DISPLAY ' TR3: ' OUT-CURR-AMT. DTSBX346 00290 MOVE WRK-FAC TO OUT-CURR-AMT. DTSBX346 00291 DISPLAY ' FAC: ' OUT-CURR-AMT. DTSBX346 00292 DTSBX346 00293 CLOSE CHRG-FILE-IN DTSBX346 00294 CHRG-FILE-OUT. DTSBX346 00295 DTSBX346 00296 T0000-EXIT. DTSBX346 00297 EXIT. DTSBX346 00298 DTSBX346 00299 S001-FROM-FED-8. DTSBX346 00300 SET L001-FROM-FED-8 TO TRUE. DTSBX346 00301 GO TO S001-DATE. DTSBX346 00302 DTSBX346 00303 S001-DATE. DTSBX346 00304 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX346 00305 DTSBX346 00306 S001-EXIT. DTSBX346 00307 EXIT. DTSBX346 00308 SKIP3 DTSBX346 00309 S999-ABEND. DTSBX346 00310 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX346 00311 S999-EXIT. DTSBX346 00312 EXIT. DTSBX346