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. SELECT06.
000005
000006*----------------------------------------------------------------*
000007* Sistema : EXEMPLO
000008* Programa : SELECT06
000009* Objetivo : Contar quantos registros existem na tabela
000010* Analista : CARLOS ALBERTO DORNELLES
000011* Desenvolvedor: CARLOS ALBERTO DORNELLES
000012* Data : 31/12/2002
000013* Linguagem : COBOL / DB2 / CICS
000014* Manutencoes :
000015*----------------------------------------------------------------*
000016* Desenvolvedor Responsavel Data
000017* ------------- ----------- ----
000018*
000019* xxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxx xx/xx/xxxx
000020* descrição xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
000021*----------------------------------------------------------------*
000022
000023 ENVIRONMENT DIVISION.
000024*---------------------
000025 CONFIGURATION SECTION.
000026*---------------------
000027 SPECIAL-NAMES.
000028 DECIMAL-POINT IS COMMA.
000029
000030 DATA DIVISION.
000031*-------------
000032 WORKING-STORAGE SECTION.
000033*-----------------------
000034 77 WS-SQLCODE-EDT PIC ----9.
000035 01 AREAS-DE-TRABALHO.
000036 03 WS-TAM PIC 9(005).
000037 01 WS-VARIAVEIS-DB2.
000038 03 WS-GR-CURSOR.
000039 49 WS-ID-TAMANHO-CURSOR PIC S9(004) COMP VALUE ZEROES.
000040 49 WS-DE-CURSOR PIC X(2500) VALUE SPACES.
000041 01 WS-AREA-SAIDA.
000042 05 PRM-QTDE-CONTAS PIC 9(004).
000043
000044 01 WS-AREA-ERROS.
000045 03 PRM-QTDE-ERROS PIC 9(003).
000046 03 PRM-ARRAY-ERROS OCCURS 1 TO 094 TIMES
000047 DEPENDING ON PRM-QTDE-ERROS.
000048 05 PRM-NUMERO-MENSAGEM PIC X(004).
000049 05 PRM-PROGRAMA PIC X(008).
000050 05 PRM-INFORMACOES PIC X(200).
000051
000052* Definicao de tabelas e areas na DCLGEN *
000053*----------------------------------------------------------------*
000054 EXEC SQL INCLUDE SQLCA END-EXEC.
000055 EXEC SQL INCLUDE TABELA01 END-EXEC.
000056
000057 LINKAGE SECTION.
000058*---------------
000059 01 DFHCOMMAREA.
000060 03 LKS-EXCECAO.
000061 05 LKS-ERRO-CICS PIC 9(003).
000062 05 LKS-NU-MENSAGEM PIC 9(004).
000063 05 LKS-NO-MENSAGEM PIC X(078).
000064 05 LKS-NU-SQLCODE PIC 9(004).
000065 03 LKS-IDENTIFICACAO.
000066 05 LKS-IN-NOME-PGM PIC X(008).
000067 05 LKS-IN-CO-USUARIO PIC X(008).
000068 05 LKS-IN-CO-FUNCAO PIC X(002).
000069 03 LKS-ENTRADA-SAIDA.
000070 05 LKS-CONTEUDO-TAM PIC 9(005).
000071 05 LKS-CONTEUDO.
000072 07 FILLER PIC X(001) OCCURS 1 TO 20000
000073 DEPENDING ON LKS-CONTEUDO-TAM.
000074
000075 PROCEDURE DIVISION USING DFHCOMMAREA.
000076*------------------------------------
000077
000078 PERFORM R000-PROCED-INICIAIS THRU R000-FIM.
000079 PERFORM R100-PROCED-PRINCIPAIS THRU R100-FIM.
000080 PERFORM R999-PROCEDIMENTOS-FINAIS THRU R999-FIM.
000081
000082 R000-PROCED-INICIAIS.
000083*--------------------
000084
000085 INITIALIZE LK-EXCECAO.
000086 MOVE SPACES TO LK-CONTEUDO(1:20000).
000087 MOVE ZEROES TO LK-CONTEUDO-TAM PRM-QTDE-ERROS.
000088
000089 R000-FIM.
000090 EXIT.
000091
000092 R100-PROCED-PRINCIPAIS.
000093*----------------------
000094
000095 PERFORM P105-GERAR-COUNT THRU P105-FIM.
000096 PERFORM P110-BUSCA-COUNT THRU P110-FIM.
000097
000098 MOVE NU-CONTA TO PRM-QTDE-CONTAS.
000099 MOVE LENGTH OF WS-AREA-SAIDA TO LK-CONTEUDO-TAM.
000100 MOVE WS-AREA-SAIDA TO LK-CONTEUDO (1:LK-CONTEUDO-TAM).
000101 PERFORM R900-FECHA-ARQUIVOS THRU R900-FIM.
000102
000103 R100-FIM.
000104 EXIT.
000105
000106 R105-GERAR-COUNT.
000107*----------------
000108
000109 INITIALIZE WS-GR-CURSOR.
000110 MOVE 1 TO WS-ID-TAMANHO-CURSOR.
000111 STRING
000112 'SELECT COUNT(*) FROM DCL.TABELA01_CONTA'
000113 DELIMITED BY SIZE INTO WS-DE-CURSOR
000114 WITH POINTER WS-ID-TAMANHO-CURSOR
000114 END-STRING.
000115
000116 EXEC SQL
000117 PREPARE CONSULTA FROM :WS-GR-CURSOR
000118 END-EXEC.
000119
000120 IF SQLCODE NOT EQUAL +0
000121 PERFORM R910-ERRO-SQLCODE THRU R910-FIM
000122 END-IF.
000123
000124 EXEC SQL
000125 DECLARE CUR001 CURSOR FOR CONSULTA
000126 END-EXEC.
000127
000128 IF SQLCODE NOT EQUAL +0
000129 PERFORM R910-ERRO-SQLCODE THRU R910-FIM
000130 END-IF.
000131
000132 EXEC SQL
000133 OPEN CUR001
000134 END-EXEC.
000135
000136 IF SQLCODE NOT EQUAL +0
000137 PERFORM R910-ERRO-SQLCODE THRU R910-FIM
000138 END-IF.
000139
000140 R105-FIM.
000141 EXIT.
000142
000143 R110-BUSCA-COUNT.
000144*----------------
000145
000146 EXEC SQL
000147 FETCH CUR001
000148 INTO :NU-CONTA
000149 END-EXEC.
000150
000151 IF NU-CONTA EQUAL ZEROES
000152 MOVE +100 TO SQLCODE
000153 END-IF.
000154
000155 IF SQLCODE NOT = +0 AND +100
000156 PERFORM R910-ERRO-SQLCODE THRU R910-FIM
000157 END-IF.
000158
000159 P110-FIM.
000160 EXIT.
000161
000162 R900-FECHA-ARQUIVOS.
000163*-------------------
000164
000165 EXEC SQL
000166 CLOSE CUR001
000167 END-EXEC.
000168
000169 R900-FIM.
000170 EXIT.
000171
000172 R910-ERRO-SQLCODE.
000173*-----------------
000174
000175 MOVE 1 TO LKS-ERRO-CICS.
000176 ADD 1 TO PRM-QTDE-ERROS.
000177 MOVE SPACES TO PRM-INFORMACOES (PRM-QTDE-ERROS).
000178 MOVE SQLCODE TO LKS-NU-SQLCODE.
000179 MOVE SQLCODE TO WS-SQLCODE-EDT.
000180 STRING 'Erro de acesso a base de dados. SQLCODE: '
000181 WS-SQLCODE-EDT ' ErrMc: ' SQLERRMC
000182 ' - Tabela utilizada -> TABELA01'
000183 DELIMITED BY SIZE
000184 INTO PRM-INFORMACOES (PRM-QTDE-ERROS)
END-STRING.
000185 MOVE '0001' TO PRM-NUMERO-MENSAGEM (PRM-QTDE-ERROS).
000186 MOVE 'SELECT06' TO PRM-PROGRAMA (PRM-QTDE-ERROS).
000187 PERFORM R999-PROCEDIMENTOS-FINAIS.
000188
OOO189 R910-FIM.
000190 EXIT.
000191
000192 R999-PROCEDIMENTOS-FINAIS.
000193*-------------------------
000194
000195 IF LK-ERRO-CICS = 1
000196 MOVE LENGTH OF WS-AREA-ERROS TO LK-CONTEUDO-TAM
000197 MOVE WS-AREA-ERROS TO LK-CONTEUDO (1:LK-CONTEUDO-TAM)
000198 END-IF.
000199
000200 EXEC CICS
000201 RETURN
000202 END-EXEC.
000203
000204 R999-FIM.
000205 EXIT.
|
