Montagem do XML em COBOL - COBOL/CICS/DB2
Desenvolvido por DORNELLES Carlos Alberto - Analista de Sistemas - Brasília DF. - cad_cobol@hotmail.com
Primeiro exemplo
1 2 3 4 5 6 7 123456789012345678901234567890123456789012345678901234567890123456789012 *----------------------------------------------------------------* IDENTIFICATION DIVISION. *----------------------------------------------------------------* PROGRAM-ID. CADPO001. AUTHOR. CARLOS ALBERTO DORNELLES. *----------------------------------------------------------------- * SISTEMA : SICAD * PROGRAMA : CADPO001 * OBJETIVO : CONSULTAR CONTAS A PAGAR DE ACORDO COM A SELECAO * : RELATORIO 5 - POR MOVIMENTO/TRANSACAO * ANALISTA : CARLOS ALBERTO DORNELLES * LINGUAGEM : COBOL/CICS/DB2 * VERSAO : V.001 * DATA : 25/11/2003 *----------------------------------------------------------------- * MANUTENCAO *----------------------------------------------------------------* * VRS DD.MM.AA AUTOR DESCRICAO * *----------------------------------------------------------------- *----------------------------------------------------------------* ENVIRONMENT DIVISION. *----------------------------------------------------------------* CONFIGURATION SECTION. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. *----------------------------------------------------------------* DATA DIVISION. *----------------------------------------------------------------* WORKING-STORAGE SECTION. *----------------------------------------------------------------* 01 WS-AUXILIARES. 03 WS-QTD-DATAS PIC 9(005) VALUE ZEROS. 03 WS-DT-MOVIMENTO PIC X(010) VALUE SPACES. 03 WS-DT-MOVIMENTO-1 PIC 9(008) VALUE ZEROS. 03 WS-LETRA PIC X(001) VALUE SPACES. 03 WS-LETRA-ANT PIC X(001) VALUE SPACES. 03 WS-FIM-CURSOR PIC X(001) VALUE SPACES. 03 WS-PRI-DATA PIC 9(001) VALUE ZEROS. 03 WS-CONTADOR PIC 9(005) VALUE ZEROS. 03 WS-CONTROLE PIC 9(005) VALUE ZEROS. 03 AUX1-DT-INI PIC X(010) VALUE SPACES. 03 AUX1-DT-FIM PIC X(010) VALUE SPACES. 03 AUX1-CO-BIN-1 PIC X(006) VALUE SPACES. 03 AUX1-CO-BIN-2 PIC X(006) VALUE SPACES. 03 AUX1-NU-BANDEIRA-1 PIC S9(09) USAGE COMP. 03 AUX1-NU-BANDEIRA-2 PIC S9(09) USAGE COMP. 03 AUX1-NU-VARIANTE-1 PIC S9(09) USAGE COMP. 03 AUX1-NU-VARIANTE-2 PIC S9(09) USAGE COMP. 03 AUX1-TP-PESSOA-1 PIC X(001) VALUE SPACES. 03 AUX1-TP-PESSOA-2 PIC X(001) VALUE SPACES. 03 AUX1-TP-MOEDA-1 PIC X(003) VALUE SPACES. 03 AUX1-TP-MOEDA-2 PIC X(003) VALUE SPACES. 77 WS-SALDO-AUX PIC S9(016)V99. 01 WS-AREA-ACUMULADORES. 03 WSD-QT-TRANS-DEB PIC 9(018). 03 WSD-QT-TRANS-CRE PIC 9(018). 03 WSD-VR-BRUTO-DEB PIC 9(016)V99. 03 WSD-VR-BRUTO-CRE PIC 9(016)V99. 03 WSD-VR-TAXA-DEB PIC 9(016)V99. 03 WSD-VR-TAXA-CRE PIC 9(016)V99. 03 WSD-VR-TAXAM-DEB PIC 9(016)V99. 03 WSD-VR-TAXAM-CRE PIC 9(016)V99. 03 WSD-VR-SALDO PIC 9(016)V99. 03 WSD-VR-DOLAR PIC 9(016)V99. 01 FILLER REDEFINES WS-AREA-ACUMULADORES. 03 QTDTRANSDEB PIC 9(018). 03 QTDTRANSCRE PIC 9(018). 03 VLTRANSDEB PIC 9(018). 03 VLTRANSCRE PIC 9(018). 03 VLFEEDEB PIC 9(018). 03 VLFEECRE PIC 9(018). 03 VLFEEDEBM PIC 9(018). 03 VLFEECREM PIC 9(018). 03 SALDOTRAN PIC 9(018). 03 COTACAODOLAR PIC 9(018). 01 WS-AREA-TOTAIS. 03 WST-QT-TRANS-DEB PIC 9(018). 03 WST-QT-TRANS-CRE PIC 9(018). 03 WST-VR-BRUTO-DEB PIC 9(016)V99. 03 WST-VR-BRUTO-CRE PIC 9(016)V99. 03 WST-VR-TAXA-DEB PIC 9(016)V99. 03 WST-VR-TAXA-CRE PIC 9(016)V99. 03 WST-VR-TAXAM-DEB PIC 9(016)V99. 03 WST-VR-TAXAM-CRE PIC 9(016)V99. 03 WST-VR-SALDO PIC 9(016)V99. 01 FILLER REDEFINES WS-AREA-TOTAIS. 03 TOTQTDTRANSDEB PIC 9(018). 03 TOTQTDTRANSCRE PIC 9(018). 03 TOTVLTRANSDEB PIC 9(018). 03 TOTVLTRANSCRE PIC 9(018). 03 TOTVLFEEDEB PIC 9(018). 03 TOTVLFEECRE PIC 9(018). 03 TOTVLFEEDEBM PIC 9(018). 03 TOTVLFEECREM PIC 9(018). 03 TOTSALDOTRAN PIC 9(018). 01 WS-AREA-ENTRADA. 03 ENT-OCORRENCIA PIC X(005). 03 ENT-PRI-DATA PIC 9(001). 03 ENT-QTD-DATAS PIC 9(005). 03 ENT-CO-BIN-1 PIC X(006). 03 ENT-CO-BIN-2 PIC X(006). 03 ENT-NU-BANDEIRA PIC 9(004). 03 ENT-NU-VARIANTE-1 PIC 9(004). 03 ENT-NU-VARIANTE-2 PIC 9(004). 03 ENT-DT-INICIO PIC X(010). 03 ENT-DT-FIM PIC X(010). 03 ENT-TIPO PIC X(001). 03 ENT-LIQ PIC X(001). 03 ENT-RELATORIO PIC 9(001). 01 WS-AREA-SAIDA. 03 SAI-ID-SAIDA PIC 9(005) VALUE ZEROS. 03 SAI-GR-SAIDA. 05 SAI-OCORRENCIA PIC 9(005) VALUE ZEROS. 05 SAI-PRI-DATA PIC 9(001) VALUE ZEROS. 05 SAI-QTD-DATAS PIC 9(005) VALUE ZEROS. 05 SAI-RESULTADO PIC X(19990) VALUE SPACES. *----------------------------------------------------------------* * INCLUDE PARA ACESSO AO DB2 * *----------------------------------------------------------------* EXEC SQL INCLUDE SQLCA END-EXEC. EXEC SQL INCLUDE CADTB001 END-EXEC. EXEC SQL INCLUDE CADTB002 END-EXEC. EXEC SQL INCLUDE CADTB004 END-EXEC. EXEC SQL INCLUDE CADTB005 END-EXEC. EXEC SQL INCLUDE CADTB016 END-EXEC. *----------------------------------------------------------------* LINKAGE SECTION. *----------------------------------------------------------------* 01 DFHCOMMAREA. 03 LK-EXCECAO. 05 LK-ERRO-CICS PIC 9(003). 05 LK-NU-MENSAGEM PIC 9(004). 05 LK-NO-MENSAGEM PIC X(078). 05 LK-CO-SQLCODE PIC 9(004). 03 LK-IDENTIFICACAO. 05 LK-IN-NOME-PGM PIC X(008). 05 LK-IN-CO-USUARIO PIC X(008). 05 LK-IN-CO-FUNCAO PIC X(002). 03 LK-ENTRADA-SAIDA. 05 LK-CONTEUDO-TAM PIC 9(005). 05 LK-CONTEUDO. 07 FILLER PIC X(001) OCCURS 1 TO 20000 DEPENDING ON LK-CONTEUDO-TAM. *----------------------------------------------------------------* PROCEDURE DIVISION USING DFHCOMMAREA. *----------------------------------------------------------------* PERFORM P000-PROCED-INICIAIS THRU P000-FIM. PERFORM P100-PROCED-PRINCIPAIS THRU P100-FIM. PERFORM P999-PROCED-FINAIS THRU P999-FIM. *----------------------------------------------------------------* P000-PROCED-INICIAIS. *----------------------------------------------------------------* MOVE LK-CONTEUDO(1:LK-CONTEUDO-TAM) TO WS-AREA-ENTRADA MOVE SPACES TO LK-CONTEUDO(1:20000) MOVE ZEROS TO LK-CONTEUDO-TAM INITIALIZE LK-EXCECAO MOVE ENT-OCORRENCIA TO SAI-OCORRENCIA MOVE ENT-PRI-DATA TO WS-PRI-DATA MOVE ENT-QTD-DATAS TO WS-QTD-DATAS. STRING ENT-DT-INICIO(1:2) '.' ENT-DT-INICIO(4:2) '.' ENT-DT-INICIO(7:4) DELIMITED BY SIZE INTO AUX1-DT-INI END-STRING STRING ENT-DT-FIM(1:2) '.' ENT-DT-FIM(4:2) '.' ENT-DT-FIM(7:4) DELIMITED BY SIZE INTO AUX1-DT-FIM END-STRING MOVE ENT-CO-BIN-1 TO AUX1-CO-BIN-1 MOVE ENT-CO-BIN-2 TO AUX1-CO-BIN-2 IF ENT-NU-BANDEIRA = 0 MOVE 0000 TO AUX1-NU-BANDEIRA-1 MOVE 9999 TO AUX1-NU-BANDEIRA-2 ELSE MOVE ENT-NU-BANDEIRA TO AUX1-NU-BANDEIRA-1 AUX1-NU-BANDEIRA-2 END-IF MOVE ENT-NU-VARIANTE-1 TO AUX1-NU-VARIANTE-1 MOVE ENT-NU-VARIANTE-2 TO AUX1-NU-VARIANTE-2 IF ENT-TIPO = 'T' MOVE 'F' TO AUX1-TP-PESSOA-1 MOVE 'J' TO AUX1-TP-PESSOA-2 ELSE MOVE ENT-TIPO TO AUX1-TP-PESSOA-1 AUX1-TP-PESSOA-2 END-IF IF ENT-LIQ = 'T' MOVE '840' TO AUX1-TP-MOEDA-1 MOVE '986' TO AUX1-TP-MOEDA-2 ELSE IF ENT-LIQ = 'I' MOVE '840' TO AUX1-TP-MOEDA-1 AUX1-TP-MOEDA-2 ELSE MOVE '986' TO AUX1-TP-MOEDA-1 AUX1-TP-MOEDA-2 END-IF END-IF. P000-FIM. EXIT. *----------------------------------------------------------------* P100-PROCED-PRINCIPAIS. *----------------------------------------------------------------* INITIALIZE WS-AREA-TOTAIS REPLACING NUMERIC BY ZEROS. PERFORM P200-ABRE-CURSOR THRU P200-FIM. PERFORM P210-LE-CURSOR THRU P210-FIM UNTIL WS-CONTADOR > ENT-OCORRENCIA. IF SQLCODE = +100 MOVE 999 TO SQLCODE MOVE 'PERIODO NAO ENCONTRADO' TO LK-NO-MENSAGEM PERFORM P800-ERRO-DB2 THRU P800-FIM END-IF. MOVE 1 TO SAI-ID-SAIDA IF ENT-OCORRENCIA = ZEROS STRING '<CLASS>' '<IDRELATORIO>' ENT-RELATORIO '</IDRELATORIO>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING END-IF. PERFORM UNTIL SQLCODE = +100 IF WS-LETRA = 'A' INITIALIZE WS-AREA-ACUMULADORES REPLACING NUMERIC BY ZEROS PERFORM UNTIL WS-LETRA NOT = 'A' PERFORM P220-MONTA-DATAS THRU P220-FIM PERFORM P210-LE-CURSOR THRU P210-FIM END-PERFORM PERFORM P221-MOVE-DATAS THRU P221-FIM ELSE INITIALIZE WS-AREA-ACUMULADORES REPLACING NUMERIC BY ZEROS PERFORM P230-MOVE-TRANSACAO THRU P230-FIM PERFORM P210-LE-CURSOR THRU P210-FIM END-IF ADD 1 TO WS-CONTROLE ADD 1 TO SAI-OCORRENCIA IF WS-CONTROLE > 25 PERFORM P999-PROCED-FINAIS THRU P999-FIM END-IF END-PERFORM. PERFORM P240-FECHA-CURSOR THRU P240-FIM. P100-FIM. EXIT. *----------------------------------------------------------------* P200-ABRE-CURSOR. *----------------------------------------------------------------* EXEC SQL DECLARE CURSOR01 CURSOR FOR SELECT TB004.DT_MOVIMENTO , 0 , 0 , 'A' , TB005.IC_NATUREZA , TB005.IC_NATUREZA_TAXA , SUM(TB005.QT_TRANSACAO) , SUM(TB005.VR_TAXA) , SUM(TB005.VR_BRUTO) , 0 FROM CAD.CADTB001_TPO_TRNSO TB001 , CAD.CADTB016_TPO_BIN TB016 , CAD.CADTB004_MVMN_APGR TB004 , CAD.CADTB005_ITEM_APGR TB005 LEFT JOIN CAD.CADTB002_TPO_OPRCO TB002 ON TB005.NU_OPERACAO = TB002.NU_OPERACAO AND TB005.TS_OPERACAO = TB002.TS_OPERACAO WHERE TB005.CO_BIN = TB016.CO_BIN AND TB005.NU_MVMN_APGR = TB004.NU_MVMN_APGR AND TB005.NU_TRANSACAO = TB001.NU_TRANSACAO AND TB005.TS_TRANSACAO = TB001.TS_TRANSACAO AND TB004.DT_MOVIMENTO BETWEEN :AUX1-DT-INI AND :AUX1-DT-FIM AND TB016.CO_BIN BETWEEN :AUX1-CO-BIN-1 AND :AUX1-CO-BIN-2 AND TB016.NU_BANDEIRA BETWEEN :AUX1-NU-BANDEIRA-1 AND :AUX1-NU-BANDEIRA-2 AND TB016.NU_VARIANTE BETWEEN :AUX1-NU-VARIANTE-1 AND :AUX1-NU-VARIANTE-2 AND TB005.IC_PESSOA BETWEEN :AUX1-TP-PESSOA-1 AND :AUX1-TP-PESSOA-2 AND TB005.CO_MOEDA BETWEEN :AUX1-TP-MOEDA-1 AND :AUX1-TP-MOEDA-2 GROUP BY TB004.DT_MOVIMENTO , TB005.IC_NATUREZA_TAXA , TB005.IC_NATUREZA UNION ALL SELECT TB004.DT_MOVIMENTO , TB001.NU_TRANSACAO , VALUE(TB002.NU_OPERACAO,0) , 'B' , TB005.IC_NATUREZA , TB005.IC_NATUREZA_TAXA , SUM(TB005.QT_TRANSACAO) , SUM(TB005.VR_TAXA) , SUM(TB005.VR_BRUTO) , TB005.VR_DOLAR FROM CAD.CADTB001_TPO_TRNSO TB001 , CAD.CADTB016_TPO_BIN TB016 , CAD.CADTB004_MVMN_APGR TB004 , CAD.CADTB005_ITEM_APGR TB005 LEFT JOIN CAD.CADTB002_TPO_OPRCO TB002 ON TB005.NU_OPERACAO = TB002.NU_OPERACAO AND TB005.TS_OPERACAO = TB002.TS_OPERACAO WHERE TB005.CO_BIN = TB016.CO_BIN AND TB005.NU_MVMN_APGR = TB004.NU_MVMN_APGR AND TB005.NU_TRANSACAO = TB001.NU_TRANSACAO AND TB005.TS_TRANSACAO = TB001.TS_TRANSACAO AND TB004.DT_MOVIMENTO BETWEEN :AUX1-DT-INI AND :AUX1-DT-FIM AND TB016.CO_BIN BETWEEN :AUX1-CO-BIN-1 AND :AUX1-CO-BIN-2 AND TB016.NU_BANDEIRA BETWEEN :AUX1-NU-BANDEIRA-1 AND :AUX1-NU-BANDEIRA-2 AND TB016.NU_VARIANTE BETWEEN :AUX1-NU-VARIANTE-1 AND :AUX1-NU-VARIANTE-2 AND TB005.IC_PESSOA BETWEEN :AUX1-TP-PESSOA-1 AND :AUX1-TP-PESSOA-2 AND TB005.CO_MOEDA BETWEEN :AUX1-TP-MOEDA-1 AND :AUX1-TP-MOEDA-2 GROUP BY TB004.DT_MOVIMENTO , TB001.NU_TRANSACAO , TB002.NU_OPERACAO , TB005.IC_NATUREZA , TB005.IC_NATUREZA_TAXA , TB005.VR_DOLAR ORDER BY 1, 2, 3, 4 END-EXEC. EXEC SQL OPEN CURSOR01 END-EXEC IF SQLCODE NOT = +0 MOVE 'ERRO DE BD2' TO LK-NO-MENSAGEM PERFORM P800-ERRO-DB2 THRU P800-FIM END-IF. P200-FIM. EXIT. *----------------------------------------------------------------* P210-LE-CURSOR. *----------------------------------------------------------------* EXEC SQL FETCH CURSOR01 INTO :CADTB004.DT-MOVIMENTO , :CADTB001.NU-TRANSACAO , :CADTB002.NU-OPERACAO , :WS-LETRA , :CADTB005.IC-NATUREZA , :CADTB005.IC-NATUREZA-TAXA , :CADTB005.QT-TRANSACAO , :CADTB005.VR-TAXA , :CADTB005.VR-BRUTO , :CADTB005.VR-DOLAR END-EXEC IF SQLCODE NOT = +0 AND +100 MOVE 'ERRO DE BD2' TO LK-NO-MENSAGEM PERFORM P800-ERRO-DB2 THRU P800-FIM END-IF. IF SQLCODE = +100 MOVE 99999 TO WS-CONTADOR MOVE 'F' TO WS-FIM-CURSOR ELSE IF WS-LETRA = 'A' PERFORM P600-ACUMULA-TOTAL THRU P600-FIM IF WS-LETRA-ANT NOT = WS-LETRA MOVE 'A' TO WS-LETRA-ANT ADD 1 TO WS-CONTADOR END-IF ELSE MOVE 'B' TO WS-LETRA-ANT ADD 1 TO WS-CONTADOR END-IF END-IF. P210-FIM. EXIT. *----------------------------------------------------------------* P220-MONTA-DATAS. *----------------------------------------------------------------* MOVE DT-MOVIMENTO OF CADTB004 TO WS-DT-MOVIMENTO. IF IC-NATUREZA OF CADTB005 = 'D' ADD QT-TRANSACAO OF CADTB005 TO WSD-QT-TRANS-DEB ADD VR-BRUTO OF CADTB005 TO WSD-VR-BRUTO-DEB ELSE ADD QT-TRANSACAO OF CADTB005 TO WSD-QT-TRANS-CRE ADD VR-BRUTO OF CADTB005 TO WSD-VR-BRUTO-CRE END-IF. IF IC-NATUREZA-TAXA OF CADTB005 = 'D' ADD VR-TAXA OF CADTB005 TO WSD-VR-TAXA-DEB ELSE ADD VR-TAXA OF CADTB005 TO WSD-VR-TAXA-CRE END-IF. P220-FIM. EXIT. *----------------------------------------------------------------* P221-MOVE-DATAS. *----------------------------------------------------------------* IF WS-PRI-DATA NOT = 0 STRING '</DATAS>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING END-IF. MOVE 1 TO WS-PRI-DATA. ADD 1 TO WS-QTD-DATAS. STRING WS-DT-MOVIMENTO(7:4) WS-DT-MOVIMENTO(4:2) WS-DT-MOVIMENTO(1:2) DELIMITED BY SIZE INTO WS-DT-MOVIMENTO-1 END-STRING. STRING '<DATAS>' '<DATALINHA>' WS-DT-MOVIMENTO-1 '</DATALINHA>' '<IDDATALINHA>' WS-QTD-DATAS '</IDDATALINHA>' '<QTDTRANSDEB>' QTDTRANSDEB '</QTDTRANSDEB>' '<VLTRANSDEB>' VLTRANSDEB '</VLTRANSDEB>' '<VLFEEDEB>' VLFEEDEB '</VLFEEDEB>' '<VLFEEDEBM>' VLFEEDEBM '</VLFEEDEBM>' '<QTDTRANSCRE>' QTDTRANSCRE '</QTDTRANSCRE>' '<VLTRANSCRE>' VLTRANSCRE '</VLTRANSCRE>' '<VLFEECRE>' VLFEECRE '</VLFEECRE>' '<VLFEECREM>' VLFEECREM '</VLFEECREM>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING. COMPUTE WS-SALDO-AUX = (WSD-VR-BRUTO-CRE + WSD-VR-TAXA-CRE) - (WSD-VR-BRUTO-DEB + WSD-VR-TAXA-DEB). MOVE WS-SALDO-AUX TO WSD-VR-SALDO. IF WS-SALDO-AUX NOT < ZEROS STRING '<SALDOTRAN>' SALDOTRAN '</SALDOTRAN>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING ELSE STRING '<SALDOTRAN>-' SALDOTRAN '</SALDOTRAN>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING END-IF. P221-FIM. EXIT. *----------------------------------------------------------------* P230-MOVE-TRANSACAO. *----------------------------------------------------------------* IF IC-NATUREZA OF CADTB005 = 'D' MOVE QT-TRANSACAO OF CADTB005 TO WSD-QT-TRANS-DEB MOVE VR-BRUTO OF CADTB005 TO WSD-VR-BRUTO-DEB ELSE MOVE QT-TRANSACAO OF CADTB005 TO WSD-QT-TRANS-CRE MOVE VR-BRUTO OF CADTB005 TO WSD-VR-BRUTO-CRE END-IF. IF IC-NATUREZA-TAXA OF CADTB005 = 'D' MOVE VR-TAXA OF CADTB005 TO WSD-VR-TAXA-DEB ELSE MOVE VR-TAXA OF CADTB005 TO WSD-VR-TAXA-CRE END-IF. MOVE VR-DOLAR OF CADTB005 TO WSD-VR-DOLAR. IF NU-OPERACAO OF CADTB002 = ZEROS PERFORM P300-BUSCA-NOTRANSACAO THRU P300-FIM ELSE PERFORM P350-BUSCA-NOOPERACAO THRU P350-FIM MOVE NO-OPERACAO OF CADTB002 TO NO-TRANSACAO OF CADTB001 END-IF. STRING '<TRANSACAO>' '<NOMETRANSACAO>' NO-TRANSACAO '</NOMETRANSACAO>' '<COTACAODOLAR>' COTACAODOLAR '</COTACAODOLAR>' '<QTDTRANSDEB>' QTDTRANSDEB '</QTDTRANSDEB>' '<VLTRANSDEB>' VLTRANSDEB '</VLTRANSDEB>' '<VLFEEDEB>' VLFEEDEB '</VLFEEDEB>' '<VLFEEDEBM>' VLFEEDEBM '</VLFEEDEBM>' '<QTDTRANSCRE>' QTDTRANSCRE '</QTDTRANSCRE>' '<VLTRANSCRE>' VLTRANSCRE '</VLTRANSCRE>' '<VLFEECRE>' VLFEECRE '</VLFEECRE>' '<VLFEECREM>' VLFEECREM '</VLFEECREM>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING. COMPUTE WS-SALDO-AUX = (WSD-VR-BRUTO-CRE + WSD-VR-TAXA-CRE) - (WSD-VR-BRUTO-DEB + WSD-VR-TAXA-DEB). MOVE WS-SALDO-AUX TO WSD-VR-SALDO. IF WS-SALDO-AUX NOT < ZEROS STRING '<SALDOTRAN>' SALDOTRAN '</SALDOTRAN>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING ELSE STRING '<SALDOTRAN>-' SALDOTRAN '</SALDOTRAN>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING END-IF. STRING '</TRANSACAO>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING. P230-FIM. EXIT. *----------------------------------------------------------------* P240-FECHA-CURSOR. *----------------------------------------------------------------* EXEC SQL CLOSE CURSOR01 END-EXEC. IF SQLCODE NOT = +0 MOVE 'ERRO DE BD2' TO LK-NO-MENSAGEM PERFORM P800-ERRO-DB2 THRU P800-FIM END-IF. P240-FIM. EXIT. *----------------------------------------------------------------* P300-BUSCA-NOTRANSACAO. *----------------------------------------------------------------* EXEC SQL SELECT NO_TRANSACAO INTO :CADTB001.NO-TRANSACAO FROM CAD.CADTB001_TPO_TRNSO WHERE NU_TRANSACAO = :CADTB001.NU-TRANSACAO AND TS_TRANSACAO = ( SELECT MAX(TS_TRANSACAO) FROM CAD.CADTB001_TPO_TRNSO WHERE NU_TRANSACAO = :CADTB001.NU-TRANSACAO ) END-EXEC. IF SQLCODE NOT = +0 MOVE 'TRANSACAO NAO CADASTRADA' TO NO-TRANSACAO OF CADTB001 END-IF. P300-FIM. EXIT. *----------------------------------------------------------------* P350-BUSCA-NOOPERACAO. *----------------------------------------------------------------* EXEC SQL SELECT NO_OPERACAO INTO :CADTB002.NO-OPERACAO FROM CAD.CADTB002_TPO_OPRCO WHERE NU_OPERACAO = :CADTB002.NU-OPERACAO AND TS_OPERACAO = ( SELECT MAX(TS_OPERACAO) FROM CAD.CADTB002_TPO_OPRCO WHERE NU_OPERACAO = :CADTB002.NU-OPERACAO ) END-EXEC. IF SQLCODE NOT = +0 MOVE 'OPERACAO NAO CADASTRADA' TO NO-OPERACAO OF CADTB002 END-IF. P350-FIM. EXIT. *----------------------------------------------------------------* P500-MONTA-FINAL. *----------------------------------------------------------------* STRING '<TOTQTDTRANSDEB>' TOTQTDTRANSDEB '</TOTQTDTRANSDEB>' '<TOTVLTRANSDEB>' TOTVLTRANSDEB '</TOTVLTRANSDEB>' '<TOTVLFEEDEB>' TOTVLFEEDEB '</TOTVLFEEDEB>' '<TOTVLFEEDEBM>' TOTVLFEEDEBM '</TOTVLFEEDEBM>' '<TOTQTDTRANSCRE>' TOTQTDTRANSCRE '</TOTQTDTRANSCRE>' '<TOTVLTRANSCRE>' TOTVLTRANSCRE '</TOTVLTRANSCRE>' '<TOTVLFEECRE>' TOTVLFEECRE '</TOTVLFEECRE>' '<TOTVLFEECREM>' TOTVLFEECREM '</TOTVLFEECREM>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING. COMPUTE WS-SALDO-AUX = (WST-VR-BRUTO-CRE + WST-VR-TAXA-CRE) - (WST-VR-BRUTO-DEB + WST-VR-TAXA-DEB). MOVE WS-SALDO-AUX TO WSD-VR-SALDO. IF WS-SALDO-AUX NOT < ZEROS STRING '<SALDO>' SALDOTRAN '</SALDO>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING ELSE STRING '<SALDO>-' SALDOTRAN '</SALDO>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING END-IF. P500-FIM. EXIT. *----------------------------------------------------------------* P600-ACUMULA-TOTAL. *----------------------------------------------------------------* IF IC-NATUREZA OF CADTB005 = 'D' ADD QT-TRANSACAO OF CADTB005 TO WST-QT-TRANS-DEB ADD VR-BRUTO OF CADTB005 TO WST-VR-BRUTO-DEB ELSE ADD QT-TRANSACAO OF CADTB005 TO WST-QT-TRANS-CRE ADD VR-BRUTO OF CADTB005 TO WST-VR-BRUTO-CRE END-IF. IF IC-NATUREZA-TAXA OF CADTB005 = 'D' ADD VR-TAXA OF CADTB005 TO WST-VR-TAXA-DEB ELSE ADD VR-TAXA OF CADTB005 TO WST-VR-TAXA-CRE END-IF. P600-FIM. EXIT. *----------------------------------------------------------------* P800-ERRO-DB2. *----------------------------------------------------------------* MOVE 1 TO LK-ERRO-CICS MOVE SQLCODE TO LK-CO-SQLCODE MOVE 'CADPO001' TO LK-IN-NOME-PGM EXEC CICS RETURN END-EXEC. P800-FIM. EXIT. *----------------------------------------------------------------* P999-PROCED-FINAIS. *----------------------------------------------------------------* MOVE WS-PRI-DATA TO SAI-PRI-DATA MOVE WS-QTD-DATAS TO SAI-QTD-DATAS IF WS-FIM-CURSOR = 'F' MOVE 99999 TO SAI-OCORRENCIA MOVE 9 TO SAI-PRI-DATA MOVE 99999 TO SAI-QTD-DATAS STRING '</DATAS>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING PERFORM P500-MONTA-FINAL THRU P500-FIM STRING '</CLASS>' DELIMITED BY SIZE INTO SAI-RESULTADO WITH POINTER SAI-ID-SAIDA END-STRING END-IF. MOVE SAI-ID-SAIDA TO LK-CONTEUDO-TAM ADD 11 TO LK-CONTEUDO-TAM. MOVE SAI-GR-SAIDA TO LK-CONTEUDO EXEC CICS RETURN END-EXEC. P999-FIM. EXIT. *----------------------------------------------------------------*
