Usando o ROWSET do DB2 - Programa exemplo 002 - www.cadcobol.com.br
Desenvolvido por DORNELLES Carlos Alberto - Analista de Sistemas - Brasília DF. - cad_cobol@hotmail.com
Usando o ROWSET do DB2 - Programa exemplo 002
1 2 3 4 5 6 7 8 12345678901234567890123456789012345678901234567890123456789012345678901234567890 *----------------------------------------------------------------- IDENTIFICATION DIVISION. *----------------------------------------------------------------- PROGRAM-ID. CADPO002. AUTHOR . DORNELLES CARLOS ALBERTO. *----------------------------------------------------------------- * SISTEMA : SICAD * PROGRAMA : CADPO002 * OBJETIVO : CONSULTA INSTITUICAO REFERENCIA * ANALISTA : DORNELLES CARLOS ALBERTO * DATA : 02/OUTUBRO/2012 *----------------------------------------------------------------- *----------------------------------------------------------------- ENVIRONMENT DIVISION. *----------------------------------------------------------------- CONFIGURATION SECTION. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. *----------------------------------------------------------------- DATA DIVISION. *----------------------------------------------------------------- *----------------------------------------------------------------- WORKING-STORAGE SECTION. *----------------------------------------------------------------- 01 WS-AUXILIARES. 05 WS-SQLCODE PIC -Z.ZZ9 VALUE ZEROES. 05 WS-PARAGRAFO PIC X(080) VALUE SPACES. 05 WS-POSCURSOR PIC S9(004) COMP VALUE ZEROES. 05 WS-POSCURSOR02 PIC S9(004) COMP VALUE ZEROES. 05 WS-TOTAL-REG-TEL PIC 9(009) VALUE ZEROES. 05 WS470-TOTREG PIC 9(005) VALUE ZEROES. 05 WS-IND PIC 9(003) VALUE ZEROES. 05 WS-IND1 PIC 9(003) VALUE ZEROES. 05 WS-SAIDA-JAVA. 10 WS-NU-INSTITUICAO PIC 9(009). 10 WS-NO-INSTITUICAO PIC X(100). 10 WS-NO-REDUZIDO PIC X(030). 10 WS-NU-CNPJ-INSTITUICAO PIC 9(014). 10 WS-DE-ENDERECO PIC X(100). 10 WS-DE-COMPLEMENTO-ENDE PIC X(100). 10 WS-NU-CEP-ENDERECO PIC 9(008). 10 WS-DE-ENDERECO-ELETRO PIC X(100). 10 WS-IC-TP-INSTITUICAO PIC X(001). 10 WS-NU-PAIS PIC X(004). 10 WS-QTDE-TELEFONES PIC 9(002). 10 WS-NRO-TELEFONES OCCURS 10 TIMES. 15 WS-NU-TELEFONE PIC X(020). 15 WS-NU-DDI PIC X(005). 15 WS-NU-DDD PIC X(003). 15 WS-NU-RAMAL PIC 9(009). 15 WS-NO-TIPO-TELEFONE PIC X(020). *----------------------------------------------------------------- * BOOK PARA O PROGRAMA CADPO002 *----------------------------------------------------------------- 01 WS470-REGISTRO. 05 WS470-ARRAY. 15 WS470-NU-INSTITUICAO PIC S9(009) USAGE COMP OCCURS 41. 15 WS470-NO-INSTITUICAO PIC X(100) OCCURS 41. 15 WS470-NO-REDUZIDO PIC X(030) OCCURS 41. 15 WS470-NU-CNPJ PIC S9(014)V USAGE COMP-3 OCCURS 41. 15 WS470-DE-ENDERECO PIC X(100) OCCURS 41. 15 WS470-DE-COMPLEMENTO PIC X(100) OCCURS 41. 15 WS470-NU-CEP-ENDERECO PIC S9(008)V USAGE COMP-3 OCCURS 41. 15 WS470-DE-ENDERECO-ELETR PIC X(100) OCCURS 41. 15 WS470-IC-TP-INSTITUICAO PIC X(001) OCCURS 41. 15 WS470-NU-PAIS PIC S9(004) USAGE COMP OCCURS 41. 05 WS470-QTDE-TELEFONES PIC 9(002). * Esta definicao esta correta - para armazenar os dados usando o * ROWSET tem que ser assim mesmo - valido para o DB2 a partir da versao 8 05 WS470-NRO-TELEFONES. 15 WS470-NU-TELEFONE PIC X(20) OCCURS 10. 15 WS470-NU-DDI PIC X(5) OCCURS 10. 15 WS470-NU-DDD PIC X(5) OCCURS 10. 15 WS470-NU-RAMAL PIC S9(9) USAGE COMP OCCURS 10. 15 WS470-NO-TIPO-TELEFONE PIC X(20) OCCURS 10. * COPY CADBK470. *----------------------------------------------------------------- LOCAL-STORAGE SECTION. *----------------------------------------------------------------- *----------------------------------------------------------------- * DEFINICAO DE TABELAS E AREAS NA DCLGEN *----------------------------------------------------------------- EXEC SQL INCLUDE SQLCA END-EXEC. EXEC SQL INCLUDE CADTBA21 END-EXEC. EXEC SQL INCLUDE CADTBA22 END-EXEC. EXEC SQL DECLARE CURSOR01 SCROLL CURSOR WITH ROWSET POSITIONING FOR SELECT NU_INSTITUICAO , NO_INSTITUICAO , NO_REDUZIDO_INSTIUTICAO ,VALUE(NU_CNPJ_INSTITUICAO,0) ,VALUE(DE_ENDERECO_INSTITUICAO,' ') ,VALUE(DE_COMPLEMENTO_ENDERECO,' ') ,VALUE(NU_CEP_ENDERECO,0) ,VALUE(DE_ENDERECO_ELETRONICO,' ') , IC_TP_INSTITUICAO ,VALUE(NU_PAIS,0) FROM CAD.CADTBA21_INSTITUICAO_RFRNA WHERE NU_INSTITUICAO = :CADTBA21.NU-INSTITUICAO AND IC_ATIVO = '1' ORDER BY NO_INSTITUICAO END-EXEC. EXEC SQL DECLARE CURSOR02 SCROLL CURSOR WITH ROWSET POSITIONING FOR SELECT NU_TELEFONE ,VALUE(NU_DDI,' ') ,VALUE(NU_DDD,' ') ,VALUE(NU_RAMAL,0) ,VALUE(NO_TIPO_TELEFONE,' ') FROM CAD.CADTBA22_TELEFONE_INSTITUICAO WHERE NU_INSTITUICAO = :CADTBA21.NU-INSTITUICAO END-EXEC. *----------------------------------------------------------------- * LINKAGE SECTION *----------------------------------------------------------------- LINKAGE SECTION. 01 DFHCOMMAREA. COPY CADB0000. *----------------------------------------------------------------- PROCEDURE DIVISION USING DFHCOMMAREA. *----------------------------------------------------------------- PERFORM P0001-PROCEDIMENTOS-INICIAIS PERFORM P1000-PROCEDIMENTOS-PRINCIPAIS PERFORM P9000-PROCEDIMENTOS-FINAIS . *----------------------------------------------------------------- * PROCEDIMENTOS INICIAIS *----------------------------------------------------------------- P0001-PROCEDIMENTOS-INICIAIS. MOVE 'P0001-PROCEDIMENTOS-INICIAIS' TO WS-PARAGRAFO MOVE LENGTH OF STREAM-IO-CONTEUDO TO STREAM-IO-CONTEUDO-TAM MOVE STREAM-IO-CONTEUDO (1:9) TO WS-NU-INSTITUICAO MOVE ZEROS TO STREAM-IO-ERRO-CICS STREAM-IO-NU-MENSAGEM MOVE 1 TO WS-POSCURSOR MOVE WS-NU-INSTITUICAO TO NU-INSTITUICAO OF CADTBA21 . P0001-FIM. EXIT. *----------------------------------------------------------------- P1000-PROCEDIMENTOS-PRINCIPAIS. *----------------------------------------------------------------- MOVE 'P1000-PROCEDIMENTOS-PRINCIPAIS' TO WS-PARAGRAFO PERFORM P300-ABRE-CURSOR IF SQLCODE NOT EQUAL +000 AND +100 PERFORM P8000-TRATA-SQLCODE END-IF PERFORM P400-LER-CURSOR IF SQLCODE NOT EQUAL +000 AND +100 PERFORM P8000-TRATA-SQLCODE END-IF IF SQLERRD(3) EQUAL ZEROES MOVE +9999 TO SQLCODE PERFORM P8000-TRATA-SQLCODE END-IF MOVE 1 TO WS-IND PERFORM UNTIL WS-IND GREATER THAN SQLERRD (3) MOVE WS470-NU-INSTITUICAO (WS-IND) TO WS-NU-INSTITUICAO MOVE WS470-NO-INSTITUICAO (WS-IND) TO WS-NO-INSTITUICAO MOVE WS470-NO-REDUZIDO (WS-IND) TO WS-NO-REDUZIDO MOVE WS470-NU-CNPJ (WS-IND) TO WS-NU-CNPJ-INSTITUICAO MOVE WS470-DE-ENDERECO (WS-IND) TO WS-DE-ENDERECO MOVE WS470-DE-COMPLEMENTO (WS-IND) TO WS-DE-COMPLEMENTO-ENDE MOVE WS470-NU-CEP-ENDERECO (WS-IND) TO WS-NU-CEP-ENDERECO MOVE WS470-DE-ENDERECO-ELETR (WS-IND) TO WS-DE-ENDERECO-ELETRO MOVE WS470-IC-TP-INSTITUICAO (WS-IND) TO WS-IC-TP-INSTITUICAO MOVE WS470-NU-PAIS (WS-IND) TO WS-NU-PAIS MOVE 1 TO WS-POSCURSOR02 PERFORM P600-ABRE-CURSOR02 PERFORM P700-LER-CURSOR02 PERFORM P800-FECHA-CURSOR02 ADD 1 TO WS-IND END-PERFORM PERFORM P500-FECHA-CURSOR IF SQLCODE NOT EQUAL +000 PERFORM P8000-TRATA-SQLCODE END-IF . P1000-FIM. EXIT. *----------------------------------------------------------------- P300-ABRE-CURSOR. *----------------------------------------------------------------- EXEC SQL OCAD CURSOR01 END-EXEC . P300-FIM. EXIT. *----------------------------------------------------------------- P400-LER-CURSOR. *----------------------------------------------------------------- EXEC SQL FETCH ROWSET STARTING AT ABSOLUTE :WS-POSCURSOR CURSOR01 FOR 41 ROWS INTO :WS470-NU-INSTITUICAO , :WS470-NO-INSTITUICAO , :WS470-NO-REDUZIDO , :WS470-NU-CNPJ , :WS470-DE-ENDERECO , :WS470-DE-COMPLEMENTO , :WS470-NU-CEP-ENDERECO , :WS470-DE-ENDERECO-ELETR , :WS470-IC-TP-INSTITUICAO , :WS470-NU-PAIS END-EXEC *----------------------------------------------------------------- * * SQLCODE = +000 o FETCH trouxe 41 registros * * SQLCODE = +100 e SQLERRD(3) = 0 * o FETCH não trouxe mais nenhum registro * * SQLCODE= +100 e SQLERRD(3) > 0 * o FETCH trouxe tantos registros quanto o valor que * consta em SQLERRD(3) * *----------------------------------------------------------------- EVALUATE SQLCODE WHEN +000 MOVE SQLERRD (3) TO WS470-TOTREG WHEN +100 IF SQLERRD (3) EQUAL +0 MOVE ZEROES TO WS470-TOTREG ELSE MOVE SQLERRD (3) TO WS470-TOTREG END-IF WHEN OTHER PERFORM P8000-TRATA-SQLCODE END-EVALUATE . P400-FIM. EXIT. *----------------------------------------------------------------- P500-FECHA-CURSOR. *----------------------------------------------------------------- EXEC SQL CLOSE CURSOR01 END-EXEC . P500-FIM. EXIT. *----------------------------------------------------------------- P600-ABRE-CURSOR02. *----------------------------------------------------------------- EXEC SQL OCAD CURSOR02 END-EXEC . P600-FIM. EXIT. *----------------------------------------------------------------- P700-LER-CURSOR02. *----------------------------------------------------------------- EXEC SQL FETCH ROWSET STARTING AT ABSOLUTE :WS-POSCURSOR02 CURSOR02 FOR 10 ROWS INTO :WS470-NU-TELEFONE , :WS470-NU-DDI , :WS470-NU-DDD , :WS470-NU-RAMAL , :WS470-NO-TIPO-TELEFONE END-EXEC *----------------------------------------------------------------- * * SQLCODE = +000 o FETCH trouxe 10 registros * * SQLCODE = +100 e SQLERRD(3) = 0 * o FETCH não trouxe mais nenhum registro * * SQLCODE= +100 e SQLERRD(3) > 0 * o FETCH trouxe tantos registros quanto o valor que * consta em SQLERRD(3) * *----------------------------------------------------------------- EVALUATE SQLCODE WHEN +000 MOVE SQLERRD (3) TO WS-QTDE-TELEFONES WHEN +100 IF SQLERRD (3) EQUAL +0 MOVE ZEROES TO WS-QTDE-TELEFONES ELSE MOVE SQLERRD (3) TO WS-QTDE-TELEFONES END-IF WHEN OTHER PERFORM P8000-TRATA-SQLCODE END-EVALUATE COMPUTE WS-TOTAL-REG-TEL = WS-TOTAL-REG-TEL + (SQLERRD (3) * 57) MOVE 1 TO WS-IND1 PERFORM UNTIL WS-IND1 GREATER THAN WS-QTDE-TELEFONES OR WS-IND1 GREATER THAN 10 MOVE WS470-NU-TELEFONE (WS-IND1) TO WS-NU-TELEFONE (WS-IND1) MOVE WS470-NU-DDI (WS-IND1) TO WS-NU-DDI (WS-IND1) MOVE WS470-NU-DDD (WS-IND1) TO WS-NU-DDD (WS-IND1) MOVE WS470-NU-RAMAL (WS-IND1) TO WS-NU-RAMAL (WS-IND1) MOVE WS470-NO-TIPO-TELEFONE (WS-IND1) TO WS-NO-TIPO-TELEFONE (WS-IND1) ADD 1 TO WS-IND1 END-PERFORM . P700-FIM. EXIT. *----------------------------------------------------------------- P800-FECHA-CURSOR02. *----------------------------------------------------------------- EXEC SQL CLOSE CURSOR02 END-EXEC . P800-FIM. EXIT. *----------------------------------------------------------------- P8000-TRATA-SQLCODE. *----------------------------------------------------------------- MOVE ZEROES TO STREAM-IO-ERRO-CICS MOVE SQLCODE TO STREAM-IO-NU-MENSAGEM STREAM-IO-NU-SQLCODE EVALUATE SQLCODE WHEN +000 WHEN +100 CONTINUE WHEN +9999 MOVE 'Nenhum registro encontrado.' TO STREAM-IO-NO-MENSAGEM WHEN OTHER MOVE 'Erro de acesso ao banco de dados.' TO STREAM-IO-NO-MENSAGEM END-EVALUATE EXEC CICS RETURN END-EXEC . P8000-FIM. EXIT. *----------------------------------------------------------------- P9000-PROCEDIMENTOS-FINAIS. *----------------------------------------------------------------- COMPUTE STREAM-IO-CONTEUDO-TAM = 468 + WS-TOTAL-REG-TEL MOVE WS-SAIDA-JAVA TO STREAM-IO-CONTEUDO EXEC CICS RETURN END-EXEC . P9000-FIM. EXIT.
