1 2 3 4 5 6 7
123456789012345678901234567890123456789012345678901234567890123456789012
*----------------- I N I C I O D O C O D I G O --------------*
IDENTIFICATION DIVISION.
*-----------------------
PROGRAM-ID. INSERT02.
* Sistema : EXEMPLO
* Programa : INSERT02
* Objetivo : INSERIR DADOS NA TABELA CFE PARAMETROS DE ENTRADA
* Analista : CARLOS ALBERTO DORNELLES
* Desenvolvedor: CARLOS ALBERTO DORNELLES
* Data : 17/04/2003
* Linguagem : COBOL / DB2 / CICS
* Manutencoes :
*----------------------------------------------------------------*
* Desenvolvedor Responsavel Data
* ------------- ----------- ----
*
* xxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxx xx/xx/xxxx
* descrição xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
*----------------------------------------------------------------*
ENVIRONMENT DIVISION.
*---------------------
CONFIGURATION SECTION.
*---------------------
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
DATA DIVISION.
*-------------
WORKING-STORAGE SECTION.
*-----------------------
77 WS-SQLCODE-EDT PIC ----9.
01 AREAS-DE-TRABALHO.
03 WS-TAM PIC 9(005).
01 WS-AREA-ENTRADA.
03 PRM-NU-CONTA PIC 9(004).
03 PRM-NO-NOME PIC X(040).
03 PRM-NO-ENDERECO PIC X(070).
03 PRM-NO-CIDADE PIC X(050).
01 WS-VARIAVEIS-DB2.
03 WS-GR-CURSOR.
49 WS-ID-TAMANHO-CURSOR PIC S9(004) COMP VALUE ZEROES.
49 WS-DE-CURSOR PIC X(2500) VALUE SPACES.
000039 01 WS-AREA-ERROS.
000040 03 PRM-QTDE-ERROS PIC 9(003).
000041 03 PRM-ARRAY-ERROS OCCURS 1 TO 094 TIMES
000042 DEPENDING ON PRM-QTDE-ERROS.
000043 05 PRM-NUMERO-MENSAGEM PIC X(004).
000044 05 PRM-PROGRAMA PIC X(008).
000045 05 PRM-INFORMACOES PIC X(200).
000046
000047* Definicao de tabelas e areas na DCLGEN *
000048*----------------------------------------------------------------*
000049 EXEC SQL INCLUDE SQLCA END-EXEC.
000050 EXEC SQL INCLUDE TABELA01 END-EXEC.
000051
000052 LINKAGE SECTION.
000053*---------------
000054 01 DFHCOMMAREA.
000055 03 LKS-EXCECAO.
000056 05 LKS-ERRO-CICS PIC 9(003).
000057 05 LKS-NU-MENSAGEM PIC 9(004).
000058 05 LKS-NO-MENSAGEM PIC X(078).
000059 05 LKS-NU-SQLCODE PIC 9(004).
000060 03 LKS-IDENTIFICACAO.
000061 05 LKS-IN-NOME-PGM PIC X(008).
000062 05 LKS-IN-CO-USUARIO PIC X(008).
000063 05 LKS-IN-CO-FUNCAO PIC X(002).
000064 03 LKS-ENTRADA-SAIDA.
000065 05 LKS-CONTEUDO-TAM PIC 9(005).
000066 05 LKS-CONTEUDO.
000067 07 FILLER PIC X(001) OCCURS 1 TO 20000
000068 DEPENDING ON LKS-CONTEUDO-TAM.
000069
000070 PROCEDURE DIVISION USING DFHCOMMAREA.
000071*------------------------------------
000072 PERFORM R000-PROCED-INICIAIS THRU R000-FIM.
000073 PERFORM R100-PROCED-PRINCIPAIS THRU R100-FIM.
000074 PERFORM R999-PROCEDIMENTOS-FINAIS THRU P999-FIM.
000075
000076 R000-PROCED-INICIAIS.
000077*--------------------
000000
000100 MOVE LK-CONTEUDO(1:LKS-CONTEUDO-TAM) TO WS-AREA-ENTRADA.
000078 INITIALIZE LKS-EXCECAO.
000079 MOVE SPACES TO LKS-CONTEUDO(1:20000).
000080 MOVE ZEROES TO LKS-CONTEUDO-TAM
000082 PRM-QTDE-ERROS.
000083 R000-FIM.
000084 EXIT.
000085
000086 R100-PROCED-PRINCIPAIS.
000087*----------------------
000000
000099 EXEC SQL
000100 SET :TS-INI-VG-CONTA = CURRENT TIMESTAMP
000101 END-EXEC.
000000
INITIALIZE WS-GR-CURSOR.
MOVE 1 TO WS-ID-TAMANHO-CURSOR.
000021 MOVE PRM-NU-CONTA TO NU-CONTA.
000022 MOVE PRM-NO-NOME TO NO-NOME.
000024 MOVE PRM-NO-ENDERECO TO NO-ENDERECO.
000025 MOVE PRM-NO-CIDADE TO NO-CIDADE.
000000
000171 STRING
000172 " INSERT INTO DCL.TABELA01_CONTA "
000173 " (NU_CONTA "
000174 " , NO_NOME "
000000 " , TS_INI_VG_CONTA "
000000 " , NO_ENDERECO "
000180 " , NO_CIDADE) "
000181 " VALUES "
000182 "(" :NU-CONTA
000183 " , " :NO-NOME
000184 " , " :TS-INI-VG-CONTA
000185 " , " :NO-ENDERECO
000186 " , " :NO-CIDADE ")"
000190 DELIMITED BY SIZE INTO WS-DE-CURSOR
WITH POINTER WS-ID-TAMANHO-CURSOR
END-STRING.
EXEC SQL
DECLARE STMT1 STATEMENT
END-EXEC.
EXEC SQL
PREPARE STMT1 FROM :WS-GR-CURSOR
END-EXEC.
000133 IF SQLCODE NOT EQUAL +0
000134 MOVE 1 TO LKS-ERRO-CICS
000135 ADD 1 TO PRM-QTDE-ERROS
000136 MOVE SPACES TO PRM-INFORMACOES (PRM-QTDE-ERROS)
000137 MOVE SQLCODE TO LKS-NU-SQLCODE
000138 MOVE SQLCODE TO WS-SQLCODE-EDT
000139 STRING 'Erro de acesso a base de dados. SQLCODE: '
000140 WS-SQLCODE-EDT ' ErrMc: ' SQLERRMC
000143 ' - Tabela utilizada -> TABELA01'
000145 DELIMITED BY SIZE
000146 INTO PRM-INFORMACOES (PRM-QTDE-ERROS)
END-STRING
000147 MOVE '0001' TO PRM-NUMERO-MENSAGEM (PRM-QTDE-ERROS)
000148 MOVE 'INSERT01' TO PRM-PROGRAMA (PRM-QTDE-ERROS)
000649 EXEC CICS
000650 SYNCPOINT ROLLBACK
000651 END-EXEC
000149 PERFORM R999-PROCEDIMENTOS-FINAIS
000150 END-IF.
EXEC SQL
EXECUTE IMMEDIATE :WS-GR-CURSOR
END-EXEC.
000090 IF SQLCODE EQUAL -803
000091 MOVE 1 TO LKS-ERRO-CICS
000092 ADD 1 TO PRM-QTDE-ERROS
000093 MOVE SPACES TO PRM-INFORMACOES (PRM-QTDE-ERROS)
000094 MOVE SQLCODE TO LKS-NU-SQLCODE
000095 MOVE SQLCODE TO WS-SQLCODE-EDT
000096 STRING 'Tentativa de inclusao para registro ja existente.'
000102 DELIMITED BY SIZE
000103 INTO PRM-INFORMACOES (PRM-QTDE-ERROS)
END-STRING
000104 MOVE '0001' TO PRM-NUMERO-MENSAGEM (PRM-QTDE-ERROS)
000105 MOVE 'INSERT01' TO PRM-PROGRAMA (PRM-QTDE-ERROS)
000649 EXEC CICS
000650 SYNCPOINT ROLLBACK
000651 END-EXEC
000106 PERFORM R999-PROCEDIMENTOS-FINAIS
000107 END-IF.
000000
000133 IF SQLCODE NOT EQUAL +0
000134 MOVE 1 TO LKS-ERRO-CICS
000135 ADD 1 TO PRM-QTDE-ERROS
000136 MOVE SPACES TO PRM-INFORMACOES (PRM-QTDE-ERROS)
000137 MOVE SQLCODE TO LKS-NU-SQLCODE
000138 MOVE SQLCODE TO WS-SQLCODE-EDT
000139 STRING 'Erro de acesso a base de dados. SQLCODE: '
000140 WS-SQLCODE-EDT ' ErrMc: ' SQLERRMC
000143 ' - Tabela utilizada -> TABELA01'
000145 DELIMITED BY SIZE
000146 INTO PRM-INFORMACOES (PRM-QTDE-ERROS)
END-STRING
000147 MOVE '0001' TO PRM-NUMERO-MENSAGEM (PRM-QTDE-ERROS)
000148 MOVE 'INSERT01' TO PRM-PROGRAMA (PRM-QTDE-ERROS)
000649 EXEC CICS
000650 SYNCPOINT ROLLBACK
000651 END-EXEC
000149 PERFORM R999-PROCEDIMENTOS-FINAIS
000150 END-IF.
000119
000120 R100-FIM.
000121 EXIT.
000122
000199 R999-PROCEDIMENTOS-FINAIS.
000200*-------------------------
000201 IF LKS-ERRO-CICS = 1
000202 MOVE LENGTH OF WS-AREA-ERROS TO LKS-CONTEUDO-TAM
000203 MOVE WS-AREA-ERROS TO LKS-CONTEUDO (1:LKS-CONTEUDO-TAM)
000205 END-IF.
000206 EXEC CICS
000207 RETURN
000208 END-EXEC.
000209 P999-FIM.
000210 EXIT.
000211*----------------- F I M D O C O D I G O --------------------*
|
