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

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!