Na WORKING, criei:
77 WRK-INDICE PIC 9(02).
77 WRK-QTDREG PIC 9(05) VALUE ZEROS.
77 WRK-QTDREG-ED PIC ZZZZ9.
01 WRK-CLIENTE-FONE.
02 WRK-CLIENTE-FONES PIC 9(09) OCCURS 6 TIMES.
01 WRK-CLIENTE-NOME.
02 WRK-CLIENTE-NOMES PIC X(30) OCCURS 6 TIMES.
01 WRK-CLIENTE-EMAIL.
02 WRK-CLIENTE-EMAILS PIC X(40) OCCURS 6 TIMES.
Na SCREEN SEXTION eu declarei:
01 TELA-RELATORIO.
02 CABECALHO-RELATORIO.
05 LINE 4 COLUMN 21 PIC X(33)
FROM 'RELATORIO DE CLIENTES CADASTRADOS'.
05 LINE 6 COLUMN 1 PIC X(09)
FROM 'TELEFONE'.
05 COLUMN PLUS 2 PIC X(30)
FROM 'NOME'.
05 COLUMN PLUS 1 PIC X(40)
FROM 'E-MAIL'.
05 LINE 7 COLUMN 1 PIC X(09)
FROM '---------'.
05 COLUMN PLUS 2 PIC X(30)
FROM '------------------------------'.
05 COLUMN PLUS 1 PIC X(40)
FROM '----------------------------------------'.
02 CORPO-RELATORIO.
05 LINE 8 COLUMN 1 PIC 9(09) FROM WRK-CLIENTE-FONES(1)
BLANK WHEN ZEROS.
05 COLUMN PLUS 2 PIC X(30)
FROM WRK-CLIENTE-NOMES(1).
05 COLUMN PLUS 1 PIC X(40)
FROM WRK-CLIENTE-EMAILS(1).
05 LINE 9 COLUMN 1 PIC 9(09) FROM WRK-CLIENTE-FONES(2)
BLANK WHEN ZEROS.
05 COLUMN PLUS 2 PIC X(30)
FROM WRK-CLIENTE-NOMES(2).
05 COLUMN PLUS 1 PIC X(40)
FROM WRK-CLIENTE-EMAILS(2).
05 LINE 10 COLUMN 1 PIC 9(09) FROM WRK-CLIENTE-FONES(3)
BLANK WHEN ZEROS.
05 COLUMN PLUS 2 PIC X(30)
FROM WRK-CLIENTE-NOMES(3).
05 COLUMN PLUS 1 PIC X(40)
FROM WRK-CLIENTE-EMAILS(3).
05 LINE 11 COLUMN 1 PIC 9(09) FROM WRK-CLIENTE-FONES(4)
BLANK WHEN ZEROS.
05 COLUMN PLUS 2 PIC X(30)
FROM WRK-CLIENTE-NOMES(4).
05 COLUMN PLUS 1 PIC X(40)
FROM WRK-CLIENTE-EMAILS(4).
05 LINE 12 COLUMN 1 PIC 9(09) FROM WRK-CLIENTE-FONES(5)
BLANK WHEN ZEROS.
05 COLUMN PLUS 2 PIC X(30)
FROM WRK-CLIENTE-NOMES(5).
05 COLUMN PLUS 1 PIC X(40)
FROM WRK-CLIENTE-EMAILS(5).
05 LINE 13 COLUMN 1 PIC 9(09) FROM WRK-CLIENTE-FONES(6)
BLANK WHEN ZEROS.
05 COLUMN PLUS 2 PIC X(30)
FROM WRK-CLIENTE-NOMES(6).
05 COLUMN PLUS 1 PIC X(40)
FROM WRK-CLIENTE-EMAILS(6).
Na PROCEDURE eu fiz:
9100-RELATORIO-TELA.
MOVE 'MODULO - RELATORIO -' TO WRK-MODULO.
DISPLAY TELA.
MOVE 1 TO CLIENTES-FONE.
START CLIENTES KEY EQUAL CLIENTES-FONE.
READ CLIENTES
INVALID KEY
MOVE 'NENHUM REGISTRO ENCONTRADO' TO WRK-MSGERRO
NOT INVALID KEY
PERFORM UNTIL CLIENTES-STATUS = 10
PERFORM VARYING WRK-INDICE FROM 1
BY 1 UNTIL WRK-INDICE > 6
OR CLIENTES-STATUS = 10
MOVE CLIENTES-FONE
TO WRK-CLIENTE-FONES(WRK-INDICE)
MOVE CLIENTES-NOME
TO WRK-CLIENTE-NOMES(WRK-INDICE)
MOVE CLIENTES-EMAIL
TO WRK-CLIENTE-EMAILS(WRK-INDICE)
ADD 1 TO WRK-QTDREG
READ CLIENTES NEXT
IF CLIENTES-STATUS = 10 THEN
MOVE 'ENTER - FINALIZAR' TO WRK-MSGERRO
MOVE WRK-QTDREG TO WRK-QTDREG-ED
DISPLAY 'TOTAL DE REGISTROS LIDOS = ' AT 1504
DISPLAY WRK-QTDREG-ED AT 1532
ELSE
MOVE 'ENTER - PROXIMA TELA' TO WRK-MSGERRO
END-PERFORM
DISPLAY TELA-RELATORIO
ACCEPT MOSTRA-ERRO
PERFORM 9110-LIMPA-CORPO-RELATORIO
END-PERFORM
END-READ.
9110-LIMPA-CORPO-RELATORIO.
PERFORM VARYING WRK-INDICE FROM 1 BY 1 UNTIL WRK-INDICE > 6
MOVE ZEROS TO WRK-CLIENTE-FONES(WRK-INDICE)
MOVE SPACES TO WRK-CLIENTE-NOMES(WRK-INDICE)
MOVE SPACES TO WRK-CLIENTE-EMAILS(WRK-INDICE)
END-PERFORM.