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
Calcula e verifica o dígito verificador do PIS/PASEP
Desenvolvido por DORNELLES Carlos Alberto - Analista de Sistemas - Brasília DF.
Pesos: 0000000008090203040506070809
1 2 3 4 5 6 7 8 12345678901234567890123456789012345678901234567890123456789012345678901234567890 *----------------------------------------------------------------- IDENTIFICATION DIVISION. *----------------------------------------------------------------- PROGRAM-ID. CADNOPIS. AUTHOR. CARLOS ALBERTO DORNELLES. *----------------------------------------------------------------- * PROGRAMA : CADNOPIS * OBJETIVO : Calcula ou verifica o digito do PIS/PSASEP * ANALISTA : CARLOS ALBERTO DORNELLES * LINGUAGEM : COBOL * MODO OPERACAO : BATCH * COMO USAR : LKS-ACAO ........: C - calcula * V - verificao * COMO USAR : LKS-NUMERO-I ....: Numero informado * : LKS-NUMERO-F ....: Numero calculado * : *----------------------------------------------------------------- * VERSAO DD.MM.AAAA HISTORICO/AUTOR * ------ ---------- --------------- * 001 21.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-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-PIS PIC X(028) VALUE '0000000008090203040506070809'. *----------------------------------------------------------------- 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 (06:10) TO WSS-NUMERO (05:10) 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-PIS TO WSS-PESOS MOVE 05 TO WSS-IND-N MOVE 05 TO WSS-IND-P MOVE 14 TO WSS-IND-O MOVE ZEROES TO WSS-SOMA PERFORM P8000-CALC-DIGITO THRU P8000-FIM. P2000-FIM. EXIT. *----------------------------------------------------------------- P8000-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 10 MOVE ZEROES TO WSS-NUMERO-T (15) ELSE MOVE WSS-RESTO TO WSS-NUMERO-T (15) END-IF. P8000-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 DISPLAY 'LKS-NUMERO-I ... - ' LKS-NUMERO-I DISPLAY 'LKS-NUMERO-F ... - ' LKS-NUMERO-F DISPLAY 'LKS-ACAO ....... - ' LKS-ACAO DISPLAY 'LKS-RETORNO .... - ' LKS-RETORNO. P9500-FIM. EXIT.
