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.