261 lines
9.8 KiB
COBOL
261 lines
9.8 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. CADASTRO.
|
|
AUTHOR. Infocont Sistemas Integrados(Danilo).
|
|
DATE-WRITTEN. 13/10/04.
|
|
SECURITY. *******************************************************
|
|
* Cadastro de Clientes *
|
|
*******************************************************
|
|
ENVIRONMENT DIVISION.
|
|
CONFIGURATION SECTION.
|
|
SPECIAL-NAMES.
|
|
DECIMAL-POINT IS COMMA.
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
SELECT CADASTRO ASSIGN TO "cadastro.dat"
|
|
ORGANIZATION IS INDEXED
|
|
ACCESS MODE IS DYNAMIC
|
|
RECORD KEY IS CAD-CHAVE
|
|
FILE STATUS IS W77-RETCOD
|
|
ALTERNATE RECORD KEY IS CAD-NOME
|
|
WITH DUPLICATES.
|
|
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD CADASTRO.
|
|
01 CAD-PRINCIPAL.
|
|
03 CAD-CHAVE.
|
|
05 CAD-CODIGO PIC 9(04).
|
|
03 CAD-NOME PIC X(40).
|
|
03 CAD-ENDERECO PIC X(40).
|
|
03 CAD-BAIRRO PIC X(25).
|
|
03 CAD-CIDADE PIC X(25).
|
|
03 CAD-UF PIC X(02).
|
|
03 CAD-CEP PIC X(10).
|
|
03 CAD-DDD PIC 9(04).
|
|
03 CAD-FONE PIC X(09).
|
|
03 CAD-FAX PIC X(09).
|
|
|
|
WORKING-STORAGE SECTION.
|
|
01 VARIAVEL PIC X(01).
|
|
01 VARIAVEIS-TCL.
|
|
03 TCL-CODIGO PIC X(04).
|
|
03 TCL-NOME PIC X(40).
|
|
03 TCL-ENDERECO PIC X(40).
|
|
03 TCL-BAIRRO PIC X(25).
|
|
03 TCL-CIDADE PIC X(25).
|
|
03 TCL-UF PIC X(02).
|
|
03 TCL-CEP PIC X(10).
|
|
03 TCL-DDD PIC X(04).
|
|
03 TCL-FONE PIC X(09).
|
|
03 TCL-FAX PIC X(09).
|
|
03 TCL-OPCAO PIC X(03).
|
|
88 TCL-GRAVA VALUE "gra".
|
|
88 TCL-DELETA VALUE "del".
|
|
88 TCL-SAI VALUE "sai".
|
|
88 TCL-BUSCA VALUE "bus".
|
|
88 TCL-ALTERA VALUE "alt".
|
|
03 TCL-MENSAGEM PIC X(60).
|
|
03 TCL-FOCUS PIC X(03).
|
|
03 TCL-MENSAGEM2 PIC X(10).
|
|
77 W77-ERRO PIC 9(01) VALUE ZEROS.
|
|
88 W88-ERRO VALUE 1.
|
|
77 W77-RETCOD PIC X(02) VALUE SPACES.
|
|
88 W88-OK VALUE "00" "02" "04" "05".
|
|
88 W88-CHAVE-DUPLICADA VALUE "22".
|
|
88 W88-ARQUIVO-INEXISTE VALUE "35".
|
|
88 W88-ARQUIVO-NAO-LIDO VALUE "43".
|
|
77 NOME-PROGRAMA PIC X(64) VALUE "cadastro.tcl".
|
|
01 W01-PARA PIC X(01).
|
|
|
|
PROCEDURE DIVISION.
|
|
0000-PRINCIPAL SECTION.
|
|
0000-INICIO.
|
|
CALL "initTcl".
|
|
0000-ABRE-CADASTRO.
|
|
OPEN I-O CADASTRO.
|
|
IF W88-ARQUIVO-INEXISTE
|
|
OPEN OUTPUT CADASTRO
|
|
CLOSE CADASTRO
|
|
GO TO 0000-ABRE-CADASTRO.
|
|
IF NOT W88-OK
|
|
DISPLAY "ERRO ABERTURA"
|
|
DISPLAY W77-RETCOD
|
|
GO TO 0000-EXIT.
|
|
INITIALIZE VARIAVEIS-TCL.
|
|
MOVE "cod" TO TCL-FOCUS.
|
|
0000-OPCAO.
|
|
CALL "tcleval" USING VARIAVEIS-TCL NOME-PROGRAMA.
|
|
MOVE SPACES TO TCL-MENSAGEM2.
|
|
0000-FUNCAO.
|
|
IF TCL-GRAVA
|
|
PERFORM 1000-GRAVA.
|
|
IF TCL-DELETA
|
|
PERFORM 2000-DELETA.
|
|
IF TCL-ALTERA
|
|
PERFORM 3000-ALTERACAO.
|
|
IF TCL-BUSCA
|
|
PERFORM 4000-BUSCA
|
|
IF W88-ERRO
|
|
MOVE ZEROS TO W77-ERRO
|
|
MOVE "err" TO TCL-OPCAO
|
|
GO TO 0000-FUNCAO
|
|
ELSE
|
|
MOVE "cod" TO TCL-FOCUS
|
|
MOVE SPACES TO TCL-OPCAO.
|
|
IF TCL-SAI
|
|
GO TO 0000-EXIT.
|
|
IF W88-ERRO
|
|
GO TO 0000-EXIT.
|
|
GO TO 0000-OPCAO.
|
|
0000-EXIT.
|
|
STOP RUN.
|
|
|
|
1000-GRAVA SECTION.
|
|
1000-INICIO.
|
|
MOVE TCL-CODIGO TO CAD-CODIGO.
|
|
MOVE TCL-NOME TO CAD-NOME.
|
|
MOVE TCL-ENDERECO TO CAD-ENDERECO.
|
|
MOVE TCL-BAIRRO TO CAD-BAIRRO.
|
|
MOVE TCL-CIDADE TO CAD-CIDADE.
|
|
MOVE TCL-UF TO CAD-UF.
|
|
MOVE TCL-CEP TO CAD-CEP.
|
|
MOVE TCL-DDD TO CAD-DDD.
|
|
MOVE TCL-FONE TO CAD-FONE.
|
|
MOVE TCL-FAX TO CAD-FAX.
|
|
WRITE CAD-PRINCIPAL.
|
|
IF W88-CHAVE-DUPLICADA
|
|
REWRITE CAD-PRINCIPAL
|
|
IF W88-ARQUIVO-NAO-LIDO
|
|
READ CADASTRO
|
|
MOVE TCL-NOME TO CAD-NOME
|
|
MOVE TCL-ENDERECO TO CAD-ENDERECO
|
|
MOVE TCL-BAIRRO TO CAD-BAIRRO
|
|
MOVE TCL-CIDADE TO CAD-CIDADE
|
|
MOVE TCL-UF TO CAD-UF
|
|
MOVE TCL-CEP TO CAD-CEP
|
|
MOVE TCL-DDD TO CAD-DDD
|
|
MOVE TCL-FONE TO CAD-FONE
|
|
MOVE TCL-FAX TO CAD-FAX
|
|
REWRITE CAD-PRINCIPAL
|
|
IF W88-OK
|
|
INITIALIZE VARIAVEIS-TCL
|
|
MOVE "ARQUIVO ATUALIZADO" TO TCL-MENSAGEM
|
|
ELSE
|
|
INITIALIZE VARIAVEIS-TCL
|
|
MOVE W77-RETCOD TO TCL-MENSAGEM
|
|
END-IF
|
|
END-IF
|
|
ELSE
|
|
IF W88-OK
|
|
INITIALIZE VARIAVEIS-TCL
|
|
MOVE "CLIENTE CADASTRADO" TO TCL-MENSAGEM
|
|
ELSE
|
|
MOVE SPACES TO TCL-MENSAGEM
|
|
STRING "OCORREU UM ERRO NA GRAVACAO ERRO:"
|
|
DELIMITED BY SIZE
|
|
W77-RETCOD DELIMITED BY SIZE
|
|
INTO TCL-MENSAGEM
|
|
MOVE 1 TO W77-ERRO.
|
|
MOVE "cod" TO TCL-FOCUS.
|
|
1000-EXIT.
|
|
EXIT.
|
|
|
|
2000-DELETA SECTION.
|
|
2000-INICIO.
|
|
MOVE TCL-CODIGO TO CAD-CODIGO.
|
|
READ CADASTRO.
|
|
IF NOT W88-OK
|
|
MOVE "CLIENTE NAO CADASTRADO" TO TCL-MENSAGEM
|
|
MOVE "cod" TO TCL-FOCUS
|
|
GO TO 2000-EXIT.
|
|
DELETE CADASTRO.
|
|
IF W88-OK
|
|
INITIALIZE VARIAVEIS-TCL
|
|
MOVE "CLIENTE EXCLUIDO" TO TCL-MENSAGEM
|
|
ELSE
|
|
MOVE 1 TO W77-ERRO
|
|
GO TO 2000-EXIT.
|
|
MOVE "cod" TO TCL-FOCUS.
|
|
2000-EXIT.
|
|
EXIT.
|
|
|
|
3000-ALTERACAO SECTION.
|
|
3000-INICIO.
|
|
MOVE TCL-CODIGO TO CAD-CODIGO.
|
|
READ CADASTRO.
|
|
IF NOT W88-OK
|
|
MOVE "Gravacao" TO TCL-MENSAGEM2
|
|
MOVE SPACES TO TCL-NOME
|
|
MOVE SPACES TO TCL-ENDERECO
|
|
MOVE SPACES TO TCL-BAIRRO
|
|
MOVE SPACES TO TCL-CIDADE
|
|
MOVE SPACES TO TCL-UF
|
|
MOVE SPACES TO TCL-CEP
|
|
MOVE SPACES TO TCL-DDD
|
|
MOVE SPACES TO TCL-FONE
|
|
MOVE SPACES TO TCL-FAX
|
|
MOVE SPACES TO TCL-MENSAGEM
|
|
GO TO 3000-EXIT
|
|
ELSE
|
|
MOVE "Alteracao" TO TCL-MENSAGEM2.
|
|
MOVE CAD-NOME TO TCL-NOME.
|
|
MOVE CAD-ENDERECO TO TCL-ENDERECO.
|
|
MOVE CAD-BAIRRO TO TCL-BAIRRO.
|
|
MOVE CAD-CIDADE TO TCL-CIDADE.
|
|
MOVE CAD-UF TO TCL-UF.
|
|
MOVE CAD-CEP TO TCL-CEP.
|
|
MOVE CAD-DDD TO TCL-DDD.
|
|
MOVE CAD-FONE TO TCL-FONE.
|
|
MOVE CAD-FAX TO TCL-FAX.
|
|
MOVE SPACES TO TCL-MENSAGEM.
|
|
3000-EXIT.
|
|
MOVE "nom" TO TCL-FOCUS.
|
|
EXIT.
|
|
|
|
4000-BUSCA SECTION.
|
|
4000-INICIO.
|
|
MOVE SPACES TO CAD-NOME
|
|
START CADASTRO KEY IS NOT LESS THAN CAD-NOME.
|
|
4000-LE-PROXIMO-REGISTRO.
|
|
READ CADASTRO NEXT.
|
|
IF NOT W88-OK
|
|
MOVE "ini" TO TCL-FOCUS
|
|
MOVE "pri" TO TCL-OPCAO
|
|
CALL "tcleval" USING VARIAVEIS-TCL NOME-PROGRAMA
|
|
IF TCL-OPCAO NOT EQUAL "cer"
|
|
MOVE 1 TO W77-ERRO
|
|
MOVE SPACES TO TCL-OPCAO
|
|
GO TO 4000-EXIT
|
|
END-IF
|
|
GO TO 4000-ACHA-REGISTRO.
|
|
MOVE SPACES TO TCL-MENSAGEM
|
|
STRING CAD-CODIGO DELIMITED BY SIZE
|
|
" " DELIMITED BY SIZE
|
|
CAD-NOME DELIMITED BY SIZE
|
|
INTO TCL-MENSAGEM.
|
|
MOVE "bus" TO TCL-OPCAO.
|
|
MOVE SPACES TO TCL-FOCUS.
|
|
CALL "tcleval" USING VARIAVEIS-TCL NOME-PROGRAMA.
|
|
GO TO 4000-LE-PROXIMO-REGISTRO.
|
|
4000-ACHA-REGISTRO.
|
|
MOVE TCL-MENSAGEM (1:4) TO CAD-CODIGO.
|
|
MOVE SPACES TO TCL-MENSAGEM.
|
|
READ CADASTRO.
|
|
IF NOT W88-OK
|
|
display "nao achei"
|
|
MOVE "Nao foi possivel localzar o registro"
|
|
TO TCL-MENSAGEM
|
|
GO TO 4000-EXIT.
|
|
MOVE CAD-CODIGO TO TCL-CODIGO
|
|
MOVE CAD-NOME TO TCL-NOME.
|
|
MOVE CAD-ENDERECO TO TCL-ENDERECO.
|
|
MOVE CAD-BAIRRO TO TCL-BAIRRO.
|
|
MOVE CAD-CIDADE TO TCL-CIDADE.
|
|
MOVE CAD-UF TO TCL-UF.
|
|
MOVE CAD-CEP TO TCL-CEP.
|
|
MOVE CAD-DDD TO TCL-DDD.
|
|
MOVE CAD-FONE TO TCL-FONE.
|
|
MOVE CAD-FAX TO TCL-FAX.
|
|
4000-EXIT.
|
|
EXIT.
|