IDENTIFICATION DIVISION. *----------------------------------------------------------------- PROGRAM-ID. AULACOBOL. AUTHOR. GRUPO2. *----------------------------------------------------------------- ENVIRONMENT DIVISION. *----------------------------------------------------------------- *----------------------------------------------------------------- CONFIGURATION SECTION. *----------------------------------------------------------------- SPECIAL-NAMES. DECIMAL-POINT IS COMMA. *----------------------------------------------------------------- INPUT-OUTPUT SECTION. *----------------------------------------------------------------- FILE-CONTROL. SELECT REGISTRO-MOVIMENTO ASSIGN TO REGISTRO-MOVIMENTO FILE STATUS IS WS-REG-MOVIMENTO. SELECT REGISTRO-FUNCIONARIO ASSIGN TO REGISTRO-FUNCIONARIO FILE STATUS IS WS-REG-FUNCIONARIO. SELECT SAIFUNC ASSIGN TO SAIFUNC FILE STATUS IS WS-FS-SAIFUNC. *----------------------------------------------------------------- DATA DIVISION. *----------------------------------------------------------------- *----------------------------------------------------------------- FILE SECTION. *----------------------------------------------------------------- FD REGISTRO-MOVIMENTO BLOCK CONTAINS 0 RECORDS RECORDING MODE IS F RECORD CONTAINS 060 CHARACTERS. 01 REG-MOVIMENTO. 03 REGMOVI-MATRICULA PIC 9(010). 03 REGMOVI-NOME PIC X(050). FD REGISTRO-FUNCIONARIO BLOCK CONTAINS 0 RECORDS RECORDING MODE IS F RECORD CONTAINS 120 CHARACTERS. 01 REG-FUNCIONARIO. 03 REGFUNC-MATRICULA PIC 9(010). 03 REGFUNC-TPREGISTRO PIC X(001). 03 REGFUNC-CSR PIC X(005). 03 REGFUNC-DESP PIC 9(010). FD SAIFUNC BLOCK CONTAINS 0 RECORDS RECORDING MODE IS F RECORD CONTAINS 170 CHARACTERS. 01 REG-SAIFUNC. 03 SAIFUNC-MATRICULA PIC 9(010). 03 SAIFUNC-NOME PIC X(050). 03 SAIFUNC-TPREGISTRO PIC 9(001). 03 SAIFUNC-CSR PIC X(005). 03 SAIFUNC-DESPCIA PIC 9(010). 03 SAIFUNC-DESPCIAT PIC 9(010). 03 SAIFUNC-DESPSUC PIC 9(010). 03 SAIFUNC-DESPSUCT PIC 9(010). 03 SAIFUNC-DESPRAM PIC 9(010). 03 SAIFUNC-DESPRAMT PIC 9(010). *----------------------------------------------------------------- WORKING-STORAGE SECTION. *----------------------------------------------------------------- 01 WS-AREA-AUXILIAR. 05 WS-COD-PROGRAMA PIC X(008) VALUE 'AULACOBO'. 05 WS-COD-VER PIC X(008) VALUE 'BETA1'. 05 WS-REG-MOVIMENTO PIC X(002) VALUE SPACES. 05 WS-REG-FUNCIONARIO PIC X(002) VALUE SPACES. 05 WS-FS-SAIFUNC PIC X(002) VALUE SPACES. 05 WS-LIDOS-MOV PIC 9(010) VALUE ZEROES. 05 WS-LIDOS-FUN2 PIC 9(010) VALUE ZEROES. 05 WS-GRAVA-FUNC PIC 9(010) VALUE ZEROES. 05 WS-MENSAGEM PIC X(070) VALUE SPACES. 05 WS-PROCESSO PIC X(070) VALUE SPACES. *----------------------------------------------------------------- PROCEDURE DIVISION. *----------------------------------------------------------------- PERFORM P0000-INICIAL THRU P0000-FIM. PERFORM P1000-PRINCIPAL THRU P1000-FIM. PERFORM P9000-FINAL THRU P9000-FIM. GOBACK. *----------------------------------------------------------------- P0000-INICIAL. *----------------------------------------------------------------- MOVE 'P0000-INICIAL' TO WS-PROCESSO. OPEN INPUT REGISTRO-MOVIMENTO. IF REG-MOVIMENTO NOT EQUAL '00' MOVE SPACES TO WS-MENSAGEM STRING 'ERRO ABERTURA ARQUIVO REG-MOVIMENTO FILE STATUS: ' WS-REG-MOVIMENTO DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF. OPEN INPUT REGISTRO-FUNCIONARIO. IF WS-REG-FUNCIONARIO NOT EQUAL '00' STRING 'ERRO ABERTURA ARQUIVO REGFUNC FILE STATUS: ' WS-REG-FUNCIONARIO DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF. OPEN OUTPUT SAIFUNC. IF WS-FS-SAIFUNC NOT EQUAL '00' STRING 'ERRO ABERTURA ARQUIVO SAIFUNC FILE STATUS: ' WS-FS-SAIFUNC DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF. P0000-FIM. EXIT. *----------------------------------------------------------------- P1000-PRINCIPAL. *----------------------------------------------------------------- MOVE 'P1000-PRINCIPAL ' TO WS-PROCESSO. PERFORM P2000-LER-REGMOVI THRU P2000-FIM PERFORM P3000-LER-REGFUNC THRU P3000-FIM PERFORM UNTIL WS-REG-MOVIMENTO EQUAL '10' AND WS-REG-FUNCIONARIO EQUAL '10' EVALUATE TRUE WHEN REGMOVI-MATRICULA EQUAL REGFUNC-MATRICULA PERFORM P4000-GRAVA-SAIFUNC THRU P4000-FIM PERFORM P2000-LER-REGMOVI THRU P2000-FIM PERFORM P3000-LER-REGFUNC THRU P3000-FIM WHEN REGMOVI-MATRICULA LESS THAN REGFUNC-MATRICULA PERFORM P2000-LER-REGMOVI THRU P2000-FIM WHEN REGMOVI-MATRICULA GREATER THAN REGFUNC-MATRICULA PERFORM P3000-LER-REGFUNC THRU P3000-FIM END-EVALUATE END-PERFORM. P1000-FIM. EXIT. *----------------------------------------------------------------- P2000-LER-REGMOVI. *----------------------------------------------------------------- MOVE 'P2000-LER-REGMOVI' TO WS-PROCESSO READ REGISTRO-MOVIMENTO AT END MOVE '10' TO WS-REG-MOVIMENTO MOVE 9999999999 TO REGMOVI-MATRICULA NOT AT END IF WS-REG-MOVIMENTO NOT EQUAL '00' AND '10' MOVE SPACES TO WS-MENSAGEM STRING 'ERRO LEITURA ARQUIVO REGISTRO-MOVIMENTO FILE STATUS: ' WS-REG-MOVIMENTO DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF IF WS-REG-MOVIMENTO EQUAL '00' IF REGFUNC-TPREGISTRO = '1' COMPUTE SAIFUNC-DESPCIAT = SAIFUNC-DESPCIA + SAIFUNC-DESPCIAT END-IF IF REGFUNC-TPREGISTRO = '2' COMPUTE SAIFUNC-DESPSUCT = SAIFUNC-DESPSUC + SAIFUNC-DESPSUCT END-IF IF REGFUNC-TPREGISTRO = '3' COMPUTE SAIFUNC-DESPRAMT = SAIFUNC-DESPRAM + SAIFUNC-DESPRAMT END-IF ADD 1 TO WS-LIDOS-MOV END-IF END-READ. P2000-FIM. EXIT. *----------------------------------------------------------------- P8000-ERRO. *----------------------------------------------------------------- DISPLAY '---------------------------------------------' DISPLAY 'PROGRAMA AULACOCOL CANCELADO' DISPLAY 'PARAGRAFO - ' WS-PROCESSO DISPLAY 'VERSAO - ' WS-COD-VER DISPLAY 'MENSAGEM - ' WS-MENSAGEM DISPLAY '---------------------------------------------' MOVE 99 TO RETURN-CODE GOBACK. P8000-FIM. EXIT. *----------------------------------------------------------------- P3000-LER-REGFUNC. *----------------------------------------------------------------- MOVE 'P3000-LER-REGFUNC' TO WS-PROCESSO READ REGISTRO-FUNCIONARIO AT END MOVE '10' TO WS-REG-FUNCIONARIO MOVE 9999999999 TO REGFUNC-MATRICULA NOT AT END IF WS-REG-FUNCIONARIO NOT EQUAL '00' AND '10' MOVE SPACES TO WS-MENSAGEM STRING 'ERRO LEITURA ARQUIVO REGISTRO-FUNCIONARIO FILE STATUS: ' WS-REG-FUNCIONARIO DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF IF WS-REG-FUNCIONARIO EQUAL '00' ADD 1 TO WS-LIDOS-FUN2 END-IF END-READ. P3000-FIM. EXIT. *----------------------------------------------------------------- P4000-GRAVA-SAIFUNC. *----------------------------------------------------------------- MOVE 'P4000-GRAVA-SAIFUNC' TO WS-PROCESSO INITIALIZE REG-SAIFUNC REPLACING ALPHANUMERIC BY SPACES NUMERIC BY ZEROES MOVE REGFUNC-MATRICULA TO SAIFUNC-MATRICULA MOVE REGFUNC-TPREGISTRO TO SAIFUNC-TPREGISTRO MOVE REGFUNC-CSR TO SAIFUNC-CSR MOVE REGMOVI-NOME TO SAIFUNC-NOME WRITE REG-SAIFUNC END-WRITE IF WS-FS-SAIFUNC NOT EQUAL '00' MOVE SPACES TO WS-MENSAGEM STRING 'ERRO GRAVACAO ARQUIVO SAIFUNC FILE STATUS: ' WS-FS-SAIFUNC DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF ADD 1 TO WS-GRAVA-FUNC. P4000-FIM. EXIT. *----------------------------------------------------------------- P9000-FINAL. *----------------------------------------------------------------- DISPLAY '---------------------------------------------' DISPLAY 'PROGRAMA AULACOBOL - TERMINO OK' DISPLAY ' ' DISPLAY 'TOTAL DE LIDOS MOVIMENTOS - ' WS-LIDOS-MOV DISPLAY 'TOTAL DE LIDOS FUNCIONARIOS - ' WS-LIDOS-FUN2 DISPLAY 'TOTAL GRAVADOS ........ - ' WS-GRAVA-FUNC. P9000-FIM. EXIT.