- Este programa é chamado para realizar a exclusão lógica da imagem.
Código
1 2 3 4 5 6 7 8
12345678901234567890123456789012345678901234567890123456789012345678901234567890
*-----------------------------------------------------------------
IDENTIFICATION DIVISION.
*-----------------------------------------------------------------
PROGRAM-ID. PROGRA03.
AUTHOR . DORNELLES CARLOS ALBERTO.
*-----------------------------------------------------------------
* SISTEMA : SICAD
* PROGRAMA : PROGRA03
* OBJETIVO : MANTEM IMAGENS
* : INATIVAR IMAGEM
* ANALISTA : CARLOS ALBERTO DORNELLES
* DATA : 11/DEZEMBRO/2012
*-----------------------------------------------------------------
*-----------------------------------------------------------------
ENVIRONMENT DIVISION.
*-----------------------------------------------------------------
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
*-----------------------------------------------------------------
DATA DIVISION.
*-----------------------------------------------------------------
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
*-----------------------------------------------------------------
01 WS-AUXILIARES.
05 WS-DE-IMAGEM-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-TAMANHO-U PIC S9(004) COMP VALUE ZEROES.
05 WS-TAMANHO-T PIC S9(004) COMP VALUE ZEROES.
05 WS-DE-IMAGEM-ENTRADA.
10 WS-NU-IMAGEM PIC 9(00009) VALUE ZEROES.
10 WS-NU-SEQUENCIAL-MODELO 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 TABELA59 END-EXEC.
*-----------------------------------------------------------------
LINKAGE SECTION.
*-----------------------------------------------------------------
01 DFHCOMMAREA.
COPY COPY0001.
*-----------------------------------------------------------------
* CONTEUDO DO BOOK - COPY0001
*-----------------------------------------------------------------
* 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
.
P0001-FIM.
EXIT.
*-----------------------------------------------------------------
P1000-PROCEDIMENTOS-PRINCIPAIS.
*-----------------------------------------------------------------
MOVE 'P1000-PROCEDIMENTOS-PRINCIPAIS' TO WS-PARAGRAFO
PERFORM P5000-UPDATE-TABELA59
PERFORM P8000-TRATA-SQLCODE
.
P1000-FIM.
EXIT.
*-----------------------------------------------------------------
P5000-UPDATE-TABELA59.
*-----------------------------------------------------------------
MOVE 'P5000-UPDATE-TABELA32' TO WS-PARAGRAFO
MOVE WS-NU-IMAGEM TO NU-IMAGEM OF TABELA59
MOVE WS-NU-SEQUENCIAL-MODELO TO NU-SEQUENCIAL-MODELO
EXEC SQL
UPDATE CAD.TABELA59_IMAGEM_CRCTA_OBJETO
SET IC_SITUACAO = '2'
WHERE NU_IMAGEM = :TABELA59.NU-IMAGEM
AND NU_SEQUENCIAL_MODELO = :NU-SEQUENCIAL-MODELO
END-EXEC
.
P5000-FIM.
EXIT.
*-----------------------------------------------------------------
P8000-TRATA-SQLCODE.
*-----------------------------------------------------------------
MOVE ZEROES TO STREAM-IO-ERRO-CICS
MOVE SQLCODE TO STREAM-IO-NU-MENSAGEM
STREAM-IO-NU-SQLCODE
EVALUATE SQLCODE
WHEN +000
MOVE 'MA00107' TO CO-MENSAGEM OF TABELA02
PERFORM P8999-OBTER-MENSAGEM THRU P8999-FIM
EXEC SQL COMMIT END-EXEC
WHEN +100
MOVE 'MN00005' TO CO-MENSAGEM OF TABELA02
PERFORM P8999-OBTER-MENSAGEM THRU P8999-FIM
EXEC CICS SYNCPOINT ROLLBACK END-EXEC
WHEN +999
EXEC CICS RETURN 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.
*----------------------------------------------------------------*
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
MOVE ZEROES TO STREAM-IO-NU-MENSAGEM
IF SQLCODE EQUAL +000
STRING CO-MENSAGEM ' - '
DE-MENSAGEM-TEXT (1:DE-MENSAGEM-LEN)
DELIMITED BY SIZE INTO STREAM-IO-NO-MENSAGEM
END-STRING
ELSE
STRING CO-MENSAGEM ' - '
'MENSAGEM NAO CADASTRADA'
DELIMITED BY SIZE INTO STREAM-IO-NO-MENSAGEM
END-STRING
END-IF
.
P8999-FIM.
EXIT.
*-----------------------------------------------------------------
P9000-PROCEDIMENTOS-FINAIS.
*-----------------------------------------------------------------
EXEC CICS RETURN END-EXEC
.
P9000-FIM.
EXIT.
|
