COBOL - Gera o dia da semana com código puro - www.cadcobol.com.br


clique aqui para imprimir esta página

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 - Gera o dia da semana em COBOL puro
O programa abaixo listado tem por finalidade gerar o dia da semana a partir de uma data com código em COBOL puro.

Código
         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.