O PROGDATA é um módulo COBOL responsável por obter e processar informações relacionadas à data do sistema, disponibilizando os dados em um registro compartilhado para utilização por outros programas.
Além de obter a data atual no formato AAAAMMDD, o programa complementa essa informação com dados úteis para o processamento das aplicações. Entre suas funções estão a identificação do dia da semana, a conversão do número do mês para sua descrição correspondente, como 01 → JANEIRO, e a conversão do dia da semana para texto, como 1 → SEGUNDA-FEIRA.
O módulo também determina quantos dias já transcorreram no ano corrente e calcula a data do dia anterior, tratando corretamente mudanças de mês e de ano. Para garantir o cálculo correto das datas, o programa considera ainda os anos bissextos, especialmente na determinação do último dia de fevereiro.
O processamento principal é organizado nas seguintes etapas:
0001-OBTER-DATA
0002-OBTER-DESC-MES
0003-OBTER-DESC-SEM
0004-OBTER-DIAS-ANO
0005-OBTER-DIA-ANT
9999-FINALIZARDessa forma, o PROGDATA funciona como um módulo utilitário de processamento de datas, centralizando operações recorrentes e permitindo que outros programas do sistema utilizem essas informações sem precisar implementar novamente as mesmas regras.
CODIGO FONTE:
******************************************************************
* PROGRAMADOR: JOSE ROBERTO - COBOLDICAS
* DATA: 30/01/2025
* OBJETIVO: OBTER DATA DO SISTEMA
******************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. PROGDATA.
*================================================================*
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WRK-DIAS-ANO-YYYYDDD.
05 WRK-DIAS-ANO-AAAA PIC 9(004) VALUE zeros.
05 WRK-DIAS-ANO-DDD PIC 9(003) VALUE ZEROS.
01 WRK-DIA-ANT PIC 9(002) VALUE ZEROS.
01 WRK-MES-ANT PIC 9(002) VALUE ZEROS.
01 WRK-ANO-ANT PIC 9(004) VALUE ZEROS.
01 WRK-ULTIMO-DIA-MES PIC 9(002) VALUE ZEROS.
01 WRK-RESTO PIC 9(002) VALUE ZEROS.
01 WRK-QUOCIENTE PIC 9(003) VALUE ZEROS.
LINKAGE SECTION.
COPY COD001A.
*================================================================*
PROCEDURE DIVISION USING COD001A-REGISTRO.
*================================================================*
*----------------------------------------------------------------*
* PROCESSAMENTO PRINCIPAL
*----------------------------------------------------------------*
*> cobol-lint CL002 0000-processar
0000-PROCESSAR SECTION.
*----------------------------------------------------------------*
PERFORM 0001-OBTER-DATA
PERFORM 0002-OBTER-DESC-MES
PERFORM 0003-OBTER-DESC-SEM
PERFORM 0004-OBTER-DIAS-ANO
PERFORM 0005-OBTER-DIA-ANT
PERFORM 9999-FINALIZAR
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0000-end
0000-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* OBTER DATA DO SISTEMA
*----------------------------------------------------------------*
0001-OBTER-DATA SECTION.
*----------------------------------------------------------------*
ACCEPT COD001A-DATA FROM DATE YYYYMMDD
ACCEPT COD001A-DIA-SEMANA FROM DAY-OF-WEEK
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0001-end
0001-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* OBTER DESCRICAO DO MES
*----------------------------------------------------------------*
0002-OBTER-DESC-MES SECTION.
*----------------------------------------------------------------*
EVALUATE COD001A-DATA-MES
WHEN 01
MOVE 'JANEIRO' TO COD001A-DESC-MES
WHEN 02
MOVE 'FEVEREIRO' TO COD001A-DESC-MES
WHEN 03
MOVE 'MARCO' TO COD001A-DESC-MES
WHEN 04
MOVE 'ABRIL' TO COD001A-DESC-MES
WHEN 05
MOVE 'MAIO' TO COD001A-DESC-MES
WHEN 06
MOVE 'JUNHO' TO COD001A-DESC-MES
WHEN 07
MOVE 'JULHO' TO COD001A-DESC-MES
WHEN 08
MOVE 'AGOSTO' TO COD001A-DESC-MES
WHEN 09
MOVE 'SETEMBRO' TO COD001A-DESC-MES
WHEN 10
MOVE 'OUTUBRO' TO COD001A-DESC-MES
WHEN 11
MOVE 'NOVEMBRO' TO COD001A-DESC-MES
WHEN 12
MOVE 'DEZEMBRO' TO COD001A-DESC-MES
WHEN OTHER
MOVE 'INVALIDO' TO COD001A-DESC-MES
END-EVALUATE
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0002-end
0002-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* OBTER DESCRICAO DA SEMANA
*----------------------------------------------------------------*
0003-OBTER-DESC-SEM SECTION.
*----------------------------------------------------------------*
EVALUATE COD001A-DIA-SEMANA
WHEN 01
MOVE 'SEGUNDA-FEIRA' TO COD001A-DESC-SEMANA
WHEN 02
MOVE 'TERCA-FEIRA' TO COD001A-DESC-SEMANA
WHEN 03
MOVE 'QUARTA-FEIRA' TO COD001A-DESC-SEMANA
WHEN 04
MOVE 'QUINTA-FEIRA' TO COD001A-DESC-SEMANA
WHEN 05
MOVE 'SEXTA-FEIRA' TO COD001A-DESC-SEMANA
WHEN 06
MOVE 'SABADO' TO COD001A-DESC-SEMANA
WHEN 07
MOVE 'DOMINGO' TO COD001A-DESC-SEMANA
WHEN OTHER
MOVE 'INVALIDO' TO COD001A-DESC-SEMANA
END-EVALUATE
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0003-end
0003-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* OBTER DIAS DO ANO
*----------------------------------------------------------------*
0004-OBTER-DIAS-ANO SECTION.
*----------------------------------------------------------------*
ACCEPT WRK-DIAS-ANO-YYYYDDD
FROM DAY YYYYDDD
MOVE WRK-DIAS-ANO-DDD TO COD001A-DIAS-ANO
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0004-end
0004-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* OBTER DATA DO DIA ANTERIOR
*----------------------------------------------------------------*
*> cobol-lint CL002 0005-obter-dia-ant
0005-OBTER-DIA-ANT SECTION.
*----------------------------------------------------------------*
MOVE COD001A-DATA-DIA TO WRK-DIA-ANT
MOVE COD001A-DATA-MES TO WRK-MES-ANT
MOVE COD001A-DATA-ANO TO WRK-ANO-ANT
IF COD001A-DATA-DIA > 1
SUBTRACT 1 FROM WRK-DIA-ANT
MOVE WRK-DIA-ANT TO COD001A-DATA-DIA-ANT
MOVE WRK-MES-ANT TO COD001A-DATA-MES-ANT
MOVE WRK-ANO-ANT TO COD001A-DATA-ANO-ANT
ELSE
SUBTRACT 1 FROM WRK-MES-ANT
IF WRK-MES-ANT EQUAL ZEROS
MOVE 12 TO WRK-MES-ANT
SUBTRACT 1 FROM WRK-ANO-ANT
MOVE WRK-ANO-ANT TO COD001A-DATA-ANO-ANT
END-IF
PERFORM 0006-OBTER-ULTIMO-DIA
MOVE WRK-ANO-ANT TO COD001A-DATA-ANO-ANT
MOVE WRK-MES-ANT TO COD001A-DATA-MES-ANT
MOVE WRK-ULTIMO-DIA-MES TO COD001A-DATA-DIA-ANT
END-IF
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0005-end
0005-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* OBTER ULTIMO DIA DO MES
*----------------------------------------------------------------*
0006-OBTER-ULTIMO-DIA SECTION.
*----------------------------------------------------------------*
EVALUATE WRK-MES-ANT
WHEN 1
WHEN 3
WHEN 5
WHEN 7
WHEN 8
WHEN 10
WHEN 12
MOVE 31 TO WRK-ULTIMO-DIA-MES
WHEN 4
WHEN 6
WHEN 9
WHEN 11
MOVE 30 TO WRK-ULTIMO-DIA-MES
WHEN 2
DIVIDE WRK-ANO-ANT BY 4 GIVING WRK-QUOCIENTE
REMAINDER WRK-RESTO
IF WRK-RESTO NOT EQUAL ZEROS
MOVE 28 TO WRK-ULTIMO-DIA-MES
ELSE
DIVIDE WRK-ANO-ANT BY 400
GIVING WRK-QUOCIENTE
REMAINDER WRK-RESTO
IF WRK-RESTO EQUAL ZEROS
MOVE 29 TO WRK-ULTIMO-DIA-MES
ELSE
DIVIDE WRK-ANO-ANT BY 100
GIVING WRK-QUOCIENTE
REMAINDER WRK-RESTO
IF WRK-RESTO EQUAL ZEROS
MOVE 28 TO WRK-ULTIMO-DIA-MES
ELSE
MOVE 29 TO WRK-ULTIMO-DIA-MES
END-IF
END-IF
END-IF
END-EVALUATE
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0006-end
0006-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* FINALIZAR PROGRAMA
*----------------------------------------------------------------*
9999-FINALIZAR SECTION.
*----------------------------------------------------------------*
GOBACK
.
*----------------------------------------------------------------*
*> cobol-lint CL002 9999-end
9999-END. EXIT.
*----------------------------------------------------------------*