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