IDENTIFICATION DIVISION.
PROGRAM-ID. CWLIST.
AUTHOR. COBOLware Services Ltda.
DATE-WRITTEN. 99/99/9999.
SECURITY. *************************************************
* *
* Exemplo de programa de listagem *
* *
*************************************************
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.
$Set IdxFormat"14"
SELECT SORTWK ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS SORTWK-KEY
LOCK MODE IS EXCLUSIVE
FILE STATUS IS FS-SORTWK.
$Set IdxFormat"4"
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 PIC 9(005).
05 FileName-DESCRICAO PIC X(030).
05 FileName-PRECO 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).
FD SORTWK
LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS LB-SORTWK.
01 SORTWK-REG.
05 SORTWK-KEY.
10 SORTWK-CHAVE PIC X(018).
10 SORTWK-CHAVE-NUMERICA REDEFINES SORTWK-CHAVE
PIC 9(016)V99.
10 SORTWK-ORDEM COMP-3 PIC 9(005).
WORKING-STORAGE SECTION.
01 AREAS-DE-TRABALHO-1.
05 SUBTITULO PIC X(174) VALUE SPACES.
05 CANCELOU PIC X(001) VALUE SPACE.
88 REPORT-CANCELED VALUE "9".
05 CHAVE PIC 9(002) VALUE 0.
88 POR-CODIGO VALUE 1.
88 POR-DESCRICAO VALUE 2.
88 POR-PRECO VALUE 3.
05 LD-FileName COMP-3 PIC 9(008) VALUE 0.
05 LS-FileName COMP-3 PIC 9(008) VALUE 0.
05 ER-FileName.
10 FS-FileName PIC X(002) VALUE "00".
10 LB-FileName PIC X(050) VALUE "FileName".
05 ER-SORTWK.
10 FS-SORTWK PIC X(002) VALUE "00".
10 LB-SORTWK PIC X(050) VALUE "SORTWK".
01 LINHAS-DE-IMPRESSAO-CLIC.
02 LINHA-01.
05 FILLER PIC X(001) VALUE SPACE.
05 FILLER PIC X(010) VALUE
"CODIGO DES".
05 FILLER PIC X(002) VALUE "CR".
05 FILLER PIC X(039) VALUE
"ICAO PRECO".
02 LINHA-02.
05 FILLER PIC X(002) VALUE SPACES.
05 CLIC-CODIGO PIC 9(005) VALUE ZEROS.
05 FILLER PIC X(001) VALUE SPACE.
05 CLIC-DESCRICAO PIC X(030) VALUE SPACES.
05 FILLER PIC X(001) VALUE SPACE.
05 CLIC-PRECO PIC ZZ.ZZZ.ZZ9,99.
SCREEN SECTION.
01 CTAC-LIT-CWLIST.
05 LINE 08 COLUMN 14 VALUE "Lidos de".
05 LINE 10 COLUMN 14 VALUE "Listados".
01 CTAC-VAR-CWLIST.
05 TELA-LD-FileName
LINE 08 COLUMN 03 PIC ZZ.ZZZ.ZZ9 FROM LD-FileName.
05 TELA-LB-FileName
LINE 08 COLUMN 23 PIC X(050) FROM LB-FileName.
05 TELA-LS-FileName
LINE 10 COLUMN 03 PIC ZZ.ZZZ.ZZ9 FROM LS-FileName.
PROCEDURE DIVISION.
000-INICIO.
PERFORM 800-INICIAIS THRU 800-99-FIM
PERFORM 100-PROCESSAMENTO THRU 100-99-FIM
UNTIL FS-FileName > "09"
OR REPORT-CANCELED
PERFORM 900-FINAIS THRU 900-99-FIM.
000-99-FIM. GOBACK.
100-PROCESSAMENTO.
READ FileName NEXT RECORD IGNORE LOCK
IF FS-FileName < "10"
ADD 1 TO LD-FileName
DISPLAY TELA-LD-FileName
IF CHAVE = 1 OR 2
PERFORM 110-LISTAR THRU 110-99-FIM
ELSE
PERFORM 120-ORDENAR THRU 120-99-FIM
END-IF
ELSE
IF FS-FileName > "10"
EXEC COBOLware ISAMerror
STATUS FS-FileName
LABEL LB-FileName
END-EXEC
ELSE
IF POR-PRECO
MOVE LOW-VALUES TO SORTWK-CHAVE
START SORTWK KEY NOT < SORTWK-CHAVE
PERFORM 130-LISTAR-ORDENADO THRU 130-99-FIM
UNTIL FS-SORTWK > "09"
OR REPORT-CANCELED
MOVE "10" TO FS-FileName
END-IF
END-IF
END-IF.
100-99-FIM. EXIT.
110-LISTAR.
MOVE FileName-CODIGO TO CLIC-CODIGO
MOVE FileName-DESCRICAO TO CLIC-DESCRICAO
MOVE FileName-PRECO TO CLIC-PRECO
EXEC COBOLware Print Report "CWLISTA"
TITLE "LISTAGEM DO FileName"
SUBTITLE SUBTITULO
HEADER(1) LINHA-01
DETAIL LINHA-02
WIDTH-080
CANCEL;CANCELOU
END-EXEC
ADD 1 TO LS-FileName
DISPLAY TELA-LS-FileName.
110-99-FIM. EXIT.
120-ORDENAR.
MOVE FileName-CHAVE TO SORTWK-ORDEM
IF POR-PRECO
MOVE FileName-PRECO TO SORTWK-CHAVE-NUMERICA
END-IF
WRITE SORTWK-REG
IF FS-SORTWK > "09"
MOVE "10" TO FS-FileName
END-IF.
120-99-FIM. EXIT.
130-LISTAR-ORDENADO.
READ SORTWK NEXT RECORD
IF FS-SORTWK < "10"
MOVE SORTWK-ORDEM TO FileName-CODIGO
READ FileName IGNORE LOCK
PERFORM 110-LISTAR THRU 110-99-FIM
END-IF.
130-99-FIM. EXIT.
800-INICIAIS.
EXEC COBOLware GetFile
Label LB-FileName
END-EXEC
EXEC COBOLware GetFile
Label LB-SORTWK
END-EXEC
OPEN INPUT FileName
IF FS-FileName > "09"
EXEC COBOLware ISAMerror
STATUS FS-FileName
LABEL LB-FileName
END-EXEC
GOBACK
END-IF
INITIALIZE FileName-REG
DISPLAY CTAC-LIT-CWLIST
CTAC-VAR-CWLIST
EXEC COBOLware BoxSelect
LINE 10 COLUMN 30
TITLE "listar por"
TEXT(1) "~C¢digo"
TEXT(2) "~Descrição"
TEXT(3) "~Preço"
OPTION 2;CHAVE
END-EXEC
EVALUATE CHAVE
WHEN 0
CLOSE FileName
GOBACK
WHEN 1
MOVE "CODIGO" TO SUBTITULO (13: )
START FileName KEY NOT < FileName-CHAVE
WHEN 2
MOVE "DESCRICAO" TO SUBTITULO (13: )
START FileName KEY NOT < FileName-DESCRICAO
WHEN 3
OPEN OUTPUT SORTWK
MOVE "PRECO" TO SUBTITULO (13: )
END-EVALUATE.
800-99-FIM. EXIT.
900-FINAIS.
IF POR-PRECO
IF FS-SORTWK > "10"
AND (NOT REPORT-CANCELED)
EXEC COBOLware ISAMerror
STATUS FS-SORTWK
LABEL LB-SORTWK
END-EXEC
MOVE "10" TO FS-FileName
EXEC COBOLware Print Report "CWLISTA"
DETAIL "ERRO DE CLASSIFICACAO"
END-EXEC
END-IF
CLOSE SORTWK
END-IF
CLOSE FileName
IF NOT REPORT-CANCELED
EXEC COBOLware Print CLOSE
END-EXEC
END-IF.
900-99-FIM. EXIT.
END PROGRAM CWLIST.