Converter data gregoriana para data juliana com um código em COBOL


Volta a página anterior

Volta ao Menu Principal


Desenvolvido por DORNELLES Carlos Alberto - Analista de Sistemas - Brasília DF. - cad_cobol@hotmail.com

Compativel com todos os compiladores e versões
         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


Teste realizados
Entre com a data gregoriana (YYYYMMDD): Data juliana (YYYYDDD):
20110515 2011:135
20010229 Data invalida
20000229 2000:060