COBOL - Calcula e verifica o dígito verificador do CPF - www.cadcobol.com.br
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 THRU P1000-FIM PERFORM P2000-PRINCIPAL THRU P2000-FIM PERFORM P9500-FINAL THRU P9500-FIM 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.
