fork download 
  1.  
  2.       *-----------------------------------------------------------------
  3.        IDENTIFICATION DIVISION.                                         
  4.       *-----------------------------------------------------------------
  5.        PROGRAM-ID.      AULACOBOL.                                       
  6.        AUTHOR.          GRUPO2.                                                                                               
  7.       *-----------------------------------------------------------------
  8.        ENVIRONMENT DIVISION.                                            
  9.       *-----------------------------------------------------------------
  10.  
  11.       *-----------------------------------------------------------------
  12.        CONFIGURATION SECTION.                                           
  13.       *-----------------------------------------------------------------
  14.        SPECIAL-NAMES.                                                   
  15.                         DECIMAL-POINT IS COMMA.                         
  16.  
  17.       *-----------------------------------------------------------------
  18.        INPUT-OUTPUT SECTION.                                            
  19.       *-----------------------------------------------------------------
  20.        FILE-CONTROL.                                                    
  21.  
  22.            SELECT REGISTRO-MOVIMENTO ASSIGN TO REGISTRO-MOVIMENTO                             
  23.                   FILE STATUS IS WS-REG-MOVIMENTO.                         
  24.            SELECT REGISTRO-FUNCIONARIO ASSIGN TO REGISTRO-FUNCIONARIO                             
  25.                   FILE STATUS IS WS-REG-FUNCIONARIO.                         
  26.            SELECT SAIFUNC TO SAIFUNC                             
  27.                   FILE STATUS IS WS-SAIDA.                         
  28.  
  29.       *-----------------------------------------------------------------
  30.        DATA DIVISION.                                                   
  31.       *-----------------------------------------------------------------
  32.  
  33.       *-----------------------------------------------------------------
  34.        FILE SECTION.                                                    
  35.       *-----------------------------------------------------------------
  36.  
  37.        FD  REGISTRO-MOVIMENTO                                                      
  38.            BLOCK CONTAINS 0 RECORDS                                     
  39.            RECORDING MODE IS F                                          
  40.            RECORD CONTAINS 060 CHARACTERS.                              
  41.  
  42.        01  REG-MOVIMENTO.                                                 
  43.            03  REGMOVI-MATRICULA         PIC 9(010).                    
  44.            03  REGMOVI-NOME              PIC X(050).                    
  45.  
  46.        FD  REGISTRO-FUNCIONARIO                                                      
  47.            BLOCK CONTAINS 0 RECORDS                                     
  48.            RECORDING MODE IS F                                          
  49.            RECORD CONTAINS 120 CHARACTERS.                              
  50.  
  51.        01  REG-FUNCIONARIO.                                                 
  52.            03  REGFUNC-MATRICULA         PIC 9(010).                    
  53.            03  REGFUNC-TPREGISTRO        PIC X(001).                    
  54.            03  REGFUNC-CSR               PIC X(005).                    
  55.            03  REGFUNC-DESP              PIC 9(010).                                       
  56.  
  57.        FD  SAIFUNC                                                      
  58.            BLOCK CONTAINS 0 RECORDS                                     
  59.            RECORDING MODE IS F                                          
  60.            RECORD CONTAINS 170 CHARACTERS.                              
  61.  
  62.        01  REG-SAIFUNC.                                                 
  63.            03  SAIFUNC-MATRICULA         PIC 9(010).                    
  64.            03  SAIFUNC-NOME              PIC X(050).                    
  65.            03  SAIFUNC-TPREGISTRO        PIC 9(001).                    
  66.            03  SAIFUNC-CSR               PIC X(005).                    
  67.            03  SAIFUNC-DESP              PIC X(010).  
  68.  
  69.  
  70.       *-----------------------------------------------------------------
  71.        WORKING-STORAGE SECTION.                                         
  72.       *-----------------------------------------------------------------
  73.  
  74.        01  WS-AREA-AUXILIAR.                                            
  75.            05  WS-COD-PROGRAMA           PIC X(008)  VALUE 'PROGRAMA COBOL'.  
  76.            05  WS-COD-VER                PIC X(008)  VALUE '001/2012'.  
  77.            05  WS-REG-MOVIMENTO          PIC X(002)  VALUE SPACES.      
  78.            05  WS-REG-FUNCIONARIO        PIC X(002)  VALUE SPACES.      
  79.            05  WS-FS-SAIFUNC             PIC X(002)  VALUE SPACES.      
  80.            05  WS-LIDOS-MOV              PIC 9(010)  VALUE ZEROES.      
  81.            05  WS-LIDOS-FUN2             PIC 9(010)  VALUE ZEROES.      
  82.            05  WS-GRAVA-FUNC             PIC 9(010)  VALUE ZEROES.      
  83.            05  WS-MENSAGEM               PIC X(070)  VALUE SPACES.      
  84.            05  WS-PROCESSO               PIC X(070)  VALUE SPACES.           
  85.  
  86.  
  87.       *-----------------------------------------------------------------
  88.        PROCEDURE DIVISION.                                              
  89.       *-----------------------------------------------------------------
  90.  
  91.            PERFORM P0000-INICIAL         THRU P0000-FIM.                
  92.            PERFORM P1000-PRINCIPAL       THRU P1000-FIM.                
  93.            PERFORM P9000-FINAL           THRU P9000-FIM.                
  94.            GOBACK.  
  95.  
  96.       *-----------------------------------------------------------------
  97.        P0000-INICIAL.                                                   
  98.       *-----------------------------------------------------------------
  99.  
  100.            MOVE 'P0000-INICIAL' TO        WS-PROCESSO.                  
  101.  
  102.            OPEN INPUT REGISTRO-MOVIMENTO.                                          
  103.            IF REG-MOVIMENTO NOT EQUAL '00'                              
  104.               MOVE SPACES TO WS-MENSAGEM                                
  105.               STRING 'ERRO ABERTURA ARQUIVO ENTNOME FILE STATUS: '      
  106.                      WS-REG-MOVIMENTO                                      
  107.                      DELIMITED BY SIZE  INTO WS-MENSAGEM                
  108.               END-STRING                                                
  109.               PERFORM P8000-ERRO THRU P8000-FIM                         
  110.            END-IF.                                                      
  111.  
  112.            OPEN INPUT REGISTRO-FUNCIONARIO.                                          
  113.            IF WS-REG-FUNCIONARIO NOT EQUAL '00'                              
  114.               STRING 'ERRO ABERTURA ARQUIVO ENTENDE FILE STATUS: '      
  115.                      WS-REG-FUNCIONARIO                                      
  116.                      DELIMITED BY SIZE  INTO WS-MENSAGEM                
  117.               END-STRING                                                
  118.               PERFORM P8000-ERRO THRU P8000-FIM                         
  119.            END-IF.                                                      
  120.  
  121.            OPEN OUTPUT SAIFUNC.                                         
  122.            IF WS-FS-SAIFUNC NOT EQUAL '00'                              
  123.               STRING 'ERRO ABERTURA ARQUIVO SAIFUNC FILE STATUS: '      
  124.                      WS-FS-SAIFUNC                                      
  125.                      DELIMITED BY SIZE  INTO WS-MENSAGEM                
  126.               END-STRING                                                
  127.               PERFORM P8000-ERRO THRU P8000-FIM                         
  128.            END-IF.                                                      
  129.  
  130.         P0000-FIM.                                                      
  131.             EXIT.          
  132.  
  133.  
  134.       *-----------------------------------------------------------------
  135.        P1000-PRINCIPAL.                                                 
  136.       *-----------------------------------------------------------------
  137.  
  138.            MOVE 'P1000-PRINCIPAL      ' TO  WS-PROCESSO.                
  139.  
  140.            PERFORM P2000-LER-REGMOVI THRU P2000-FIM                     
  141.            PERFORM P3000-LER-REGMOVI THRU P3000-FIM                     
  142.            PERFORM UNTIL WS-REG-MOVIMENTO EQUAL '10'                       
  143.                      AND WS-REG-FUNCIONARIO EQUAL '10'                       
  144.               EVALUATE TRUE                                             
  145.                  WHEN REGMOVI-MATRICULA EQUAL        REGFUNC-MATRICULA  
  146.                       PERFORM P4000-GRAVA-SAIFUNC THRU P4000-FIM        
  147.                       PERFORM P2000-LER-REGMOVI   THRU P2000-FIM        
  148.                       PERFORM P3000-LER-REGFUNC   THRU P3000-FIM        
  149.                  WHEN REGMOVI-MATRICULA LESS THAN    REGFUNC-MATRICULA  
  150.                       PERFORM P2000-LER-REGMOVI   THRU P2000-FIM        
  151.                  WHEN REGMOVI-MATRICULA GREATER THAN REGFUNC-MATRICULA  
  152.                       PERFORM P3000-LER-REGFUNC   THRU P3000-FIM        
  153.               END-EVALUATE                                              
  154.            END-PERFORM.                                                 
  155.  
  156.        P1000-FIM.                                                       
  157.            EXIT.  
  158.  
  159.       *-----------------------------------------------------------------
  160.        P2000-LER-REGMOVI.                                               
  161.       *-----------------------------------------------------------------
  162.  
  163.            MOVE 'P2000-LER-REGMOVI' TO WS-PROCESSO                      
  164.            READ REG-MOVIMENTO                                                 
  165.                 AT END                                                  
  166.                 MOVE '10'       TO WS-REG-MOVIMENTO                        
  167.                 MOVE 9999999999 TO REGMOVI-MATRICULA                    
  168.                 NOT AT END                                              
  169.                 IF WS-REG-MOVIMENTO NOT EQUAL '00' AND '10'                
  170.                    MOVE SPACES TO WS-MENSAGEM                           
  171.                    STRING 'ERRO LEITURA ARQUIVO ENTNOME FILE STATUS: '  
  172.                            WS-REG-MOVIMENTO                                
  173.                            DELIMITED BY SIZE  INTO WS-MENSAGEM          
  174.                    END-STRING                                           
  175.                    PERFORM P8000-ERRO THRU P8000-FIM                    
  176.                 END-IF                                                  
  177.                 IF WS-REG-MOVIMENTO EQUAL '00'                             
  178.                    ADD 1 TO WS-LIDOS-NOME                               
  179.                 END-IF                                                  
  180.            END-READ.                                                    
  181.  
  182.        P2000-FIM.                                                       
  183.            EXIT.   
  184.  
  185.  
  186.       *-----------------------------------------------------------------
  187.        P3000-LER-REGFUNC.                                               
  188.       *-----------------------------------------------------------------
  189.  
  190.            MOVE 'P3000-LER-REGFUNC' TO WS-PROCESSO                      
  191.            READ REG-FUNCIONARIO                                                 
  192.                 AT END                                                  
  193.                 MOVE '10'       TO WS-REG-FUNCIONARIO                        
  194.                 MOVE 9999999999 TO REGFUNC-MATRICULA                    
  195.                 NOT AT END                                              
  196.                 IF WS-REG-FUNCIONARIO NOT EQUAL '00' AND '10'                
  197.                    MOVE SPACES TO WS-MENSAGEM                           
  198.                    STRING 'ERRO LEITURA ARQUIVO ENTENDE FILE STATUS: '  
  199.                            WS-REG-FUNCIONARIO                                
  200.                            DELIMITED BY SIZE  INTO WS-MENSAGEM          
  201.                    END-STRING                                           
  202.                    PERFORM P8000-ERRO THRU P8000-FIM                    
  203.                 END-IF                                                  
  204.                 IF WS-REG-FUNCIONARIO EQUAL '00'                             
  205.                    ADD 1 TO WS-LIDOS-FUN2                               
  206.                 END-IF                                                  
  207.            END-READ.                                                    
  208.  
  209.        P3000-FIM.                                                       
  210.            EXIT.  
  211.  
  212.       *-----------------------------------------------------------------
  213.        P4000-GRAVA-SAIFUNC.                                             
  214.       *-----------------------------------------------------------------
  215.  
  216.            MOVE 'P4000-GRAVA-SAIFUNC' TO WS-PROCESSO                    
  217.            INITIALIZE REG-SAIFUNC                                       
  218.                       REPLACING ALPHANUMERIC BY SPACES                  
  219.                                      NUMERIC BY ZEROES                  
  220.  
  221.            MOVE REGFUNC-MATRICULA  TO SAIFUNC-MATRICULA                  
  222.            MOVE REGFUNC-TPREGISTRO TO SAIFUNC-TPREGISTRO                   
  223.            MOVE REGFUNC-CSR        TO SAIFUNC-CSR                    
  224.            MOVE REGFUNC-DESP       TO SAIFUNC-DESP                                              
  225.            MOVE REGMOVI-NOME       TO SAIFUNC-NOME                       
  226.            WRITE REG-SAIFUNC         END-WRITE                          
  227.  
  228.            IF WS-FS-SAIFUNC NOT EQUAL '00'                              
  229.               MOVE SPACES TO WS-MENSAGEM                                
  230.               STRING 'ERRO GRAVACAO ARQUIVO SAIFUNC FILE STATUS: '      
  231.                       WS-FS-SAIFUNC                                     
  232.                       DELIMITED BY SIZE  INTO WS-MENSAGEM               
  233.               END-STRING                                                
  234.               PERFORM P8000-ERRO THRU P8000-FIM                         
  235.            END-IF                                                       
  236.  
  237.            ADD 1 TO WS-GRAVA-FUNC.                                      
  238.  
  239.        P4000-FIM.                                                       
  240.            EXIT.  
  241.  
  242.       *-----------------------------------------------------------------
  243.        P9000-FINAL.                                                     
  244.       *-----------------------------------------------------------------
  245.  
  246.            DISPLAY '---------------------------------------------'      
  247.            DISPLAY 'PROGRAMA AULACOBOL - TERMINO OK'                     
  248.            DISPLAY '                                             '      
  249.            DISPLAY 'TOTAL DE LIDOS MOVIMENTOS  -  ' WS-LIDOS-MOVI           
  250.            DISPLAY 'TOTAL DE LIDOS FUNCIONARIOS - ' WS-LIDOS-FUN2           
  251.            DISPLAY 'TOTAL GRAVADOS ........ -   ' WS-GRAVA-FUNC.          
  252.  
  253.        P9000-FIM.                                                       
  254.            EXIT.
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin 
Standard input is empty
compilation info 
prog.cob:253: Warning: File not terminated by a newline
prog.cob:26: Error: syntax error, unexpected TO, expecting SEQUENCE
stdout 
Standard output is empty
https://ideone.com/F76AY
language:
Cobol (gnucobol 2.2.0)
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!