COBOL - Verifica o dígito verificador do PIS/PASEP - www.cadcobol.com.br


Volta ao Menu Principal


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

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

      *-----------------------------------------------------------------
       IDENTIFICATION DIVISION.                                         
      *-----------------------------------------------------------------
       PROGRAM-ID.       CADVEPIS.                                      
       AUTHOR.           DORNELLES CARLOS ALBERTO.                      
      *-----------------------------------------------------------------
      *  PROGRAMA      : CADVEPIS                                       
      *  OBJETIVO      : Verifica o digito do PIS/PASEP           
      *  ANALISTA      : CARLOS ALBERTO DORNELLES                       
      *  DESENVOLVEDOR : CARLOS ALBERTO DORNELLES                       
      *  LINGUAGEM     : COBOL                                          
      *  MODO OPERACAO : BATCH                                          
      *  COMO USAR     : LKS-RETORNO ...: 0 - Codigo esta correto           
      *                                   1 - Codigo esta com erro          
      *                  LKS-NUMERO ....: Numero informado 
      *-----------------------------------------------------------------
      *  VERSAO DD.MM.AAAA  HISTORICO        AUTOR                             
      *  ------ ----------  ---------------  ---------------------------                           
      *    001  17.11.2011  PROGRAMA INICIAL DORNELLES CARLOS ALBERTO                           
      *-----------------------------------------------------------------
                                                                        
      *-----------------------------------------------------------------
       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.                                               
           05 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(011)  VALUE ZEROES.      
           05 WSS-NUMERO-R               REDEFINES   WSS-NUMERO.          
              10  WSS-NUMERO-T           PIC 9(001)  OCCURS 11 TIMES.   
           05 WSS-PESOS                  PIC X(010)  VALUE SPACES.      
           05 WSS-PESOS-R                REDEFINES   WSS-PESOS.           
              10  WSS-PESOS-T            PIC 9(001)  OCCURS 10 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-PIS              PIC X(010)  VALUE              
                                         '3298765432'.
                                                                        
      *-----------------------------------------------------------------
       LINKAGE SECTION.                                                 
      *-----------------------------------------------------------------
                                                                        
       01  LKS-PARAMETRO.                                               
      * A variavel COMPRIMENTO somente sera usada para programas on-line                                               
           05 COMPRIMENTO                PIC S9(04) COMP.               
      *
           05 LKS-RETORNO                PIC 9(001).                    
           05 LKS-NUMERO                 PIC 9(011).                    
                                                                        
      *-----------------------------------------------------------------
      * LKS-RETORNO      = 0 - Codigo verificado esta correto           
      *                  = 1 - Codigo verificado esta com erro          
      * LKS-NUMERO       = Numero informado ao programa                 
      *-----------------------------------------------------------------
                                                                        
      *-----------------------------------------------------------------
       PROCEDURE DIVISION USING LKS-PARAMETRO.                          
      *-----------------------------------------------------------------
                                                                        
           PERFORM P1000-INICIAL
           PERFORM P2000-PRINCIPAL
           PERFORM P9500-FINAL
           GOBACK.                                                      
                                                                        
      *-----------------------------------------------------------------
       P1000-INICIAL.                                                   
      *-----------------------------------------------------------------
                                                                        
           MOVE LKS-NUMERO    TO WSS-NUMERO                     
           MOVE WSS-PESOS-PIS TO WSS-PESOS.
                                                                        
       P1000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P2000-PRINCIPAL.                                                 
      *-----------------------------------------------------------------
                                                                        
           MOVE 01            TO WSS-IND-N                              
           MOVE 01            TO WSS-IND-P                              
           MOVE 10            TO WSS-IND-O                              
           MOVE 11            TO WSS-IND-D                              
           MOVE ZEROES        TO WSS-SOMA                               
           PERFORM P8000-CALC-DIGITO THRU P8000-FIM.                  
                                                                        
       P2000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P8000-CALC-DIGITO.                                             
      *-----------------------------------------------------------------
                                                                        
           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.                                                      
                                                                        
       P8000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P9500-FINAL.                                                     
      *-----------------------------------------------------------------
                                                                        
           IF  LKS-NUMERO EQUAL WSS-NUMERO                       
               MOVE 0 TO LKS-RETORNO                                 
           ELSE                                                     
               MOVE 1 TO LKS-RETORNO                                 
           END-IF.                                                   
                                                                        
       P9500-FIM.                                                       
           EXIT.                                                        


Como Calcular O Dígito Verificador do PIS/PASEP

O PIS/PASEP é composto de 11 algarismos, sendo o último o dígito verificador.

Cálculo do Dígito verificador

De posse dos 10 algarismos do PIS/PASEP, multiplique:

o primeiro algarismo por 3
o segundo  algarismo por 2
o terceiro algarismo por 9
o quarto   algarismo por 8
o quinto algarismo por 7
o sexto  algarismo por 6
o sétimo algarismo por 5
o oitavo algarismo por 4
o nono   algarismo por 3
o décimo algarismo por 2
  • Some todos os resultados e divida o total por 11.
  • Subtraia o resto encontrado de 11, ou seja 11 - RESTO.
  • Se o resultado for menor que 2 (zero ou hum), o dígito verificador é 0 (zero).
  • Caso contrário, o dígito verificador é o resultado da subtração.

Exemplo prático

Considerando o PIS/PASEP 1.002.723.088

Calculando o dígito verificador - Multiplicando


o primeiro algarismo por 3 (1 x 3 = 3)
o segundo  algarismo por 2 (0 x 2 = 0)
o terceiro algarismo por 9 (0 x 9 = 0)
o quarto   algarismo por 8 (2 x 8 = 16)

o quinto algarismo por 7 (7 x 7 = 49)
o sexto  algarismo por 6 (2 x 6 = 12)
o sétimo algarismo por 5 (3 x 5 = 15)
o oitavo algarismo por 4 (0 x 4 = 0)

o nono   algarismo por 3 (8 x 3 = 24)
o décimo algarismo por 2 (8 x 2 = 16)
  • Somando todos os resultados (3 + 0 + 0 + 16 + 49 + 12 + 15 + 0 + 24 + 16 = 135)
  • Dividindo o total por 11 (135 / 11)
  • O resto desta divisão é 3
  • Subtraindo o resto encontrado de 11 (11 - 3 = 8).

Resultado final: 1.002.723.088-8