IDENTIFICATION DIVISION. PROGRAM-ID. CLA15. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT ENTRADA ASSIGN TO ENTRA * ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-FS-ENTR. SELECT IMPR ASSIGN TO SALID * ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-FS-IMPR. DATA DIVISION. FILE SECTION. FD ENTRADA. 01 REC-ENTRADA PIC X(80). FD IMPR BLOCK CONTAINS 0 RECORDS RECORDING MODE IS F. 01 REC-IMPR PIC X(79). *--------------------WORKING-STORAGE-----------------------------* WORKING-STORAGE SECTION. 77 FILLER PIC X(20) VALUE "WORKING-STORAGE". 77 WS-FS-ENTR PIC XX VALUE SPACES. 77 WS-FS-IMPR PIC XX VALUE SPACES. *--------------------WS-ENTRADA----------------------------------* 01 WS-REG-ENTRADA. 03 WS-SUC-NRO PIC 9(02) VALUE ZEROS. 03 WS-SUC-IMPORTE PIC 9(7)V99 VALUE ZEROS. 03 WS-SUC-TIPN PIC X(02) VALUE ZEROS. 03 WS-SUC-TIPC. 05 WS-SUC-TIPC1 PIC 9(02) VALUE ZEROS. 05 WS-SUC-TIPC2 PIC 9(01) VALUE ZEROS. *POSICIóN RELATIVA (13:08) PARA USO FUTURO 03 FILLER PIC X(8) VALUE SPACES. *--------------------WS-REG-ANTERIOR-----------------------------* 01 WS-REG-ANT. 03 WS-SUC-NRO-ANT PIC 9(02) VALUE ZEROS. 03 WS-SUC-TIPC1-ANT PIC 9(02) VALUE ZEROS. *--------------------CONTADORES----------------------------------* 77 WS-SUC-TOT-CUENT PIC 9(03) VALUE ZERO. 77 WS-SUMA-TIPC1 PIC 9(03) VALUE ZERO. 77 WS-TOT-GRAL PIC 9(03) VALUE ZERO. 77 WS-TOT-SUC PIC 9(03) VALUE ZERO. 77 WS-CUENTA-LINEA PIC 9(02) VALUE ZERO. 77 WS-CUENTA-PAGINA PIC 9(02) VALUE 1. 77 WS-IMPRESOS PIC 9(02) VALUE ZERO. 77 WS-MAX-LINEA-PP PIC 9(03) VALUE 60. *--------------------TITULOS-------------------------------------* 01 WS-TITULO. 03 FILLER PIC X(15) VALUE "NUMERO PAGINA: ". 03 WS-PAGINA PIC Z9 VALUE ZEROS. 03 FILLER PIC X(115) VALUE SPACES. 01 WS-IMPR-CORTE-SUCURSAL. 03 FILLER PIC X(5) VALUE SPACES. 03 FILLER PIC X(26) VALUE "TOTAL SUCURSAL: ". 03 WS-TOT-SUC3 PIC ZZ9 VALUE ZERO. 03 FILLER PIC X(98) VALUE SPACES. 01 WS-IMPR-CORTE-TIPCTA. 03 FILLER PIC X(05) VALUE SPACES. 03 FILLER PIC X(06) VALUE "TOTAL ". 03 WS-SUC-TIPC13 PIC X(19) VALUE ZEROS. 03 FILLER PIC X VALUE SPACE. 03 WS-SUMA-TIPC13 PIC ZZ9 VALUE ZERO. 03 FILLER PIC X(98) VALUE SPACES. 01 WS-TOT-GRAL-IMP. 03 FILLER PIC X VALUE SPACES. 03 FILLER PIC X(27) VALUE "TOTAL GENERAL DE CUENTAS: ". 03 WS-TOT-GRAL3 PIC ZZ9 VALUE ZERO. 03 FILLER PIC X(101) VALUE SPACES. 01 WS-SUC-NRO-IMP. 03 FILLER PIC X VALUE SPACES. 03 FILLER PIC X(14) VALUE "SUCURSAR NRO: ". 03 WS-SUC-NRO3 PIC Z(02) VALUE ZERO. 03 FILLER PIC X(115) VALUE SPACES. PROCEDURE DIVISION. MAIN-PROGRAM. PERFORM 1000-INICIO THRU F-1000-INICIO. PERFORM 2000-PROCESO THRU F-2000-PROCESO UNTIL WS-FS-ENTR EQUAL '10'. PERFORM 9999-FINAL THRU F-9999-FINAL. F-MAIN-PROGRAM. GOBACK. ****************************************************************** * * * CUERPO INICIO APERTURA ARCHIVOS * * * ****************************************************************** 1000-INICIO. OPEN INPUT ENTRADA. EVALUATE WS-FS-ENTR WHEN '00' CONTINUE WHEN '10' DISPLAY "ARCHIVO VACIO." GOBACK WHEN OTHER DISPLAY '* ERROR EN OPEN IMPR= ' WS-FS-ENTR GOBACK END-EVALUATE. OPEN OUTPUT IMPR. EVALUATE WS-FS-IMPR WHEN '00' CONTINUE * CUANDO CREA UN ARCHIVO QUE NO EXISTE DEVUELVE '05' WHEN '05' CONTINUE WHEN OTHER DISPLAY '* ERROR EN OPEN IMPR= ' WS-FS-IMPR GOBACK END-EVALUATE. READ ENTRADA INTO WS-REG-ENTRADA. EVALUATE WS-FS-ENTR WHEN '00' MOVE WS-SUC-NRO TO WS-SUC-NRO-ANT MOVE WS-SUC-TIPC1 TO WS-SUC-TIPC1-ANT MOVE WS-SUC-NRO TO WS-SUC-NRO3 ADD 1 TO WS-SUMA-TIPC1 PERFORM 3400-IMPR-TIT THRU F-3400-IMPR-TIT PERFORM 3200-IMPR-SUC THRU F-3200-IMPR-SUC WHEN '10' DISPLAY 'ARCHIVO VACÍO ' WS-FS-ENTR GOBACK WHEN OTHER DISPLAY 'ERROR EN LECTURA DE ENTRADA ' WS-FS-ENTR GOBACK END-EVALUATE. F-1000-INICIO. EXIT. ****************************************************************** * * * CUERPO PRINCIPAL DE PROCESOS * * * ****************************************************************** 2000-PROCESO. PERFORM 2100-LEER THRU F-2100-LEER. IF WS-SUC-NRO EQUAL WS-SUC-NRO-ANT IF WS-SUC-TIPC1 EQUAL WS-SUC-TIPC1-ANT ADD 1 TO WS-SUMA-TIPC1 ELSE PERFORM 2210-CORTE-TIPCTA THRU 2210-CORTE-TIPCTA END-IF ELSE PERFORM 2200-CORTE-SUCURSAL THRU F-2200-CORTE-SUCURSAL END-IF. F-2000-PROCESO. EXIT. ****************************************************************** 2100-LEER. READ ENTRADA INTO WS-REG-ENTRADA. EVALUATE WS-FS-ENTR WHEN '00' CONTINUE WHEN '10' PERFORM 2205-ULTIMA-LINEA THRU F-2205-ULTIMA-LINEA WHEN OTHER DISPLAY 'ERROR EN LECTURA DE ENTRADA ' WS-FS-ENTR GOBACK END-EVALUATE. F-2100-LEER. EXIT. ****************************************************************** 2200-CORTE-SUCURSAL. PERFORM 2210-CORTE-TIPCTA THRU 2210-CORTE-TIPCTA. MOVE WS-TOT-SUC TO WS-TOT-SUC3. PERFORM 3000-GRABAR-CORTE-SUC THRU F-3000-GRABAR-CORTE-SUC. ADD WS-TOT-SUC TO WS-TOT-GRAL. MOVE WS-SUC-NRO TO WS-SUC-NRO-ANT. MOVE WS-SUC-NRO TO WS-SUC-NRO3. PERFORM 3200-IMPR-SUC THRU F-3200-IMPR-SUC. MOVE 0 TO WS-TOT-SUC. F-2200-CORTE-SUCURSAL. EXIT. ****************************************************************** 2205-ULTIMA-LINEA. PERFORM 2210-CORTE-TIPCTA THRU 2210-CORTE-TIPCTA. MOVE WS-TOT-SUC TO WS-TOT-SUC3. PERFORM 3000-GRABAR-CORTE-SUC THRU F-3000-GRABAR-CORTE-SUC. ADD WS-TOT-SUC TO WS-TOT-GRAL. MOVE WS-TOT-GRAL TO WS-TOT-GRAL3. PERFORM 3300-IMPR-GRAL THRU 3300-IMPR-GRAL. F-2205-ULTIMA-LINEA. EXIT. ****************************************************************** 2210-CORTE-TIPCTA. EVALUATE WS-SUC-TIPC1-ANT WHEN 01 MOVE "CUENTAS CORRIENTE: " TO WS-SUC-TIPC13 WHEN 02 MOVE "CAJAS AHORRO: " TO WS-SUC-TIPC13 WHEN 03 MOVE "PLAZO FIJO: " TO WS-SUC-TIPC13 WHEN OTHER DISPLAY "ARCHIVO MAL" GOBACK END-EVALUATE. MOVE WS-SUMA-TIPC1 TO WS-SUMA-TIPC13. PERFORM 3100-GRABAR-CORTE-TIPCTA THRU F-3100-GRABAR-CORTE-TIPCTA. ADD WS-SUMA-TIPC1 TO WS-TOT-SUC. MOVE WS-SUC-TIPC1 TO WS-SUC-TIPC1-ANT. MOVE 1 TO WS-SUMA-TIPC1. F-2210-CORTE-TIPCTA. EXIT. ****************************************************************** 3000-GRABAR-CORTE-SUC. IF WS-CUENTA-LINEA GREATER WS-MAX-LINEA-PP PERFORM 3400-IMPR-TIT THRU F-3400-IMPR-TIT END-IF. WRITE REC-IMPR FROM WS-IMPR-CORTE-SUCURSAL AFTER 1. IF WS-FS-IMPR IS NOT EQUAL '00' DISPLAY " ERROR EN WRITE LISTADO 3000 " WS-FS-IMPR GOBACK END-IF. ADD 1 TO WS-IMPRESOS. ADD 1 TO WS-CUENTA-LINEA. F-3000-GRABAR-CORTE-SUC. EXIT. ****************************************************************** 3100-GRABAR-CORTE-TIPCTA. IF WS-CUENTA-LINEA GREATER WS-MAX-LINEA-PP PERFORM 3400-IMPR-TIT THRU F-3400-IMPR-TIT END-IF. WRITE REC-IMPR FROM WS-IMPR-CORTE-TIPCTA AFTER 1. IF WS-FS-IMPR IS NOT EQUAL '00' DISPLAY " ERROR EN WRITE LISTADO 3100 " WS-FS-IMPR GOBACK END-IF. ADD 1 TO WS-IMPRESOS. ADD 1 TO WS-CUENTA-LINEA. F-3100-GRABAR-CORTE-TIPCTA. EXIT. ****************************************************************** 3200-IMPR-SUC. IF WS-CUENTA-LINEA GREATER WS-MAX-LINEA-PP PERFORM 3400-IMPR-TIT THRU F-3400-IMPR-TIT END-IF. WRITE REC-IMPR FROM WS-SUC-NRO-IMP AFTER 1. IF WS-FS-IMPR IS NOT EQUAL '00' DISPLAY " ERROR EN WRITE LISTADO 3200 " WS-FS-IMPR GOBACK END-IF. ADD 1 TO WS-IMPRESOS. ADD 1 TO WS-CUENTA-LINEA. F-3200-IMPR-SUC. EXIT. ****************************************************************** 3300-IMPR-GRAL. IF WS-CUENTA-LINEA GREATER WS-MAX-LINEA-PP PERFORM 3400-IMPR-TIT THRU F-3400-IMPR-TIT END-IF. WRITE REC-IMPR FROM WS-TOT-GRAL-IMP AFTER 1. IF WS-FS-IMPR IS NOT EQUAL '00' DISPLAY " ERROR EN WRITE LISTADO 3300 " WS-FS-IMPR GOBACK END-IF. F-3300-IMPR-GRAL. EXIT. ****************************************************************** 3400-IMPR-TIT. MOVE WS-CUENTA-PAGINA TO WS-PAGINA. MOVE 1 TO WS-CUENTA-LINEA. ADD 1 TO WS-CUENTA-PAGINA. ADD 1 TO WS-IMPRESOS WRITE REC-IMPR FROM WS-TITULO AFTER PAGE. * WRITE REC-IMPR FROM WS-TITULO AFTER 1. IF WS-FS-IMPR IS NOT EQUAL '00' DISPLAY " ERROR EN WRITE LISTADO 3400 " WS-FS-IMPR GOBACK END-IF. F-3400-IMPR-TIT. EXIT. ****************************************************************** * * * FINAL * * * ****************************************************************** 9999-FINAL. CLOSE ENTRADA. EVALUATE WS-FS-ENTR WHEN '00' CONTINUE WHEN '10' CONTINUE WHEN OTHER DISPLAY '* ERROR EN OPEN IMPR= ' WS-FS-ENTR GOBACK END-EVALUATE. CLOSE IMPR. EVALUATE WS-FS-IMPR WHEN '00' CONTINUE WHEN OTHER DISPLAY '* ERROR EN OPEN IMPR= ' WS-FS-IMPR GOBACK END-EVALUATE. F-9999-FINAL. EXIT.