Usando o ROWSET do DB2 - Programa exemplo 003 - 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 003
1 2 3 4 5 6 7 8 12345678901234567890123456789012345678901234567890123456789012345678901234567890 *----------------------------------------------------------------- IDENTIFICATION DIVISION. *----------------------------------------------------------------- PROGRAM-ID. CADPO003. AUTHOR . DORNELLES CARLOS ALBERTO. *----------------------------------------------------------------- * SISTEMA : SICAD * PROGRAMA : CADPO003 * OBJETIVO : CONSULTA TABELA DE PAIS - CADVW979_PAIS * ANALISTA : DORNELLES CARLOS ALBERTO * DATA : 26/OUTUBRO/2012 *----------------------------------------------------------------- *----------------------------------------------------------------- * MANUTENCAO *----------------------------------------------------------------- * VRS DD.MM.AAAA AUTOR DESCRICAO * 001 25.10.2012 DORNELLES CRIACAO *----------------------------------------------------------------- * 002 *----------------------------------------------------------------- *----------------------------------------------------------------- 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-IND PIC 9(003) VALUE ZEROES. 05 WS-SAIDA-JAVA. 10 WS-ARRAY-SAIDA OCCURS 400 TIMES. 15 WS-NU-PAIS PIC 9(004). 15 WS-NO-PAIS PIC X(040). 01 WS487-REGISTRO. 05 WS487-TOTREG PIC 9(005). * 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 WS487-ARRAY. 10 WS487-NU-PAIS PIC S9(004) COMP OCCURS 400 TIMES. 10 WS487-NO-PAIS PIC X(0040) OCCURS 400 TIMES. *----------------------------------------------------------------- LOCAL-STORAGE SECTION. *----------------------------------------------------------------- *----------------------------------------------------------------- * DEFINICAO DE TABELAS E AREAS NA DCLGEN *----------------------------------------------------------------- EXEC SQL INCLUDE SQLCA END-EXEC. EXEC SQL INCLUDE CADVW979 END-EXEC. EXEC SQL DECLARE CURSOR01 SCROLL CURSOR WITH ROWSET POSITIONING FOR SELECT NU_PAIS , NO_PAIS FROM CAD.CADVW979_PAIS WHERE NU_PAIS > 0 ORDER BY NO_PAIS 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:STREAM-IO-CONTEUDO-TAM) TO WS487-REGISTRO MOVE ZEROES TO STREAM-IO-ERRO-CICS STREAM-IO-NU-MENSAGEM MOVE 1 TO WS-POSCURSOR . 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 WS487-NU-PAIS (WS-IND) TO WS-NU-PAIS (WS-IND) MOVE WS487-NO-PAIS (WS-IND) TO WS-NO-PAIS (WS-IND) 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 400 ROWS INTO :WS487-NU-PAIS , :WS487-NO-PAIS END-EXEC *----------------------------------------------------------------- * * SQLCODE = +000 o FETCH trouxe 400 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 WS487-TOTREG WHEN +100 IF SQLERRD (3) EQUAL +0 MOVE ZEROES TO WS487-TOTREG ELSE MOVE SQLERRD (3) TO WS487-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. *----------------------------------------------------------------- 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 . P8000-FIM. EXIT. *----------------------------------------------------------------- P9000-PROCEDIMENTOS-FINAIS. *----------------------------------------------------------------- COMPUTE STREAM-IO-CONTEUDO-TAM = (WS487-TOTREG * 44) MOVE WS-SAIDA-JAVA TO STREAM-IO-CONTEUDO EXEC CICS RETURN END-EXEC . P9000-FIM. EXIT.
