00001 IDENTIFICATION DIVISION. 07/08/08 00002 PROGRAM-ID. DTSBU192. DTSBU192 00003 AUTHOR. TDI OUTSOURCES LV001 00004 DATE-WRITTEN. JUNE 2008 DTSBU192 00005 DATE-COMPILED. DTSBU192 00006 DTSBU192 00007 ***** DTSBU192 00008 * DTSBU192 00009 * FUNCTION: PROGRAM WILL ISSUES A RETURN CODE OF +1, DTSBU192 00010 * IF THE INPUT FILE IS EMPTY. DTSBU192 00011 * DTSBU192 00012 * MODIFICATION LOG: DTSBU192 00013 * DTSBU192 00014 * 06/24/2008 INITIAL DEVELOPMENT DTSBU192 00015 * REFERENCE: PROGRAMMER: RW1 DTSBU192 00016 * DTSBU192 00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU192 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU192 00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU192 00020 * DTSBU192 00021 * DTSBU192 00022 * DESCRIPTION: DTSBU192 00023 * DTSBU192 00024 * DTSBU192 READS INPUT REFUND FILE AND COPY TO PROD DTSBU192 00025 * OUTPUT FILE FOR PROCESSING. DTSBU192 00026 * DTSBU192 00027 * DTSBU192 00028 ***** DTSBU192 00029 DTSBU192 00030 ENVIRONMENT DIVISION. DTSBU192 00031 DTSBU192 00032 INPUT-OUTPUT SECTION. DTSBU192 00033 DTSBU192 00034 FILE-CONTROL. DTSBU192 00035 DTSBU192 00036 SELECT REFUND-IN ASSIGN TO RFUNDINP DTSBU192 00037 FILE STATUS IS RFUND-IN-STATUS. DTSBU192 00038 DTSBU192 00039 DATA DIVISION. DTSBU192 00040 DTSBU192 00041 FILE SECTION. DTSBU192 00042 DTSBU192 00043 FD REFUND-IN DTSBU192 00044 RECORDING MODE IS F DTSBU192 00045 BLOCK CONTAINS 0 RECORDS. DTSBU192 00046 DTSBU192 00047 01 REFUND-IN-REC PIC X(750). DTSBU192 00048 DTSBU192 00049 WORKING-STORAGE SECTION. DTSBU192 000495 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU192 07/08/08'. DTSBU192 00050 DTSBU192 00051 01 WRK-AREA. DTSBU192 00052 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +192. DTSBU192 00053 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU192'. DTSBU192 00054 DTSBU192 00055 05 WRK-RETURN-CODE PIC S9(04) COMP VALUE +0. DTSBU192 00056 05 INPUT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU192 00057 05 OUTPUT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU192 00058 DTSBU192 00059 05 RFUND-IN-STATUS PIC X(02). DTSBU192 00060 88 RFUND-IN-OK-88 VALUE '00'. DTSBU192 00061 88 RFUND-IN-EOF-88 VALUE '10'. DTSBU192 00062 DTSBU192 00063 05 RFUND-OUT-STATUS PIC X(02). DTSBU192 00064 88 RFUND-OUT-OK-88 VALUE '00'. DTSBU192 00065 DTSBU192 00066 05 WRK-INPUT-FILE-TYPE PIC X(04). DTSBU192 00067 88 WRK-INPUT-FILE-RFND-88 VALUE 'RFND'. DTSBU192 00068 DTSBU192 00069 05 WRK-RETURN-CD-IND PIC X(01). DTSBU192 00070 88 WRK-RETURN-CD-YES-88 VALUE 'Y'. DTSBU192 00071 88 WRK-RETURN-CD-NO-88 VALUE 'N'. DTSBU192 00072 DTSBU192 00073 PROCEDURE DIVISION. DTSBU192 00074 DTSBU192 00075 DESBU190-MAINLINE. DTSBU192 00076 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBU192 00077 DTSBU192 00078 PERFORM P0000-COPY-DATA THRU P0000-EXIT. DTSBU192 00079 DTSBU192 00080 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBU192 00081 DTSBU192 00082 MOVE WRK-RETURN-CODE TO RETURN-CODE. DTSBU192 00083 DTSBU192 00084 DISPLAY 'DTSBU192 RETURN CODE ' RETURN-CODE. DTSBU192 00085 DTSBU192 00086 DESBU190-MAINLINE-EXIT. DTSBU192 00087 GOBACK. DTSBU192 00088 DTSBU192 00089 I0000-INITIATE. DTSBU192 00090 DTSBU192 00091 MOVE ZEROS TO INPUT-CNT DTSBU192 00092 OUTPUT-CNT. DTSBU192 00093 DTSBU192 00094 PERFORM S2500-OPEN-REFUND-IN THRU S2500-EXIT. DTSBU192 00095 DTSBU192 00096 I0000-EXIT. DTSBU192 00097 EXIT. DTSBU192 00098 DTSBU192 00099 P0000-COPY-DATA. DTSBU192 00100 DTSBU192 00101 PERFORM S2600-READ-REFUND-IN THRU S2600-EXIT. DTSBU192 00102 IF NOT RFUND-IN-OK-88 DTSBU192 00103 DISPLAY '************************************************'DTSBU192 00104 DISPLAY 'INPUT FILE IS EMPTY; PGM ISSUES RETURN CODE OF 1'DTSBU192 00105 DISPLAY 'REFUND FILE STATUS: ' RFUND-IN-STATUS DTSBU192 00106 DISPLAY '************************************************'DTSBU192 00107 SET WRK-RETURN-CD-YES-88 TO TRUE DTSBU192 00108 MOVE +1 TO WRK-RETURN-CODE DTSBU192 00109 GO TO P0000-EXIT DTSBU192 00110 END-IF. DTSBU192 00111 DTSBU192 00112 PERFORM S2700-CLOSE-REFUND-IN THRU S2700-EXIT. DTSBU192 00113 DTSBU192 00114 P0000-EXIT. DTSBU192 00115 EXIT. DTSBU192 00116 DTSBU192 00117 T0000-TERMINATE. DTSBU192 00118 DISPLAY 'DTSBU192 TERMINATION STATISTICS' DTSBU192 00119 DISPLAY SPACE. DTSBU192 00120 DISPLAY ' INPUT RECORDS READ ' INPUT-CNT. DTSBU192 00121 DISPLAY SPACE. DTSBU192 00122 DTSBU192 00123 T0000-EXIT. DTSBU192 00124 EXIT. DTSBU192 00125 EJECT DTSBU192 00126 DTSBU192 00127 S2500-OPEN-REFUND-IN. DTSBU192 00128 OPEN INPUT REFUND-IN. DTSBU192 00129 IF NOT RFUND-IN-OK-88 DTSBU192 00130 DISPLAY 'CANNOT OPEN REFUND INPUT FILE ' DTSBU192 00131 RFUND-IN-STATUS DTSBU192 00132 PERFORM S999-ABEND THRU S999-EXIT DTSBU192 00133 END-IF. DTSBU192 00134 DTSBU192 00135 S2500-EXIT. DTSBU192 00136 EXIT. DTSBU192 00137 DTSBU192 00138 S2600-READ-REFUND-IN. DTSBU192 00139 READ REFUND-IN. DTSBU192 00140 IF RFUND-IN-EOF-88 DTSBU192 00141 GO TO S2600-EXIT DTSBU192 00142 ELSE DTSBU192 00143 IF NOT RFUND-IN-OK-88 DTSBU192 00144 DISPLAY 'REFUND INPUT FILE READ ERROR ' DTSBU192 00145 RFUND-IN-STATUS DTSBU192 00146 PERFORM S999-ABEND THRU S999-EXIT DTSBU192 00147 ELSE DTSBU192 00148 ADD +1 TO INPUT-CNT DTSBU192 00149 END-IF DTSBU192 00150 END-IF. DTSBU192 00151 DTSBU192 00152 S2600-EXIT. DTSBU192 00153 EXIT. DTSBU192 00154 DTSBU192 00155 S2700-CLOSE-REFUND-IN. DTSBU192 00156 CLOSE REFUND-IN. DTSBU192 00157 IF NOT RFUND-IN-OK-88 DTSBU192 00158 DISPLAY 'REFUND INPUT FILE CLOSE ERROR ' DTSBU192 00159 RFUND-IN-STATUS DTSBU192 00160 END-IF. DTSBU192 00161 DTSBU192 00162 S2700-EXIT. DTSBU192 00163 EXIT. DTSBU192 00164 DTSBU192 00165 S999-ABEND. DTSBU192 00166 DISPLAY '*** DTSBU192 ABENDING'. DTSBU192 00167 DTSBU192 00168 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU192 00169 S999-EXIT. DTSBU192 00170 EXIT. DTSBU192