 000100        IDENTIFICATION DIVISION.
 000110         PROGRAM-ID PGMSUC33.
 000200        ENVIRONMENT DIVISION.
 000300        CONFIGURATION SECTION.
 000400        SPECIAL-NAMES.
 000401            DECIMAL-POINT IS COMMA.
 000402        INPUT-OUTPUT SECTION.
 000403        FILE-CONTROL.
 000404              SELECT SUCURSAL ASSIGN DDSUCU
 000405                     FILE STATUS IS WS-SUC-CODE.
 000406
 000407              SELECT SALIDA  ASSIGN DDSALI
 000408                     FILE STATUS IS WS-SAL-CODE.
 000409
 000410        DATA DIVISION.
 000411        FILE SECTION.
 000412        FD SUCURSAL
 000413             BLOCK CONTAINS 0 RECORDS
 000414             RECORDING MODE IS F.
 000415
 000416        01 REG-SUCURSAL PIC X(93).
 000417
 000418        FD SALIDA
 000419             BLOCK CONTAINS 0 RECORDS
 000420             RECORDING MODE IS F.
 000421
 000422        01 REG-SALIDA   PIC X(133).
 000423
 000424       **************************************
 000425        WORKING-STORAGE SECTION.
 000426       **************************************
 000427        77  FILLER        PIC X(26) VALUE '* INICIO WORKING-STORAGE *'.
 000428        77  FILLER        PIC X(26) VALUE '* CODIGOS RETORNO FILES  *'.
 000429        77  WS-SUC-CODE      PIC XX    VALUE SPACES.
 000430        77  WS-SAL-CODE      PIC XX    VALUE SPACES.
 000431       *******************************************
 000432       *    GUARDO SALDO DE CLIENTE ACUMULADO    *
 000433       *******************************************
 000434        01  WS-STATUS-FIN    PIC X.
 000435            88  WS-FIN-LECTURA         VALUE 'Y'.
 000436            88  WS-NO-FIN-LECTURA      VALUE 'N'.
 000437
 000438        01  WS-STATUS-SUC    PIC X.
 000439            88  WS-FIN-SUC             VALUE 'Y'.
 000440            88  WS-NO-FIN-SUC          VALUE 'N'.
 000441       **************************************
 000442       *         LAYOUT SUCURSAL            *
 000443       **************************************
 000444        COPY CPSUCUR.
 000456       **************************************
 000457       *         LAYOUT SALIDA              *
 000458       **************************************
 000459        COPY CPLISTA.
 000487       **************************************
 000488       *         VARIABLES                  *
 000489       **************************************
 000490        01 WS-VARIABLES.
 000500           03 WS-BANCO.
 000510              05 WS-TEXTO-BAN   PIC X(19)  VALUE 'CANTIDAD CTA BANCO:'.
 000520
 000600              05 WS-CTA-BANCO   PIC 9(03)  VALUE ZEROS.
 000610              05 WS-TEXTO-BAN2  PIC X(17)  VALUE ' SALDO DEL BANCO:'.
 000620              05 WS-SALDO-BAN   PIC ZZZZ.ZZ9,99     VALUE ZEROS.
 000900           03 WS-LEIDOS         PIC 9(03)  VALUE ZEROS.
 000901           03 WS-GRABADOS       PIC 9(03)  VALUE ZEROS.
 000902           03 WS-SALDO-BANCO    PIC S9(07)V99 COMP-3 VALUE ZEROS.
 000903           03 WS-TEXTO.
 000904              05 WS-TEXTO-SUC   PIC X(09)  VALUE 'SUCURSAL:'.
 000905              05 WS-SUC-ACT     PIC 9(03)  VALUE ZEROS.
 000907
 000908        77  FILLER        PIC X(26) VALUE '* FINAL  WORKING-STORAGE *'.
 000909
 000910       **************************************
 000911        PROCEDURE DIVISION.
 000912       **************************************
 000913       *  CUERPO PRINCIPAL DEL PROGRAMA     *
 000914       **************************************
 000915        MAIN-PROGRAM.
 000916
 000917            PERFORM 1000-I-INICIO   THRU   1000-F-INICIO.
 000918
 000919            PERFORM 2000-I-PROCESO  THRU  2000-F-PROCESO
 000920                    UNTIL WS-FIN-LECTURA.
 000921
 000922            PERFORM 9999-I-FINAL    THRU  9999-F-FINAL.
 000923
 000924        F-MAIN-PROGRAM. GOBACK.
 000925
 000926       **************************************
 000927       *  CUERPO INICIO APERTURA ARCHIVOS   *
 000928       **************************************
 000929        1000-I-INICIO.
 000930
 000931            SET WS-NO-FIN-LECTURA TO TRUE.
 000932
 000933            OPEN INPUT SUCURSAL.
 000934
 000935            IF WS-SUC-CODE IS NOT EQUAL '00'
 000936               DISPLAY '* ERROR EN OPEN SUCURSAL = ' WS-SUC-CODE
 000937               MOVE 9999 TO RETURN-CODE
 000938               SET WS-FIN-LECTURA TO TRUE
 000939            END-IF.
 000940
 000941            OPEN OUTPUT SALIDA.
 000942
 000943            IF WS-SAL-CODE IS NOT EQUAL '00'
 000944               DISPLAY '* ERROR EN OPEN SALIDA = ' WS-SAL-CODE
 000945               MOVE 9999 TO RETURN-CODE
 000946               SET WS-FIN-LECTURA TO TRUE
 000947            END-IF.
 000948
 000949            PERFORM 2500-I-LEER-SUCURSAL THRU 2500-F-LEER-SUCURSAL.
 000950
 000951            MOVE WS-SUC-NRO TO WS-SUC-ACT.
 000952
 000953        1000-F-INICIO. EXIT.
 000954
 000955       **************************************
 000956       *  CUERPO PRINCIPAL DE PROCESOS      *
 000957       **************************************
 000958        2000-I-PROCESO.
 000959
 000960            IF WS-SUC-ACT = WS-SUC-NRO THEN
 000961
 000962              ADD 1 TO WS-CTA-BANCO
 000963              ADD WS-SUC-SALDO TO WS-SALDO-BANCO
 000964              PERFORM 3000-I-GRABAR-SALIDA THRU 3000-F-GRABAR-SALIDA
 000965              PERFORM 2500-I-LEER-SUCURSAL THRU 2500-F-LEER-SUCURSAL
 000966
 000967            ELSE
 000968
 000972              WRITE REG-SALIDA FROM WS-TEXTO
 000973              MOVE WS-SUC-NRO  TO WS-SUC-ACT
 000974
 000975            END-IF.
 000976
 000977            IF WS-FIN-LECTURA
 000979              PERFORM 3500-I-CORTE-FINAL THRU 3500-F-CORTE-FINAL
 000980            END-IF.
 000981
 000982        2000-F-PROCESO. EXIT.
 000983
 000984       **************************************
 000985       *           LEER SUCURSAL            *
 000986       **************************************
 000987
 000988        2500-I-LEER-SUCURSAL.
 000989
 000990            READ SUCURSAL INTO WS-REG-SUCURSAL.
 000991
 000992            EVALUATE WS-SUC-CODE
 000993
 000994            WHEN '00'
 000995                ADD 1 TO WS-LEIDOS
 000996            WHEN '10'
 000997                SET WS-FIN-LECTURA TO TRUE
 000998            WHEN OTHER
 000999                 DISPLAY '* ERROR EN LECTURA SUCURSAL = ' WS-SUC-CODE
 001000                 MOVE 9999 TO RETURN-CODE
 001001                 SET WS-FIN-LECTURA TO TRUE
 001002            END-EVALUATE.
 001003
 001004        2500-F-LEER-SUCURSAL. EXIT.
 001005
 001006       **************************************
 001007       *  PARRAFO PARA GRABAR LA SALIDA     *
 001008       **************************************
 001009        3000-I-GRABAR-SALIDA.
 001010
 001011            MOVE WS-SUC-NRO     TO WS-LIS-NRO.
 001012
 001013            MOVE WS-SUC-TIP-DOC TO WS-LIS-TIP-DOC.
 001014
 001015            MOVE WS-SUC-NRO-DOC TO WS-LIS-NRO-DOC.
 001016
 001017            MOVE WS-SUC-NOMAPE  TO WS-LIS-NOMAPE.
 001018
 001019            MOVE WS-SUC-EST-CIV TO WS-LIS-EST-CIV.
 001020
 001021            MOVE WS-SUC-CTA     TO WS-LIS-CTA.
 001022
 001023            MOVE WS-SUC-SALDO   TO WS-LIS-SALDO.
 001024
 001025            EVALUATE WS-SUC-SEXO
 001026
 001027            WHEN 'M'
 001028                MOVE 'MASCULINO' TO WS-LIS-SEXO
 001029            WHEN 'F'
 001030                MOVE 'FEMENINO'  TO WS-LIS-SEXO
 001031            WHEN 'O'
 001032                MOVE 'OTROS'     TO WS-LIS-SEXO
 001033            WHEN OTHER
 001034                DISPLAY 'INGRESO WHEN OTHER EN EVALUATE SEXO'
 001035
 001036            END-EVALUATE.
 001037
 001038
 001039            WRITE REG-SALIDA FROM WS-REG-LISTA.
 001040
 001041            EVALUATE WS-SAL-CODE
 001042
 001043            WHEN 00
 001044                ADD 1 TO WS-GRABADOS
 001045            WHEN OTHER
 001046                DISPLAY '* ERROR EN GRABAR SALIDA = ' WS-SAL-CODE
 001047                MOVE 9999 TO RETURN-CODE
 001048                SET WS-FIN-LECTURA TO TRUE
 001049            END-EVALUATE.
 001050
 001051        3000-F-GRABAR-SALIDA. EXIT.
 001052
 001053        3500-I-CORTE-FINAL.
 001056
 001057            ADD WS-SUC-SALDO TO WS-SALDO-BANCO.
 001058
 001059            IF WS-SUC-ACT = WS-SUC-NRO THEN
 001060
 001063              WRITE REG-SALIDA FROM WS-TEXTO
 001064
 001065            ELSE
 001066
 001068              WRITE REG-SALIDA FROM WS-TEXTO
 001069              PERFORM 3000-I-GRABAR-SALIDA THRU 3000-F-GRABAR-SALIDA
 001071              WRITE REG-SALIDA FROM WS-TEXTO
 001072
 001073            END-IF.
 001074
 001075
 001076        3500-F-CORTE-FINAL. EXIT.
 001077
 001078        4000-I-GRABAR-BANCO.
 001081
 001082            MOVE WS-SALDO-BANCO TO WS-SALDO-BAN.
 001085
 001086            WRITE REG-SALIDA FROM WS-BANCO.
 001087
 001088            EVALUATE WS-SAL-CODE
 001089
 001090            WHEN '00'
 001091                CONTINUE
 001092            WHEN OTHER
 001093                DISPLAY '* ERROR EN GRABAR SALIDA = ' WS-SAL-CODE
 001094                MOVE 9999 TO RETURN-CODE
 001095                SET WS-FIN-LECTURA TO TRUE
 001096            END-EVALUATE.
 001097
 001098        4000-F-GRABAR-BANCO. EXIT.
 001099
 001100       **************************************
 001101       *  CUERPO FINAL CIERRE DE FILES      *
 001102       **************************************
 001103        9999-I-FINAL.
 001104
 001105            PERFORM 4000-I-GRABAR-BANCO THRU 4000-F-GRABAR-BANCO.
 001106
 001107            CLOSE SUCURSAL
 001108
 001109            IF WS-SUC-CODE NOT EQUAL '00'
 001110              DISPLAY '* ERROR AL CERRAR SUCURSAL = ' WS-SUC-CODE
 001111              MOVE 9999 TO RETURN-CODE
 001112              SET WS-FIN-LECTURA TO TRUE
 001113            END-IF.
 001114
 001115            CLOSE SALIDA
 001116
 001117            IF WS-SAL-CODE NOT EQUAL '00'
 001118              DISPLAY '* ERROR AL CERRAR SALIDA = ' WS-SAL-CODE
 001119              MOVE 9999 TO RETURN-CODE
 001120              SET WS-FIN-LECTURA TO TRUE
 001121            END-IF.
 001122
 001123            DISPLAY 'CANTIDAD DE LEIDOS = '   WS-LEIDOS.
 001124            DISPLAY 'CANTIDAD DE GRABADOS = ' WS-GRABADOS.
 001125
 001126        9999-F-FINAL.
 001127            EXIT.
 002000       *
