language: COBOL 85 (tinycobol-0.65.9)
date: 128 days 2 hours ago
link:
可見度: public
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
***************************** Top of Data ****************************
 IDENTIFICATION DIVISION.                                             
*-------------------------------------------------------------        
 PROGRAM-ID. SLSRPT02.                                                
 AUTHOR. SHANTONOB.                                                   
 DATE-WRITTEN.  13-01-2012.                                           
*                                                                     
*                                                                     
******************************************************************    
*                      PROGRAM DESCRIPTION                       *    
******************************************************************    
*                                                                *    
*  PROGRAM NAME   : INSERT TRANSACTION                           *    
*                                                                *    
*  APPLICATION    : INSERT MODULE IN LIBRARY MGMT SYSTEM         *    
*                                                                *    
*                                                                *    
******************************************************************    
*                      ENVIRONMENT DIVISION                      *    
******************************************************************    
*                                                                *    
 ENVIRONMENT DIVISION.                                                
 INPUT-OUTPUT SECTION.                                                
 FILE-CONTROL.                                                        
******************************************************************    
*              DECLARATION OF INSERT TRANSACTION FILE            *    
******************************************************************    
                   
******************************************************************     
*                      DATA DIVISION                             *     
******************************************************************     
*                                                                      
 DATA DIVISION.                                                        
 FILE SECTION.                                                         
******************************************************************     
*                  FILE LAYOUT FOR INSERT TRANSACTION            *     
******************************************************************     
 FD SALES-IN.                                                          
   01 INCONTENT.                                                       
      05  SLS-NUM                PIC 9(5).                             
      05  FILLER                 PIC X(1).                             
      05  SLS-DATE               PIC X(8).                             
      05  FILLER                 PIC X(1).                             
      05  DRUG-CODE              PIC 9(4).                             
      05  FILLER                 PIC X(1).                              
      05  SALS-AMT               PIC 9(5).                         
      05  FILLER                 PIC X(55).                             
*************************************************************           
*                   WORKING STORAGE SECTION                      *      
******************************************************************      
 WORKING-STORAGE SECTION.                                               
*----------------------------------------------------------------*      
*----------------------------------------------------------------*  
  01 INCONTENT1.                                                       
      05  SLS-NUM1                PIC 9(5).                             
      05  FILLER                 PIC X(1).                             
      05  SLS-DATE1               PIC X(8).                             
      05  FILLER                 PIC X(1).                             
      05  DRUG-CODE1              PIC 9(4).                             
      05  FILLER                 PIC X(1).                              
      05  SALS-AMT1               PIC 9(5).                         
      05  FILLER                 PIC X(55).
  01 WS-FLAG PIC 9(1) VALUE 0.       
  01 SYS-DATE PIC 9999/99/99.                                           
  01 SYS-TIME PIC 9(8).                                                 
  01 WS-PGM-NAME PIC X(20) VALUE 'SLSRPT02'.                            
  01 WS-PGM-VER PIC 99V99 VALUE 01.11.                                  
  01 WS-INSERT-FILE-STATUS PIC X(2).                                    
  01 EOF-TRUE PIC 9(1) VALUE 0.                                         
  01 WS-DISP-MES PIC X(25).                                             
  01 WS-ERROR-FLAG         PIC 9(1).                          
  01 WS-VALIDATION-FLAG    PIC 9(1).                          
  01 WS-IO-STATUS PIC X(02).                                  
   88 C-IO-SUCCESS VALUE '00'.                                
   88 C-IO-DUP-OK        VALUE '02'.                          
   88 C-IO-EOF           VALUE '10'.                          
   88 C-IO-DUP-NOT-OK    VALUE '22'.                          
   88 C-IO-NOT-FOUND     VALUE '23'.                          
   88 C-IO-OPEN-OK       VALUE '97'.                          
   88 C-IO-MISMATCH      VALUE '39'.                          
   88 C-IO-IO-MODE       VALUE '47'.                          
   01 WS-INCONTENT.                                           
       05  WS-SLS-NUM                PIC 9(5).                
       05  FILLER                 PIC X(1).                   
       05  WS-SLS-DATE               PIC X(8).                
       05  FILLER                 PIC X(1).                   
       05  WS-DRUG-CODE              PIC 9(4).                   
       05  FILLER                 PIC X(1).                      
       05  WS-SALS-AMT               PIC X(5).                   
       05  FILLER                 PIC X(55).                    
*----------------------------------------------------------------
   01 ERROR-MESSAGES.                                            
       05 ERROR-MESSAGE-LENGTH  PIC S9(4) COMP VALUE +800.       
       05 ERROR-MESSAGE-LINE    PIC X(80) OCCURS 10 TIMES        
                                   INDEXED BY EML-INDEX.         
   01 ERROR-LINE-LENGTH        PIC S9(9) COMP VALUE +80.         
*----------------------------------------------------------------
   01 ERROR-MESSAGE.                                             
       05 FILLER           PIC  X(09) VALUE 'ERR FILE-'.         
       05 ERR-FILE-NAME    PIC  X(15).                           
       05 FILLER           PIC  X(11) VALUE 'ERR ACTION-'.       
       05 ERR-FILE-ACTION  PIC  X(10).                           
       05 FILLER           PIC  X(11) VALUE 'ERR STATUS-'.           
       05 ERR-FILE-STATUS  PIC  X(02).                               
******************************************************************   
*       WORKING STORAGE INCLUDE FOR SQL COMMUNICATION AREA       *   
******************************************************************   
******************************************************************   
*                      PROCEDURE SECTION                         *   
******************************************************************   
 PROCEDURE DIVISION.                                                 
 MAIN-PARA.                                                          
      PERFORM OPEN-PARA THRU OPEN-PARA-EXIT                          
      PERFORM PROCESS-PARA THRU PROCESS-PARA-EXIT                    
      UNTIL EOF-TRUE = 1                                             
      PERFORM CLOSE-FILE-PARA THRU CLOSE-FILE-EXIT                   
      STOP RUN.                                                      
*                      OPENING THE INPUT INSERT FILE             *  
******************************************************************  
  OPEN-PARA.                                                         
       OPEN INPUT SALES-IN                                           
       MOVE WS-INSERT-FILE-STATUS TO WS-IO-STATUS                    
       PERFORM FILE-STATUS-CHECK                                     
               THRU FILE-STATUS-CHECK-EXIT                           
       IF WS-ERROR-FLAG = 1                                          
       MOVE 'INSERT1-INPUT' TO ERR-FILE-NAME                         
       MOVE 'OPEN' TO ERR-FILE-ACTION                                
       MOVE WS-IO-STATUS TO ERR-FILE-STATUS                          
       PERFORM ABEND-PARA THRU ABEND-PARA-EXIT                       
       END-IF.                                                       
*------------------------------------------------------------*      
  OPEN-PARA-EXIT.                                                    
       EXIT.                                                         
*----------------------------------------------------------------*      
******************************************************************      
*                 WRITTING MESSAGE FOR ERROR                     *      
******************************************************************      
  ABEND-PARA.                                                            
       DISPLAY ERROR-MESSAGE.                                            
       STOP RUN.                                                         
                                                                         
*----------------------------------------------------------------*      
  ABEND-PARA-EXIT.                                                       
       EXIT.                                                             
 
 
 
*----------------------------------------------------------------*      
******************************************************************      
*                READING THE INPUT-INSERT FILE                   *      
******************************************************************      
  PROCESS-PARA.                                                          
    READ SALES-IN AT END MOVE 1 TO EOF-TRUE                      
    END-READ
    IF WS-FLAG = 0
    MOVE DRUG-CODE TO DRUG-CODE1
        END-IF                                       
    PERFORM FILE-STATUS-CHECK                                    
         THRU FILE-STATUS-CHECK-EXIT                             
    IF WS-ERROR-FLAG = 1                                         
    MOVE 'INSERT1-INPUT' TO ERR-FILE-NAME                        
    MOVE 'READ' TO ERR-FILE-ACTION                               
    MOVE WS-IO-STATUS TO ERR-FILE-STATUS                         
    PERFORM ABEND-PARA THRU ABEND-PARA-EXIT                      
    END-IF                                                      
                                                                 
    IF EOF-TRUE = 0                                              
         PERFORM VALIDATION-PARA THRU VALIDATION-PARA-EXIT       
    END-IF
 
    IF WS-VALIDATION-FLAG = 1
    PERFORM ABEND-PARA THRU ABEND-PARA-EXIT
    ELSE
    PERFORM SUM-PARA THRU SUM-PARA-EXIT.
  PROCESS-PARA-EXIT.                                                 
       EXIT.            
                                                 
*                DISPLAYING THE FILE CONTENTS IN SPOOL           *  
******************************************************************  
                                           
*----------------------------------------------------------------*  
                                               
*----------------------------------------------------------------*  
******************************************************************
  SUM-PARA.
    IF DRUG-CODE = DRUG-CODE1
    MOVE 1 TO WS-FLAG
    MOVE SLS-NUM TO SLS-NUM1
    MOVE SLS-DATE TO SLS-DATE1
    ADD SALS-AMT TO SALS-AMT1 GIVING SALS-AMT1
    ELSE
    MOVE 0 TO WS-FLAG
    DISPLAY INCONTENT1
    MOVE DRUG-CODE TO DRUG-CODE1
    MOVE 0 TO SALS-AMT1
    PERFORM SUM-PARA THRU SUM-PARA-EXIT UNTIL WS-FLAG = 1
    END-IF.
  SUM-PARA-EXIT.
    EXIT.
 
                                                 
  
*                    VALIDATION CHECK                            *  
******************************************************************  
  VALIDATION-PARA.                                                   
                                                                     
       IF SLS-NUM NOT = SPACES                                       
            MOVE SLS-NUM TO WS-SLS-NUM                               
       ELSE                                                          
            MOVE 1 TO WS-VALIDATION-FLAG                             
           DISPLAY 'ERROR IN SERIAL NUMBER'                             
      END-IF                                                            
                                                                        
      IF DRUG-CODE NOT = SPACES                                         
           MOVE DRUG-CODE  TO WS-DRUG-CODE                              
      ELSE                                                              
           MOVE 1 TO WS-VALIDATION-FLAG                                 
           DISPLAY 'ERROR IN DRUG CODE'                                 
      END-IF.                                                           
*----------------------------------------------------------------*      
 VALIDATION-PARA-EXIT.                                                  
      EXIT.                                                             
******************************************************************      
*                       CLOSE FILES PARA                        *       
******************************************************************      
 CLOSE-FILE-PARA.                                                       
      CLOSE SALES-IN.                                               
      PERFORM FILE-STATUS-CHECK                                     
              THRU FILE-STATUS-CHECK-EXIT                           
      IF WS-ERROR-FLAG = 1                                          
      MOVE 'INSERT1-INPUT' TO ERR-FILE-NAME                         
      MOVE 'CLOSE' TO ERR-FILE-ACTION                               
           MOVE WS-IO-STATUS TO ERR-FILE-STATUS                     
      PERFORM ABEND-PARA THRU ABEND-PARA-EXIT                       
      END-IF.                                                       
*----------------------------------------------------------------*  
 CLOSE-FILE-EXIT.                                                   
      EXIT.                                                         
******************************************************************  
*                       FILE STATUS CHECK                        *  
******************************************************************  
*    PARA TO CHECK THE FILE STATUS AFTER THE FOLLOWING           *  
*        1. FILE OPENING              2.FILE READING             *   
*        3. FILE WRITING              4.FILE CLOSING             *   
*                                                                *   
******************************************************************   
 FILE-STATUS-CHECK.                                                  
      EVALUATE TRUE                                                  
        WHEN C-IO-EOF                                                
          MOVE 0  TO WS-ERROR-FLAG                                   
        WHEN C-IO-DUP-NOT-OK                                         
          MOVE 1  TO WS-ERROR-FLAG                                   
        WHEN C-IO-NOT-FOUND                                          
          MOVE 1  TO WS-ERROR-FLAG                                   
        WHEN C-IO-SUCCESS                                            
          MOVE 0  TO WS-ERROR-FLAG                                   
        WHEN C-IO-DUP-OK                                             
          MOVE 0  TO WS-ERROR-FLAG                                   
 
        WHEN C-IO-OPEN-OK                                            
          MOVE 0  TO WS-ERROR-FLAG                                   
        WHEN C-IO-MISMATCH                                           
          MOVE 1  TO WS-ERROR-FLAG                                   
        WHEN C-IO-IO-MODE                                            
          MOVE 1  TO WS-ERROR-FLAG                                   
        WHEN OTHER                                                   
          MOVE 1  TO WS-ERROR-FLAG                                   
      END-EVALUATE.                                                  
*----------------------------------------------------------------*   
 FILE-STATUS-CHECK-EXIT.                                             
      EXIT.                                                          
*----------------------------------------------------------------*   
prog.cbl:    38: error: undefined SALES-IN at FD/SD, on or before 'SALES-IN'
/spoj/tinycobol_compile: line 10:  1847 Segmentation fault      htcobol -o prog prog.cbl