00001 IDENTIFICATION DIVISION. 11/20/09 00002 PROGRAM-ID. DTSBX305. DTSBX305 00003 AUTHOR. NGC. LV011 00004 DATE-WRITTEN. FEBRUARY 2008. DTSBX305 00005 DATE-COMPILED. DTSBX305 00006 SKIP3 DTSBX305 00007 ***** DTSBX305 00008 * DTSBX305 00009 * FUNCTION: CFO R*STARS OUTBOUND INTERFACE PROCESSOR. DTSBX305 00010 * THIS PROGRAM READS THE DATA RETURNED FROM DTSBX305 00011 * THE CFO ABOUT REFUND CHECKS ISSUED, AND DTSBX305 00012 * UPDATES THE MRFD TAX MASTER FILE REFUND RECORDS. DTSBX305 00013 * DTSBX305 00014 * DTSBX305 00015 * MODIFICATION HISTORY: DTSBX305 00016 * DTSBX305 00017 * 02-15-2007 INITIAL DEVELOPMENT DTSBX305 00018 * REFERENCE RFP: AUTOMATED REFUNDS DTSBX305 00019 * DTSBX305 00020 * 08-04-2008 MODIFIED TO WRITE A DUMMY RECORD TO DTSBX305 00021 * X306-EXP-FILE WHEN NO CHECKS HAVE BEEN ISSUED. DTSBX305 00022 * REFERENCE RFP: GD DTSBX305 00023 * DTSBX305 00024 * 10-22-2008 REMOVED EDIT AGAINST CFO-REQUEST-DATE IN DTSBX305 00025 * P1200. THE EDIT WOULD HAVE PREVENTED THE DTSBX305 00026 * SYSTEM FROM FINDING THE MRDF RECORD FOR THE DTSBX305 00027 * BATCHES THAT WERE RERUN WITH A NEW DATE. DTSBX305 00028 * REFERENCE RFP: GD DTSBX305 00029 * DTSBX305 00030 * DTSBX305 00031 ***** DTSBX305 00032 SKIP3 DTSBX305 00033 ENVIRONMENT DIVISION. DTSBX305 00034 SKIP2 DTSBX305 00035 INPUT-OUTPUT SECTION. DTSBX305 00036 DTSBX305 00037 FILE-CONTROL. DTSBX305 00038 DTSBX305 00039 SELECT X305-IMP-FILE ASSIGN TO X305IMP DTSBX305 00040 FILE STATUS IS X305-IMP-STATUS. DTSBX305 00041 DTSBX305 00042 SELECT X305-PARM-FILE ASSIGN TO X305PARM DTSBX305 00043 FILE STATUS IS X305-PARM-STATUS. DTSBX305 00044 DTSBX305 00045 SELECT X306-EXP-FILE ASSIGN TO X306EXP DTSBX305 00046 FILE STATUS IS X306-EXP-STATUS. DTSBX305 00047 DTSBX305 00048 DATA DIVISION. DTSBX305 00049 DTSBX305 00050 FILE SECTION. DTSBX305 00051 DTSBX305 00052 FD X305-IMP-FILE DTSBX305 00053 RECORDING MODE IS F DTSBX305 00054 BLOCK CONTAINS 0 RECORDS DTSBX305 00055 LABEL RECORDS ARE OMITTED. DTSBX305 00056 DTSBX305 00057 01 X305-WEB-IMP-REC PIC X(109). DTSBX305 00058 DTSBX305 00059 FD X305-PARM-FILE DTSBX305 00060 RECORDING MODE IS F DTSBX305 00061 BLOCK CONTAINS 0 RECORDS DTSBX305 00062 LABEL RECORDS ARE OMITTED. DTSBX305 00063 01 X305-WEB-PARM-REC PIC X(101). DTSBX305 00064 DTSBX305 00065 FD X306-EXP-FILE DTSBX305 00066 RECORDING MODE IS F DTSBX305 00067 BLOCK CONTAINS 0 RECORDS DTSBX305 00068 LABEL RECORDS ARE OMITTED. DTSBX305 00069 DTSBX305 00070 01 X306-WEB-EXP-REC PIC X(109). DTSBX305 00071 DTSBX305 00072 WORKING-STORAGE SECTION. DTSBX305 000725 77 PAN-VALET PICTURE X(24) VALUE '011DTSBX305 11/20/09'. DTSBX305 00073 SKIP3 DTSBX305 00074 01 WRK-AREA. DTSBX305 00075 05 W-ABEND-CD PIC S9(04) COMP VALUE 305. DTSBX305 00076 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX305'.DTSBX305 00077 05 W-X305-PARM-DATE PIC 9(08) VALUE ZEROS. DTSBX305 00078 DTSBX305 00079 05 X305-IMP-STATUS PIC X(02). DTSBX305 00080 88 X305-IMP-STATUS-OK-88 VALUE '00'. DTSBX305 00081 88 X305-IMP-STATUS-EOF-88 VALUE '10'. DTSBX305 00082 DTSBX305 00083 05 X305-PARM-STATUS PIC X(02). DTSBX305 00084 88 X305-PARM-STATUS-OK-88 VALUE '00'. DTSBX305 00085 88 X305-PARM-STATUS-EOF-88 VALUE '10'. DTSBX305 00086 DTSBX305 00087 05 X306-EXP-STATUS PIC X(02). DTSBX305 00088 88 X306-EXP-STATUS-OK-88 VALUE '00'. DTSBX305 00089 88 X306-EXP-STATUS-EOF-88 VALUE '10'. DTSBX305 00090 DTSBX305 00091 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX305 00092 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX305 00093 88 W-ERROR-NO-88 VALUE 'N'. DTSBX305 00094 DTSBX305 00095 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX305 00096 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX305 00097 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX305 00098 DTSBX305 00099 05 SUB1 PIC S9(04) COMP. DTSBX305 00100 05 SUB2 PIC S9(04) COMP. DTSBX305 00101 05 W-REFUND-LEN PIC S9(04) COMP VALUE +15. DTSBX305 00102 05 W-REFUND-AMT-X PIC X(15). DTSBX305 00103 05 W-REFUND-AMT-9 REDEFINES W-REFUND-AMT-X DTSBX305 00104 PIC 9(13)V99. DTSBX305 00105 05 W-MRFD-REFUND-AMT PIC S9(09)V9(02) COMP-3. DTSBX305 00106 05 W-AMT-DISP PIC Z(08)9.99. DTSBX305 00107 05 W-ABSTIME PIC S9(15) COMP-3. DTSBX305 00108 DTSBX305 00109 05 EVL-TEXT. DTSBX305 00110 10 FILLER PIC X(21) DTSBX305 00111 VALUE 'REFUND CK ISSUED. #: '. DTSBX305 00112 10 EVL-RFD-VOUCHER PIC X(08). DTSBX305 00113 10 FILLER PIC X(07) DTSBX305 00114 VALUE ' AMT:'. DTSBX305 00115 10 EVL-REFUND-AMT PIC ZZZZZZ,ZZ9.99-. DTSBX305 00116 DTSBX305 00117 DTSBX305 00118 05 W-X305-IMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX305 00119 05 W-X306-EXP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX305 00120 05 W-MRFD-UPD-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX305 00121 DTSBX305 00122 05 W-AMT-DISP1 PIC ----------9.99. DTSBX305 00123 05 W-AMT-DISP2 PIC ----------9.99. DTSBX305 00124 DTSBX305 00125 01 W-X305-REC. DTSBX305 00126 ++INCLUDE DTSIX305 DTSBX305 00127 DTSBX305 00128 01 W-X306-REC. DTSBX305 00129 ++INCLUDE DTSIX306 DTSBX305 00130 DTSBX305 00131 01 L001-LINK-AREA. DTSBX305 00132 ++INCLUDE DTSIL001 DTSBX305 00133 DTSBX305 00134 01 L003-LINK-AREA. DTSBX305 00135 ++INCLUDE DTSIL003 DTSBX305 00136 DTSBX305 00137 01 L004-LINK-AREA. DTSBX305 00138 ++INCLUDE DTSIL004 DTSBX305 00139 DTSBX305 00140 01 L005-LINK-AREA. DTSBX305 00141 ++INCLUDE DTSIL005 DTSBX305 00142 DTSBX305 00143 01 L910-LINK-AREA. DTSBX305 00144 ++INCLUDE DTSIL910 DTSBX305 00145 01 MSKL-REC. DTSBX305 00146 ++INCLUDE DTSIMSKL DTSBX305 00147 DTSBX305 00148 01 MHDR-REC. DTSBX305 00149 ++INCLUDE DTSIMHDR DTSBX305 00150 DTSBX305 00151 01 MPRF-REC. DTSBX305 00152 ++INCLUDE DTSIMPRF DTSBX305 00153 DTSBX305 00154 01 MRFD-REC. DTSBX305 00155 ++INCLUDE DTSIMRFD DTSBX305 00156 DTSBX305 00157 01 MEVL-REC. DTSBX305 00158 ++INCLUDE DTSIMEVL DTSBX305 00159 DTSBX305 00160 01 L921-LINK-AREA. DTSBX305 00161 ++INCLUDE DTSIL921 DTSBX305 00162 SKIP3 DTSBX305 00163 01 ISKL-REC. DTSBX305 00164 ++INCLUDE DTSIISKL DTSBX305 00165 SKIP3 DTSBX305 00166 01 IRFD-REC. DTSBX305 00167 ++INCLUDE DTSIIRFD DTSBX305 00168 DTSBX305 00169 01 L931-LINK-AREA. DTSBX305 00170 ++INCLUDE DTSIL931 DTSBX305 00171 DTSBX305 00172 01 FSKL-REC. DTSBX305 00173 ++INCLUDE DTSIFSKL DTSBX305 00174 DTSBX305 00175 PROCEDURE DIVISION. DTSBX305 00176 DTSBX305 00177 DTSBX305-MAIN. DTSBX305 00178 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX305 00179 IF W-FATAL-ERROR-YES-88 DTSBX305 00180 GO TO DTSBX305-MAIN-EXIT DTSBX305 00181 END-IF. DTSBX305 00182 DTSBX305 00183 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX305 00184 DTSBX305 00185 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX305 00186 DTSBX305 00187 DTSBX305-MAIN-EXIT. DTSBX305 00188 GOBACK. DTSBX305 00189 EJECT DTSBX305 00190 I0000-INITIATE. DTSBX305 00191 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX305 00192 MOVE L005-ABSTIME TO W-ABSTIME. DTSBX305 00193 DTSBX305 00194 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX305 00195 IF W-FATAL-ERROR-YES-88 DTSBX305 00196 GO TO I0000-EXIT DTSBX305 00197 END-IF. DTSBX305 00198 DTSBX305 00199 I0000-EXIT. DTSBX305 00200 EXIT. DTSBX305 00201 DTSBX305 00202 I2000-OPEN-FILES. DTSBX305 00203 OPEN INPUT X305-IMP-FILE. DTSBX305 00204 IF NOT X305-IMP-STATUS-OK-88 DTSBX305 00205 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX305 00206 DISPLAY 'CANNOT OPEN X305-IMP-FILE ' DTSBX305 00207 X305-IMP-STATUS DTSBX305 00208 GO TO I2000-EXIT DTSBX305 00209 END-IF. DTSBX305 00210 DTSBX305 00211 OPEN I-O X305-PARM-FILE. DTSBX305 00212 IF NOT X305-PARM-STATUS-OK-88 DTSBX305 00213 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX305 00214 DISPLAY 'CANNOT OPEN X305-PARM-FILE ' DTSBX305 00215 X305-PARM-STATUS DTSBX305 00216 GO TO I2000-EXIT DTSBX305 00217 END-IF. DTSBX305 00218 DTSBX305 00219 OPEN OUTPUT X306-EXP-FILE. DTSBX305 00220 IF NOT X306-EXP-STATUS-OK-88 DTSBX305 00221 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX305 00222 DISPLAY 'CANNOT OPEN X306-EXP-FILE ' DTSBX305 00223 X306-EXP-STATUS DTSBX305 00224 GO TO I2000-EXIT DTSBX305 00225 END-IF. DTSBX305 00226 DTSBX305 00227 PERFORM S1100-READ-X305-PARM THRU S1100-EXIT. DTSBX305 00228 ** PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX305 00229 PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBX305 00230 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX305 00231 DTSBX305 00232 *** PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBX305 00233 DTSBX305 00234 I2000-EXIT. DTSBX305 00235 EXIT. DTSBX305 00236 DTSBX305 00237 DTSBX305 00238 P0000-PROCESS. DTSBX305 00239 DISPLAY 'CFO REFUND IMPORT PROCESS'. DTSBX305 00240 DISPLAY SPACE. DTSBX305 00241 DTSBX305 00242 PERFORM S1000-READ-X305-IMP THRU S1000-EXIT. DTSBX305 00243 IF X305-IMP-STATUS-EOF-88 DTSBX305 00244 DISPLAY 'NO X305 RECORDS TO IMPORT ' DTSBX305 00245 ELSE DTSBX305 00246 PERFORM DTSBX305 00247 UNTIL X305-IMP-STATUS-EOF-88 DTSBX305 00248 OR W-FATAL-ERROR-YES-88 DTSBX305 00249 PERFORM P1000-UPDATE-MRFD THRU P1000-EXIT DTSBX305 00250 PERFORM S1000-READ-X305-IMP THRU S1000-EXIT DTSBX305 00251 END-PERFORM DTSBX305 00252 END-IF. DTSBX305 00253 DTSBX305 00254 IF W-X306-EXP-CNT = ZERO DTSBX305 00255 DISPLAY 'NO CHECKS ISSUED - DUMMY REC WRITTEN ' DTSBX305 00256 PERFORM P2000-DUMMY-X306 THRU P2000-EXIT DTSBX305 00257 END-IF. DTSBX305 00258 DTSBX305 00259 P0000-EXIT. DTSBX305 00260 EXIT. DTSBX305 00261 DTSBX305 00262 P1000-UPDATE-MRFD. DTSBX305 00263 SET W-ERROR-NO-88 TO TRUE. DTSBX305 00264 DTSBX305 00265 * IF X305-APPROVAL-DATE > W-X305-PARM-DATE DTSBX305 00266 * NEXT SENTENCE DTSBX305 00267 * ELSE DTSBX305 00268 * GO TO P1000-EXIT. DTSBX305 00269 DTSBX305 00270 PERFORM P1100-EDIT-X305 THRU P1100-EXIT. DTSBX305 00271 IF W-ERROR-NO-88 DTSBX305 00272 PERFORM P1200-FIND-MRFD THRU P1200-EXIT DTSBX305 00273 END-IF. DTSBX305 00274 DTSBX305 00275 P1000-EXIT. DTSBX305 00276 EXIT. DTSBX305 00277 DTSBX305 00278 P1100-EDIT-X305. DTSBX305 00279 IF X305-BATCH-NO NOT NUMERIC DTSBX305 00280 DISPLAY 'NON-NUMERIC BATCH ' X305-BATCH-NO DTSBX305 00281 SET W-ERROR-YES-88 TO TRUE DTSBX305 00282 END-IF. DTSBX305 00283 DTSBX305 00284 IF X305-BATCH-SEQ-NO NOT NUMERIC DTSBX305 00285 DISPLAY 'NON-NUMERIC BATCH SEQ ' X305-BATCH-SEQ-NO DTSBX305 00286 SET W-ERROR-YES-88 TO TRUE DTSBX305 00287 END-IF. DTSBX305 00288 DTSBX305 00289 MOVE ZERO TO W-REFUND-AMT-9. DTSBX305 00290 MOVE W-REFUND-LEN TO SUB2. DTSBX305 00291 ADD +1 TO SUB2. DTSBX305 00292 PERFORM DTSBX305 00293 VARYING SUB1 FROM W-REFUND-LEN BY -1 DTSBX305 00294 UNTIL SUB1 < +1 DTSBX305 00295 IF (X305-AMOUNT (SUB1:1) >= '0' AND <= '9') DTSBX305 00296 SUBTRACT +1 FROM SUB2 DTSBX305 00297 MOVE X305-AMOUNT (SUB1:1) TO W-REFUND-AMT-X (SUB2:1) DTSBX305 00298 END-IF DTSBX305 00299 END-PERFORM. DTSBX305 00300 DISPLAY 'REFUND AMT ' W-REFUND-AMT-X. DTSBX305 00301 DTSBX305 00302 IF W-REFUND-AMT-9 NOT NUMERIC DTSBX305 00303 DISPLAY 'NON-NUMERIC AMOUNT ' X305-AMOUNT DTSBX305 00304 SET W-ERROR-YES-88 TO TRUE DTSBX305 00305 END-IF. DTSBX305 00306 DTSBX305 00307 MOVE X305-BATCH-DATE-X TO L001-FED-8-DATE-X. DTSBX305 00308 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX305 00309 IF L001-INVALID-DATE DTSBX305 00310 DISPLAY 'INVALID BATCH DATE ' X305-BATCH-DATE-X DTSBX305 00311 SET W-ERROR-YES-88 TO TRUE DTSBX305 00312 END-IF. DTSBX305 00313 DTSBX305 00314 MOVE X305-WARRANT-DATE TO L001-FED-8-DATE-X. DTSBX305 00315 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX305 00316 IF L001-INVALID-DATE DTSBX305 00317 DISPLAY 'INVALID CHECK DATE ' X305-WARRANT-DATE DTSBX305 00318 SET W-ERROR-YES-88 TO TRUE DTSBX305 00319 END-IF. DTSBX305 00320 DTSBX305 00321 *& MOVE X305-APPROVAL-DATE TO L001-FED-8-DATE-X. DTSBX305 00322 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX305 00323 * IF L001-INVALID-DATE DTSBX305 00324 * DISPLAY 'INVALID APPROVAL DATE ' X305-APPROVAL-DATE DTSBX305 00325 * SET W-ERROR-YES-88 TO TRUE DTSBX305 00326 * END-IF. DTSBX305 00327 DTSBX305 00328 P1100-EXIT. DTSBX305 00329 EXIT. DTSBX305 00330 DTSBX305 00331 P1200-FIND-MRFD. DTSBX305 00332 MOVE LOW-VALUES TO IRFD-KEY-AREA. DTSBX305 00333 SET IRFD-RFD-88 TO TRUE. DTSBX305 00334 MOVE X305-BATCH-NO TO IRFD-CFO-BATCH-NO. DTSBX305 00335 MOVE X305-BATCH-SEQ-NO TO IRFD-CFO-SEQ-NO. DTSBX305 00336 MOVE IRFD-KEY-AREA TO ISKL-KEY-AREA. DTSBX305 00337 PERFORM S921-START-BROWSE THRU S921-EXIT. DTSBX305 00338 DTSBX305 00339 P1200-NEXT-MRFD. DTSBX305 00340 IF L921-NO-REC-88 DTSBX305 00341 SET W-ERROR-YES-88 TO TRUE DTSBX305 00342 DISPLAY 'P1200 NO REC FOUND' DTSBX305 00343 ELSE DTSBX305 00344 MOVE ISKL-REC TO IRFD-REC DTSBX305 00345 IF IRFD-CFO-BATCH-NO = X305-BATCH-NO DTSBX305 00346 AND IRFD-CFO-SEQ-NO = X305-BATCH-SEQ-NO DTSBX305 00347 *& AND IRFD-CFO-REQUEST-DATE = X305-BATCH-DATE-9 DTSBX305 00348 PERFORM P1210-READ-MRFD THRU P1210-EXIT DTSBX305 00349 PERFORM S921-READ-NEXT THRU S921-EXIT DTSBX305 00350 GO TO P1200-NEXT-MRFD DTSBX305 00351 ELSE DTSBX305 00352 SET W-ERROR-YES-88 TO TRUE DTSBX305 00353 END-IF DTSBX305 00354 END-IF. DTSBX305 00355 P1200-EXIT. DTSBX305 00356 EXIT. DTSBX305 00357 DTSBX305 00358 P1210-READ-MRFD. DTSBX305 00359 MOVE LOW-VALUES TO MRFD-KEY-AREA. DTSBX305 00360 SET MRFD-RFD-88 TO TRUE. DTSBX305 00361 MOVE IRFD-EMP-NO TO MRFD-EMP-NO. DTSBX305 00362 MOVE IRFD-TAX-BATCH-NO TO MRFD-TAX-BATCH-NO DTSBX305 00363 MOVE IRFD-TAX-ITEM-NO TO MRFD-TAX-ITEM-NO DTSBX305 00364 MOVE MRFD-KEY-AREA TO MSKL-KEY-AREA. DTSBX305 00365 PERFORM S910-READ THRU S910-EXIT. DTSBX305 00366 DTSBX305 00367 P1210-NEXT-MRFD. DTSBX305 00368 IF L910-NO-REC-88 DTSBX305 00369 SET W-ERROR-YES-88 TO TRUE DTSBX305 00370 DISPLAY 'P1210 CANNOT FIND MRFD ' DTSBX305 00371 ' ' X305-FEIN ' ' X305-BATCH-NO DTSBX305 00372 ' ' X305-BATCH-SEQ-NO DTSBX305 00373 ' ' IRFD-EMP-NO ' ' IRFD-TAX-BATCH-NO DTSBX305 00374 ' ' IRFD-TAX-ITEM-NO DTSBX305 00375 GO TO P1210-EXIT DTSBX305 00376 ELSE DTSBX305 00377 MOVE MSKL-REC TO MRFD-REC DTSBX305 00378 END-IF. DTSBX305 00379 DTSBX305 00380 IF IRFD-EMP-NO = MRFD-EMP-NO AND DTSBX305 00381 IRFD-TAX-BATCH-NO = MRFD-TAX-BATCH-NO AND DTSBX305 00382 IRFD-TAX-ITEM-NO = MRFD-TAX-ITEM-NO DTSBX305 00383 SET W-ERROR-NO-88 TO TRUE DTSBX305 00384 ELSE DTSBX305 00385 SET W-ERROR-YES-88 TO TRUE DTSBX305 00386 GO TO P1210-EXIT. DTSBX305 00387 DTSBX305 00388 IF MRFD-CURR-DOC-NO NOT = X305-CURR-DOC-NO DTSBX305 00389 SET W-ERROR-YES-88 TO TRUE DTSBX305 00390 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX305 00391 GO TO P1210-NEXT-MRFD. DTSBX305 00392 DTSBX305 00393 IF MRFD-CFO-CHECK-NO > SPACES DTSBX305 00394 SET W-ERROR-YES-88 TO TRUE DTSBX305 00395 DISPLAY 'P1210 REFUND ALREADY UPDATED ' DTSBX305 00396 MRFD-EMP-NO ' ' MRFD-TAX-BATCH-NO DTSBX305 00397 ' ' MRFD-TAX-ITEM-NO DTSBX305 00398 ' ' MRFD-CFO-CHECK-NO DTSBX305 00399 GO TO P1210-EXIT DTSBX305 00400 END-IF. DTSBX305 00401 DTSBX305 00402 IF MRFD-REFUND-AMT < +0 DTSBX305 00403 COMPUTE W-MRFD-REFUND-AMT = (MRFD-REFUND-AMT * -1) DTSBX305 00404 ELSE DTSBX305 00405 MOVE MRFD-REFUND-AMT TO W-MRFD-REFUND-AMT DTSBX305 00406 END-IF. DTSBX305 00407 IF W-MRFD-REFUND-AMT NOT = W-REFUND-AMT-9 DTSBX305 00408 SET W-ERROR-YES-88 TO TRUE DTSBX305 00409 MOVE W-MRFD-REFUND-AMT TO W-AMT-DISP1 DTSBX305 00410 MOVE X305-AMOUNT TO W-AMT-DISP2 DTSBX305 00411 DISPLAY 'P1210 WRONG CHECK AMOUNT. TAX: ' DTSBX305 00412 W-AMT-DISP1 ' CFO ' W-AMT-DISP2 DTSBX305 00413 ' ' MRFD-EMP-NO ' ' MRFD-TAX-BATCH-NO DTSBX305 00414 ' ' MRFD-TAX-ITEM-NO DTSBX305 00415 END-IF. DTSBX305 00416 DTSBX305 00417 IF W-ERROR-NO-88 DTSBX305 00418 PERFORM P1300-UPDATE THRU P1300-EXIT DTSBX305 00419 END-IF. DTSBX305 00420 P1210-EXIT. DTSBX305 00421 EXIT. DTSBX305 00422 DTSBX305 00423 P1300-UPDATE. DTSBX305 00424 PERFORM P1310-UPD-MRFD THRU P1310-EXIT. DTSBX305 00425 PERFORM P1320-ADD-MEVL THRU P1320-EXIT. DTSBX305 00426 PERFORM P1330-WRITE-X306 THRU P1330-EXIT. DTSBX305 00427 DTSBX305 00428 P1300-EXIT. DTSBX305 00429 EXIT. DTSBX305 00430 DTSBX305 00431 P1310-UPD-MRFD. DTSBX305 00432 MOVE X305-WARRANT-NO TO MRFD-CFO-CHECK-NO. DTSBX305 00433 DTSBX305 00434 MOVE X305-WARRANT-DATE TO L001-FED-8-DATE-9. DTSBX305 00435 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX305 00436 MOVE L001-FED-8-DATE-9 TO MRFD-CFO-CHECK-DATE DTSBX305 00437 MRFD-CFO-APPROVAL-DATE. DTSBX305 00438 DTSBX305 00439 *& MOVE X305-APPROVAL-DATE TO L001-FED-8-DATE-9. DTSBX305 00440 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX305 00441 * MOVE L001-FED-8-DATE-9 TO MRFD-CFO-APPROVAL-DATE. DTSBX305 00442 DTSBX305 00443 MOVE L005-DATE TO MRFD-CHNG-DATE. DTSBX305 00444 DTSBX305 00445 MOVE MRFD-REC TO MSKL-REC. DTSBX305 00446 PERFORM S910-REWRITE THRU S910-EXIT. DTSBX305 00447 ADD +1 TO W-MRFD-UPD-CNT. DTSBX305 00448 DTSBX305 00449 P1310-EXIT. DTSBX305 00450 EXIT. DTSBX305 00451 DTSBX305 00452 P1320-ADD-MEVL. DTSBX305 00453 MOVE LOW-VALUES TO MEVL-REC. DTSBX305 00454 DTSBX305 00455 MOVE MRFD-EMP-NO TO MEVL-EMP-NO. DTSBX305 00456 SET MEVL-EVL-88 TO TRUE. DTSBX305 00457 ADD +1000 TO W-ABSTIME. DTSBX305 00458 MOVE W-ABSTIME TO L005-ABSTIME. DTSBX305 00459 PERFORM S005-FROM-ABS THRU S005-EXIT. DTSBX305 00460 MOVE L005-DATE TO MEVL-DATE. DTSBX305 00461 MOVE L005-TIME TO MEVL-TIME. DTSBX305 00462 MOVE +0 TO MEVL-PURGE-DATE. DTSBX305 00463 MOVE X305-CURR-DOC-NO TO EVL-RFD-VOUCHER. DTSBX305 00464 MOVE W-REFUND-AMT-9 TO W-AMT-DISP. DTSBX305 00465 MOVE W-AMT-DISP TO EVL-REFUND-AMT. DTSBX305 00466 MOVE EVL-TEXT TO MEVL-TEXT. DTSBX305 00467 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBX305 00468 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBX305 00469 MOVE L005-DATE TO MEVL-ESTB-DATE DTSBX305 00470 MEVL-CHNG-DATE. DTSBX305 00471 MOVE MEVL-REC TO MSKL-REC. DTSBX305 00472 DTSBX305 00473 PERFORM S910-WRITE THRU S910-EXIT. DTSBX305 00474 DTSBX305 00475 P1320-EXIT. DTSBX305 00476 EXIT. DTSBX305 00477 DTSBX305 00478 P1330-WRITE-X306. DTSBX305 00479 SET X306-TYPE-FROM-CFO-88 TO TRUE. DTSBX305 00480 MOVE MRFD-EMP-NO TO X306-EMP-NO. DTSBX305 00481 MOVE MRFD-TAX-BATCH-NO TO X306-TAX-BATCH. DTSBX305 00482 MOVE MRFD-TAX-ITEM-NO TO X306-TAX-ITEM. DTSBX305 00483 MOVE MRFD-PAY-BATCH-NO TO X306-APPLIC-BATCH. DTSBX305 00484 MOVE MRFD-PAY-ITEM-NO TO X306-APPLIC-ITEM. DTSBX305 00485 MOVE MRFD-CFO-AGENCY TO X306-BATCH-AGY. DTSBX305 00486 MOVE MRFD-CFO-TYPE TO X306-BATCH-TYPE. DTSBX305 00487 *& MOVE MRFD-CFO-REQUEST-DATE TO L001-FED-8-DATE-9. DTSBX305 00488 MOVE X305-BATCH-DATE-9 TO L001-FED-8-DATE-9. DTSBX305 00489 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX305 00490 MOVE L001-SLASH-8-DATE TO X306-BATCH-DATE. DTSBX305 00491 MOVE MRFD-CFO-BATCH-NO TO X306-BATCH-NUMBER. DTSBX305 00492 MOVE MRFD-CFO-SEQ-NO TO X306-BATCH-SEQUENCE. DTSBX305 00493 MOVE MRFD-CURR-DOC-NO TO X306-CURR-DOC-NO. DTSBX305 00494 MOVE MRFD-CURR-DOC-NO-SFX TO X306-CURR-DOC-NO-SFX. DTSBX305 00495 MOVE MRFD-RESPONSIBLE-OP-ID TO X306-OPID. DTSBX305 00496 MOVE MRFD-CFO-CHECK-DATE TO L001-FED-8-DATE-9. DTSBX305 00497 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX305 00498 MOVE L001-SLASH-8-DATE TO X306-CHECK-DATE. DTSBX305 00499 MOVE MRFD-CFO-CHECK-NO TO X306-CHECK-NO. DTSBX305 00500 MOVE SPACES TO X306-APPROVAL-DATE. DTSBX305 00501 DTSBX305 00502 WRITE X306-WEB-EXP-REC FROM W-X306-REC. DTSBX305 00503 ADD +1 TO W-X306-EXP-CNT. DTSBX305 00504 DTSBX305 00505 DISPLAY 'X306 WRITTEN ' X306-EMP-NO DTSBX305 00506 ' ' X306-CURR-DOC-NO DTSBX305 00507 ' ' X306-TAX-BATCH DTSBX305 00508 ' ' X306-TAX-ITEM. DTSBX305 00509 DISPLAY 'X305 ' X305-INVOICE-NO DTSBX305 00510 ' ' X305-CURR-DOC-NO DTSBX305 00511 ' ' X305-BATCH-NO DTSBX305 00512 ' ' X305-BATCH-SEQ-NO. DTSBX305 00513 P1330-EXIT. DTSBX305 00514 EXIT. DTSBX305 00515 DTSBX305 00516 P2000-DUMMY-X306. DTSBX305 00517 MOVE '9' TO X306-TYPE. DTSBX305 00518 MOVE ZEROS TO X306-EMP-NO DTSBX305 00519 X306-TAX-BATCH DTSBX305 00520 X306-TAX-ITEM DTSBX305 00521 X306-APPLIC-BATCH DTSBX305 00522 X306-APPLIC-ITEM. DTSBX305 00523 MOVE SPACES TO X306-BATCH-AGY DTSBX305 00524 X306-BATCH-TYPE DTSBX305 00525 X306-BATCH-DATE. DTSBX305 00526 MOVE ZEROS TO X306-BATCH-NUMBER DTSBX305 00527 X306-BATCH-SEQUENCE DTSBX305 00528 X306-CURR-DOC-NO DTSBX305 00529 X306-CURR-DOC-NO-SFX. DTSBX305 00530 MOVE SPACES TO X306-OPID DTSBX305 00531 X306-CHECK-DATE DTSBX305 00532 X306-CHECK-NO DTSBX305 00533 X306-APPROVAL-DATE. DTSBX305 00534 DTSBX305 00535 WRITE X306-WEB-EXP-REC FROM W-X306-REC. DTSBX305 00536 ADD +1 TO W-X306-EXP-CNT. DTSBX305 00537 DTSBX305 00538 P2000-EXIT. DTSBX305 00539 EXIT. DTSBX305 00540 DTSBX305 00541 DTSBX305 00542 T0000-TERMINATE. DTSBX305 00543 DISPLAY ' '. DTSBX305 00544 DTSBX305 00545 DISPLAY '*** DTSBX305 TERMINATION STATISTICS ***'. DTSBX305 00546 DTSBX305 00547 DISPLAY ' '. DTSBX305 00548 DTSBX305 00549 DISPLAY ' '. DTSBX305 00550 DTSBX305 00551 DISPLAY 'INPUT RECORDS READ: ' DTSBX305 00552 W-X305-IMP-CNT. DTSBX305 00553 DTSBX305 00554 DISPLAY 'EXPORT RECORDS WRITTEN: ' DTSBX305 00555 W-X306-EXP-CNT. DTSBX305 00556 DTSBX305 00557 DISPLAY ' '. DTSBX305 00558 DTSBX305 00559 DISPLAY 'MRFD RECORD UPDATED: ' DTSBX305 00560 W-MRFD-UPD-CNT. DTSBX305 00561 DTSBX305 00562 DISPLAY ' '. DTSBX305 00563 DTSBX305 00564 IF W-MRFD-UPD-CNT > 0 DTSBX305 00565 REWRITE X305-WEB-PARM-REC FROM W-X305-REC DTSBX305 00566 IF NOT X305-PARM-STATUS-OK-88 DTSBX305 00567 DISPLAY 'CANNOT REWRITE X305-PARM-FILE ' DTSBX305 00568 X305-PARM-STATUS DTSBX305 00569 SET W-ERROR-YES-88 TO TRUE DTSBX305 00570 ELSE DTSBX305 00571 DISPLAY '!!!!!!!! X305 PARM RECORD UPDATED ' DTSBX305 00572 ELSE DTSBX305 00573 DISPLAY '!! NO NEW RECORDS ON CFO (SOAR) FTP FILE' DTSBX305 00574 END-IF. DTSBX305 00575 DTSBX305 00576 DISPLAY '***************************************'. DTSBX305 00577 DTSBX305 00578 CLOSE X305-IMP-FILE DTSBX305 00579 X305-PARM-FILE DTSBX305 00580 X306-EXP-FILE. DTSBX305 00581 DTSBX305 00582 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX305 00583 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX305 00584 DTSBX305 00585 T0000-EXIT. DTSBX305 00586 EXIT. DTSBX305 00587 DTSBX305 00588 S001-FROM-FED-8. DTSBX305 00589 SET L001-FROM-FED-8 TO TRUE. DTSBX305 00590 GO TO S001-DATE. DTSBX305 00591 DTSBX305 00592 S001-FROM-CAL-8. DTSBX305 00593 SET L001-FROM-CAL-8 TO TRUE. DTSBX305 00594 GO TO S001-DATE. DTSBX305 00595 DTSBX305 00596 S001-FROM-ABS-DAY. DTSBX305 00597 SET L001-FROM-ABS-DAY TO TRUE. DTSBX305 00598 GO TO S001-DATE. DTSBX305 00599 DTSBX305 00600 S001-DATE. DTSBX305 00601 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX305 00602 S001-EXIT. DTSBX305 00603 EXIT. DTSBX305 00604 DTSBX305 00605 S003-AGENCY-DAY. DTSBX305 00606 SET L003-AGENCY-DAY TO TRUE. DTSBX305 00607 GO TO S003-WORK-DAY. DTSBX305 00608 DTSBX305 00609 S003-WORK-DAY. DTSBX305 00610 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX305 00611 S003-EXIT. DTSBX305 00612 EXIT. DTSBX305 00613 DTSBX305 00614 S004-FROM-5. DTSBX305 00615 SET L004-FROM-5 TO TRUE. DTSBX305 00616 GO TO S004-YRQ. DTSBX305 00617 DTSBX305 00618 S004-FROM-DATE. DTSBX305 00619 SET L004-FROM-DATE TO TRUE. DTSBX305 00620 GO TO S004-YRQ. DTSBX305 00621 DTSBX305 00622 S004-FROM-ABS. DTSBX305 00623 SET L004-FROM-ABS TO TRUE. DTSBX305 00624 GO TO S004-YRQ. DTSBX305 00625 DTSBX305 00626 S004-YRQ. DTSBX305 00627 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX305 00628 DTSBX305 00629 S004-EXIT. DTSBX305 00630 EXIT. DTSBX305 00631 DTSBX305 00632 S005-FROM-SYS. DTSBX305 00633 SET L005-FROM-SYS TO TRUE. DTSBX305 00634 GO TO S005-ABSTIME. DTSBX305 00635 DTSBX305 00636 S005-FROM-ABS. DTSBX305 00637 SET L005-FROM-ABSTIME TO TRUE. DTSBX305 00638 GO TO S005-ABSTIME. DTSBX305 00639 DTSBX305 00640 S005-ABSTIME. DTSBX305 00641 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX305 00642 S005-EXIT. DTSBX305 00643 EXIT. DTSBX305 00644 DTSBX305 00645 DTSBX305 00646 S910-OPEN-UPDATE. DTSBX305 00647 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX305 00648 GO TO S910-MSTR-IO. DTSBX305 00649 DTSBX305 00650 S910-OPEN-READ. DTSBX305 00651 SET L910-OPEN-READ-88 TO TRUE. DTSBX305 00652 GO TO S910-MSTR-IO. DTSBX305 00653 DTSBX305 00654 S910-READ. DTSBX305 00655 SET L910-READ-88 TO TRUE. DTSBX305 00656 GO TO S910-MSTR-IO. DTSBX305 00657 DTSBX305 00658 S910-START-BROWSE. DTSBX305 00659 SET L910-START-BROWSE-88 TO TRUE. DTSBX305 00660 GO TO S910-MSTR-IO. DTSBX305 00661 DTSBX305 00662 S910-READ-NEXT. DTSBX305 00663 SET L910-READ-NEXT-88 TO TRUE. DTSBX305 00664 GO TO S910-MSTR-IO. DTSBX305 00665 DTSBX305 00666 S910-WRITE. DTSBX305 00667 SET L910-WRITE-88 TO TRUE. DTSBX305 00668 GO TO S910-MSTR-IO. DTSBX305 00669 DTSBX305 00670 S910-REWRITE. DTSBX305 00671 SET L910-REWRITE-88 TO TRUE. DTSBX305 00672 GO TO S910-MSTR-IO. DTSBX305 00673 DTSBX305 00674 S910-CLOSE. DTSBX305 00675 SET L910-CLOSE-88 TO TRUE. DTSBX305 00676 GO TO S910-MSTR-IO. DTSBX305 00677 DTSBX305 00678 S910-MSTR-IO. DTSBX305 00679 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX305 00680 MSKL-REC. DTSBX305 00681 S910-EXIT. DTSBX305 00682 EXIT. DTSBX305 00683 DTSBX305 00684 S921-OPEN-READ. DTSBX305 00685 SET L921-OPEN-READ-88 TO TRUE. DTSBX305 00686 GO TO S921-AIX-IO. DTSBX305 00687 DTSBX305 00688 S921-READ. DTSBX305 00689 SET L921-READ-88 TO TRUE. DTSBX305 00690 GO TO S921-AIX-IO. DTSBX305 00691 DTSBX305 00692 S921-START-BROWSE. DTSBX305 00693 SET L921-START-BROWSE-88 TO TRUE. DTSBX305 00694 GO TO S921-AIX-IO. DTSBX305 00695 DTSBX305 00696 S921-READ-NEXT. DTSBX305 00697 SET L921-READ-NEXT-88 TO TRUE. DTSBX305 00698 GO TO S921-AIX-IO. DTSBX305 00699 DTSBX305 00700 S921-CLOSE. DTSBX305 00701 SET L921-CLOSE-88 TO TRUE. DTSBX305 00702 GO TO S921-AIX-IO. DTSBX305 00703 DTSBX305 00704 S921-AIX-IO. DTSBX305 00705 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX305 00706 ISKL-REC. DTSBX305 00707 S921-EXIT. DTSBX305 00708 EXIT. DTSBX305 00709 DTSBX305 00710 S931-OPEN-READ. DTSBX305 00711 SET L931-OPEN-READ-88 TO TRUE. DTSBX305 00712 GO TO S931-REF-IO. DTSBX305 00713 DTSBX305 00714 S931-CLOSE. DTSBX305 00715 SET L931-CLOSE-88 TO TRUE. DTSBX305 00716 GO TO S931-REF-IO. DTSBX305 00717 DTSBX305 00718 S931-REF-IO. DTSBX305 00719 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX305 00720 FSKL-REC. DTSBX305 00721 S931-EXIT. DTSBX305 00722 EXIT. DTSBX305 00723 DTSBX305 00724 S1000-READ-X305-IMP. DTSBX305 00725 READ X305-IMP-FILE INTO W-X305-REC. DTSBX305 00726 IF X305-IMP-STATUS-OK-88 DTSBX305 00727 ADD +1 TO W-X305-IMP-CNT DTSBX305 00728 ELSE DTSBX305 00729 IF X305-IMP-STATUS-EOF-88 DTSBX305 00730 NEXT SENTENCE DTSBX305 00731 ELSE DTSBX305 00732 DISPLAY 'CANNOT READ X305-IMP-FILE ' DTSBX305 00733 X305-IMP-STATUS DTSBX305 00734 SET W-ERROR-YES-88 TO TRUE DTSBX305 00735 END-IF DTSBX305 00736 END-IF. DTSBX305 00737 DTSBX305 00738 S1000-EXIT. DTSBX305 00739 EXIT. DTSBX305 00740 DTSBX305 00741 S1100-READ-X305-PARM. DTSBX305 00742 READ X305-PARM-FILE INTO W-X305-REC. DTSBX305 00743 IF X305-PARM-STATUS-OK-88 DTSBX305 00744 MOVE X305-APPROVAL-DATE TO W-X305-PARM-DATE DTSBX305 00745 ELSE DTSBX305 00746 DISPLAY 'CANNOT READ X305-PARM-FILE ' DTSBX305 00747 X305-PARM-STATUS DTSBX305 00748 SET W-ERROR-YES-88 TO TRUE DTSBX305 00749 END-IF. DTSBX305 00750 DTSBX305 00751 S1100-EXIT. DTSBX305 00752 EXIT. DTSBX305 00753 DTSBX305 00754 S999-ABEND. DTSBX305 00755 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX305 00756 S999-EXIT. DTSBX305 00757 EXIT. DTSBX305 00758 DTSBX305