1 2 3 4 5 6 7 8
12345678901234567890123456789012345678901234567890123456789012345678901234567890
*-----------------------------------------------------------------
IDENTIFICATION DIVISION.
*-----------------------------------------------------------------
PROGRAM-ID. CADANOBI.
AUTHOR. CARLOS ALBERTO DORNELLES.
*-----------------------------------------------------------------
* BRASILIA, 14 DE NOVEMBRO DE 2011
* Verificar se a data é válida sem usar o banco de dados
* Segunda versao para ano entre 0001 ate 9999
*-----------------------------------------------------------------
*-----------------------------------------------------------------
DATA DIVISION.
*-----------------------------------------------------------------
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
*-----------------------------------------------------------------
01 WS-AUXILIARES.
05 WS-CALCULO-BISEXTO.
10 WS-QUOCIENTE PIC 9(004).
10 WS-RESTO-004 PIC 9(004).
88 RESTO-ZERO-004 VALUE 0000.
88 RESTO-DIFE-004 VALUE 0001 THRU 9999.
10 WS-RESTO-400 PIC 9(004).
88 RESTO-ZERO-400 VALUE 0000.
88 RESTO-DIFE-400 VALUE 0001 THRU 9999.
10 WS-RESTO-100 PIC 9(004).
88 RESTO-ZERO-100 VALUE 0000.
88 RESTO-DIFE-100 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 0001 THRU 9999.
*-----------------------------------------------------------------
LINKAGE SECTION.
*-----------------------------------------------------------------
01 LKS-PARAMETRO.
05 COMPRIMENTO PIC S9(04) COMP.
05 LKS-DATA PIC X(010).
05 LKS-RETORNO PIC 9(001).
*-----------------------------------------------------------------
* LKS-RETORNO = 0 - A DATA INFORMADA ESTA CORRETA
* LKS-RETORNO = 1 - A DATA INFORMADA ESTA INCORRETA
* LKS-RETORNO = 2 - O ANO OU O MES EH INVALIDO
*-----------------------------------------------------------------
*-----------------------------------------------------------------
PROCEDURE DIVISION USING LKS-PARAMETRO.
*-----------------------------------------------------------------
MOVE LKS-DATA TO WS-DATA.
DIVIDE WS-ANO BY 004 GIVING WS-QUOCIENTE
REMAINDER WS-RESTO-004
DIVIDE WS-ANO BY 400 GIVING WS-QUOCIENTE
REMAINDER WS-RESTO-400
DIVIDE WS-ANO BY 100 GIVING WS-QUOCIENTE
REMAINDER WS-RESTO-100
EVALUATE TRUE
WHEN ANO-VALIDO AND WS-MES-VALIDO
EVALUATE TRUE
WHEN RESTO-ZERO-004 AND WS-MES-28 AND WS-DIA-29
WHEN RESTO-DIFE-004 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 WS-MES EQUAL 02 AND WS-DIA EQUAL 29 AND LKS-RETORNO = 0
EVALUATE WS-RESTO-004 = 0 ALSO
WS-RESTO-400 = 0 ALSO
WS-RESTO-100 > 0
WHEN TRUE ALSO TRUE ALSO ANY
WHEN TRUE ALSO TRUE ALSO TRUE
WHEN TRUE ALSO ANY ALSO TRUE
MOVE 0 TO LKS-RETORNO
WHEN OTHER
MOVE 1 TO LKS-RETORNO
END-EVALUATE
END-IF
GOBACK.
|
