1 2 3 4 5 6 7 8
12345678901234567890123456789012345678901234567890123456789012345678901234567890
*-----------------------------------------------------------------
IDENTIFICATION DIVISION.
*-----------------------------------------------------------------
PROGRAM-ID. CADBAL01.
AUTHOR. CARLOS ALBERTO DORNELLES.
*-----------------------------------------------------------------
* SISTEMA : SICAD
* PROGRAMA : CADBAL01
* OBJETIVO : ATUALIZA A TABELA CAD.CADTB000_CLSFOEXTO
* : A PARTIR DA BET.BETTB000_CLSFOEXTO
* ANALISTA(S) : CARLOS ALBERTO DORNELLES
* DESENVOVLERDOR: CARLOS ALBERTO DORNELLES
* LINGUAGEM : COBOL 85 (II) / DB2
* MODO OPERACAO : BATCH
*-----------------------------------------------------------------
* COD-VER DD.MM.AAAA HISTORCAD/AUTOR
* ------- ---------- ---------------
* V.001 13.06.2008 PROGRAMA INICIAL
*
*-----------------------------------------------------------------
*-----------------------------------------------------------------
ENVIRONMENT DIVISION.
*-----------------------------------------------------------------
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
*-----------------------------------------------------------------
DATA DIVISION.
*-----------------------------------------------------------------
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
*-----------------------------------------------------------------
01 WS-AREAS-AUXILIARES.
05 WS-LIDOS-DES PIC 9(009) VALUE ZEROES.
05 WS-LIDOS-PRD PIC 9(009) VALUE ZEROES.
05 WS-GRAVADOS PIC 9(009) VALUE ZEROES.
05 WS-ALTERADOS PIC 9(009) VALUE ZEROES.
05 WS-REJEITADOS PIC 9(009) VALUE ZEROES.
05 WS-SQLCODE PIC -----9 VALUE ZEROES.
05 WS-MENSAGEM PIC X(078) VALUE SPACES.
05 WS-PARAGRAFO PIC X(078) VALUE SPACES.
05 WS-CURRENT-DATE-I PIC X(010) VALUE SPACES.
05 WS-CURRENT-TIME-I PIC X(008) VALUE SPACES.
05 WS-CURRENT-DATE-F PIC X(010) VALUE SPACES.
05 WS-CURRENT-TIME-F PIC X(008) VALUE SPACES.
05 WS-VERSAO-PG PIC 9(003) VALUE 001. .
05 WS-CHAVE-DES PIC 9(004) VALUE ZEROES.
05 WS-CHAVE-PRD PIC 9(004) VALUE ZEROES.
05 FLAG-ALTERACAO PIC X(001) VALUE 'S'.
88 SIM-ALTERA VALUE 'S'.
88 NAO-ALTERA VALUE 'N'.
*-----------------------------------------------------------------
LOCAL-STORAGE SECTION.
*-----------------------------------------------------------------
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL INCLUDE CADTB000 END-EXEC.
EXEC SQL INCLUDE BETTB000 END-EXEC.
EXEC SQL
DECLARE CURSOR_CADDES CURSOR FOR
SELECT NU_CLSFO_EXTNO
, DE_CLSFO_EXTNO
,VALUE(NU_TIPO_CLSFO_U49,0)
FROM CAD.CADTB000_CLSFOEXTO
ORDER BY
NU_CLSFO_EXTNO
END-EXEC.
EXEC SQL
DECLARE CURSOR_BETPRD CURSOR FOR
SELECT NU_CLSFO_EXTNO
, DE_CLSFO_EXTNO
,VALUE(NU_TIPO_CLSFO_U49,0)
FROM BET.BETTB000_CLSFOEXTO
ORDER BY
NU_CLSFO_EXTNO
END-EXEC.
*-----------------------------------------------------------------
PROCEDURE DIVISION.
*-----------------------------------------------------------------
PERFORM P1000-INICIAL
PERFORM P2000-PRINCIPAL
PERFORM P3000-FINAL
GOBACK.
*-----------------------------------------------------------------
P1000-INICIAL.
*-----------------------------------------------------------------
MOVE 'P1000-INICIAL ' TO WS-PARAGRAFO.
EXEC SQL OPEN CURSOR_CADDES END-EXEC.
IF SQLCODE NOT EQUAL +000
MOVE 'ERRO NA ABERTURA DO CURSOR_CADDES' TO WS-MENSAGEM
PERFORM P8000-ERRO-DB2 THRU P8000-FIM
END-IF.
MOVE 'P1000-INICIAL ' TO WS-PARAGRAFO.
EXEC SQL OPEN CURSOR_BETPRD END-EXEC.
IF SQLCODE NOT EQUAL +000
MOVE 'ERRO NA ABERTURA DO CURSOR_BETPRD' TO WS-MENSAGEM
PERFORM P8000-ERRO-DB2 THRU P8000-FIM
END-IF.
EXEC SQL
SELECT CURRENT DATE
INTO :WS-CURRENT-DATE-I
FROM SYSIBM.SYSDUMMY1
END-EXEC
EXEC SQL
SELECT CURRENT TIME
INTO :WS-CURRENT-TIME-I
FROM SYSIBM.SYSDUMMY1
END-EXEC.
P1000-FIM.
EXIT.
*-----------------------------------------------------------------
P2000-PRINCIPAL.
*-----------------------------------------------------------------
MOVE 'P2000-PRINCIPAL' TO WS-PARAGRAFO.
PERFORM P2400-LER-CAD-DES THRU P2400-FIM.
PERFORM P2500-LER-BET-PRD THRU P2500-FIM.
PERFORM UNTIL WS-CHAVE-PRD EQUAL 9999 AND
WS-CHAVE-DES EQUAL 9999
EVALUATE TRUE
WHEN WS-CHAVE-PRD LESS THAN WS-CHAVE-DES
PERFORM P2230-INCLUSAO-DES THRU P2230-FIM
PERFORM P2500-LER-BET-PRD THRU P2500-FIM
WHEN WS-CHAVE-PRD EQUAL WS-CHAVE-DES
PERFORM P2250-ALTERACAO-DES THRU P2250-FIM
PERFORM P2400-LER-CAD-DES THRU P2400-FIM
PERFORM P2500-LER-BET-PRD THRU P2500-FIM
WHEN WS-CHAVE-PRD GREATER THAN WS-CHAVE-DES
PERFORM P2400-LER-CAD-DES THRU P2400-FIM
END-EVALUATE
END-PERFORM.
P2000-FIM.
EXIT.
*-----------------------------------------------------------------
P2230-INCLUSAO-DES.
*-----------------------------------------------------------------
MOVE 'P2230-INCLUSAO-DES' TO WS-PARAGRAFO.
EXEC SQL
INSERT INTO CAD.CADTB000_CLSFOEXTO
(NU_CLSFO_EXTNO
, DE_CLSFO_EXTNO
, NU_TIPO_CLSFO_U49)
VALUES
(:BETTB000.NU-CLSFO-EXTNO
, :BETTB000.DE-CLSFO-EXTNO
, :BETTB000.NU-TIPO-CLSFO-U49)
END-EXEC.
EVALUATE SQLCODE
WHEN +000
ADD 1 TO WS-GRAVADOS
WHEN -530
ADD 1 TO WS-REJEITADOS
WHEN OTHER
MOVE 'ERRO NO INSERT DESENVOLVIMENTO' TO WS-MENSAGEM
PERFORM P8000-ERRO-DB2 THRU P8000-FIM
END-EVALUATE.
P2230-FIM.
EXIT.
*-----------------------------------------------------------------
P2250-ALTERACAO-DES.
*-----------------------------------------------------------------
MOVE 'P2250-ALTERACAO-DES' TO WS-PARAGRAFO.
SET NAO-ALTERA TO TRUE.
EVALUATE TRUE
WHEN DE-CLSFO-EXTNO OF CADTB000 NOT EQUAL
DE-CLSFO-EXTNO OF BETTB000
SET SIM-ALTERA TO TRUE
WHEN NU-TIPO-CLSFO-U49 OF CADTB000 NOT EQUAL
NU-TIPO-CLSFO-U49 OF BETTB000
SET SIM-ALTERA TO TRUE
END-EVALUATE.
IF SIM-ALTERA
PERFORM 2800-UPDATE-DES THRU 2800-99-FIM
END-IF.
P2250-FIM.
EXIT.
*-----------------------------------------------------------------
P2400-LER-CAD-DES.
*-----------------------------------------------------------------
MOVE 'P2400-LER-CAD-DES' TO WS-PARAGRAFO.
INITIALIZE CADTB000
EXEC SQL
FETCH CURSOR_CADDES
INTO :CADTB000.NU-CLSFO-EXTNO
, :CADTB000.DE-CLSFO-EXTNO
, :CADTB000.NU-TIPO-CLSFO-U49
END-EXEC.
EVALUATE SQLCODE
WHEN +000
ADD 1 TO WS-LIDOS-DES
MOVE NU-CLSFO-EXTNO OF CADTB000 TO WS-CHAVE-DES
WHEN +100
MOVE 9999 TO WS-CHAVE-DES
WHEN OTHER
MOVE 'ERRO NO FETCH DO CURSOR_CADDES' TO WS-MENSAGEM
PERFORM P8000-ERRO-DB2 THRU P8000-FIM
END-EVALUATE.
P2400-FIM.
EXIT.
*-----------------------------------------------------------------
P2500-LER-BET-PRD.
*-----------------------------------------------------------------
MOVE 'P2500-LER-BET-PRD' TO WS-PARAGRAFO.
INITIALIZE BETTB000.
EXEC SQL
FETCH CURSOR_BETPRD
INTO :BETTB000.NU-CLSFO-EXTNO
, :BETTB000.DE-CLSFO-EXTNO
, :BETTB000.NU-TIPO-CLSFO-U49
END-EXEC.
EVALUATE SQLCODE
WHEN +000
ADD 1 TO WS-LIDOS-PRD
MOVE NU-CLSFO-EXTNO OF BETTB000 TO WS-CHAVE-PRD
WHEN +100
MOVE 9999 TO WS-CHAVE-PRD
WHEN OTHER
MOVE 'ERRO NO FETCH DO CURSOR_BETPRD' TO WS-MENSAGEM
PERFORM P8000-ERRO-DB2 THRU P8000-FIM
END-EVALUATE.
P2500-FIM.
EXIT.
*-----------------------------------------------------------------
2800-UPDATE-DES.
*-----------------------------------------------------------------
MOVE '2800-UPDATE-DES' TO WS-PARAGRAFO.
EXEC SQL
UPDATE CAD.CADTB000_CLSFOEXTO
SET DE_CLSFO_EXTNO = :BETTB000.DE-CLSFO-EXTNO
, NU_TIPO_CLSFO_U49 = :BETTB000.NU-TIPO-CLSFO-U49
WHERE NU_CLSFO_EXTNO = :BETTB000.NU-CLSFO-EXTNO
END-EXEC.
EVALUATE SQLCODE
WHEN +000
ADD 1 TO WS-ALTERADOS
WHEN -530
ADD 1 TO WS-REJEITADOS
WHEN OTHER
MOVE 'ERRO NO UPDATE DESENVOLVIMENTO' TO WS-MENSAGEM
PERFORM P8000-ERRO-DB2 THRU P8000-FIM
END-EVALUATE.
2800-99-FIM.
EXIT.
*-----------------------------------------------------------------
P3000-FINAL.
*-----------------------------------------------------------------
MOVE 'P3000-FINAL' TO WS-PARAGRAFO.
EXEC SQL CLOSE CURSOR_CADDES END-EXEC.
IF SQLCODE NOT EQUAL +0
MOVE 'ERRO NA FECHAMENTO DO CURSOR_CADDES' TO WS-MENSAGEM
PERFORM P8000-ERRO-DB2 THRU P8000-FIM
END-IF.
EXEC SQL CLOSE CURSOR_BETPRD END-EXEC.
IF SQLCODE NOT EQUAL +0
MOVE 'ERRO NA FECHAMENTO DO CURSOR_BETPRD' TO WS-MENSAGEM
PERFORM P8000-ERRO-DB2 THRU P8000-FIM
END-IF.
EXEC SQL COMMIT END-EXEC.
EXEC SQL
SELECT CURRENT DATE
INTO :WS-CURRENT-DATE-F
FROM SYSIBM.SYSDUMMY1
END-EXEC
EXEC SQL
SELECT CURRENT TIME
INTO :WS-CURRENT-TIME-F
FROM SYSIBM.SYSDUMMY1
END-EXEC
DISPLAY '------------------------------------------------'
DISPLAY ' PROGRAMA CADBAL01 ........ - TERMINO OK '
DISPLAY ' VERSAO ................... - ' WS-VERSAO-PG
DISPLAY ' '
DISPLAY ' DATA INICIAL ............. - ' WS-CURRENT-DATE-I
DISPLAY ' HORA INICIAL ............. - ' WS-CURRENT-TIME-I
DISPLAY ' '
DISPLAY ' DATA FINAL ............... - ' WS-CURRENT-DATE-F
DISPLAY ' HORA FINAL ............... - ' WS-CURRENT-TIME-F
DISPLAY ' '
DISPLAY ' TOTAL REG. LIDOS PRODUCAO - ' WS-LIDOS-PRD
DISPLAY ' TOTAL REG. LIDOS DESENVOL - ' WS-LIDOS-DES
DISPLAY ' TOTAL REG. GRAVADOS ...... - ' WS-GRAVADOS
DISPLAY ' TOTAL REG. ALTERADOS ..... - ' WS-ALTERADOS
DISPLAY ' TOTAL REG. REJEITADOS .... - ' WS-REJEITADOS
DISPLAY ' '
DISPLAY '------------------------------------------------'
IF WS-REJEITADOS NOT EQUAL ZEROES
DISPLAY ' OS REGISTROS FORAM REJEITADOS PORQUE A TABELA'
DISPLAY ' CADTBU49 NAO FOI ATUALIZADA ANTES DESTA'
DISPLAY ' EXECUCAO. '
DISPLAY ' EXECUTAR O PROGRAMA: '
DISPLAY ' CADPB682 - ATUALIZA A TABELA CADTBU49 '
DISPLAY '------------------------------------------------'
END-IF
.
P3000-FIM.
EXIT.
*-----------------------------------------------------------------
P8000-ERRO-DB2.
*-----------------------------------------------------------------
MOVE SQLCODE TO WS-SQLCODE
DISPLAY '------------------------------------------------'
DISPLAY ' CADBAL01 - ERRO DE ACESSO AO DB2 ---------- '
DISPLAY '------------------------------------------------'
DISPLAY ' MENSAGEM - ' WS-PARAGRAFO
DISPLAY ' SQLCODE - ' WS-SQLCODE
DISPLAY ' MENSAGEM - ' WS-MENSAGEM
DISPLAY '------------------------------------------------'
MOVE 99 TO RETURN-CODE
GOBACK.
P8000-FIM.
EXIT.
|
