COBOL - Calcula e verifica o dígito verificador do CPF - www.cadcobol.com.br


Volta ao Menu Principal


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

Pesos: 0000000011100908070605040302
         1         2         3         4         5         6         7         8
12345678901234567890123456789012345678901234567890123456789012345678901234567890

      *-----------------------------------------------------------------
       IDENTIFICATION DIVISION.                                         
      *-----------------------------------------------------------------
       PROGRAM-ID.       CADCACPF.                                      
       AUTHOR.           CARLOS ALBERTO DORNELLES.                      
      *-----------------------------------------------------------------
      *  PROGRAMA      : CADCACPF                                       
      *  OBJETIVO      : Calcula ou verifica o digito do CPF            
      *  ANALISTA      : CARLOS ALBERTO DORNELLES                       
      *  LINGUAGEM     : COBOL                                          
      *  MODO OPERACAO : BATCH                                          
      *  COMO USAR     : LKS-NUMERO-I ....: Numero informado            
      *                : LKS-NUMERO-F ....: Numero calculado            
      *                : LKS-ACAO ........: C - calcula                 
      *                                     V - verifica                
      *-----------------------------------------------------------------
      *  VERSAO DD.MM.AAAA  HISTORICO/AUTOR                             
      *  ------ ----------  ---------------                             
      *    001  17.11.2011  PROGRAMA INICIAL                            
      *-----------------------------------------------------------------
                                                                        
      *-----------------------------------------------------------------
       ENVIRONMENT DIVISION.                                            
      *-----------------------------------------------------------------
       CONFIGURATION SECTION.                                           
       SPECIAL-NAMES.    DECIMAL-POINT IS COMMA.                        
       INPUT-OUTPUT SECTION.                                            
       FILE-CONTROL.                                                    
                                                                        
      *-----------------------------------------------------------------
       DATA DIVISION.                                                   
      *-----------------------------------------------------------------
       FILE SECTION.                                                    
                                                                        
      *-----------------------------------------------------------------
       WORKING-STORAGE SECTION.                                         
      *-----------------------------------------------------------------
                                                                        
       01  WS-AUXILIARES. 
           O5 WSS-IND-D                  PIC 9(002)  VALUE ZEROES.                                              
           05 WSS-IND-N                  PIC 9(002)  VALUE ZEROES.      
           05 WSS-IND-O                  PIC 9(002)  VALUE ZEROES.      
           05 WSS-IND-P                  PIC 9(002)  VALUE ZEROES.      
           05 WSS-SOMA                   PIC 9(008)  VALUE ZEROES.      
           05 WSS-NUMERO                 PIC 9(015)  VALUE ZEROES.      
           05 WSS-NUMERO-R               REDEFINES WSS-NUMERO.          
              10  WSS-NUMERO-T           PIC 9(001)  OCCURS 15 TIMES.   
           05 WSS-PESOS                  PIC X(028)  VALUE SPACES.      
           05 WSS-PESOS-R                REDEFINES WSS-PESOS.           
              10  WSS-PESOS-T            PIC 9(002)  OCCURS 14 TIMES.   
           05 WSS-QUOCI                  PIC 9(008)  VALUE ZEROES.      
           05 WSS-RESTO                  PIC 9(008)  VALUE ZEROES.      
           05 WSS-MENSAGEM               PIC X(078)  VALUE SPACES.      
           05 WSS-PESOS-CPF              PIC X(028)  VALUE              
                                         '0000000011100908070605040302'.
                                                                        
      *-----------------------------------------------------------------
       LINKAGE SECTION.                                                 
      *-----------------------------------------------------------------
                                                                        
       01  LKS-PARAMETRO.                                               
           05 COMPRIMENTO                PIC S9(04) COMP.               
           05 LKS-ACAO                   PIC X(001).                    
           05 LKS-RETORNO                PIC 9(001).                    
           05 FILLER                     PIC X(001).                    
           05 LKS-NUMERO-I               PIC 9(015).                    
           05 FILLER                     PIC X(001).                    
           05 LKS-NUMERO-F               PIC 9(015).                    
                                                                        
      *-----------------------------------------------------------------
      * LKS-ACAO         = C - calcula  o digito                        
      *                    V - verifica o digito                        
      * LKS-RETORNO      = 0 - Codigo verificado esta correto           
      *                  = 1 - LKS-ACAO esta incorreta                  
      *                  = 2 - Codigo verificado esta com erro          
      * LKS-NUMERO-I     = Numero informado ao programa                 
      * LKS-NUMERO-F     = Numero retornado do programa                 
      *-----------------------------------------------------------------
                                                                        
      *-----------------------------------------------------------------
       PROCEDURE DIVISION USING LKS-PARAMETRO.                          
      *-----------------------------------------------------------------
                                                                        
           PERFORM P1000-INICIAL
           PERFORM P2000-PRINCIPAL
           PERFORM P9500-FINAL
           GOBACK.                                                      
                                                                        
      *-----------------------------------------------------------------
       P1000-INICIAL.                                                   
      *-----------------------------------------------------------------
                                                                        
           EVALUATE TRUE                                                
               WHEN LKS-ACAO = 'C'                                      
                    MOVE LKS-NUMERO-I (07:09) TO WSS-NUMERO (05:09)     
               WHEN LKS-ACAO = 'V'                                      
                    MOVE LKS-NUMERO-I TO WSS-NUMERO                     
               WHEN OTHER                                               
                    MOVE 1 TO LKS-RETORNO                               
                    GOBACK                                              
           END-EVALUATE.                                                
                                                                        
       P1000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P2000-PRINCIPAL.                                                 
      *-----------------------------------------------------------------
                                                                        
           MOVE WSS-PESOS-CPF TO WSS-PESOS                              
           MOVE 05            TO WSS-IND-N                              
           MOVE 06            TO WSS-IND-P                              
           MOVE 13            TO WSS-IND-O  
           MOVE 14            TO WSS-IND-D                            
           MOVE ZEROES        TO WSS-SOMA                               
           PERFORM P7000-CALC-DIGITO THRU P7000-FIM                   
                                                                        
           MOVE 05            TO WSS-IND-N                              
           MOVE 05            TO WSS-IND-P                              
           MOVE 14            TO WSS-IND-O                              
           MOVE 15            TO WSS-IND-D                            
           MOVE ZEROES        TO WSS-SOMA                               
           PERFORM P7000-CALC-DIGITO THRU P7000-FIM.                  
                                                                        
       P2000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P7000-CALC-DIGITO.                                             
      *-----------------------------------------------------------------
                                                                        
           MOVE ZEROES TO WSS-SOMA                                      
           PERFORM UNTIL WSS-IND-N GREATER WSS-IND-O                    
                   COMPUTE WSS-SOMA = WSS-SOMA +                        
                                     (WSS-NUMERO-T (WSS-IND-N) *        
                                      WSS-PESOS-T  (WSS-IND-P))         
                   ADD 1 TO WSS-IND-N                                   
                            WSS-IND-P                                   
           END-PERFORM                                                  
           DIVIDE WSS-SOMA BY 11 GIVING WSS-QUOCI REMAINDER WSS-RESTO   
           IF WSS-RESTO EQUAL 0 OR 1                                    
              MOVE ZEROES TO WSS-NUMERO-T (WSS-IND-D)                          
           ELSE                                                         
              SUBTRACT WSS-RESTO FROM 11 GIVING WSS-NUMERO-T (WSS-IND-D)       
           END-IF.                                                      
                                                                        
       P7000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P9500-FINAL.                                                     
      *-----------------------------------------------------------------
                                                                        
           MOVE WSS-NUMERO TO LKS-NUMERO-F                              
           IF  LKS-ACAO EQUAL 'V'                                       
               IF LKS-NUMERO-I EQUAL LKS-NUMERO-F                       
                  MOVE 0 TO LKS-RETORNO                                 
               ELSE                                                     
                  MOVE 2 TO LKS-RETORNO                                 
               END-IF                                                   
           ELSE                                                         
               MOVE 0 TO LKS-RETORNO                                    
           END-IF                                                       
                                                                        
       P9500-FIM.                                                       
           EXIT.