O CAD0001A é o programa principal responsável por coordenar o processo completo de cadastro de usuários. Em vez de concentrar todas as funcionalidades em um único programa, ele atua como um orquestrador, acionando diferentes módulos especializados para executar cada etapa do processamento.
Inicialmente, o programa chama o PROGDATA para obter as informações da data atual do sistema. Em seguida, utiliza o LER0001A para carregar os registros já existentes no arquivo sequencial para a memória.
Após a leitura dos dados, o CAD0002A é chamado para realizar o cadastro ou receber as informações do usuário. Os registros são então enviados ao SORT003A, responsável pela classificação dos dados.
Com os registros atualizados e organizados, o GRAV001A é executado para gravar as informações novamente em arquivo sequencial. Caso existam registros disponíveis, o programa também chama o REL0001A para gerar o relatório de usuários.
O fluxo principal segue esta sequência:
- 0001-OBTER-DATA — obtém a data atual;
- 1002-LER-ARQSEQ — realiza a leitura dos registros existentes;
- 0002-CAD-USUAR — executa o cadastro do usuário;
- 0005-CLASSIFICAR-REG — classifica os registros;
- 0003-GRAVA-ARQSEQ — grava os dados em arquivo;
- 0004-REL-USUAR — gera o relatório quando existem registros;
- 9999-FINALIZAR — apresenta a data atual e encerra o processamento.
Dessa forma, o CAD0001A funciona como o controlador central do processo de cadastro, integrando os diferentes módulos do sistema em uma sequência definida: obtém a data, carrega os dados existentes, realiza o cadastro, organiza os registros, grava as informações e gera o relatório.
Esse exemplo também demonstra na prática uma característica importante de aplicações COBOL: a modularização, na qual diferentes programas possuem responsabilidades específicas e são chamados por um programa principal para compor um processamento completo.
CODIGO FONTE:
******************************************************************
* PROGRAMADOR: JOSE ROBERTO - COBOLDICAS
* DATA: 06/02/2025
* OBJETIVO: PROGRAMA DE CADASTRO DE USUARIO
* OBS.:
******************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. CAD0001A.
DATA DIVISION.
WORKING-STORAGE SECTION.
* MASCARA FORMATO DA DATA - DD/MM/AAAA
01 WRK-MASC-DATA.
05 WRK-MASC-DATA-DIA PIC 9(002) VALUE ZEROS.
05 FILLER PIC X(001) VALUE '/'.
05 WRK-MASC-DATA-MES PIC 9(002) VALUE ZEROS.
05 FILLER PIC X(001) VALUE '/'.
05 WRK-MASC-DATA-ANO PIC 9(004) VALUE ZEROS.
* Variável para armazenar o código de retorno das chamadas
01 WRK-RETURN-CODE PIC S9(4) COMP VALUE ZERO.
* DEFINICAO DE DATA E HORA DO SISTEMA.
COPY COD001A.
* Definição da estrutura do cadastro
COPY COPY002A.
PROCEDURE DIVISION.
*----------------------------------------------------------------*
* PROCESSAMENTO PRINCIPAL
*----------------------------------------------------------------*
*> cobol-lint CL002 0000-processar
0000-PROCESSAR SECTION.
*----------------------------------------------------------------*
PERFORM 0001-OBTER-DATA
PERFORM 1002-LER-ARQSEQ
PERFORM 0002-CAD-USUAR
PERFORM 0005-CLASSIFICAR-REG
PERFORM 0003-GRAVA-ARQSEQ
PERFORM 0004-REL-USUAR
PERFORM 9999-FINALIZAR
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0000-end
0000-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* OBTER DATA SISTEMA
*----------------------------------------------------------------*
0001-OBTER-DATA SECTION.
*----------------------------------------------------------------*
CALL 'PROGDATA' USING COD001A-REGISTRO
MOVE RETURN-CODE TO WRK-RETURN-CODE
IF WRK-RETURN-CODE NOT = 0
DISPLAY 'ERRO NA CHAMADA PROGDATA. RETURN-CODE: '
WRK-RETURN-CODE
STOP RUN
END-IF
MOVE COD001A-DATA-ANO TO WRK-MASC-DATA-ANO
MOVE COD001A-DATA-MES TO WRK-MASC-DATA-MES
MOVE COD001A-DATA-DIA TO WRK-MASC-DATA-DIA
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0001-end
0001-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* FAZER CADASTRO USUARIO
*----------------------------------------------------------------*
0002-CAD-USUAR SECTION.
*----------------------------------------------------------------*
CALL 'CAD0002A' USING COPY002A-REGISTRO
MOVE RETURN-CODE TO WRK-RETURN-CODE
IF WRK-RETURN-CODE NOT = 0
DISPLAY 'ERRO NA CHAMADA CAD0002A. RETURN-CODE: '
WRK-RETURN-CODE
STOP RUN
END-IF
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0002-end
0002-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* FAZER CADASTRO USUARIO
*----------------------------------------------------------------*
1002-LER-ARQSEQ SECTION.
*----------------------------------------------------------------*
CALL 'LER0001A' USING COPY002A-REGISTRO
MOVE RETURN-CODE TO WRK-RETURN-CODE
IF WRK-RETURN-CODE NOT = 0
DISPLAY 'ERRO NA CHAMADA LER0001A. RETURN-CODE: '
WRK-RETURN-CODE
STOP RUN
END-IF
.
*----------------------------------------------------------------*
*> cobol-lint CL002 1002-end
1002-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* FAZER CADASTRO USUARIO
*----------------------------------------------------------------*
0003-GRAVA-ARQSEQ SECTION.
*----------------------------------------------------------------*
CALL 'GRAV001A' USING COPY002A-REGISTRO
MOVE RETURN-CODE TO WRK-RETURN-CODE
IF WRK-RETURN-CODE NOT = 0
DISPLAY 'ERRO NA CHAMADA GRAV001A. RETURN-CODE: '
WRK-RETURN-CODE
STOP RUN
END-IF
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0003-end
0003-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
0004-REL-USUAR SECTION.
*----------------------------------------------------------------*
IF COPY002A-QUANT-REG NOT EQUAL ZEROS
CALL 'REL0001A' USING COPY002A-REGISTRO
MOVE RETURN-CODE TO WRK-RETURN-CODE
IF WRK-RETURN-CODE NOT = 0
DISPLAY 'ERRO NA CHAMADA REL0001A. RETURN-CODE: '
WRK-RETURN-CODE
STOP RUN
END-IF
ELSE
DISPLAY 'NAO HÁ DADOS INFORMADOS NA TELA'
END-IF
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0004-end
0004-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* FAZER CADASTRO USUARIO
*----------------------------------------------------------------*
0005-CLASSIFICAR-REG SECTION.
*----------------------------------------------------------------*
CALL 'SORT003A' USING COPY002A-REGISTRO
MOVE RETURN-CODE TO WRK-RETURN-CODE
IF WRK-RETURN-CODE NOT = 0
DISPLAY 'ERRO NA CHAMADA SORT001A. RETURN-CODE: '
WRK-RETURN-CODE
STOP RUN
END-IF
.
*----------------------------------------------------------------*
*> cobol-lint CL002 0005-end
0005-END. EXIT.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
* FINALIZAR PROGRAMA
*----------------------------------------------------------------*
9999-FINALIZAR SECTION.
*----------------------------------------------------------------*
DISPLAY "DATA.........: " WRK-MASC-DATA
STOP RUN
.
*----------------------------------------------------------------*
*> cobol-lint CL002 9999-end
9999-END. EXIT.
*----------------------------------------------------------------*