COBOL - BALANCE-LINE com três arquivos - www.cadcobol.com.br
*----------------------------------------------------------------- IDENTIFICATION DIVISION. *----------------------------------------------------------------- PROGRAM-ID. CADBALAN. AUTHOR. DORNELLES CARLOS ALBERTO. *----------------------------------------------------------------- * SISTEMA : PROGRAMAS EXEMPLOS * PROGRAMA : CADBALAN * OBJETIVO : BALANCE-LINE DE TRES ARQUIVOS * ENTRADA : PRIMEIRO ARQUIVO DE ENTRADA - ENTRADA1 * : SEGUNDO ARQUIVO DE ENTRADA - ENTRADA2 * : TERCEIRO ARQUIVO DE ENTRADA - ENTRADA3 * SAIDA : ARQUIVO DE SAIDA - SAIDA01 * ANALISTA : CARLOS ALBERTO DORNELLES * LINGUAGEM : COBOL II - COBOL 85 * MODO OPERACAO : BATCH *----------------------------------------------------------------- * VERSAO DD.MM.AAAA HISTORICO/AUTOR * ------ ---------- --------------- * V.001 17.06.2021 PROGRAMA INICIAL/DORNELLES * *----------------------------------------------------------------- *----------------------------------------------------------------- ENVIRONMENT DIVISION. *----------------------------------------------------------------- CONFIGURATION SECTION. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT ENTRADA1 ASSIGN TO ENTRADA01 FILE STATUS IS WS-FS-ENTRADA1. SELECT ENTRADA2 ASSIGN TO ENTRADA02 FILE STATUS IS WS-FS-ENTRADA2. SELECT ENTRADA3 ASSIGN TO ENTRADA03 FILE STATUS IS WS-FS-ENTRADA3. SELECT SAIDA01 ASSIGN TO ARQSAIDA FILE STATUS IS WS-FS-SAIDA01. *----------------------------------------------------------------- DATA DIVISION. *----------------------------------------------------------------- FILE SECTION. FD ENTRADA1 BLOCK CONTAINS 0 RECORDS RECORDING MODE IS F RECORD CONTAINS 80 CHARACTERS. 01 REG-ENTRADA1. 03 CHAVE1 PIC 9(010). 03 FILLER PIC X(070). FD ENTRADA2 BLOCK CONTAINS 0 RECORDS RECORDING MODE IS F RECORD CONTAINS 80 CHARACTERS. 01 REG-ENTRADA2. 03 CHAVE2 PIC 9(010). 03 FILLER PIC X(070). FD ENTRADA3 BLOCK CONTAINS 0 RECORDS RECORDING MODE IS F RECORD CONTAINS 80 CHARACTERS. 01 REG-ENTRADA3. 03 CHAVE3 PIC 9(010). 03 FILLER PIC X(070). FD SAIDA01 BLOCK CONTAINS 0 RECORDS RECORDING MODE IS F RECORD CONTAINS 80 CHARACTERS. 01 REG-SAIDA01. 03 FILLER PIC X(080). WORKING-STORAGE SECTION. 01 WS-AREA-AUXILIAR. 05 WS-COD-PROGRAMA PIC X(008) VALUE 'CADBALAN'. 05 WS-COD-VER PIC X(008) VALUE '001/2021'. 05 WS-FS-ENTRADA1 PIC X(002) VALUE SPACES. 05 WS-FS-ENTRADA2 PIC X(002) VALUE SPACES. 05 WS-FS-ENTRADA3 PIC X(002) VALUE SPACES. 05 WS-FS-SAIDA01 PIC X(002) VALUE SPACES. 05 WS-LIDOS-ENTRA1 PIC 9(010) VALUE ZEROES. 05 WS-LIDOS-ENTRA2 PIC 9(010) VALUE ZEROES. 05 WS-LIDOS-ENTRA3 PIC 9(010) VALUE ZEROES. 05 WS-GRAVADOS 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 PERFORM P1000-PRINCIPAL PERFORM P9000-FINAL STOP RUN. *----------------------------------------------------------------- P0000-INICIAL. *----------------------------------------------------------------- MOVE 'P0000-INICIAL' TO WS-PROCESSO OPEN INPUT ENTRADA1 IF WS-FS-ENTRADA1 NOT EQUAL '00' MOVE SPACES TO WS-MENSAGEM STRING 'ERRO ABERTURA ARQUIVO ENTRADA1 FILE STATUS: ' WS-FS-ENTRADA1 DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF OPEN INPUT ENTRADA2 IF WS-FS-ENTRADA2 NOT EQUAL '00' STRING 'ERRO ABERTURA ARQUIVO ENTRADA2 FILE STATUS: ' WS-FS-ENTRADA2 DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF OPEN INPUT ENTRADA3 IF WS-FS-ENTRADA3 NOT EQUAL '00' STRING 'ERRO ABERTURA ARQUIVO ENTRADA3 FILE STATUS: ' WS-FS-ENTRADA3 DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF OPEN OUTPUT SAIDA01 IF WS-FS-SAIDA01 NOT EQUAL '00' STRING 'ERRO ABERTURA ARQUIVO SAIDA01 FILE STATUS: ' WS-FS-SAIDA01 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-ENTRADA1 PERFORM P3000-LER-ENTRADA2 PERFORM P4000-LER-ENTRADA3 PERFORM UNTIL WS-FS-ENTRADA1 EQUAL '10' AND WS-FS-ENTRADA2 EQUAL '10' AND WS-FS-ENTRADA3 EQUAL '10' EVALUATE TRUE WHEN CHAVE1 = CHAVE2 EVALUATE TRUE WHEN CHAVE1 = CHAVE3 AND CHAVE2 = CHAVE3 MOVE REG-ENTRADA1 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P2000-LER-ENTRADA1 PERFORM P3000-LER-ENTRADA2 PERFORM P4000-LER-ENTRADA3 WHEN CHAVE1 < CHAVE3 AND CHAVE2 < CHAVE3 MOVE REG-ENTRADA1 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P2000-LER-ENTRADA1 PERFORM P3000-LER-ENTRADA2 WHEN CHAVE1 > CHAVE3 AND CHAVE2 > CHAVE3 MOVE REG-ENTRADA3 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P4000-LER-ENTRADA3 WHEN OTHER DISPLAY "CHAVE1 = CHAVE2 - ERRO" END-EVALUATE WHEN CHAVE1 > CHAVE2 EVALUATE TRUE WHEN CHAVE1 = CHAVE3 AND CHAVE2 < CHAVE3 MOVE REG-ENTRADA2 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P3000-LER-ENTRADA2 WHEN CHAVE1 < CHAVE3 AND CHAVE2 < CHAVE3 MOVE REG-ENTRADA2 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P3000-LER-ENTRADA2 WHEN CHAVE1 > CHAVE3 AND CHAVE2 = CHAVE3 MOVE REG-ENTRADA2 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P3000-LER-ENTRADA2 PERFORM P4000-LER-ENTRADA3 WHEN CHAVE1 > CHAVE3 AND CHAVE2 > CHAVE3 MOVE REG-ENTRADA3 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P4000-LER-ENTRADA3 WHEN CHAVE1 > CHAVE3 AND CHAVE2 < CHAVE3 MOVE REG-ENTRADA2 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P3000-LER-ENTRADA2 WHEN OTHER DISPLAY "CHAVE1 > CHAVE2 - ERRO" END-EVALUATE WHEN CHAVE1 < CHAVE2 EVALUATE TRUE WHEN CHAVE1 = CHAVE3 AND CHAVE2 > CHAVE3 MOVE REG-ENTRADA1 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P2000-LER-ENTRADA1 PERFORM P4000-LER-ENTRADA3 WHEN CHAVE1 < CHAVE3 AND CHAVE2 = CHAVE3 MOVE REG-ENTRADA1 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P2000-LER-ENTRADA1 WHEN CHAVE1 < CHAVE3 AND CHAVE2 < CHAVE3 MOVE REG-ENTRADA1 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P2000-LER-ENTRADA1 WHEN CHAVE1 < CHAVE3 AND CHAVE2 > CHAVE3 MOVE REG-ENTRADA1 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P2000-LER-ENTRADA1 WHEN CHAVE1 > CHAVE3 AND CHAVE2 > CHAVE3 MOVE REG-ENTRADA3 TO REG-SAIDA01 PERFORM P5000-GRAVA-SAIDA01 PERFORM P4000-LER-ENTRADA3 WHEN OTHER DISPLAY "CHAVE1 < CHAVE2 - ERRO" END-EVALUATE END-EVALUATE END-PERFORM . P1000-FIM. EXIT. *----------------------------------------------------------------- P2000-LER-ENTRADA1. *----------------------------------------------------------------- MOVE 'P2000-LER-ENTRADA1' TO WS-PROCESSO READ ENTRADA1 AT END MOVE '10' TO WS-FS-ENTRADA1 MOVE 9999999999 TO CHAVE1 NOT AT END IF WS-FS-ENTRADA1 NOT EQUAL '00' AND '10' MOVE SPACES TO WS-MENSAGEM STRING 'ERRO LEITURA ARQUIVO ENTRADA1 FILE STATUS: ' WS-FS-ENTRADA1 DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF IF WS-FS-ENTRADA1 EQUAL '00' ADD 1 TO WS-LIDOS-ENTRA1 END-IF END-READ. P2000-FIM. EXIT. *----------------------------------------------------------------- P3000-LER-ENTRADA2. *----------------------------------------------------------------- MOVE 'P3000-LER-ENTRADA2' TO WS-PROCESSO READ ENTRADA2 AT END MOVE '10' TO WS-FS-ENTRADA2 MOVE 9999999999 TO CHAVE2 NOT AT END IF WS-FS-ENTRADA2 NOT EQUAL '00' AND '10' MOVE SPACES TO WS-MENSAGEM STRING 'ERRO LEITURA ARQUIVO ENTRADA2 FILE STATUS: ' WS-FS-ENTRADA2 DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF IF WS-FS-ENTRADA2 EQUAL '00' ADD 1 TO WS-LIDOS-ENTRA2 END-IF END-READ. P3000-FIM. EXIT. *----------------------------------------------------------------- P4000-LER-ENTRADA3. *----------------------------------------------------------------- MOVE 'P4000-LER-ENTRADA3' TO WS-PROCESSO READ ENTRADA3 AT END MOVE '10' TO WS-FS-ENTRADA3 MOVE 9999999999 TO CHAVE3 NOT AT END IF WS-FS-ENTRADA3 NOT EQUAL '00' AND '10' MOVE SPACES TO WS-MENSAGEM STRING 'ERRO LEITURA ARQUIVO ENTRADA3 FILE STATUS: ' WS-FS-ENTRADA3 DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF IF WS-FS-ENTRADA3 EQUAL '00' ADD 1 TO WS-LIDOS-ENTRA3 END-IF END-READ. P4000-FIM. EXIT. *----------------------------------------------------------------- P5000-GRAVA-SAIDA01. *----------------------------------------------------------------- MOVE 'P5000-GRAVA-SAIDA01' TO WS-PROCESSO WRITE REG-SAIDA01 END-WRITE IF WS-FS-SAIDA01 NOT EQUAL '00' MOVE SPACES TO WS-MENSAGEM STRING 'ERRO GRAVACAO ARQUIVO SAIDA01 FILE STATUS: ' WS-FS-SAIDA01 DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF ADD 1 TO WS-GRAVADOS. P5000-FIM. EXIT. *----------------------------------------------------------------- P8000-ERRO. *----------------------------------------------------------------- DISPLAY '------------------------------------------------------------' DISPLAY 'PROGRAMA CADBALAN CANCELADO' DISPLAY 'PARAGRAFO - ' WS-PROCESSO DISPLAY 'VERSAO - ' WS-COD-VER DISPLAY 'MENSAGEM - ' WS-MENSAGEM DISPLAY '------------------------------------------------------------' MOVE 99 TO RETURN-CODE STOP RUN. P8000-FIM. EXIT. *----------------------------------------------------------------- P9000-FINAL. *----------------------------------------------------------------- CLOSE ENTRADA1 IF WS-FS-ENTRADA1 NOT EQUAL '00' MOVE SPACES TO WS-MENSAGEM STRING 'ERRO FECHAMENTO ARQUIVO ENTRADA1 FILE STATUS: ' WS-FS-ENTRADA1 DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF CLOSE ENTRADA2 IF WS-FS-ENTRADA2 NOT EQUAL '00' STRING 'ERRO FECHAMENTO ARQUIVO ENTRADA2 FILE STATUS: ' WS-FS-ENTRADA2 DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF CLOSE ENTRADA3 IF WS-FS-ENTRADA3 NOT EQUAL '00' STRING 'ERRO FECHAMENTO ARQUIVO ENTRADA3 FILE STATUS: ' WS-FS-ENTRADA3 DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF CLOSE SAIDA01 IF WS-FS-SAIDA01 NOT EQUAL '00' STRING 'ERRO FECHAMENTO ARQUIVO SAIDA01 FILE STATUS: ' WS-FS-SAIDA01 DELIMITED BY SIZE INTO WS-MENSAGEM END-STRING PERFORM P8000-ERRO THRU P8000-FIM END-IF DISPLAY '---------------------------------------------' DISPLAY 'PROGRAMA CADBALAN - TERMINO OK' DISPLAY ' ' DISPLAY 'TOTAL DE LIDOS ENTRADA1 - ' WS-LIDOS-ENTRA1 DISPLAY 'TOTAL DE LIDOS ENTRADA2 - ' WS-LIDOS-ENTRA2 DISPLAY 'TOTAL DE LIDOS ENTRADA3 - ' WS-LIDOS-ENTRA3 DISPLAY 'TOTAL GRAVADOS ........ - ' WS-GRAVADOS. P9000-FIM. EXIT.
