fork download
copy 
  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 ASSIGN 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-DESPCIA           PIC X(010).
  68.            03  SAIFUNC-DESPCIAT          PIC X(010).
  69.            03  SAIFUNC-DESPSUC           PIC X(010).
  70.            03  SAIFUNC-DESPSUCT          PIC X(010).
  71.            03  SAIFUNC-DESPRAM           PIC X(010). 
  72.            03  SAIFUNC-DESPRAMT          PIC X(010). 
  73.  
  74.  
  75.       *-----------------------------------------------------------------
  76.        WORKING-STORAGE SECTION.                                         
  77.       *-----------------------------------------------------------------
  78.  
  79.        01  WS-AREA-AUXILIAR.                                            
  80.            05  WS-COD-PROGRAMA           PIC X(015)  VALUE 'PROGRAMA COBOL'.  
  81.            05  WS-COD-VER                PIC X(008)  VALUE '001/2012'.  
  82.            05  WS-REG-MOVIMENTO          PIC X(002)  VALUE SPACES.      
  83.            05  WS-REG-FUNCIONARIO        PIC X(002)  VALUE SPACES.      
  84.            05  WS-FS-SAIFUNC             PIC X(002)  VALUE SPACES.      
  85.            05  WS-LIDOS-MOV              PIC 9(010)  VALUE ZEROES.      
  86.            05  WS-LIDOS-FUN2             PIC 9(010)  VALUE ZEROES.      
  87.            05  WS-GRAVA-FUNC             PIC 9(010)  VALUE ZEROES.      
  88.            05  WS-MENSAGEM               PIC X(070)  VALUE SPACES.      
  89.            05  WS-PROCESSO               PIC X(070)  VALUE SPACES.           
  90.  
  91.  
  92.       *-----------------------------------------------------------------
  93.        PROCEDURE DIVISION.                                              
  94.       *-----------------------------------------------------------------
  95.  
  96.            PERFORM P0000-INICIAL         THRU P0000-FIM.                
  97.            PERFORM P1000-PRINCIPAL       THRU P1000-FIM.                
  98.            PERFORM P9000-FINAL           THRU P9000-FIM.                
  99.            GOBACK.  
  100.  
  101.       *-----------------------------------------------------------------
  102.        P0000-INICIAL.                                                   
  103.       *-----------------------------------------------------------------
  104.  
  105.            MOVE 'P0000-INICIAL' TO        WS-PROCESSO.                  
  106.  
  107.            OPEN INPUT REGISTRO-MOVIMENTO.                                          
  108.            IF REG-MOVIMENTO NOT EQUAL '00'                              
  109.               MOVE SPACES TO WS-MENSAGEM                                
  110.               STRING 'ERRO ABERTURA ARQUIVO REGMOVI FILE STATUS: '      
  111.                      WS-REG-MOVIMENTO                                      
  112.                      DELIMITED BY SIZE  INTO WS-MENSAGEM                
  113.               END-STRING                                                
  114.               PERFORM P8000-ERRO THRU P8000-FIM                         
  115.            END-IF.                                                      
  116.  
  117.            OPEN INPUT REGISTRO-FUNCIONARIO.                                          
  118.            IF WS-REG-FUNCIONARIO NOT EQUAL '00'                              
  119.               STRING 'ERRO ABERTURA ARQUIVO REGFUNC FILE STATUS: '      
  120.                      WS-REG-FUNCIONARIO                                      
  121.                      DELIMITED BY SIZE  INTO WS-MENSAGEM                
  122.               END-STRING                                                
  123.               PERFORM P8000-ERRO THRU P8000-FIM                         
  124.            END-IF.                                                      
  125.  
  126.            OPEN OUTPUT SAIFUNC.                                         
  127.            IF WS-FS-SAIFUNC NOT EQUAL '00'                              
  128.               STRING 'ERRO ABERTURA ARQUIVO SAIFUNC FILE STATUS: '      
  129.                      WS-FS-SAIFUNC                                      
  130.                      DELIMITED BY SIZE  INTO WS-MENSAGEM                
  131.               END-STRING                                                
  132.               PERFORM P8000-ERRO THRU P8000-FIM                         
  133.            END-IF.                                                      
  134.  
  135.         P0000-FIM.                                                      
  136.             EXIT.          
  137.  
  138.  
  139.       *-----------------------------------------------------------------
  140.        P1000-PRINCIPAL.                                                 
  141.       *-----------------------------------------------------------------
  142.  
  143.            MOVE 'P1000-PRINCIPAL      ' TO  WS-PROCESSO.                
  144.  
  145.            PERFORM P2000-LER-REGMOVI THRU P2000-FIM                     
  146.            PERFORM P3000-LER-REGMOVI THRU P3000-FIM                     
  147.            PERFORM UNTIL WS-REG-MOVIMENTO EQUAL '10'                       
  148.                      AND WS-REG-FUNCIONARIO EQUAL '10'                       
  149.               EVALUATE TRUE                                             
  150.                  WHEN REGMOVI-MATRICULA EQUAL        REGFUNC-MATRICULA  
  151.                       PERFORM P4000-GRAVA-SAIFUNC THRU P4000-FIM        
  152.                       PERFORM P2000-LER-REGMOVI   THRU P2000-FIM        
  153.                       PERFORM P3000-LER-REGFUNC   THRU P3000-FIM        
  154.                  WHEN REGMOVI-MATRICULA LESS THAN    REGFUNC-MATRICULA  
  155.                       PERFORM P2000-LER-REGMOVI   THRU P2000-FIM        
  156.                  WHEN REGMOVI-MATRICULA GREATER THAN REGFUNC-MATRICULA  
  157.                       PERFORM P3000-LER-REGFUNC   THRU P3000-FIM        
  158.               END-EVALUATE                                              
  159.            END-PERFORM.                                                 
  160.  
  161.        P1000-FIM.                                                       
  162.            EXIT.  
  163.  
  164.       *-----------------------------------------------------------------
  165.        P2000-LER-REGMOVI.                                               
  166.       *-----------------------------------------------------------------
  167.  
  168.            MOVE 'P2000-LER-REGMOVI' TO WS-PROCESSO                      
  169.            READ REG-MOVIMENTO                                                 
  170.                 AT END                                                  
  171.                 MOVE '10'       TO WS-REG-MOVIMENTO                        
  172.                 MOVE 9999999999 TO REGMOVI-MATRICULA                    
  173.                 NOT AT END                                              
  174.                 IF WS-REG-MOVIMENTO NOT EQUAL '00' AND '10'                
  175.                    MOVE SPACES TO WS-MENSAGEM                           
  176.                    STRING 'ERRO LEITURA ARQUIVO ENTNOME FILE STATUS: '  
  177.                            WS-REG-MOVIMENTO                                
  178.                            DELIMITED BY SIZE  INTO WS-MENSAGEM          
  179.                    END-STRING                                           
  180.                    PERFORM P8000-ERRO THRU P8000-FIM                    
  181.                 END-IF                                                  
  182.                 IF WS-REG-MOVIMENTO EQUAL '00'
  183.  
  184.                     IF REGFUNC-TPREGISTRO = '1'
  185.                     	COMPUTE SAIFUNC-DESPCIAT = SAIFUNC-DESPCIA + SAIFUNC-DESPCIAT
  186.                     END-IF
  187.                     IF REGFUNC-TPREGISTRO = '2'
  188.                     	COMPUTE SAIFUNC-DESPSUCT = SAIFUNC-DESPSUC + SAIFUNC-DESPSUCT
  189. 		  END-IF
  190. 		  IF REGFUNC-TPREGISTRO = '3'
  191. 		  	COMPUTE SAIFUNC-DESPRAMT = SAIFUNC-DESPRAM + SAIFUNC-DESPRAMT
  192. 		  END-IF
  193.  
  194.                    ADD 1 TO WS-LIDOS-NOME                               
  195.                 END-IF                                                  
  196.            END-READ.                                                    
  197.  
  198.        P2000-FIM.                                                       
  199.            EXIT.   
  200.  
  201.  
  202.       *-----------------------------------------------------------------
  203.        P8000-ERRO.                                                      
  204.       *-----------------------------------------------------------------
  205.  
  206.            DISPLAY '---------------------------------------------'      
  207.            DISPLAY 'PROGRAMA AULACOCOL CANCELADO'                        
  208.            DISPLAY 'PARAGRAFO   - ' WS-PROCESSO                         
  209.            DISPLAY 'VERSAO      - ' WS-COD-VER                          
  210.            DISPLAY 'MENSAGEM    - ' WS-MENSAGEM                         
  211.            DISPLAY '---------------------------------------------'      
  212.            MOVE 99 TO RETURN-CODE                                       
  213.            GOBACK.                                                      
  214.  
  215.        P8000-FIM.                                                       
  216.            EXIT.  
  217.  
  218.       *-----------------------------------------------------------------
  219.        P3000-LER-REGFUNC.                                               
  220.       *-----------------------------------------------------------------
  221.  
  222.            MOVE 'P3000-LER-REGFUNC' TO WS-PROCESSO                      
  223.            READ REG-FUNCIONARIO                                                 
  224.                 AT END                                                  
  225.                 MOVE '10'       TO WS-REG-FUNCIONARIO                        
  226.                 MOVE 9999999999 TO REGFUNC-MATRICULA                    
  227.                 NOT AT END                                              
  228.                 IF WS-REG-FUNCIONARIO NOT EQUAL '00' AND '10'                
  229.                    MOVE SPACES TO WS-MENSAGEM                           
  230.                    STRING 'ERRO LEITURA ARQUIVO ENTENDE FILE STATUS: '  
  231.                            WS-REG-FUNCIONARIO                                
  232.                            DELIMITED BY SIZE  INTO WS-MENSAGEM          
  233.                    END-STRING                                           
  234.                    PERFORM P8000-ERRO THRU P8000-FIM                    
  235.                 END-IF                                                  
  236.                 IF WS-REG-FUNCIONARIO EQUAL '00'                             
  237.                    ADD 1 TO WS-LIDOS-FUN2                               
  238.                 END-IF                                                  
  239.            END-READ.                                                    
  240.  
  241.        P3000-FIM.                                                       
  242.            EXIT.  
  243.  
  244.       *-----------------------------------------------------------------
  245.        P4000-GRAVA-SAIFUNC.                                             
  246.       *-----------------------------------------------------------------
  247.  
  248.            MOVE 'P4000-GRAVA-SAIFUNC' TO WS-PROCESSO                    
  249.            INITIALIZE REG-SAIFUNC                                       
  250.                       REPLACING ALPHANUMERIC BY SPACES                  
  251.                                      NUMERIC BY ZEROES                  
  252.  
  253.            MOVE REGFUNC-MATRICULA  TO SAIFUNC-MATRICULA                  
  254.            MOVE REGFUNC-TPREGISTRO TO SAIFUNC-TPREGISTRO                   
  255.            MOVE REGFUNC-CSR        TO SAIFUNC-CSR                    
  256.            MOVE REGFUNC-DESP       TO SAIFUNC-DESP                                              
  257.            MOVE REGMOVI-NOME       TO SAIFUNC-NOME                       
  258.            WRITE REG-SAIFUNC         END-WRITE                          
  259.  
  260.            IF WS-FS-SAIFUNC NOT EQUAL '00'                              
  261.               MOVE SPACES TO WS-MENSAGEM                                
  262.               STRING 'ERRO GRAVACAO ARQUIVO SAIFUNC FILE STATUS: '      
  263.                       WS-FS-SAIFUNC                                     
  264.                       DELIMITED BY SIZE  INTO WS-MENSAGEM               
  265.               END-STRING                                                
  266.               PERFORM P8000-ERRO THRU P8000-FIM                         
  267.            END-IF                                                       
  268.  
  269.            ADD 1 TO WS-GRAVA-FUNC.                                      
  270.  
  271.        P4000-FIM.                                                       
  272.            EXIT.  
  273.  
  274.       *-----------------------------------------------------------------
  275.        P9000-FINAL.                                                     
  276.       *-----------------------------------------------------------------
  277.  
  278.            DISPLAY '---------------------------------------------'      
  279.            DISPLAY 'PROGRAMA AULACOBOL - TERMINO OK'                     
  280.            DISPLAY '                                             '      
  281.            DISPLAY 'TOTAL DE LIDOS MOVIMENTOS  -  ' WS-LIDOS-MOVI           
  282.            DISPLAY 'TOTAL DE LIDOS FUNCIONARIOS - ' WS-LIDOS-FUN2           
  283.            DISPLAY 'TOTAL GRAVADOS ........ -   ' WS-GRAVA-FUNC.          
  284.  
  285.        P9000-FIM.                                                       
  286.            EXIT.
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
compilation info 
prog.cob:285: Warning: File not terminated by a newline
prog.cob:80: Error: syntax error, unexpected '/', expecting EXTERNAL or GLOBAL
stdout
copy 
Standard output is empty
https://ideone.com/5W50L
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!