IDENTIFICATION DIVISION.
PROGRAM-ID. CWCADS.
AUTHOR. COBOLware Services Ltda.
DATE-WRITTEN. 99/99/9999.
SECURITY. *************************************************
* *
* Exemplo de manutenção de cadastros *
* *
*************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FileName ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS FileName-CHAVE
ALTERNATE RECORD KEY IS FileName-DESCRICAO
WITH DUPLICATES
LOCK MODE IS MANUAL
FILE STATUS IS FS-FileName.
DATA DIVISION.
FILE SECTION.
FD FileName
LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS LB-FileName.
01 FileName-REG.
05 FileName-CHAVE.
10 FileName-CODIGO COMP-3 PIC 9(005).
05 FileName-DESCRICAO PIC X(030).
05 FileName-PRECO COMP-3 PIC 9(008)V99.
05 FileName-TIPO PIC 9(001).
88 FileName-PECA VALUE 1.
88 FileName-ACABADO VALUE 2.
88 FileName-MATERIAL VALUE 3.
05 FileName-OPCOES.
10 FileName-IMPORTADO PIC 9(001).
10 FileName-GARANTIA PIC 9(001).
10 FileName-DURAVEL PIC 9(001).
WORKING-STORAGE SECTION.
01 AREAS-DE-TRABALHO-1.
05 TIPOS.
10 CWRADIO OCCURS 3 PIC 9(001).
05 OPCOES.
10 CWCHECK OCCURS 3 PIC 9(001).
05 MENSAGEM PIC X(074) VALUE SPACES.
05 POSICIONA PIC 9(001) VALUE ZERO.
05 ERRO PIC 9(001) VALUE ZERO.
05 CHAVE PIC 9(002) VALUE ZERO.
05 CHAVE-ANTERIOR PIC 9(002) VALUE ZERO.
05 CAMPO PIC 9(002) VALUE ZERO.
05 SALVA-REG PIC X(4096) VALUE ZERO.
05 SALVA-CHAVE PIC X(255) VALUE SPACES.
05 TECLA PIC 9(003) VALUE ZERO.
COPY CWKEYS.
05 COMANDO PIC X(001) VALUE SPACE.
88 COMANDO-OK VALUE "A" "a"
"E" "e".
88 ABORTAR VALUE "C".
88 EFETIVAR VALUE "O".
05 FUNCAO-ANTERIOR PIC X(001) VALUE SPACE.
05 FUNCAO PIC X(001) VALUE SPACE.
88 ALTERACAO VALUE "A".
88 EXCLUSAO VALUE "E".
88 INCLUSAO VALUE "I".
88 FINALIZAR VALUE "F" "V".
88 PARAR VALUE "F".
88 CONSULTA VALUE "C".
05 FS-FileName PIC X(002) VALUE "00".
05 LB-FileName PIC X(050) VALUE "FileName".
SCREEN SECTION.
01 CTAC-LIT-CWCADS.
05 LINE 08 COLUMN 03 VALUE "Código".
05 LINE 10 COLUMN 03 VALUE "Descrição".
05 LINE 12 COLUMN 03 VALUE "Valor".
05 LINE 15 COLUMN 08 VALUE "Peça".
05 LINE 15 COLUMN 17 VALUE "Acabado".
05 LINE 15 COLUMN 29 VALUE "Material".
05 LINE 19 COLUMN 08 VALUE "Importado".
05 LINE 19 COLUMN 22 VALUE "Garantia".
05 LINE 19 COLUMN 35 VALUE "Durável".
01 CTAC-VAR-CWCADS.
05 TELA-CHAVE.
10 LINE 08 COLUMN 13 PIC Z(005) USING FileName-CODIGO.
05 TELA-DADOS.
10 LINE 10 COLUMN 13 PIC X(030) USING FileName-DESCRICAO.
10 LINE 12 COLUMN 13 PIC ZZ.ZZZ.ZZ9,99
USING FileName-PRECO.
10 LINE 15 COLUMN 05 PIC X(001) USING CWRADIO(1).
10 LINE 15 COLUMN 14 PIC X(001) USING CWRADIO(2).
10 LINE 15 COLUMN 26 PIC X(001) USING CWRADIO(3).
10 LINE 19 COLUMN 05 PIC X(001) USING CWCHECK(1).
10 LINE 19 COLUMN 19 PIC X(001) USING CWCHECK(2).
10 LINE 19 COLUMN 32 PIC X(001) USING CWCHECK(3).
01 TELA-DESCRICAO.
10 LINE 10 COLUMN 13 PIC X(030) USING FileName-DESCRICAO.
PROCEDURE DIVISION.
000-INICIO.
OPEN INPUT FileName
IF FS-FileName > "29"
AND FS-FileName < "39"
OPEN OUTPUT FileName
CLOSE FileName
ELSE
IF FS-FileName < "10"
CLOSE FileName
ELSE
GOBACK
END-IF
END-IF
OPEN I-O FileName
PERFORM 110-GRUPO THRU 110-99-FIM
INITIALIZE FileName-REG
DISPLAY CTAC-LIT-CWCADS
PERFORM 111-EXIBE THRU 111-99-FIM
PERFORM TEST AFTER UNTIL FINALIZAR
IF FUNCAO = SPACE
MOVE 0 TO CHAVE
END-IF
EXEC COBOLware Option
Function FUNCAO
END-EXEC
IF NOT FINALIZAR
PERFORM 100-PROCESSAMENTO THRU 100-99-FIM
END-IF
END-PERFORM
CLOSE FileName
IF PARAR
STOP RUN
ELSE
EXEC COBOLware Picture Erase
LINE 9 COLUMN 52
END-EXEC
GOBACK
END-IF.
100-PROCESSAMENTO.
PERFORM 110-GRUPO THRU 110-99-FIM
COPY CWESCP.
EVALUATE TRUE
WHEN INCLUSAO
PERFORM 140-NOVA-CHAVE THRU 140-99-FIM
ACCEPT TELA-CHAVE
IF FileName-CHAVE = SALVA-CHAVE
PERFORM 140-NOVA-CHAVE THRU 140-99-FIM
END-IF
WHEN ALTERACAO OR EXCLUSAO OR CONSULTA
COPY CWUPDN.
MOVE 0 TO POSICIONA
MOVE FileName-REG TO SALVA-REG
PERFORM UNTIL CHAVE NOT = 0
EXEC COBOLware BoxSelect
TITLE "Pesquisar:"
LINE 10 COLUMN 10
TEXT(1) "~C¢digo"
TEXT(2) "~Descrição"
OPTION CHAVE;CHAVE
END-EXEC
MOVE CHAVE TO POSICIONA
IF CHAVE = 0
MOVE 99 TO CHAVE
MOVE SPACE TO FUNCAO
END-IF
END-PERFORM
EVALUATE TRUE
WHEN ALTERACAO
EXEC COBOLware Object Push-Button SMALL
LINE 23 COLUMN 32 WIDTH 7
CAPTION " Altera "
KEY CODE-F2 TAB-OFF
END-EXEC
WHEN EXCLUSAO
EXEC COBOLware Object Push-Button SMALL
LINE 23 COLUMN 32 WIDTH 7
CAPTION " Exclui "
KEY CODE-F2 TAB-OFF
END-EXEC
END-EVALUATE
EVALUATE CHAVE
WHEN 1
EXEC COBOLware Object COMBO-BOX
LINE 08 COLUMN 13 HEIGHT 10 WIDTH 5
PROVIDER "CWCAD3"
FIELD Filename-CODIGO
ORDER-LEFT RETURN-LEFT
LEFT-WIDTH 6
RIGHT-WIDTH 30
END-EXEC
ACCEPT TELA-CHAVE
WHEN 2
EXEC COBOLware Object COMBO-BOX
LINE 10 COLUMN 13 HEIGHT 10 WIDTH 30
PROVIDER "CWCAD3"
FIELD Filename-DESCRICAO
ORDER-RIGHT RETURN-RIGHT
RIGHT-WIDTH 30
END-EXEC
ACCEPT TELA-DESCRICAO
END-EVALUATE
PERFORM 110-GRUPO THRU 110-99-FIM
IF FileName-REG = SALVA-REG
AND CHAVE = CHAVE-ANTERIOR
AND FUNCAO = CHAVE-ANTERIOR
MOVE 0 TO POSICIONA
END-IF
MOVE CHAVE TO CHAVE-ANTERIOR
MOVE FUNCAO TO CHAVE-ANTERIOR
IF POSICIONA NOT = 0
OR FileName-REG NOT = SALVA-REG
MOVE 1 TO POSICIONA
EVALUATE CHAVE
WHEN 1
START FileName KEY NOT < FileName-CHAVE
INVALID KEY
START FileName
KEY NOT > FileName-CHAVE
END-START
END-START
WHEN 2
START FileName KEY NOT < FileName-DESCRICAO
INVALID KEY
START FileName
KEY NOT > FileName-DESCRICAO
END-START
END-START
END-EVALUATE
END-IF
END-EVALUATE
IF POSICIONA = 0
ACCEPT TECLA FROM ESCAPE KEY
ELSE
SET PAGE-DOWN TO TRUE
END-IF
EVALUATE TRUE
WHEN ESC
MOVE SPACE TO FUNCAO
WHEN INCLUSAO
AND FileName-CODIGO = 0
EXEC COBOLware Send
Message "Informe c¢digo do produto"
END-EXEC
WHEN INCLUSAO
READ FileName
IF FS-FileName < "10"
PERFORM 111-EXIBE THRU 111-99-FIM
EXEC COBOLware Send
Message "Produto já cadastrado"
END-EXEC
ELSE
IF FS-FileName = "23"
WRITE FileName-REG
READ FileName WITH LOCK
PERFORM 120-CRITICA THRU 120-99-FIM
IF EFETIVAR
REWRITE FileName-REG
UNLOCK FileName
ELSE
EXEC COBOLware Picture Erase
LINE 9 COLUMN 52
END-EXEC
DELETE FileName RECORD
EXEC COBOLware Picture Remove
RECORD FileName-CODIGO
FILE "fotos"
END-EXEC
END-IF
END-IF
END-IF
WHEN (ALTERACAO OR EXCLUSAO OR CONSULTA)
AND (PAGE-DOWN OR PAGE-UP)
IF FS-FileName = "23"
EVALUATE CHAVE
WHEN 1
START FileName
KEY NOT < FileName-CHAVE
INVALID KEY
START FileName
KEY NOT > FileName-CHAVE
END-START
END-START
WHEN 2
START FileName
KEY NOT < FileName-DESCRICAO
INVALID KEY
START FileName
KEY NOT > FileName-DESCRICAO
END-START
END-START
END-EVALUATE
END-IF
EVALUATE TRUE
WHEN PAGE-DOWN
READ FileName
NEXT RECORD IGNORE LOCK
WHEN PAGE-UP
READ FileName
PREVIOUS RECORD IGNORE LOCK
END-EVALUATE
IF FS-FileName > "09"
IF FS-FileName > "10"
MOVE "V" TO FUNCAO
END-IF
ELSE
PERFORM 111-EXIBE THRU 111-99-FIM
END-IF
IF FS-FileName = "10"
EVALUATE TRUE
WHEN PAGE-DOWN
READ FileName
PREVIOUS RECORD IGNORE LOCK
WHEN PAGE-UP
READ FileName
NEXT RECORD IGNORE LOCK
END-EVALUATE
IF FS-FileName NOT = "10"
MOVE "10" TO FS-FileName
END-IF
END-IF
WHEN (ALTERACAO OR EXCLUSAO OR CONSULTA)
AND (ENTER-KEY OR F2)
MOVE SPACE TO COMANDO
PERFORM TEST AFTER UNTIL FS-FileName NOT = "9D"
IF CONSULTA
READ FileName IGNORE LOCK
ELSE
READ FileName WITH LOCK
END-IF
END-PERFORM
MOVE 1 TO POSICIONA
MOVE SPACES TO SALVA-REG
PERFORM 111-EXIBE THRU 111-99-FIM
EVALUATE TRUE
WHEN FS-FileName = "23"
EXEC COBOLware Send
Message "Produto não cadastrado"
END-EXEC
WHEN FS-FileName > "09"
AND FS-FileName NOT = "9D"
MOVE "V" TO FUNCAO
WHEN ALTERACAO
MOVE FileName-REG TO SALVA-REG
PERFORM 120-CRITICA THRU 120-99-FIM
IF EFETIVAR
REWRITE FileName-REG
ELSE
UNLOCK FileName
END-IF
WHEN EXCLUSAO
PERFORM 130-CONFIRMA THRU 130-99-FIM
IF EFETIVAR
DELETE FileName RECORD
ELSE
UNLOCK FileName
END-IF
EXEC COBOLware Picture Erase
LINE 9 COLUMN 52
END-EXEC
EXEC COBOLware Picture Remove
RECORD FileName-CODIGO
FILE "fotos"
END-EXEC
END-EVALUATE
IF FS-FileName > "09"
AND EFETIVAR
MOVE "V" TO FUNCAO
END-IF
END-EVALUATE.
100-99-FIM. EXIT.
110-GRUPO.
EXEC COBOLware Object DROP END-EXEC
EXEC COBOLware Object GROUP
LINE 14 COLUMN 3 WIDTH 36
CAPTION "Tipo"
END-EXEC
EXEC COBOLware Object GROUP
LINE 18 COLUMN 3 WIDTH 41
CAPTION "Opcões"
END-EXEC.
110-99-FIM. EXIT.
111-EXIBE.
INITIALIZE TIPOS
IF FileName-TIPO > 0
MOVE "1" TO CWRADIO(FileName-TIPO)
END-IF
MOVE FileName-OPCOES TO OPCOES
EXEC COBOLware Picture Display
LINE 9 COLUMN 52 WIDTH 21
HEIGHT 13
RECORD FileName-CODIGO
FILE "fotos"
END-EXEC
DISPLAY CTAC-VAR-CWCADS.
111-99-FIM. EXIT.
120-CRITICA.
PERFORM 110-GRUPO THRU 110-99-FIM
COPY CWESCP.
EXEC COBOLware Object Push-Button SMALL
LINE 23 COLUMN 02 WIDTH 13
CAPTION " F3-Concluir "
KEY CODE-F3 TAB-OFF
END-EXEC
EXEC COBOLware Object Push-Button SMALL
LINE 23 COLUMN 17 WIDTH 9
CAPTION " F4-Foto "
KEY CODE-F4 TAB-OFF
END-EXEC
EXEC COBOLware Object Validate
PROGRAM "CWCAD2" USING FileName-DESCRICAO
FileName-PRECO
FIELD ANY
END-EXEC
PERFORM TEST AFTER UNTIL NOT F4
ACCEPT TELA-DADOS
ACCEPT TECLA FROM ESCAPE KEY
IF F4
EXEC COBOLware Picture Update
RECORD FileName-CODIGO
FILE "fotos"
END-EXEC
EXEC COBOLware Picture Display
LINE 9 COLUMN 52 WIDTH 21
HEIGHT 13
RECORD FileName-CODIGO
FILE "fotos"
END-EXEC
END-IF
END-PERFORM
MOVE SPACE TO COMANDO
IF NOT ESC
PERFORM VARYING FileName-TIPO FROM 3 BY -1
UNTIL FileName-TIPO = 0
OR CWRADIO (FileName-TIPO) = "1"
CONTINUE
END-PERFORM
MOVE OPCOES TO FileName-OPCOES
IF FileName-REG = SALVA-REG
AND ALTERACAO
SET ABORTAR TO TRUE
ELSE
PERFORM 130-CONFIRMA THRU 130-99-FIM
END-IF
ELSE
MOVE SPACE TO FUNCAO
END-IF
PERFORM 110-GRUPO THRU 110-99-FIM.
120-99-FIM. EXIT.
130-CONFIRMA.
COPY CWEFAB.
IF EFETIVAR
EXEC COBOLware LogWrite
FUNCTION FUNCAO
TEXT FileName-CODIGO
END-EXEC.
130-99-FIM. EXIT.
140-NOVA-CHAVE.
MOVE ALL X"FF" TO FileName-REG
START FileName KEY NOT > FileName-CHAVE
INVALID KEY
INITIALIZE FileName-REG
MOVE 1 TO FileName-CODIGO
NOT INVALID KEY
READ FileName PREVIOUS RECORD IGNORE LOCK
ADD 1 TO FileName-CODIGO
MOVE FileName-CHAVE TO SALVA-CHAVE
INITIALIZE FileName-REG
MOVE SALVA-CHAVE TO FileName-CHAVE
END-START
PERFORM 111-EXIBE THRU 111-99-FIM
DISPLAY TELA-CHAVE.
140-99-FIM. EXIT.
END PROGRAM CWCADS.