- Este programa é chamado para realizar o INSERT da primeira parte da imagem.
- As demais partes serao realizadas pelo programa CADpo619, fazendo um UPDATE (append).
- A variavel WS-IMAGEL-REAL é usada para fazer o INSERT na coluna DE_IMAGEM da tabela CAD.TABELA32_IMAGEM e a mesma quando da compilacao do programa
gera as variaveis:
WS-IMAGEL-REAL-DATA e
WS-IMAGEL-REAL-LENGTH.
Código
1 2 3 4 5 6 7 8
12345678901234567890123456789012345678901234567890123456789012345678901234567890
*-----------------------------------------------------------------
IDENTIFICATION DIVISION.
*-----------------------------------------------------------------
PROGRAM-ID. PROGRA01.
AUTHOR . DORNELLES CARLOS ALBERTO.
*-----------------------------------------------------------------
* SISTEMA : SICAD
* PROGRAMA : PROGRA01
* OBJETIVO : MANTEM IMAGENS
* : MANTER IMAGEM - INCLUSAO
* ANALISTA : CARLOS ALBERTO DORNELLES
* DATA : 11/DEZEMBRO/2012
*-----------------------------------------------------------------
*-----------------------------------------------------------------
*
* ESTE PROGRAMA EH CHAMADO PARA REALIZAR O INSERT DA PRIMEIRA
* PARTE DA IMAGEM.
* AS DEMAIS PARTES SERAO REALIZADAS PELO PROGRAMA PROGRA02, FAZEN-
* DO UM UPDATE (APCADD).
* A VARIAVEL WS-IMAGEL-REAL EH USADA PARA FAZER O INSERT NA COLUNA
* DE_IMAGEM DA TABELA CAD.TABELA32_IMAGEM E A MESMA QUANDO DA COM-
* PILACAO DO PROGRAMA GERA AS VARIAVEIS:
* WS-IMAGEL-REAL-DATA E WS-IMAGEL-REAL-LENGTH
*
*-----------------------------------------------------------------
*-----------------------------------------------------------------
ENVIRONMENT DIVISION.
*-----------------------------------------------------------------
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
*-----------------------------------------------------------------
DATA DIVISION.
*-----------------------------------------------------------------
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
*-----------------------------------------------------------------
01 WS-AUXILIARES.
05 WS-IMAGEL-REAL USAGE IS SQL TYPE IS BLOB (50M).
05 WS-DE-IMAGEM PIC X(50000000) VALUE SPACES.
05 WS-SQLCODE PIC -Z.ZZ9 VALUE ZEROES.
05 WS-PARAGRAFO PIC X(080) VALUE SPACES.
05 WS-TAMANHO-I PIC S9(004) COMP VALUE ZEROES.
05 WS-VER-QTDE PIC S9(004) COMP VALUE ZEROES.
05 WS-DE-IMAGEM-ENTRADA.
10 WS-NU-SEQUENCIAL-MODELO PIC 9(00009) VALUE ZEROES.
10 WS-DE-IMAGEM-JAVA PIC X(19980) VALUE SPACES.
05 WS-DE-IMAGEM-SAIDA.
10 WS-NU-IMAGEM-SAI PIC 9(00009) VALUE ZEROES.
*-----------------------------------------------------------------
LOCAL-STORAGE SECTION.
*-----------------------------------------------------------------
* DEFINICAO DE TABELAS E AREAS NA DCLGEN
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL INCLUDE TABELA02 END-EXEC.
EXEC SQL INCLUDE TABELA32 END-EXEC.
EXEC SQL INCLUDE TABELA59 END-EXEC.
EXEC SQL INCLUDE TABELA61 END-EXEC.
*-----------------------------------------------------------------
LINKAGE SECTION.
*-----------------------------------------------------------------
01 DFHCOMMAREA.
COPY COPY0000.
*-----------------------------------------------------------------
* CONTEUDO DO BOOK - CADB0000
*-----------------------------------------------------------------
* 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(3).
* 03 STREAM-IO-IDENTIFICACAO.
* 04 STREAM-IO-NOME-PGM PIC X(008).
* 04 STREAM-IO-CO-USUARIO PIC X(008).
* 04 STREAM-IO-CO-FUNCAO PIC X(002).
* 03 STREAM-IO-ENTRADA-SAIDA.
* 04 STREAM-IO-CONTEUDO-TAM PIC 9(005).
* 04 STREAM-IO-CONTEUDO.
* 05 FILLER PIC X(001) OCCURS 1 TO 20000
* DECADDING ON STREAM-IO-CONTEUDO-TAM.
*-----------------------------------------------------------------
*-----------------------------------------------------------------
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-IO-CONTEUDO TO STREAM-IO-CONTEUDO-TAM
MOVE STREAM-IO-CONTEUDO (1:STREAM-IO-CONTEUDO-TAM)
TO WS-DE-IMAGEM-ENTRADA
MOVE ZEROES TO STREAM-IO-ERRO-CICS
STREAM-IO-NU-MENSAGEM
MOVE WS-NU-SEQUENCIAL-MODELO TO
NU-SEQUENCIAL-MODELO OF TABELA61
.
P0001-FIM.
EXIT.
*-----------------------------------------------------------------
P1000-PROCEDIMENTOS-PRINCIPAIS.
*-----------------------------------------------------------------
MOVE 'P1000-PROCEDIMENTOS-PRINCIPAIS' TO WS-PARAGRAFO
PERFORM P1300-VERIFICA-QDTE
PERFORM P2000-MAX-NU-IMAGEM
PERFORM P1500-SELECT-TABELA61
PERFORM P3000-INSERT-TABELA32
PERFORM P4000-INSERT-TABELA59
PERFORM P8000-TRATA-SQLCODE
.
P1000-FIM.
EXIT.
*-----------------------------------------------------------------
P1300-VERIFICA-QDTE.
*-----------------------------------------------------------------
EXEC SQL
SELECT COUNT(*)
INTO :WS-VER-QTDE
FROM CAD.TABELA32_IMAGEM TBA32
, CAD.TABELA59_IMAGEM_CRCTA_OBJETO TBA59
, CAD.TABELA61_CRCTA_MODELO_OBJETO TBA61
WHERE TBA61.NU_SEQUENCIAL_MODELO =
:TABELA61.NU-SEQUENCIAL-MODELO
AND TBA61.NU_SEQUENCIAL_MODELO =
TBA59.NU_SEQUENCIAL_MODELO
AND TBA61.TS_CARACTERISTICA =
TBA59.TS_CARACTERISTICA
AND TBA32.NU_IMAGEM = TBA59.NU_IMAGEM
AND IC_SITUACAO = '1'
END-EXEC
IF WS-VER-QTDE GREATER THAN 9
MOVE 'Quantidade de imagens no limite permitido.' TO
STREAM-IO-NO-MENSAGEM
EXEC CICS SYNCPOINT ROLLBACK END-EXEC
PERFORM P850-ERRO-INFORMACAO
END-IF
.
P1000-FIM.
EXIT.
*-----------------------------------------------------------------
P1500-SELECT-TABELA61.
*-----------------------------------------------------------------
EXEC SQL
SELECT MAX(TS_CARACTERISTICA)
INTO :TABELA61.TS-CARACTERISTICA
FROM CAD.TABELA61_CRCTA_MODELO_OBJETO
WHERE NU_SEQUENCIAL_MODELO =
:TABELA61.NU-SEQUENCIAL-MODELO
END-EXEC
IF SQLCODE NOT EQUAL +000
MOVE 'Sequencial modelo invalido.' TO
STREAM-IO-NO-MENSAGEM
EXEC CICS SYNCPOINT ROLLBACK END-EXEC
PERFORM P850-ERRO-INFORMACAO
END-IF
.
P1000-FIM.
EXIT.
*-----------------------------------------------------------------
P2000-MAX-NU-IMAGEM.
*-----------------------------------------------------------------
MOVE 'P2000-MAX-NU-IMAGEM' TO WS-PARAGRAFO
EXEC SQL
SELECT VALUE(MAX(NU_IMAGEM),0) + 1
INTO :TABELA32.NU-IMAGEM
FROM CAD.TABELA32_IMAGEM
END-EXEC
MOVE NU-IMAGEM OF TABELA32 TO WS-NU-IMAGEM-SAI
.
P2000-FIM.
EXIT.
*-----------------------------------------------------------------
P3000-INSERT-TABELA32.
*-----------------------------------------------------------------
MOVE 'P3000-INSERT-TABELA32' TO WS-PARAGRAFO
EXEC SQL
SELECT LENGTH(STRIP(:WS-DE-IMAGEM-JAVA))
INTO :WS-TAMANHO-I
FROM SYSIBM.SYSDUMMY1
END-EXEC
MOVE WS-DE-IMAGEM-JAVA (1:WS-TAMANHO-I) TO
WS-IMAGEL-REAL-DATA
MOVE WS-TAMANHO-I TO WS-IMAGEL-REAL-LENGTH
EXEC SQL
INSERT INTO CAD.TABELA32_IMAGEM
( NU_IMAGEM
, DE_IMAGEM )
VALUES
(:TABELA32.NU-IMAGEM
, BLOB(:WS-IMAGEL-REAL) )
END-EXEC
IF SQLCODE NOT EQUAL +000
MOVE 'Inclusão não efetuada.' TO STREAM-IO-NO-MENSAGEM
EXEC CICS SYNCPOINT ROLLBACK END-EXEC
PERFORM P850-ERRO-INFORMACAO
END-IF
.
P3000-FIM.
EXIT.
*-----------------------------------------------------------------
P4000-INSERT-TABELA59.
*-----------------------------------------------------------------
MOVE 'P4000-INSERT-TABELA59' TO WS-PARAGRAFO
MOVE NU-IMAGEM OF TABELA32 TO NU-IMAGEM OF TABELA59
MOVE WS-NU-SEQUENCIAL-MODELO TO
NU-SEQUENCIAL-MODELO OF TABELA59
EXEC SQL
INSERT INTO CAD.TABELA59_IMAGEM_CRCTA_OBJETO
( NU_IMAGEM
, NU_SEQUENCIAL_MODELO
, TS_CARACTERISTICA
, IC_SITUACAO )
VALUES
(:TABELA59.NU-IMAGEM
, :TABELA59.NU-SEQUENCIAL-MODELO
, :TABELA61.TS-CARACTERISTICA
, '1' )
END-EXEC
.
P4000-FIM.
EXIT.
*-----------------------------------------------------------------
P8000-TRATA-SQLCODE.
*-----------------------------------------------------------------
MOVE 'P8000-TRATA-SQLCODE' TO WS-PARAGRAFO
MOVE ZEROES TO STREAM-IO-ERRO-CICS
MOVE SQLCODE TO STREAM-IO-NU-MENSAGEM
STREAM-IO-NU-SQLCODE
EVALUATE SQLCODE
WHEN +000
MOVE 'MA00106' TO CO-MENSAGEM OF TABELA02
PERFORM P8999-OBTER-MENSAGEM THRU P8999-FIM
EXEC SQL COMMIT END-EXEC
WHEN +100
MOVE 'Inclusão não efetuada.' TO
STREAM-IO-NO-MENSAGEM
EXEC CICS SYNCPOINT ROLLBACK END-EXEC
WHEN -803
MOVE 'MA00041' TO CO-MENSAGEM OF TABELA02
PERFORM P8999-OBTER-MENSAGEM THRU P8999-FIM
EXEC CICS SYNCPOINT ROLLBACK END-EXEC
WHEN OTHER
MOVE 'Erro de acesso ao banco de dados.' TO
STREAM-IO-NO-MENSAGEM
EXEC CICS SYNCPOINT ROLLBACK END-EXEC
END-EVALUATE
.
P8000-FIM.
EXIT.
*-----------------------------------------------------------------
P850-ERRO-INFORMACAO.
*-----------------------------------------------------------------
MOVE 'P8500-TRATA-SQLCODE' TO WS-PARAGRAFO
MOVE 00 TO STREAM-IO-ERRO-CICS
MOVE SQLCODE TO STREAM-IO-NU-SQLCODE
WS-SQLCODE
MOVE 01 TO STREAM-IO-NU-MENSAGEM
EXEC CICS RETURN END-EXEC
.
P8500-FIM.
EXIT.
*-----------------------------------------------------------------
P8999-OBTER-MENSAGEM.
*-----------------------------------------------------------------
EXEC SQL
SELECT DE_MENSAGEM
INTO :TABELA02.DE-MENSAGEM
FROM CAD.TABELA02_MENSAGEM_APOIO
WHERE CO_MENSAGEM = :TABELA02.CO-MENSAGEM
AND DT_FIM_VIGENCIA = '31.12.9999'
WITH UR
END-EXEC
IF SQLCODE = 0
MOVE 0 TO STREAM-IO-NU-MENSAGEM
STRING CO-MENSAGEM ' - '
DE-MENSAGEM-TEXT (1:DE-MENSAGEM-LEN)
DELIMITED BY SIZE INTO STREAM-IO-NO-MENSAGEM
END-STRING
ELSE
MOVE 0 TO STREAM-IO-NU-MENSAGEM
STRING CO-MENSAGEM ' - '
'Mensagem não cadastrada'
DELIMITED BY SIZE INTO STREAM-IO-NO-MENSAGEM
END-STRING
END-IF
.
P8999-FIM.
EXIT.
*-----------------------------------------------------------------
P9000-PROCEDIMENTOS-FINAIS.
*-----------------------------------------------------------------
MOVE 9 TO STREAM-IO-CONTEUDO-TAM
MOVE WS-DE-IMAGEM-SAIDA TO STREAM-IO-CONTEUDO
EXEC CICS RETURN END-EXEC
.
P9000-FIM.
EXIT.
|
