760 lines
60 KiB
COBOL
760 lines
60 KiB
COBOL
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
|