Menu principal
[Fechar]
Introdução
Divisões
Identification Division
Environment Division
Data Division
Procedure Division
Comandos CICS
VSAM - File Status
Quadros importantes
SQL - Structured Query Language
Outros programas
Rotinas prontas
Palavras reservadas
Introdução ao Oracle
Sites de busca
Sites interessantes
Meu e-mail
COBOL - Verifica o dígito da agência e conta corrente do Banco do Brasil
Desenvolvido por DORNELLES Carlos Alberto - Analista de Sistemas - Brasília DF. - cad_cobol@hotmail.com
Metodologia para cálculo do dígito verificador - DV da agência e conta corrente
Cada algarismo que compõe o número é multiplicado pelo respectivo multiplicador (peso)
Os multiplicadores (pesos) variam de 9 a 2, da direita para a esquerda
O primeiro dígito da direita para a esquerda deverá ser multiplicado por 9, o segundo por 8 e assim sucessivamente
Os resultados das multiplicacoes são somados
O total da soma é dívido por onze
se o resto for menor que 10 (dez) o DV será igual ao resto
se o resto for igual a 10 (dez) o DV sera igual a X
se o resto for igual a 0 (zero) o DV sera igual a 0
Compativel com todos os compiladores e versões
1 2 3 4 5 6 7 8 12345678901234567890123456789012345678901234567890123456789012345678901234567890 *----------------------------------------------------------------- IDENTIFICATION DIVISION. *----------------------------------------------------------------- PROGRAM-ID. CADCABB. AUTHOR. CARLOS ALBERTO DORNELLES. *----------------------------------------------------------------- * PROGRAMA : CADCABB * OBJETIVO : Verifica o digito c/c do Banco do Brasil * ANALISTA : CARLOS ALBERTO DORNELLES * LINGUAGEM : COBOL * MODO OPERACAO : BATCH * COMO USAR : LKS-CODAGE-I ....: Codigo da agencia com digito * : LKS-NUMCTA-I ....: Numero da conta com digito *----------------------------------------------------------------- * VERSAO DD.MM.AAAA HISTORICO/AUTOR * ------ ---------- --------------- * 001 16.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. 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-CODAGE PIC X(005) VALUE ZEROES. 05 WSS-CODAGE-R REDEFINES WSS-CODAGE. 10 WSS-CODAGE-T PIC 9(001) OCCURS 05 TIMES. 05 WSS-NUMCTA PIC X(007) VALUE ZEROES. 05 WSS-NUMCTA-R REDEFINES WSS-NUMCTA. 10 WSS-NUMCTA-T PIC 9(001) OCCURS 07 TIMES. 05 WSS-PESOS PIC X(012) VALUE SPACES. 05 WSS-PESOS-R REDEFINES WSS-PESOS. 10 WSS-PESOS-T PIC 9(002) OCCURS 06 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-CTA PIC X(012) VALUE '040506070809'. *----------------------------------------------------------------- LINKAGE SECTION. *----------------------------------------------------------------- 01 LKS-PARAMETRO. 05 COMPRIMENTO PIC S9(04) COMP. 05 LKS-CODAGE-I PIC X(005). 05 FILLER PIC X(001). 05 LKS-NUMCTA-I PIC X(007). 05 FILLER PIC X(001). 05 LKS-RETORNO PIC 9(001). *----------------------------------------------------------------- * LKS-CODAGE-I = Numero da agencia com o digito * LKS-NUMCTA-I = Numero da conta com o digito * LKS-RETORNO = 0 - Codigo verificado esta correto * = 1 - Codigo da agencia com erro * = 2 - Codigo da conta com erro * = 3 - Codigo da agencia e conta com erro *----------------------------------------------------------------- *----------------------------------------------------------------- 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. *----------------------------------------------------------------- MOVE LKS-CODAGE-I TO WSS-CODAGE MOVE LKS-NUMCTA-I TO WSS-NUMCTA . P1000-FIM. EXIT. *----------------------------------------------------------------- P2000-PRINCIPAL. *----------------------------------------------------------------- MOVE WSS-PESOS-CTA TO WSS-PESOS MOVE 01 TO WSS-IND-N MOVE 03 TO WSS-IND-P MOVE 04 TO WSS-IND-O MOVE ZEROES TO WSS-SOMA PERFORM P7000-CALC-CODAGE THRU P7000-FIM MOVE WSS-PESOS-CTA TO WSS-PESOS MOVE 01 TO WSS-IND-N MOVE 01 TO WSS-IND-P MOVE 06 TO WSS-IND-O MOVE ZEROES TO WSS-SOMA PERFORM P8000-CALC-NUMCTA THRU P8000-FIM. P2000-FIM. EXIT. *----------------------------------------------------------------- P7000-CALC-CODAGE. *----------------------------------------------------------------- MOVE ZEROES TO WSS-SOMA PERFORM UNTIL WSS-IND-N GREATER WSS-IND-O COMPUTE WSS-SOMA = WSS-SOMA + (WSS-CODAGE-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 EVALUATE WSS-RESTO WHEN 10 MOVE 'X' TO WSS-CODAGE (05:01) WHEN 0 MOVE 0 TO WSS-CODAGE-T (05) WHEN OTHER MOVE WSS-RESTO TO WSS-CODAGE-T (05) END-EVALUATE. P7000-FIM. EXIT. *----------------------------------------------------------------- P8000-CALC-NUMCTA. *----------------------------------------------------------------- MOVE ZEROES TO WSS-SOMA PERFORM UNTIL WSS-IND-N GREATER WSS-IND-O COMPUTE WSS-SOMA = WSS-SOMA + (WSS-NUMCTA-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 EVALUATE WSS-RESTO WHEN 10 MOVE 'X' TO WSS-NUMCTA (07:01) WHEN 0 MOVE 0 TO WSS-NUMCTA-T (07) WHEN OTHER MOVE WSS-RESTO TO WSS-NUMCTA-T (07) END-EVALUATE. P8000-FIM. EXIT. *----------------------------------------------------------------- P9500-FINAL. *----------------------------------------------------------------- EVALUATE LKS-CODAGE-I = WSS-CODAGE ALSO LKS-NUMCTA-I = WSS-NUMCTA WHEN TRUE ALSO TRUE MOVE 0 TO LKS-RETORNO WHEN FALSE ALSO TRUE MOVE 1 TO LKS-RETORNO WHEN TRUE ALSO FALSE MOVE 2 TO LKS-RETORNO WHEN FALSE ALSO FALSE MOVE 3 TO LKS-RETORNO END-EVALUATE. P9500-FIM. EXIT.
Exemplos
Agencia
Conta
Agencia
Conta
Agencia
Conta
Agencia
Conta
Agencia
Conta
Agencia
Conta
6510-2
003655-2
6507-2
024601-8
7009-2
022810-9
6746-6
006373-8
6605-2
461462-3
6845-4
100140-X
