1 2 3 4 5 6 7
123456789012345678901234567890123456789012345678901234567890123456789012
*-----------------------------------------------------------------
IDENTIFICATION DIVISION.
*-----------------------------------------------------------------
PROGRAM-ID. CADDIAUT.
AUTHOR. CARLOS ALBERTO DORNELLES.
*-----------------------------------------------------------------
* PROGRAMA : CADDIAUT
* OBJETIVO : CALCULA O PROXIMO DIA UTIL APOS SABADO, DOMINGO
* : OU FERIADO
* ANALISTA : CARLOS ALBERTO DORNELLES
* LINGUAGEM : COBOL/DB2
* MODO OPERACAO : BATCH
*-----------------------------------------------------------------
* VERSAO DD.MM.AAAA HISTORICO/AUTOR
* ------ ---------- ---------------
* 001 19.06.2008 PROGRAMA INICIAL
*-----------------------------------------------------------------
*-----------------------------------------------------------------
ENVIRONMENT DIVISION.
*-----------------------------------------------------------------
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*-----------------------------------------------------------------
DATA DIVISION.
*-----------------------------------------------------------------
FILE SECTION.
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
*-----------------------------------------------------------------
01 WS-AUXILIARES.
05 WS-PARAGRAFO PIC X(080).
05 WS-MENSAGEM PIC X(080).
05 WS-SQLCODE PIC -ZZZZ9.
05 WS-DIA-SEMANA PIC S9(04) COMP.
\ 05 WS-CALCULO-BISEXTO.
10 WS-QUOCIENTE PIC 9(004).
10 WS-RESTO PIC 9(004).
88 RESTO-ZERO VALUE 0000.
88 RESTO-DIFE VALUE 0001 THRU 9999.
05 WS-DATA PIC X(010).
05 WS-DATA-R REDEFINES WS-DATA.
10 WS-DIA PIC 9(002).
88 WS-DIA-29 VALUE 01 THRU 29.
88 WS-DIA-28 VALUE 01 THRU 28.
88 WS-DIA-30 VALUE 01 THRU 30.
88 WS-DIA-31 VALUE 01 THRU 31.
10 PONTO-001 PIC X(001).
10 WS-MES PIC 9(002).
88 WS-MES-VALIDO VALUE 01 THRU 12.
88 WS-MES-28 VALUE 02.
88 WS-MES-30 VALUE 04 06 09 11.
88 WS-MES-31 VALUE 01 03 05 07 08 10 12.
10 PONTO-002 PIC X(001).
10 WS-ANO PIC 9(004).
88 ANO-VALIDO VALUE 1901 THRU 2099.
*-----------------------------------------------------------------
LOCAL-STORAGE SECTION.
*-----------------------------------------------------------------
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL INCLUDE CADTB007 END-EXEC.
*-----------------------------------------------------------------
LINKAGE SECTION.
*-----------------------------------------------------------------
01 LK-PARAMETRO.
05 COMPRIMENTO PIC S9(04) COMP.
05 LKS-DATA PIC X(010).
05 LKS-RETORNO PIC 9(001).
*-----------------------------------------------------------------
* LKS-DATA = FORMATO DD/MM/AAAA OU DD.MM.AAAA OU DD MM AAAA
* LKS-RETORNO = 0 - A DATA INFORMADA ESTá CORRETA
* LKS-RETORNO = 1 - A DATA INFORMADA ESTá INCORRETA
* LKS-RETORNO = 2 - O ANO OU O MES INFORMADO é INVALIDO
*-----------------------------------------------------------------
*-----------------------------------------------------------------
PROCEDURE DIVISION USING LK-PARAMETRO.
*-----------------------------------------------------------------
PERFORM P1000-INICIAL
PERFORM P2000-PRINCIPAL
PERFORM P3000-FINAL
GOBACK.
*-----------------------------------------------------------------
P1000-INICIAL.
*-----------------------------------------------------------------
MOVE 'P1000-INICIAL ' TO WS-PARAGRAFO.
MOVE LKS-DATA TO WS-DATA
MOVE '.' TO WS-DATA (3:1) WS-DATA (6:1)
DIVIDE WS-ANO BY 4 GIVING WS-QUOCIENTE REMAINDER WS-RESTO
EVALUATE TRUE
WHEN ANO-VALIDO AND WS-MES-VALIDO
EVALUATE TRUE
WHEN RESTO-ZERO AND WS-MES-28 AND WS-DIA-29
WHEN RESTO-DIFE AND WS-MES-28 AND WS-DIA-28
WHEN WS-MES-30 AND WS-DIA-30
WHEN WS-MES-31 AND WS-DIA-31
MOVE 0 TO LKS-RETORNO
WHEN OTHER
MOVE 1 TO LKS-RETORNO
END-EVALUATE
WHEN OTHER
MOVE 2 TO LKS-RETORNO
END-EVALUATE
IF LKS-RETORNO NOT EQUAL ZEROES
MOVE 'ERRO NA CRITICA DA DATA' TO WS-MENSAGEM
PERFORM P8000-ERRO-EXECUCAO
END-IF
.
P1000-FIM.
EXIT.
*-----------------------------------------------------------------
P2000-PRINCIPAL.
*-----------------------------------------------------------------
MOVE 'P2000-PRINCIPAL ' TO WS-PARAGRAFO.
PERFORM UNTIL SQLCODE EQUAL +100
PERFORM P2100-BUSCA-DIA-SEMANA
PERFORM UNTIL WS-DIA-SEMANA NOT EQUAL 1 AND 7
PERFORM P2200-SOMA-DIA-SEMANA
PERFORM P2100-BUSCA-DIA-SEMANA
END-PERFORM
PERFORM P2300-TESTA-FERIADO
IF SQLCODE EQUAL +000
PERFORM P2200-SOMA-DIA-SEMANA
END-IF
END-PERFORM.
P2000-FIM.
EXIT.
*-----------------------------------------------------------------
P2100-BUSCA-DIA-SEMANA.
*-----------------------------------------------------------------
MOVE 'P2100-BUSCA-DIA-SEMANA' TO WS-PARAGRAFO.
EXEC SQL
SELECT DAYOFWEEK (:WS-DATA)
INTO :WS-DIA-SEMANA
FROM SYSIBM.SYSDUMMY1
END-EXEC.
IF SQLCODE NOT EQUAL +000
MOVE 'ERRO NA BUSCA DO DIA DA SEMANA' TO WS-MENSAGEM
PERFORM P8000-ERRO-EXECUCAO
END-IF
.
P2100-FIM.
EXIT.
*-----------------------------------------------------------------
P2200-SOMA-DIA-SEMANA.
*-----------------------------------------------------------------
MOVE 'P2200-SOMA-DIA-SEMANA' TO WS-PARAGRAFO.
EXEC SQL
SELECT DATE(:WS-DATA) + 1 DAY
INTO :WS-DATA
FROM SYSIBM.SYSDUMMY1
END-EXEC.
IF SQLCODE NOT EQUAL +000
MOVE 'ERRO NA SOMA DO DIA DA SEMANA' TO WS-MENSAGEM
PERFORM P8000-ERRO-EXECUCAO
END-IF
.
P2200-FIM.
EXIT.
*-----------------------------------------------------------------
P2300-TESTA-FERIADO.
*-----------------------------------------------------------------
MOVE 'P2300-TESTA-FERIADO ' TO WS-PARAGRAFO.
EXEC SQL
SELECT DISTINCT(DT_FERIADO)
INTO :DT-FERIADO
FROM CAD.CADTB007_FERIADO
WHERE DT_FERIADO = :WS-DATA
END-EXEC.
IF SQLCODE NOT EQUAL +000 AND +100
MOVE 'ERRO AO TESTAR SE O DIA EH FERIADO' TO WS-MENSAGEM
PERFORM P8000-ERRO-EXECUCAO
END-IF
.
P2300-FIM.
EXIT.
*-----------------------------------------------------------------
P3000-FINAL.
*-----------------------------------------------------------------
MOVE 'P3000-FINAL ' TO WS-PARAGRAFO.
P3000-FIM.
EXIT.
*-----------------------------------------------------------------
P8000-ERRO-EXECUCAO.
*-----------------------------------------------------------------
MOVE SQLCODE TO WS-SQLCODE
DISPLAY '------------------------------------------------'
DISPLAY ' CADDIAUT - ERRO DE EXECUCAO DO PROGRAMA '
DISPLAY '------------------------------------------------'
DISPLAY ' MENSAGEM - ' WS-PARAGRAFO
DISPLAY ' SQLCODE - ' WS-SQLCODE
DISPLAY ' MENSAGEM - ' WS-MENSAGEM
DISPLAY '------------------------------------------------'
MOVE 99 TO RETURN-CODE
GOBACK.
P8000-FIM.
EXIT.
|
