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