1 2 3 4 5 6 7
123456789012345678901234567890123456789012345678901234567890123456789012
*-----------------------------------------------------------------
IDENTIFICATION DIVISION.
*-----------------------------------------------------------------
PROGRAM-ID. CADSEDIA.
AUTHOR. CARLOS ALBERTO DORNELLES.
*-----------------------------------------------------------------
* ESTE PROGRAMA GERA O DIA DA SEMANA A PARTIR DE UMA CERTA DATA
* ELE PODERA SERVIR COMO UM SUB-PROGRAMA CHAMADO POR UM CALL
* OU COPIAR AS ROTINAS DO MESMO E ACRESCENTAR DENTRO DO TEU CODIGO
*-----------------------------------------------------------------
*-----------------------------------------------------------------
ENVIRONMENT DIVISION.
*-----------------------------------------------------------------
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
*-----------------------------------------------------------------
DATA DIVISION.
*-----------------------------------------------------------------
FILE SECTION.
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
*-----------------------------------------------------------------
01 WS-VERIFICA-DATA.
05 WS-CALCULO-BISEXTO.
10 WS-QUOCIENTE PIC 9(004) VALUE ZEROES.
10 WS-RESTO PIC 9(004) VALUE ZEROES.
88 RESTO-ZERO VALUE 0000.
88 RESTO-DIFE VALUE 0001 THRU 9999.
05 WS-DATA PIC X(010) VALUE SPACES.
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).
10 WS-ANO-R REDEFINES WS-ANO.
15 WS-ANO-MIL PIC 9(002).
88 ANO-MILVAL VALUE 19 20.
15 ANO-DEZ-CAD PIC 9(002).
88 ANO-DEZVAL VALUE 00 THRU 99.
01 WK-VARIA.
05 WS-DATA-CALC PIC 9(008) VALUE ZEROES.
05 WS-DATA-CALC-R REDEFINES WS-DATA-CALC.
10 WS-ANO-CALC PIC 9(004).
10 WS-MES-CALC PIC 9(002).
10 WS-DIA-CALC PIC 9(002).
01 WS-AUXILIARES.
05 WS-DSENAMA PIC 9(001) VALUE ZEROES.
05 TAB-NOME-SEMANA VALUE
"SEGUNDA-FEIRATERCA-FEIRA QUARTA-FEIRA QUINTA-FEIRA SEXT
- "A-FEIRA SABADO DOMINGO ".
10 NOME-SEMANA PIC X(013) OCCURS 07 TIMES.
*-----------------------------------------------------------------
LINKAGE SECTION.
*-----------------------------------------------------------------
*-----------------------------------------------------------------
* LKS-DATA = FORMATO DD.MM.AAAA DD MM AAAA DD/MM/AAAA
* 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
*-----------------------------------------------------------------
01 LK-PARAMETRO.
05 FILLER PIC S9(04) COMP.
05 LK-DATA PIC X(10).
05 LK-DIA-SEM PIC X(13).
05 LK-RETORNO PIC X(01).
05 LK-TEXTO PIC X(64).
*-----------------------------------------------------------------
PROCEDURE DIVISION USING LK-PARAMETRO.
*-----------------------------------------------------------------
*-----------------------------------------------------------------
P1000-PRINCIPAL.
*-----------------------------------------------------------------
MOVE LK-DATA (7:4) TO WS-ANO-CALC
MOVE LK-DATA (4:2) TO WS-MES-CALC
MOVE LK-DATA (1:2) TO WS-DIA-CALC
MOVE LK-DATA TO WS-DATA
PERFORM P2000-VERIFICA-DATA THRU P2000-FIM
EVALUATE LK-RETORNO
WHEN 0
MOVE 'A DATA INFORMADA ESTA CORRETA ' TO LK-TEXTO
WHEN 1
MOVE 'A DATA INFORMADA ESTA INCORRETA' TO LK-TEXTO
MOVE 'ERRO ' TO LK-DIA-SEM
GOBACK
WHEN 2
MOVE 'O ANO OU O MES EH INVALIDO ' TO LK-TEXTO
MOVE 'ERRO ' TO LK-DIA-SEM
GOBACK
END-EVALUATE
COMPUTE WS-DSENAMA =
FUNCTION REM(FUNCTION INTEGER-OF-DATE(WS-DATA-CALC), 7)
IF WS-DSENAMA EQUAL ZEROES
MOVE 7 TO WS-DSENAMA
END-IF
MOVE NOME-SEMANA (WS-DSENAMA) TO LK-DIA-SEM
GOBACK.
*-----------------------------------------------------------------
P2000-VERIFICA-DATA.
*-----------------------------------------------------------------
DIVIDE WS-ANO BY 4 GIVING WS-QUOCIENTE REMAINDER WS-RESTO
EVALUATE TRUE
WHEN ANO-MILVAL AND ANO-DEZVAL 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 LK-RETORNO
WHEN OTHER
MOVE 1 TO LK-RETORNO
END-EVALUATE
WHEN OTHER
MOVE 2 TO LK-RETORNO
END-EVALUATE.
P2000-FIM.
EXIT.
|
