1 2 3 4 5 6 7 8
12345678901234567890123456789012345678901234567890123456789012345678901234567890
*---------------------------------------------------------------
IDENTIFICATION DIVISION.
*---------------------------------------------------------------
PROGRAM-ID. CONGREJU.
AUTHOR. CARLOS ALBERTO DORNELLES.
*---------------------------------------------------------------
* SISTEMA : SICAD
* PROGRAMA : CONGREJU
* OBJETIVO : CONVERTER DATA GREGORIANA PARA DATA JULIANA
* ANALISTA : CARLOS ALBERTO DORNELLES
* LINGUAGEM : COBOL
* VERSAO : V.001
* DATA : 15/05/2011
*---------------------------------------------------------------
* MANUTENCAO
*---------------------------------------------------------------
* VRS DD.MM.AA AUTOR DESCRICAO
*
*---------------------------------------------------------------
*---------------------------------------------------------------
DATA DIVISION.
*---------------------------------------------------------------
WORKING-STORAGE SECTION.
01 WS-DATA.
05 WS-ANO PIC 9(004).
05 WS-MES PIC 9(002).
05 WS-DIA PIC 9(002).
01 WS-AUXILIARES.
05 WS-GUARDA-ANO PIC 9(004).
05 WS-NRO-DIAS PIC 9(003).
05 WS-RETORNO PIC 9(001).
05 WS-RESTO-BI PIC 9(001) VALUE 2.
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-C PIC X(010).
05 WS-DATA-R REDEFINES WS-DATA-C.
10 WS-DIA-C 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-C 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-C PIC 9(004).
88 ANO-VALIDO VALUE 1901 THRU 2099.
*---------------------------------------------------------------
PROCEDURE DIVISION.
*---------------------------------------------------------------
0001-ROTINA.
MOVE 1 TO WS-RETORNO
PERFORM 0002-VERIFICA-DATA UNTIL
WS-RETORNO EQUAL ZEROES.
MOVE WS-ANO TO WS-GUARDA-ANO.
COMPUTE WS-NRO-DIAS = WS-DIA.
EVALUATE TRUE
WHEN WS-MES EQUAL 12
ADD 30 TO WS-NRO-DIAS
SUBTRACT 1 FROM WS-MES
WHEN WS-MES EQUAL 11
ADD 31 TO WS-NRO-DIAS
SUBTRACT 1 FROM WS-MES
WHEN WS-MES EQUAL 10
ADD 30 TO WS-NRO-DIAS
SUBTRACT 1 FROM WS-MES
WHEN WS-MES EQUAL 9
ADD 31 TO WS-NRO-DIAS
SUBTRACT 1 FROM WS-MES
WHEN WS-MES EQUAL 8
ADD 31 TO WS-NRO-DIAS
SUBTRACT 1 FROM WS-MES
WHEN WS-MES EQUAL 7
ADD 30 TO WS-NRO-DIAS
SUBTRACT 1 FROM WS-MES
WHEN WS-MES EQUAL 6
ADD 31 TO WS-NRO-DIAS
SUBTRACT 1 FROM WS-MES
WHEN WS-MES EQUAL 5
ADD 30 TO WS-NRO-DIAS
SUBTRACT 1 FROM WS-MES
WHEN WS-MES EQUAL 4
ADD 31 TO WS-NRO-DIAS
SUBTRACT 1 FROM WS-MES
WHEN WS-MES EQUAL 3
ADD 28 TO WS-NRO-DIAS
SUBTRACT 1 FROM WS-MES
DIVIDE WS-ANO BY 4 GIVING WS-ANO REMAINDER WS-RESTO-BI
IF WS-RESTO-BI EQUAL 0
ADD 1 TO WS-NRO-DIAS
END-IF
WHEN WS-MES EQUAL 2
ADD 31 TO WS-NRO-DIAS
END-EVALUATE
DISPLAY " ".
DISPLAY "Data juliana (YYYYDDD): ".
DISPLAY WS-GUARDA-ANO ":" WS-NRO-DIAS.
STOP RUN.
0002-VERIFICA-DATA.
DISPLAY "Entre com a data gregoriana (YYYYMMDD): ".
ACCEPT WS-DATA.
MOVE WS-ANO TO WS-ANO-C
MOVE WS-MES TO WS-MES-C
MOVE WS-DIA TO WS-DIA-C
DIVIDE WS-ANO-C 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 WS-RETORNO
WHEN OTHER
MOVE 1 TO WS-RETORNO
END-EVALUATE
WHEN OTHER
MOVE 2 TO WS-RETORNO
END-EVALUATE
IF WS-RETORNO NOT EQUAL ZEROES
DISPLAY "Data invalida"
END-IF.
* Resultado do teste realizado abaixo
|
