COBOL - BALANCE-LINE com três arquivos - www.cadcobol.com.br


clique aqui para imprimir esta página

Volta a página anterior

Volta ao Menu Principal


Desenvolvido por DORNELLES Carlos Alberto - Analista de Sistemas - Brasília DF. - cad_cobol@hotmail.com


COBOL - BALANCE-LINE com três arquivos
O programa abaixo listado tem por finalidade demonstrar a execução de um BALANCE-LINE de três arquivos.

O termo balance-line no Cobol refere-se ao ato de realizar a consolidação de dados de duas ou mais base de dados.
Ou seja, realizar o balanceamento das informações que estão presentes nestas bases e verificando a existência de compatibilidade ou a inconsistência de registros, está verificação depende da regra negocial a ser aplicada.

No Cobol este termo é aplicado para a verificação das informações que estão presentes em dois ou mais arquivos, com o objetivo de produzir um resultado com o balanço das informações contidas nos arquivos analisados.

Sendo que o resultado produzido pelo balanço dos dados dos arquivos, pode no fim gerar um novo arquivo, ou atualização de registros na base de dados, ou um relatório gerencial, etc.

Para realizar o balanceamento das informações é primordial que os arquivos estejam com os dados ordenados, e também possuam alguma chave para comparação dos registros.

Os ajustes na gravação, movimentação dos campos, fica de acordo com cada caso.

Nota:
Se alguém achar outras combinações, válidas, por favor me avise.

Balance-line com mais de 2 (dois) arquivos, recomendo a fazem um JCL-MERGE, e depois fazer um programa que irá tratar esses dados.

Código
      *-----------------------------------------------------------------
       IDENTIFICATION DIVISION.                                         
      *-----------------------------------------------------------------
       PROGRAM-ID.      CADBALAN.                                       
       AUTHOR.          DORNELLES CARLOS ALBERTO.                       
      *-----------------------------------------------------------------
      * SISTEMA       : PROGRAMAS EXEMPLOS                              
      * PROGRAMA      : CADBALAN                                        
      * OBJETIVO      : BALANCE-LINE DE TRES ARQUIVOS                   
      * ENTRADA       : PRIMEIRO ARQUIVO DE ENTRADA - ENTRADA1                 
      *               : SEGUNDO  ARQUIVO DE ENTRADA - ENTRADA2 
      *               : TERCEIRO ARQUIVO DE ENTRADA - ENTRADA3 
      * SAIDA         : ARQUIVO DE SAIDA            - SAIDA01
      * ANALISTA      : CARLOS ALBERTO DORNELLES                        
      * LINGUAGEM     : COBOL II - COBOL 85                             
      * MODO OPERACAO : BATCH                                           
      *-----------------------------------------------------------------
      *  VERSAO DD.MM.AAAA HISTORICO/AUTOR                              
      *  ------ ---------- ---------------                              
      *   V.001 17.06.2021 PROGRAMA INICIAL/DORNELLES                   
      *                                                                 
      *-----------------------------------------------------------------
                                                                        
      *-----------------------------------------------------------------
       ENVIRONMENT DIVISION.                                            
      *-----------------------------------------------------------------
       CONFIGURATION SECTION.                                           
       SPECIAL-NAMES.                                                   
                        DECIMAL-POINT IS COMMA.                         
                                                                        
       INPUT-OUTPUT SECTION.                                            
       FILE-CONTROL.                                                    
                                                                        
           SELECT ENTRADA1 ASSIGN TO ENTRADA01                             
                  FILE STATUS IS WS-FS-ENTRADA1.
                         
           SELECT ENTRADA2 ASSIGN TO ENTRADA02                             
                  FILE STATUS IS WS-FS-ENTRADA2. 
                        
           SELECT ENTRADA3 ASSIGN TO ENTRADA03                             
                  FILE STATUS IS WS-FS-ENTRADA3. 

           SELECT SAIDA01 ASSIGN TO ARQSAIDA                             
                  FILE STATUS IS WS-FS-SAIDA01.                         
                                                                        
      *-----------------------------------------------------------------
       DATA DIVISION.                                                   
      *-----------------------------------------------------------------
       FILE SECTION.                                                    

       FD  ENTRADA1                                                      
           BLOCK CONTAINS 0 RECORDS                                     
           RECORDING MODE IS F                                          
           RECORD CONTAINS 80 CHARACTERS.                              
                                                                        
       01  REG-ENTRADA1.                                                 
           03  CHAVE1                     PIC 9(010).                    
           03  FILLER                     PIC X(070).                    
                                                                        
       FD  ENTRADA2                                                      
           BLOCK CONTAINS 0 RECORDS                                     
           RECORDING MODE IS F                                          
           RECORD CONTAINS 80 CHARACTERS.                              
                                                                        
       01  REG-ENTRADA2.                                                 
           03  CHAVE2                     PIC 9(010).                    
           03  FILLER                     PIC X(070).                    

       FD  ENTRADA3                                                      
           BLOCK CONTAINS 0 RECORDS                                     
           RECORDING MODE IS F                                          
           RECORD CONTAINS 80 CHARACTERS.                              
                                                                        
       01  REG-ENTRADA3.                                                 
           03  CHAVE3                     PIC 9(010).                    
           03  FILLER                     PIC X(070).                    

       FD  SAIDA01                                                      
           BLOCK CONTAINS 0 RECORDS                                     
           RECORDING MODE IS F                                          
           RECORD CONTAINS 80 CHARACTERS.                              
                                                                        
       01  REG-SAIDA01.                                                 
           03  FILLER                     PIC X(080).                    
                                                                        
       WORKING-STORAGE SECTION.                                         

       01  WS-AREA-AUXILIAR.                                            
           05  WS-COD-PROGRAMA           PIC X(008)  VALUE 'CADBALAN'.  
           05  WS-COD-VER                PIC X(008)  VALUE '001/2021'.  
           05  WS-FS-ENTRADA1            PIC X(002)  VALUE SPACES.      
           05  WS-FS-ENTRADA2            PIC X(002)  VALUE SPACES.      
           05  WS-FS-ENTRADA3            PIC X(002)  VALUE SPACES.      
           05  WS-FS-SAIDA01             PIC X(002)  VALUE SPACES.      
           05  WS-LIDOS-ENTRA1           PIC 9(010)  VALUE ZEROES.      
           05  WS-LIDOS-ENTRA2           PIC 9(010)  VALUE ZEROES.      
           05  WS-LIDOS-ENTRA3           PIC 9(010)  VALUE ZEROES.      
           05  WS-GRAVADOS               PIC 9(010)  VALUE ZEROES.      
           05  WS-MENSAGEM               PIC X(070)  VALUE SPACES.      
           05  WS-PROCESSO               PIC X(070)  VALUE SPACES.      
                                                                        
      *-----------------------------------------------------------------
       PROCEDURE DIVISION.                                              
      *-----------------------------------------------------------------

           PERFORM P0000-INICIAL                
           PERFORM P1000-PRINCIPAL                
           PERFORM P9000-FINAL
           STOP RUN.                                                      
                                                                        
      *-----------------------------------------------------------------
       P0000-INICIAL.                                                   
      *-----------------------------------------------------------------

           MOVE 'P0000-INICIAL' TO        WS-PROCESSO                  
                                                                        
           OPEN INPUT ENTRADA1                                          
           IF  WS-FS-ENTRADA1 NOT EQUAL '00'                              
               MOVE SPACES TO WS-MENSAGEM                                
               STRING 'ERRO ABERTURA ARQUIVO ENTRADA1 FILE STATUS: '      
                       WS-FS-ENTRADA1                                      
                       DELIMITED BY SIZE  INTO WS-MENSAGEM                
               END-STRING                                                
               PERFORM P8000-ERRO THRU P8000-FIM                         
           END-IF                                                      
                                                                        
           OPEN INPUT ENTRADA2
           IF  WS-FS-ENTRADA2 NOT EQUAL '00'                              
               STRING 'ERRO ABERTURA ARQUIVO ENTRADA2 FILE STATUS: '      
                       WS-FS-ENTRADA2                                      
                       DELIMITED BY SIZE  INTO WS-MENSAGEM                
               END-STRING                                                
               PERFORM P8000-ERRO THRU P8000-FIM                         
           END-IF                                                      

           OPEN INPUT ENTRADA3                                          
           IF  WS-FS-ENTRADA3 NOT EQUAL '00'                              
               STRING 'ERRO ABERTURA ARQUIVO ENTRADA3 FILE STATUS: '      
                       WS-FS-ENTRADA3                                      
                       DELIMITED BY SIZE  INTO WS-MENSAGEM                
               END-STRING                                                
               PERFORM P8000-ERRO THRU P8000-FIM                         
           END-IF                                                      
                                                                        
           OPEN OUTPUT SAIDA01                                         
           IF  WS-FS-SAIDA01 NOT EQUAL '00'                              
               STRING 'ERRO ABERTURA ARQUIVO SAIDA01 FILE STATUS: '      
                       WS-FS-SAIDA01                                      
                       DELIMITED BY SIZE  INTO WS-MENSAGEM                
               END-STRING                                                
               PERFORM P8000-ERRO THRU P8000-FIM                         
           END-IF 

           PERFORM P2000-LER-ENTRADA1                     
           PERFORM P3000-LER-ENTRADA2                     
           PERFORM P4000-LER-ENTRADA3
                     
           PERFORM UNTIL WS-FS-ENTRADA1 EQUAL '10' AND                       
                         WS-FS-ENTRADA2 EQUAL '10' AND                      
                         WS-FS-ENTRADA3 EQUAL '10'
           END-PERFORM.                       
        P0000-FIM.                                                      
            EXIT.                                                       
                                                                        
      *-----------------------------------------------------------------
       P1000-PRINCIPAL.                                                 
      *-----------------------------------------------------------------

           EVALUATE TRUE
               WHEN CHAVE1 = CHAVE2 
                    EVALUATE TRUE
                        WHEN CHAVE1 = CHAVE3 AND 
                             CHAVE2 = CHAVE3 
                             MOVE REG-ENTRADA1 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P2000-LER-ENTRADA1
                             PERFORM P3000-LER-ENTRADA2
                             PERFORM P4000-LER-ENTRADA3
                        WHEN CHAVE1 < CHAVE3 AND
                             CHAVE2 < CHAVE3
                             MOVE REG-ENTRADA1 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P2000-LER-ENTRADA1
                             PERFORM P3000-LER-ENTRADA2
                        WHEN CHAVE1 > CHAVE3 AND
                             CHAVE2 > CHAVE3 
                             MOVE REG-ENTRADA3 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P4000-LER-ENTRADA3
                        WHEN OTHER
                             DISPLAY "CHAVE1 = CHAVE2 - ERRO" 
                    END-EVALUATE
  
               WHEN CHAVE1 > CHAVE2
                    EVALUATE TRUE
                        WHEN CHAVE1 = CHAVE3 AND
                             CHAVE2 < CHAVE3
                             MOVE REG-ENTRADA2 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P3000-LER-ENTRADA2
                        WHEN CHAVE1 < CHAVE3 AND
                             CHAVE2 < CHAVE3
                             MOVE REG-ENTRADA2 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P3000-LER-ENTRADA2
                        WHEN CHAVE1 > CHAVE3 AND
                             CHAVE2 = CHAVE3
                             MOVE REG-ENTRADA2 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P3000-LER-ENTRADA2
                             PERFORM P4000-LER-ENTRADA3
                        WHEN CHAVE1 > CHAVE3 AND
                             CHAVE2 > CHAVE3
                             MOVE REG-ENTRADA3 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P4000-LER-ENTRADA3
                        WHEN CHAVE1 > CHAVE3 AND
                             CHAVE2 < CHAVE3
                             MOVE REG-ENTRADA2 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P3000-LER-ENTRADA2
                        WHEN OTHER
                             DISPLAY "CHAVE1 > CHAVE2 - ERRO" 
                    END-EVALUATE

               WHEN CHAVE1 < CHAVE2
                    EVALUATE TRUE
                        WHEN CHAVE1 = CHAVE3 AND 
                             CHAVE2 > CHAVE3
                             MOVE REG-ENTRADA1 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P2000-LER-ENTRADA1
                             PERFORM P4000-LER-ENTRADA3
                        WHEN CHAVE1 < CHAVE3 AND 
                             CHAVE2 = CHAVE3
                             MOVE REG-ENTRADA1 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P2000-LER-ENTRADA1
                        WHEN CHAVE1 < CHAVE3 AND 
                             CHAVE2 < CHAVE3
                             MOVE REG-ENTRADA1 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P2000-LER-ENTRADA1
                        WHEN CHAVE1 < CHAVE3 AND 
                             CHAVE2 > CHAVE3
                             MOVE REG-ENTRADA1 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P2000-LER-ENTRADA1
                        WHEN CHAVE1 > CHAVE3 AND 
                             CHAVE2 > CHAVE3
                             MOVE REG-ENTRADA3 TO REG-SAIDA01 
                             PERFORM P5000-GRAVA-SAIDA01
                             PERFORM P4000-LER-ENTRADA3
                        WHEN OTHER
                             DISPLAY "CHAVE1 < CHAVE2 - ERRO" 
                    END-EVALUATE
           END-EVALUATE.
		 P1000-FIM.
           EXIT.

      *-----------------------------------------------------------------
       P2000-LER-ENTRADA1.                                               
      *-----------------------------------------------------------------

           MOVE 'P2000-LER-ENTRADA1' TO WS-PROCESSO                      
           READ ENTRADA1                                                 
                AT END 
                   MOVE '10'       TO WS-FS-ENTRADA1                        
                   MOVE 9999999999 TO CHAVE1                    
                NOT AT END                                              
                IF WS-FS-ENTRADA1 NOT EQUAL '00' AND '10'                
                   MOVE SPACES TO WS-MENSAGEM                           
                   STRING 'ERRO LEITURA ARQUIVO ENTRADA1 FILE STATUS: '  
                           WS-FS-ENTRADA1                                
                           DELIMITED BY SIZE  INTO WS-MENSAGEM          
                   END-STRING                                           
                   PERFORM P8000-ERRO THRU P8000-FIM                    
                END-IF                                                  
                IF WS-FS-ENTRADA1 EQUAL '00'                             
                   ADD 1 TO WS-LIDOS-ENTRA1                               
                END-IF                                                  
           END-READ.                                                    
                                                                        
       P2000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P3000-LER-ENTRADA2.                                               
      *-----------------------------------------------------------------

           MOVE 'P3000-LER-ENTRADA2' TO WS-PROCESSO                      
           READ ENTRADA2                                                 
                AT END                                                  
                   MOVE '10'       TO WS-FS-ENTRADA2                        
                   MOVE 9999999999 TO CHAVE2                    
                NOT AT END                                              
                IF WS-FS-ENTRADA2 NOT EQUAL '00' AND '10'                
                   MOVE SPACES TO WS-MENSAGEM                           
                   STRING 'ERRO LEITURA ARQUIVO ENTRADA2 FILE STATUS: '  
                           WS-FS-ENTRADA2                                
                           DELIMITED BY SIZE  INTO WS-MENSAGEM          
                   END-STRING                                           
                   PERFORM P8000-ERRO THRU P8000-FIM                    
                END-IF                                                  
                IF WS-FS-ENTRADA2 EQUAL '00'                             
                   ADD 1 TO WS-LIDOS-ENTRA2                               
                END-IF                                                  
           END-READ.                                                    
                                                                        
       P3000-FIM.                                                       
           EXIT.                                                        

      *-----------------------------------------------------------------
       P4000-LER-ENTRADA3.                                               
      *-----------------------------------------------------------------

           MOVE 'P4000-LER-ENTRADA3' TO WS-PROCESSO                      
           READ ENTRADA3                                                 
                AT END                                                  
                   MOVE '10'       TO WS-FS-ENTRADA3                        
                   MOVE 9999999999 TO CHAVE3                    
                NOT AT END                                              
                IF WS-FS-ENTRADA3 NOT EQUAL '00' AND '10'                
                   MOVE SPACES TO WS-MENSAGEM                           
                   STRING 'ERRO LEITURA ARQUIVO ENTRADA3 FILE STATUS: '  
                           WS-FS-ENTRADA3                                
                           DELIMITED BY SIZE  INTO WS-MENSAGEM          
                   END-STRING                                           
                   PERFORM P8000-ERRO THRU P8000-FIM                    
                END-IF                                                  
                IF WS-FS-ENTRADA3 EQUAL '00'                             
                   ADD 1 TO WS-LIDOS-ENTRA3                               
                END-IF                                                  
           END-READ.                                                    
                                                                        
       P4000-FIM.                                                       
           EXIT.

      *-----------------------------------------------------------------
       P5000-GRAVA-SAIDA01.
      *-----------------------------------------------------------------

           MOVE 'P5000-GRAVA-SAIDA01' TO WS-PROCESSO                    
                                                                        
           WRITE REG-SAIDA01         END-WRITE                          
                                                                        
           IF WS-FS-SAIDA01 NOT EQUAL '00'                              
              MOVE SPACES TO WS-MENSAGEM                                
              STRING 'ERRO GRAVACAO ARQUIVO SAIDA01 FILE STATUS: '      
                      WS-FS-SAIDA01                                     
                      DELIMITED BY SIZE  INTO WS-MENSAGEM               
              END-STRING                                                
              PERFORM P8000-ERRO THRU P8000-FIM                         
           END-IF                                                       
                                                                        
           ADD 1 TO WS-GRAVADOS.                                      
                                                                        
       P5000-FIM.                                                       
           EXIT.                                                        
                                                                        
                                                                        
      *-----------------------------------------------------------------
       P8000-ERRO.                                                      
      *-----------------------------------------------------------------

           DISPLAY '------------------------------------------------------------'      
           DISPLAY 'PROGRAMA CADBALAN CANCELADO'                        
           DISPLAY 'PARAGRAFO   - ' WS-PROCESSO                         
           DISPLAY 'VERSAO      - ' WS-COD-VER                          
           DISPLAY 'MENSAGEM    - ' WS-MENSAGEM                         
           DISPLAY '------------------------------------------------------------'      
           MOVE 99 TO RETURN-CODE                                       
           STOP RUN.                                                      
                                                                        
       P8000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P9000-FINAL.                                                     
      *-----------------------------------------------------------------

           CLOSE ENTRADA1                                          
           IF  WS-FS-ENTRADA1 NOT EQUAL '00'                              
               MOVE SPACES TO WS-MENSAGEM                                
               STRING 'ERRO FECHAMENTO ARQUIVO ENTRADA1 FILE STATUS: '      
                       WS-FS-ENTRADA1                                      
                       DELIMITED BY SIZE  INTO WS-MENSAGEM                
               END-STRING                                                
               PERFORM P8000-ERRO THRU P8000-FIM                         
           END-IF                                                      
                                                                        
           CLOSE ENTRADA2
           IF  WS-FS-ENTRADA2 NOT EQUAL '00'                              
               STRING 'ERRO FECHAMENTO ARQUIVO ENTRADA2 FILE STATUS: '      
                       WS-FS-ENTRADA2                                      
                       DELIMITED BY SIZE  INTO WS-MENSAGEM                
               END-STRING                                                
               PERFORM P8000-ERRO THRU P8000-FIM                         
           END-IF                                                      

           CLOSE ENTRADA3                                          
           IF  WS-FS-ENTRADA3 NOT EQUAL '00'                              
               STRING 'ERRO FECHAMENTO ARQUIVO ENTRADA3 FILE STATUS: '      
                       WS-FS-ENTRADA3                                      
                       DELIMITED BY SIZE  INTO WS-MENSAGEM                
               END-STRING                                                
               PERFORM P8000-ERRO THRU P8000-FIM                         
           END-IF                                                      
                                                                        
           CLOSE SAIDA01                                         
           IF  WS-FS-SAIDA01 NOT EQUAL '00'                              
               STRING 'ERRO FECHAMENTO ARQUIVO SAIDA01 FILE STATUS: '      
                       WS-FS-SAIDA01                                      
                       DELIMITED BY SIZE  INTO WS-MENSAGEM                
               END-STRING                                                
               PERFORM P8000-ERRO THRU P8000-FIM                         
           END-IF 
                                                                        
           DISPLAY '---------------------------------------------'      
           DISPLAY 'PROGRAMA CADBALAN - TERMINO OK'                     
           DISPLAY '                                             '      
           DISPLAY 'TOTAL DE LIDOS ENTRADA1 - ' WS-LIDOS-ENTRA1           
           DISPLAY 'TOTAL DE LIDOS ENTRADA2 - ' WS-LIDOS-ENTRA2         
           DISPLAY 'TOTAL DE LIDOS ENTRADA3 - ' WS-LIDOS-ENTRA3         
           DISPLAY 'TOTAL GRAVADOS ........ - ' WS-GRAVADOS. 

       P9000-FIM.                                                       
           EXIT.