COBOL - Calcula o próximo dia útil após um sábado, domingo ou feriado


Volta a página anterior

Volta ao Menu Principal


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

COBOL - calcula o próximo dia útil após um sábado, domingo ou feriado
O programa abaixo listado tem por finalidade calcular o próximo dia útil após um sábado, domingo ou feriado.

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 abaixo só deve ser usada para processamento BATCH (LINKAGE SECTION)

05 COMPRIMENTO PIC S9(04) COMP.

Código
         1         2         3         4         5         6         7   
123456789012345678901234567890123456789012345678901234567890123456789012

      *-----------------------------------------------------------------
       IDENTIFICATION DIVISION.                                         
      *-----------------------------------------------------------------
       PROGRAM-ID.       CADDIAUT.                                      
       AUTHOR.           CARLOS ALBERTO DORNELLES.                      
      *-----------------------------------------------------------------
      *  PROGRAMA      : CADDIAUT                                       
      *  OBJETIVO      : CALCULA O PROXIMO DIA UTIL APOS SABADO, DOMINGO
      *                : OU FERIADO                                     
      *  ANALISTA      : CARLOS ALBERTO DORNELLES                       
      *  LINGUAGEM     : COBOL/DB2                                      
      *  MODO OPERACAO : BATCH                                          
      *-----------------------------------------------------------------
      *  VERSAO DD.MM.AAAA  HISTORICO/AUTOR                             
      *  ------  ---------- ---------------                             
      *    001  19.06.2008  PROGRAMA INICIAL                            
      *-----------------------------------------------------------------
                                                                        
      *-----------------------------------------------------------------
       ENVIRONMENT DIVISION.                                            
      *-----------------------------------------------------------------
                                                                        
       CONFIGURATION SECTION.                                           
       SPECIAL-NAMES.                                                   
                         DECIMAL-POINT IS COMMA.                        
       INPUT-OUTPUT SECTION.                                            
       FILE-CONTROL.                                                    
                                                                        
      *-----------------------------------------------------------------
       DATA DIVISION.                                                   
      *-----------------------------------------------------------------
       FILE SECTION.                                                    
                                                                        
      *-----------------------------------------------------------------
       WORKING-STORAGE SECTION.                                         
      *-----------------------------------------------------------------
                                                                        
       01  WS-AUXILIARES.                                               
           05  WS-PARAGRAFO              PIC X(080).                    
           05  WS-MENSAGEM               PIC X(080).                    
           05  WS-SQLCODE                PIC -ZZZZ9.                    
           05  WS-DIA-SEMANA             PIC S9(04) COMP.               
\          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                   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 1901 THRU 2099.          
                                                                        
      *-----------------------------------------------------------------
       LOCAL-STORAGE SECTION.                                           
      *-----------------------------------------------------------------
                                                                        
           EXEC SQL INCLUDE SQLCA    END-EXEC.                          
           EXEC SQL INCLUDE CADTB007 END-EXEC.                          
                                                                        
      *-----------------------------------------------------------------
       LINKAGE SECTION.                                                 
      *-----------------------------------------------------------------
                                                                        
       01  LK-PARAMETRO.                                                
           05 COMPRIMENTO                PIC S9(04) COMP.               
           05 LKS-DATA                   PIC X(010).                    
           05 LKS-RETORNO                PIC 9(001).                    
      *-----------------------------------------------------------------
      * LKS-DATA    = FORMATO DD/MM/AAAA OU DD.MM.AAAA OU DD MM AAAA    
      * LKS-RETORNO = 0 - A DATA INFORMADA ESTá CORRETA                 
      * LKS-RETORNO = 1 - A DATA INFORMADA ESTá INCORRETA               
      * LKS-RETORNO = 2 - O ANO OU O MES INFORMADO é INVALIDO           
      *-----------------------------------------------------------------
                                                                        
      *-----------------------------------------------------------------
       PROCEDURE DIVISION USING LK-PARAMETRO.                           
      *-----------------------------------------------------------------
                                                                        
           PERFORM P1000-INICIAL                                        
           PERFORM P2000-PRINCIPAL                                      
           PERFORM P3000-FINAL                                          
           GOBACK.                                                      
                                                                        
      *-----------------------------------------------------------------
       P1000-INICIAL.                                                   
      *-----------------------------------------------------------------
                                                                        
           MOVE 'P1000-INICIAL                  ' TO WS-PARAGRAFO.      
           MOVE LKS-DATA                          TO WS-DATA            
           MOVE '.' TO WS-DATA (3:1) WS-DATA (6:1)                      
           DIVIDE WS-ANO 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 LKS-RETORNO                      
                        WHEN OTHER                                      
                             MOVE 1 TO LKS-RETORNO                      
                    END-EVALUATE                                        
               WHEN OTHER                                               
                    MOVE 2 TO LKS-RETORNO                               
           END-EVALUATE                                                 
           IF LKS-RETORNO NOT EQUAL ZEROES                              
              MOVE 'ERRO NA CRITICA DA DATA' TO WS-MENSAGEM             
              PERFORM P8000-ERRO-EXECUCAO                               
           END-IF                                                       
           .                                                            
       P1000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P2000-PRINCIPAL.                                                 
      *-----------------------------------------------------------------
                                                                        
           MOVE 'P2000-PRINCIPAL ' TO WS-PARAGRAFO.                     
           PERFORM UNTIL SQLCODE EQUAL +100                             
                   PERFORM P2100-BUSCA-DIA-SEMANA                       
                   PERFORM UNTIL WS-DIA-SEMANA NOT EQUAL 1 AND 7        
                           PERFORM P2200-SOMA-DIA-SEMANA                
                           PERFORM P2100-BUSCA-DIA-SEMANA               
                   END-PERFORM                                          
                   PERFORM P2300-TESTA-FERIADO                          
                   IF SQLCODE EQUAL +000                                
                      PERFORM P2200-SOMA-DIA-SEMANA                     
                   END-IF                                               
           END-PERFORM.                                                 
                                                                        
       P2000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P2100-BUSCA-DIA-SEMANA.                                          
      *-----------------------------------------------------------------
                                                                        
           MOVE 'P2100-BUSCA-DIA-SEMANA' TO WS-PARAGRAFO.               
           EXEC SQL                                                     
                SELECT DAYOFWEEK (:WS-DATA)                             
                INTO  :WS-DIA-SEMANA                                    
                FROM   SYSIBM.SYSDUMMY1                                 
           END-EXEC.                                                    
           IF SQLCODE NOT EQUAL +000                                    
              MOVE 'ERRO NA BUSCA DO DIA DA SEMANA' TO WS-MENSAGEM      
              PERFORM P8000-ERRO-EXECUCAO                               
           END-IF                                                       
           .                                                            
       P2100-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P2200-SOMA-DIA-SEMANA.                                           
      *-----------------------------------------------------------------
                                                                        
           MOVE 'P2200-SOMA-DIA-SEMANA' TO WS-PARAGRAFO.                
           EXEC SQL                                                     
                SELECT DATE(:WS-DATA) + 1 DAY                           
                INTO  :WS-DATA                                          
                FROM   SYSIBM.SYSDUMMY1                                 
           END-EXEC.                                                    
           IF SQLCODE NOT EQUAL +000                                    
              MOVE 'ERRO NA SOMA DO DIA DA SEMANA' TO WS-MENSAGEM       
              PERFORM P8000-ERRO-EXECUCAO                               
           END-IF                                                       
           .                                                            
       P2200-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P2300-TESTA-FERIADO.                                             
      *-----------------------------------------------------------------
                                                                        
           MOVE 'P2300-TESTA-FERIADO  ' TO WS-PARAGRAFO.                
           EXEC SQL                                                     
                SELECT DISTINCT(DT_FERIADO)                             
                INTO  :DT-FERIADO                                       
                FROM   CAD.CADTB007_FERIADO                             
                WHERE  DT_FERIADO = :WS-DATA                            
           END-EXEC.                                                    
           IF SQLCODE NOT EQUAL +000 AND +100                           
              MOVE 'ERRO AO TESTAR SE O DIA EH FERIADO' TO WS-MENSAGEM  
              PERFORM P8000-ERRO-EXECUCAO                               
           END-IF                                                       
           .                                                            
       P2300-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P3000-FINAL.                                                     
      *-----------------------------------------------------------------
                                                                        
           MOVE 'P3000-FINAL                    ' TO WS-PARAGRAFO.      
                                                                        
       P3000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P8000-ERRO-EXECUCAO.                                             
      *-----------------------------------------------------------------
                                                                        
           MOVE SQLCODE TO WS-SQLCODE                                   
           DISPLAY '------------------------------------------------'   
           DISPLAY ' CADDIAUT - ERRO DE EXECUCAO DO PROGRAMA        '   
           DISPLAY '------------------------------------------------'   
           DISPLAY ' MENSAGEM - ' WS-PARAGRAFO                          
           DISPLAY ' SQLCODE  - ' WS-SQLCODE                            
           DISPLAY ' MENSAGEM - ' WS-MENSAGEM                           
           DISPLAY '------------------------------------------------'   
           MOVE 99 TO RETURN-CODE                                       
           GOBACK.                                                      
       P8000-FIM.                                                       
           EXIT.