************************************************************************ DATA DIVISION. ************************************************************************ *----------------------------------------------------------------------* FILE SECTION. *----------------------------------------------------------------------* FD ARQALUNO RECORD 064 BLOCK 0. 01 FD-ARQALUNO-REG PIC X(064). FD RELALUNO RECORD 080 BLOCK 0. 01 FD-RELALUNO-REG PIC X(080). *----------------------------------------------------------------------* WORKING-STORAGE SECTION. *----------------------------------------------------------------------* 77 WS-IN-FIM-ARQALUNO PIC X(001) VALUE 'N'. 88 FIM-ARQALUNO VALUE 'S'. 01 WS-AUXILIARES. 03 WS-CNT-REG-LIDOS PIC 9(009) VALUE ZEROS. 03 WS-CNT-CAB-LIDOS PIC 9(009) VALUE ZEROS. 03 WS-CNT-DET-LIDOS PIC 9(009) VALUE ZEROS. 03 WS-CNT-ROD-LIDOS PIC 9(009) VALUE ZEROS. 03 WS-CNT-CAB-GRAVADOS PIC 9(009) VALUE ZEROS. 03 WS-CNT-DET-GRAVADOS PIC 9(009) VALUE ZEROS. 03 WS-CNT-ROD-GRAVADOS PIC 9(009) VALUE ZEROS. 03 WS-MEDIA PIC 9(002)V99 VALUE ZEROS. 03 WS-NR-MATRICULA-ANT PIC 9(007) VALUE ZEROS. 01 WS-DATA-SIS. 03 WS-ANO-SIS PIC 9(002) VALUE ZEROS. 03 WS-MES-SIS PIC 9(002) VALUE ZEROS. 03 WS-DIA-SIS PIC 9(002) VALUE ZEROS. 01 WS-HORA-SIS. 03 WS-HOR-SIS PIC 9(002) VALUE ZEROS. 03 WS-MIN-SIS PIC 9(002) VALUE ZEROS. 03 WS-SEG-SIS PIC 9(002) VALUE ZEROS. COPY CFPK0003.CPY. COPY CFPK0004.CPY. ************************************************************************ PROCEDURE DIVISION. ************************************************************************ *----------------------------------------------------------------------* 000000-ROTINA-PRINCIPAL SECTION. *----------------------------------------------------------------------* MOVE ZEROS TO WS-AUXILIARES. PERFORM 100000-ABRIR-ARQUIVOS. PERFORM 200000-LER-ARQALUNO. PERFORM UNTIL FIM-ARQALUNO PERFORM 300000-PROCESSAR-REGISTRO PERFORM 200000-LER-ARQALUNO END-PERFORM. PERFORM 983000-GRAVAR-RODAPE-ALUNO. PERFORM 400000-FECHAR-ARQUIVOS. DISPLAY 'QTD REG. LIDOS...: ' WS-CNT-REG-LIDOS. DISPLAY 'QTD CAB. LIDOS...: ' WS-CNT-CAB-LIDOS. DISPLAY 'QTD DET. LIDOS...: ' WS-CNT-DET-LIDOS. DISPLAY 'QTD ROD. LIDOS...: ' WS-CNT-ROD-LIDOS. DISPLAY ' '. DISPLAY 'QTD CAB. GRAVADOS: ' WS-CNT-CAB-GRAVADOS. DISPLAY 'QTD DET. GRAVADOS: ' WS-CNT-DET-GRAVADOS. DISPLAY 'QTD ROD. GRAVADOS: ' WS-CNT-ROD-GRAVADOS. DISPLAY ' '. DISPLAY 'FIM NORMAL DE PROCESSAMENTO.'. DISPLAY ' '. 000099-FIM. STOP RUN. *----------------------------------------------------------------------* 100000-ABRIR-ARQUIVOS SECTION. *----------------------------------------------------------------------* OPEN INPUT ARQALUNO OUTPUT RELALUNO. 100099-SAIDA. EXIT. *----------------------------------------------------------------------* 200000-LER-ARQALUNO SECTION. *----------------------------------------------------------------------* READ ARQALUNO INTO K0003-ARQUIVO AT END IF WS-CNT-REG-LIDOS EQUAL ZEROS DISPLAY ' ' DISPLAY 'ERRO 001 - ARQUIVO VAZIO.' DISPLAY 'CANCELADO POR ABEND.' DISPLAY ' ' STOP RUN ELSE MOVE 'S' TO WS-IN-FIM-ARQALUNO END-IF NOT AT END ADD 1 TO WS-CNT-REG-LIDOS END-READ. 200099-SAIDA. EXIT. *----------------------------------------------------------------------* 300000-PROCESSAR-REGISTRO SECTION. *----------------------------------------------------------------------* EVALUATE K0003-TP-REGISTRO WHEN 0 ADD 1 TO WS-CNT-CAB-LIDOS PERFORM 310000-TRATAR-CABECALHO WHEN 1 ADD 1 TO WS-CNT-DET-LIDOS PERFORM 320000-TRATAR-DETALHE WHEN 9 ADD 1 TO WS-CNT-ROD-LIDOS PERFORM 330000-TRATAR-RODAPE WHEN OTHER DISPLAY ' ' DISPLAY 'TIPO DE REGISTRO INVALIDO.' DISPLAY 'CANCELADO POR ABEND.' DISPLAY ' ' STOP RUN END-EVALUATE. 300099-SAIDA. EXIT. *----------------------------------------------------------------------* 310000-TRATAR-CABECALHO SECTION. *----------------------------------------------------------------------* ACCEPT WS-DATA-SIS FROM DATE. ACCEPT WS-HORA-SIS FROM TIME. MOVE WS-DIA-SIS TO K0004-DIA-ATUAL. MOVE WS-MES-SIS TO K0004-MES-ATUAL. MOVE WS-ANO-SIS TO K0004-ANO-ATUAL. MOVE WS-HOR-SIS TO K0004-HOR-ATUAL. MOVE WS-MIN-SIS TO K0004-MIN-ATUAL. MOVE WS-SEG-SIS TO K0004-SEG-ATUAL. MOVE 'CFPP0005' TO K0004-NM-PROGRAMA. 310099-SAIDA. EXIT. *----------------------------------------------------------------------* 320000-TRATAR-DETALHE SECTION. *----------------------------------------------------------------------* IF WS-CNT-DET-LIDOS EQUAL 1 PERFORM 981000-GRAVAR-CABECALHO-ALUNO MOVE K0003-NR-MATRICULA TO WS-NR-MATRICULA-ANT END-IF. IF K0003-NR-MATRICULA NOT EQUAL WS-NR-MATRICULA-ANT PERFORM 983000-GRAVAR-RODAPE-ALUNO PERFORM 981000-GRAVAR-CABECALHO-ALUNO PERFORM 321000-INICIALIZAR-CAMPOS END-IF. PERFORM 322000-CALCULAR-MEDIA-ALUNO. PERFORM 982000-GRAVAR-DETALHE-ALUNO. 320099-SAIDA. EXIT. *----------------------------------------------------------------------* 321000-INICIALIZAR-CAMPOS SECTION. *----------------------------------------------------------------------* MOVE K0003-NR-MATRICULA TO WS-NR-MATRICULA-ANT. INITIALIZE WS-MEDIA K0004-QT-MAT-AP K0004-QT-MAT-REP REPLACING NUMERIC BY ZEROS ALPHANUMERIC BY SPACES. 321099-SAIDA. EXIT. *----------------------------------------------------------------------* 322000-CALCULAR-MEDIA-ALUNO SECTION. *----------------------------------------------------------------------* COMPUTE WS-MEDIA = ( K0003-VL-NOTA1 * 1 + K0003-VL-NOTA2 * 2 + K0003-VL-NOTA3 * 3 + K0003-VL-NOTA4 * 4 ) / 10. IF WS-MEDIA GREATER OR EQUAL 7,00 MOVE 'APROVADO' TO K0004-SITUACAO ADD 1 TO K0004-QT-MAT-AP ELSE MOVE 'REPROVADO' TO K0004-SITUACAO ADD 1 TO K0004-QT-MAT-REP END-IF. 322099-SAIDA. EXIT. *----------------------------------------------------------------------* 330000-TRATAR-RODAPE SECTION. *----------------------------------------------------------------------* IF K0003-QTD-REGISTROS NOT EQUAL WS-CNT-REG-LIDOS DISPLAY ' ' DISPLAY 'QTD DE REGISTROS NAO CONFERE' DISPLAY 'CANCELADO POR ABEND' DISPLAY '