Usando o ROWSET do DB2 - Programa exemplo 001 - 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 001
1 2 3 4 5 6 7 8 12345678901234567890123456789012345678901234567890123456789012345678901234567890 *----------------------------------------------------------------- IDENTIFICATION DIVISION. *----------------------------------------------------------------- PROGRAM-ID. CADPO001. AUTHOR . DORNELLES CARLOS ALBERTO. *----------------------------------------------------------------- * SISTEMA : SICAD * PROGRAMA : CADPO001 * OBJETIVO : CONSULTA TIPO MENSAGEM - CADTB002 * TIPO : CONSULTA TIPO 3 - 1 MEGA * ANALISTA : DORNELLES CARLOS ALBERTO * DATA : 22/OUTUBRO/2012 *----------------------------------------------------------------- *----------------------------------------------------------------- * MANUTENCAO *----------------------------------------------------------------- * VRS DD.MM.AAAA AUTOR DESCRICAO * 001 22.10.2012 DORNELLES CRIACAO *----------------------------------------------------------------- * 002 *----------------------------------------------------------------- *----------------------------------------------------------------- ENVIRONMENT DIVISION. *----------------------------------------------------------------- CONFIGURATION SECTION. *----------------------------------------------------------------- SPECIAL-NAMES. DECIMAL-POINT IS COMMA. *----------------------------------------------------------------- *----------------------------------------------------------------- DATA DIVISION. *----------------------------------------------------------------- *----------------------------------------------------------------- WORKING-STORAGE SECTION. *----------------------------------------------------------------- 01 WS-AUXILIARES. 05 TAM-GETMAIN PIC S9(008) BINARY. 05 WS-NU-TAMANHO PIC S9(008) COMP VALUE ZEROES. 05 WS-SQLCODE PIC -Z.ZZ9 VALUE ZEROES. 05 WS-TOTAL-BYTES PIC 9(006) VALUE ZEROES. 05 WS-PARAGRAFO PIC X(080) VALUE SPACES. 05 WS-POSCURSOR PIC S9(004) COMP VALUE ZEROES. 05 WS-DT-AUXILIAR PIC X(019) VALUE SPACES. 05 WS-DT-AUXILIAR-R REDEFINES WS-DT-AUXILIAR. 10 WS-DATA-VIGENCIA PIC X(010). 10 WS-BRANCO PIC X(001). 10 WS-HORA-VIGENCIA PIC X(008). 05 WS-IND PIC 9(003) VALUE ZEROES. 05 WS-IC-SIT-VIGENCIA-PRI PIC X(001) VALUE SPACES. 05 WS-IC-SIT-VIGENCIA-ULT PIC X(001) VALUE SPACES. 05 WS-SAIDA-JAVA. 10 WS-TOTREG PIC 9(005). 10 WS-TOTREG-RETORNO PIC 9(005). 10 WS-ARRAY-SAIDA OCCURS 932 TIMES. 15 WS-CO-MENSAGEM PIC X(0007). 15 WS-TS-INCLUSAO PIC X(0026). 15 WS-DE-MENSAGEM PIC X(1000). 15 WS-DT-INICIO-VIGENCIA PIC X(0019). 15 WS-DT-FIM-VIGENCIA PIC X(0019). 15 WS-IC-SITUACAO-VIGENCIA PIC X(0001). 01 WS466-REGISTRO. 05 WS466-TOTREG PIC 9(005). 05 WS466-TOTREG-RETORNO PIC 9(005). 05 WS466-NU-TP-MENSAGEM PIC 9(004). 05 WS466-IC-SIT-VIGENCIA-JAVA PIC X(001). * 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 WS466-ARRAY. 10 WS466-CO-MENSAGEM PIC X(0007) OCCURS 932 TIMES. 10 WS466-TS-INCLUSAO PIC X(0026) OCCURS 932 TIMES. 10 WS466-DE-MENSAGEM PIC X(1000) OCCURS 932 TIMES. 10 WS466-DT-INICIO-VIGENCIA PIC X(0010) OCCURS 932 TIMES. 10 WS466-HH-INICIO-VIGENCIA PIC X(0008) OCCURS 932 TIMES. 10 WS466-DT-FIM-VIGENCIA PIC X(0010) OCCURS 932 TIMES. 10 WS466-HH-FIM-VIGENCIA PIC X(0008) OCCURS 932 TIMES. 10 WS466-IC-SITUACAO-VIGENCIA PIC X(0001) OCCURS 932 TIMES. *----------------------------------------------------------------- LOCAL-STORAGE SECTION. *----------------------------------------------------------------- *----------------------------------------------------------------- * DEFINICAO DE TABELAS E AREAS NA DCLGEN *----------------------------------------------------------------- EXEC SQL INCLUDE SQLCA END-EXEC. EXEC SQL INCLUDE CADTB001 END-EXEC. EXEC SQL INCLUDE CADTB002 END-EXEC. EXEC SQL DECLARE CURSOR01 SCROLL CURSOR WITH ROWSET POSITIONING FOR SELECT CO_MENSAGEM , TS_INCLUSAO , DE_MENSAGEM , DT_INICIO_VIGENCIA , HH_INICIO_VIGENCIA , DT_FIM_VIGENCIA , HH_FIM_VIGENCIA , IC_SITUACAO_VIGENCIA FROM CAD.CADTB002_MENSAGEM_APOIO TB002 , CAD.CADTB001_TIPO_MENSAGEM TB001 WHERE (IC_SITUACAO_VIGENCIA BETWEEN :WS-IC-SIT-VIGENCIA-PRI AND :WS-IC-SIT-VIGENCIA-ULT) AND TB001.NU_TP_MENSAGEM = TB002.NU_TP_MENSAGEM AND TB002.NU_TP_MENSAGEM = :CADTB002.NU-TP-MENSAGEM ORDER BY CO_MENSAGEM END-EXEC. *----------------------------------------------------------------- * LINKAGE SECTION *----------------------------------------------------------------- LINKAGE SECTION. 01 DFHCOMMAREA. COPY CADB0001. *----------------------------------------------------------------- * CONTEUDO DO BOOK - CADB0001 *----------------------------------------------------------------- * 02 STREAM. * 03 STREAM-IO-EXCECAO. * 05 STREAM-IO-ERRO-CICS PIC 9(003). * 05 STREAM-IO-NU-MENSAGEM PIC 9(004). * 05 STREAM-IO-NO-MENSAGEM PIC X(078). * 05 STREAM-IO-NU-SQLCODE PIC -9(03). * 05 FILLER PIC X(018). * 03 STREAM-IO-ENTRADA. * 05 STREAM-IO-CONTEUDO-TAM PIC 9(005). * 05 STREAM-IO-CONTEUDO-ENT. * 07 STREAM-ENT-DADOS PIC X(2000). * 03 STREAM-IO-ENTRADA1 REDEFINES STREAM-IO-ENTRADA. * 05 STREAM-IO-POINTER-MEM POINTER. * 05 STREAM-IO-CONTEUDO PIC X(2001). *01 MEMAREA. * 03 STREAM-IO-TAM-MEM PIC 9(006). * 03 STREAM-IO-DADOS. * 05 STREAM-BA-DADOS OCCURS 1 TO 1000000 * DECADDING ON STREAM-IO-TAM-MEM. * 09 FILLER PIC X(001). * *----------------------------------------------------------------- *----------------------------------------------------------------- PROCEDURE DIVISION USING DFHCOMMAREA. *----------------------------------------------------------------- PERFORM P0001-PROCEDIMENTOS-INICIAIS PERFORM P1000-PROCEDIMENTOS-PRINCIPAIS PERFORM P9000-PROCEDIMENTOS-FINAIS . *----------------------------------------------------------------- P0001-PROCEDIMENTOS-INICIAIS. *----------------------------------------------------------------- MOVE 'P0001-PROCEDIMENTOS-INICIAIS' TO WS-PARAGRAFO MOVE LENGTH OF STREAM-ENT-DADOS TO STREAM-IO-CONTEUDO-TAM MOVE STREAM-ENT-DADOS (1:15) TO WS466-REGISTRO MOVE ZEROS TO STREAM-IO-ERRO-CICS STREAM-IO-NU-MENSAGEM IF WS466-TOTREG-RETORNO EQUAL ZEROES MOVE 1 TO WS-POSCURSOR ELSE COMPUTE WS-POSCURSOR = WS466-TOTREG-RETORNO + 1 END-IF EVALUATE WS466-IC-SIT-VIGENCIA-JAVA WHEN '1' MOVE '1' TO WS-IC-SIT-VIGENCIA-PRI MOVE '3' TO WS-IC-SIT-VIGENCIA-ULT WHEN '4' MOVE '4' TO WS-IC-SIT-VIGENCIA-PRI MOVE '4' TO WS-IC-SIT-VIGENCIA-ULT WHEN OTHER MOVE '1' TO WS-IC-SIT-VIGENCIA-PRI MOVE '4' TO WS-IC-SIT-VIGENCIA-ULT END-EVALUATE MOVE WS466-NU-TP-MENSAGEM TO NU-TP-MENSAGEM OF CADTB002 . 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 AND WS466-TOTREG-RETORNO EQUAL ZEROES MOVE +9999 TO SQLCODE PERFORM P8000-TRATA-SQLCODE END-IF MOVE WS466-TOTREG-RETORNO TO WS-TOTREG-RETORNO MOVE WS466-TOTREG TO WS-TOTREG MOVE 1 TO WS-IND PERFORM UNTIL WS-IND GREATER THAN SQLERRD (3) MOVE WS466-CO-MENSAGEM (WS-IND) TO WS-CO-MENSAGEM (WS-IND) MOVE WS466-DE-MENSAGEM (WS-IND) TO WS-DE-MENSAGEM (WS-IND) MOVE WS466-TS-INCLUSAO (WS-IND) TO WS-TS-INCLUSAO (WS-IND) PERFORM P2100-FORMATA-DI-VIGENCIA PERFORM P2200-FORMATA-DF-VIGENCIA MOVE WS466-IC-SITUACAO-VIGENCIA (WS-IND) TO WS-IC-SITUACAO-VIGENCIA (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. *----------------------------------------------------------------- P2100-FORMATA-DI-VIGENCIA. *----------------------------------------------------------------- MOVE WS466-DT-INICIO-VIGENCIA (WS-IND) TO WS-DATA-VIGENCIA MOVE WS466-HH-INICIO-VIGENCIA (WS-IND) TO WS-HORA-VIGENCIA MOVE '/' TO WS-DATA-VIGENCIA (03:1) WS-DATA-VIGENCIA (06:1) MOVE ':' TO WS-HORA-VIGENCIA (03:1) WS-HORA-VIGENCIA (06:1) MOVE SPACES TO WS-BRANCO MOVE WS-DT-AUXILIAR TO WS-DT-INICIO-VIGENCIA (WS-IND) . P2100-FIM. EXIT. *----------------------------------------------------------------- P2200-FORMATA-DF-VIGENCIA. *----------------------------------------------------------------- MOVE WS466-DT-FIM-VIGENCIA (WS-IND) TO WS-DATA-VIGENCIA MOVE WS466-HH-FIM-VIGENCIA (WS-IND) TO WS-HORA-VIGENCIA IF WS-DATA-VIGENCIA EQUAL '31.12.9999' MOVE SPACES TO WS-HORA-VIGENCIA WS-DATA-VIGENCIA MOVE 'Vigente' TO WS-DATA-VIGENCIA ELSE MOVE '/' TO WS-DATA-VIGENCIA (03:1) WS-DATA-VIGENCIA (06:1) MOVE ':' TO WS-HORA-VIGENCIA (03:1) WS-HORA-VIGENCIA (06:1) END-IF MOVE SPACES TO WS-BRANCO MOVE WS-DT-AUXILIAR TO WS-DT-FIM-VIGENCIA (WS-IND) . P2200-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 932 ROWS INTO :WS466-CO-MENSAGEM , :WS466-TS-INCLUSAO , :WS466-DE-MENSAGEM , :WS466-DT-INICIO-VIGENCIA , :WS466-HH-INICIO-VIGENCIA , :WS466-DT-FIM-VIGENCIA , :WS466-HH-FIM-VIGENCIA , :WS466-IC-SITUACAO-VIGENCIA END-EXEC *----------------------------------------------------------------- * * SQLCODE = +000 o FETCH trouxe 932 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) * *----------------------------------------------------------------- COMPUTE WS466-TOTREG-RETORNO = (WS-POSCURSOR + SQLERRD (3)) - 1 EVALUATE SQLCODE WHEN +000 MOVE SQLERRD (3) TO WS466-TOTREG WHEN +100 IF SQLERRD (3) EQUAL +0 MOVE ZEROES TO WS466-TOTREG ELSE MOVE SQLERRD (3) TO WS466-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. *----------------------------------------------------------------- * CALCULA O TAMANHO DA AREA ENVIADA PARA O JAVA * --------------------------------------------- IF WS-IND GREATER THAN ZEROS COMPUTE WS-NU-TAMANHO = (WS466-TOTREG * 1072) + 10 ELSE MOVE 1 TO WS-NU-TAMANHO END-IF EXEC CICS GETMAIN SET(STREAM-IO-POINTER-MEM) FLENGTH(WS-NU-TAMANHO) END-EXEC SET ADDRESS OF MEMAREA TO STREAM-IO-POINTER-MEM. MOVE WS-NU-TAMANHO TO STREAM-IO-TAM-MEM. MOVE WS-SAIDA-JAVA TO STREAM-IO-DADOS. EXEC CICS RETURN END-EXEC . P9000-FIM. EXIT.
