COBOL - Verifica a data entre os anos de 0001 ate 9999 - www.cadcobol.com.br


Volta a página anterior

Volta ao Menu Principal


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

Verifica a data entre os anos de 0001 até 9999
O programa abaixo listado tem por finalidade a validação de datas com um código de cobol puro, sem a utilização dos comandos de SQL (banco de dados).
O código pode ser copiado e colado dentro de um programa ou utilizá-lo como um outro a ser chamado usando a area da LINKAGE SECTION para o tratamento do retorno.
A linha COMPRIMENTO só deve ser usada para processamento BATCH (LINKAGE SECTION)
05 COMPRIMENTO PIC S9(04) COMP.


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