172 lines
14 KiB
COBOL
172 lines
14 KiB
COBOL
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
|