1 2 3 4 5 6 7
123456789012345678901234567890123456789012345678901234567890123456789012
000001*----------------- I N I C I O D O C O D I G O --------------*
000002 IDENTIFICATION DIVISION.
000003*-----------------------
000004 PROGRAM-ID. UPDATE01.
000005
000006* Sistema : EXEMPLO
000007* Programa : UPDATE01
000008* Objetivo : ALTERAR DADOS NA TABELA CFE PARAMETROS DE ENTRADA
000009* Analista : CARLOS ALBERTO DORNELLES
000010* Desenvolvedor: CARLOS ALBERTO DORNELLES
000011* Data : 31/12/2002
000012* Linguagem : COBOL / DB2 / CICS
000013* Manutencoes :
000014*----------------------------------------------------------------*
000015* Desenvolvedor Responsavel Data
000016* ------------- ----------- ----
000018* xxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxx xx/xx/xxxx
000019* descrição xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
000020*----------------------------------------------------------------*
000021 ENVIRONMENT DIVISION.
000022*---------------------
000023 CONFIGURATION SECTION.
000024*---------------------
000025 SPECIAL-NAMES.
000026 DECIMAL-POINT IS COMMA.
000027
000028 DATA DIVISION.
000029*-------------
000030 WORKING-STORAGE SECTION.
000031*-----------------------
000032 77 WS-SQLCODE-EDT PIC ----9.
000033 01 AREAS-DE-TRABALHO.
000034 03 WS-TAM PIC 9(005).
000035 01 WS-AREA-ENTRADA.
000021 03 PRM-NU-CONTA PIC 9(004).
000022 03 PRM-NO-NOME PIC X(040).
000024 03 PRM-NO-ENDERECO PIC X(070).
000025 03 PRM-NO-CIDADE PIC X(050).
000000
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
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 EXEC SQL
000172 UPDATE EMP.EMPTB060_CTRT_FASE
000183 SET NO_NOME = :NO-NOME
000184 , TS_INI_VG_CONTA = :TS-INI-VG-CONTA
000185 , NO_ENDERECO = :NO-ENDERECO
000186 , NO_CIDADE = :NO-CIDADE
000000 WHERE NU_CONTA = :NU-CONTA
000190 END-EXEC.
000000
000090 IF SQLCODE EQUAL +100
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 alteracao para registro inexistente.'
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 'UPDATE01' 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 'UPDATE01' 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 --------------------*
|
