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