Como buscar por nombre en un registro indexado?

[Marengo97]

Quiero implementar la funcion de buscar por nombre en un archivo indexado, no tengo claro como hacerlo

Codigo completo:

       IDENTIFICATION DIVISION.
 
       PROGRAM-ID.                 LIBRERIA.
       AUTHOR.                     LUCAS GALEANO.
       DATE-WRITTEN                9/7/2023.
 
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT REG-LIBROS ASSIGN TO "REGISTRO-LIBROS.DAT"
                               ORGANIZATION IS INDEXED
                               RECORD KEY IS LIBRO-ID
                               ALTERNATE RECORD KEY IS NOMBRE
                               ALTERNATE RECORD KEY IS EDITORIAL
                               ACCESS MODE IS DYNAMIC
                               FILE STATUS FS-REGISTRO-LIBROS.
 
 
       DATA DIVISION.
       FILE SECTION.
 
       FD REG-LIBROS.
 
       01 DATOS-LIBRO.
           05 LIBRO-ID PIC 999     VALUE ZEROS.
           05 NOMBRE   PIC X(20)   VALUE SPACES.
           05 EDITORIAL PIC X(20)  VALUE SPACES.
           05 ESTADO   PIC X(12)   VALUE SPACES.
      *05 FECHA-INGRESO.
      *     10 DIA  PIC 99 VALUE ZEROS.
      *     10 MES  PIC X(10) VALUE SPACES.
      *     10 AÑO  PIC 9999 VALUE ZEROS.
      * 05 FECHA-ALQUILER.
      *     10 DDIA PIC 99 VALUE ZEROS.
      *     10 MMES PIC X(10) VALUE SPACES.
      *     10 AAÑO PIC 9999 VALUE ZEROS.
 
       WORKING-STORAGE SECTION.
      *Codigos de error del archivo.
       01 FS-REGISTRO-LIBROS PIC XX.
           88 ESTA-REG         VALUE "00" "02".
           88 N-ESTA-REG       VALUE "23".
           88 F-NOEXISTE-REG   VALUE "35".
           88 FIN-REG          VALUE "10".
           88 F-ABIERTO        VALUE "12".
      *Variables del programa.
       77 CONTINUAR PIC X.
       77 CONTINUAR-REG PIC X.
       77 ELIMINAR-OPC  PIC X.
       77 BUSCAR-OPC    PIC X.    
       77 OPC       PIC X.
       77 LIMPIAR   PIC X(80) VALUE SPACES.
       77 LIMPIAR-LINEA PIC X(80) VALUE SPACES.
       77 N         PIC 99.
       77 AUX-ID    PIC 999.
       77 AUX-NOMBRE PIC X(20).
 
       PROCEDURE DIVISION.
       DECLARATIVES.
      *Estados de error del archivo
       FILE-ERROR SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON REG-LIBROS.
           IF FS-REGISTRO-LIBROS EQUALS "35" THEN
               SET F-NOEXISTE-REG TO TRUE
           END-IF.
       END DECLARATIVES.
      *LOGICA PRINCIPAL
       MENU.
           PERFORM UNTIL CONTINUAR = "N"
           PERFORM LIMPIAR-PANTALLA
           DISPLAY "ADMINISTRADOR DE CATALOGO" AT LINE 1 COL 1 WITH
                                                           REVERSE-VIDEO
           DISPLAY " "                         AT LINE 3 COL 1
           DISPLAY "1.Registrar, Editar, Remplazar libro" AT LINE 4
                                                           COL 1
           DISPLAY "2.Eliminar libro"          AT LINE 5 COL 1
           DISPLAY "3.Ver catalogo"            AT LINE 6 COL 1
           DISPLAY "4.Crear nuevo registro"    AT LINE 7 COL 1
           DISPLAY "5.Buscar libro"            AT LINE 8   
           DISPLAY "0.Salir"                   AT LINE 9 COL 1
           DISPLAY " "                         AT LINE 10 COL 1
           DISPLAY "Ingrese tecla ( )"         AT LINE 11 COL 1 WITH
                                                           REVERSE-VIDEO
           ACCEPT OPC                          AT LINE 11 COL 16 WITH
                                               PROMPT UNDERLINE
           EVALUATE OPC
           WHEN 1 PERFORM REGISTRAR-LIBRO
           WHEN 2 PERFORM ELIMINAR-LIBRO
           WHEN 3 PERFORM VER-LIBROS
           WHEN 4 PERFORM CREAR-ARCHIVO
           WHEN 5 PERFORM BUSCAR-LIBRO
           WHEN 0 MOVE "N" TO CONTINUAR
           END-EVALUATE
           END-PERFORM.
           CLOSE REG-LIBROS.
           STOP RUN.
 
 
       REGISTRAR-LIBRO.
           MOVE SPACES TO DATOS-LIBRO.
           PERFORM LIMPIAR-PANTALLA.
           MOVE "S" TO CONTINUAR-REG.
      *************************************************************************     
      *INTERFAZ MENU DE INGRESO DE DATOS
      *************************************************************************
           DISPLAY "Numero de serie:" AT LINE 1 COL 1.
           DISPLAY "Nombre:"       AT LINE 2 COL 1.
           DISPLAY "Editorial:"    AT LINE 3 COL 1.
           DISPLAY "Estado:"       AT LINE 4 COL 1.
           DISPLAY
           "presione ENTER sin ingresar datos para salir al menu"
                                               AT LINE 7 COL 12
                                                     WITH REVERSE-VIDEO.
 
 
           DISPLAY "Numero de serie    :" AT LINE 1 COL 1 WITH
                                                          REVERSE-VIDEO.
           ACCEPT LIBRO-ID WITH PROMPT UNDERLINE UPDATE AT LINE 1
                                                       COL 25.
 
           IF LIBRO-ID EQUALS 000 MOVE "N" TO CONTINUAR-REG END-IF.
 
 
           IF CONTINUAR-REG EQUALS "S"
           DISPLAY "Numero de serie    :" AT LINE 1 COL 1
           DISPLAY LIBRO-ID            AT LINE 1 COL 25
 
           DISPLAY "Nombre    :"     AT LINE 2 COL 1 WITH REVERSE-VIDEO
           ACCEPT NOMBRE               AT LINE 2 COL 25
           DISPLAY "Nombre:    "       AT LINE 2 COL 1
           DISPLAY NOMBRE              AT LINE 2 COL 25
 
           DISPLAY "Editorial    :"  AT LINE 3 COL 1 WITH REVERSE-VIDEO
           ACCEPT EDITORIAL            AT LINE 3 COL 25
           DISPLAY "Editorial    :"    AT LINE 3 COL 1
           DISPLAY EDITORIAL           AT LINE 3 COL 25
 
           DISPLAY "Estado    :"     AT LINE 4 COL 1 WITH REVERSE-VIDEO
           ACCEPT ESTADO               AT LINE 4 COL 25
           DISPLAY "Estado    :"       AT LINE 4 COL 1
           DISPLAY ESTADO              AT LINE 4 COL 25
      *************************************************************************
           PERFORM ABRIR-IO-ARCHIVO
           WRITE DATOS-LIBRO INVALID KEY
               REWRITE DATOS-LIBRO INVALID KEY
                   PERFORM LIMPIAR-PANTALLA
                   DISPLAY "ERROR AL REGISTRAR DATOS" AT LINE 1 COL 1
                                           WITH BACKGROUND-COLOR 4
           END-WRITE
           PERFORM CERRAR-ARCHIVO
           END-IF.
 
 
       VER-LIBROS.
           PERFORM ABRIR-ARCHIVO-INPUT.
           IF F-NOEXISTE-REG THEN
               PERFORM LIMPIAR-PANTALLA
               DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS"
                       WITH BACKGROUND-COLOR 4 AT LINE 1 COL 1
 
 
 
               DISPLAY "Presione ENTER para salir al menu"
                                               AT LINE 7 COL 12 WITH
                                               REVERSE-VIDEO
               ACCEPT OPC AT LINE  10 COL 34
           ELSE
               PERFORM LIMPIAR-PANTALLA
               INITIALIZE LIBRO-ID
               START REG-LIBROS KEY IS >= LIBRO-ID END-START
               READ REG-LIBROS NEXT RECORD END-READ
               DISPLAY
               "ID |TITULO            |EDITORIAL          |ESTADO     "
               WITH REVERSE-VIDEO AT LINE 1 COL 1
               PERFORM VARYING N FROM 02 BY 1 UNTIL FIN-REG
                   DISPLAY DATOS-LIBRO AT LINE N COL 1
                   READ REG-LIBROS NEXT RECORD END-READ
               END-PERFORM
               ADD 1 TO N
               DISPLAY "Presione ENTER para salir al menu"
                                               AT LINE N COL 1 WITH
                                               REVERSE-VIDEO
               ACCEPT OPC AT LINE N COL 34
               PERFORM CERRAR-ARCHIVO
           END-IF.
 
 
       ELIMINAR-LIBRO.
           PERFORM ABRIR-IO-ARCHIVO.
           PERFORM LIMPIAR-PANTALLA.
           MOVE SPACES TO DATOS-LIBRO
 
           DISPLAY "Indique por id el libro que desea eliminar:"
           WITH REVERSE-VIDEO AT LINE 1 COL 1.
           DISPLAY "Presione ENTER para salir al menu"
           WITH REVERSE-VIDEO AT LINE 7 COL 12.
                      
           ACCEPT LIBRO-ID AT LINE 1 COL 46 WITH PROMPT UNDERLINE UPDATE.
           
           IF LIBRO-ID NOT EQUALS 000    
           
           PERFORM LIMPIAR-PANTALLA
 
           START REG-LIBROS KEY IS = LIBRO-ID
           READ REG-LIBROS END-READ
           IF ESTA-REG
               DISPLAY
               "ID |TITULO            |EDITORIAL         |ESTADO     "
                                   WITH REVERSE-VIDEO AT LINE 1 COL 1
               DISPLAY DATOS-LIBRO AT LINE 2 COL 1
               DISPLAY "ELIMINAR(1)|VOLVER(0) :" AT LINE 5 COL 1
                                                   WITH REVERSE-VIDEO
               
               ACCEPT ELIMINAR-OPC AT LINE 5 COL 25
               EVALUATE ELIMINAR-OPC
                   WHEN 1
                   DISPLAY LIMPIAR-LINEA AT LINE 10 COL 1
                   DELETE REG-LIBROS INVALID KEY
                       DISPLAY "ERROR AL ELIMINAR" AT LINE 5 COL 1
                   END-DELETE
                   DISPLAY "REGISTRO ELIMINADO CON EXITO" AT LINE 5 
                                                COL 1
                                                WITH BACKGROUND-COLOR 2
                           ACCEPT OPC AT LINE 5 COL 29
                   WHEN 0 PERFORM ELIMINAR-LIBRO
           ELSE
               DISPLAY "EL REGISTRO NO EXISTE" AT LINE 1 COL 1
                                           WITH BACKGROUND-COLOR 4
                           ACCEPT OPC AT LINE 1 COL 22
           END-IF
           
           END-IF.
           PERFORM CERRAR-ARCHIVO.
           
 
       CREAR-ARCHIVO.
           PERFORM ABRIR-IO-ARCHIVO
           IF NOT F-NOEXISTE-REG THEN
               PERFORM LIMPIAR-PANTALLA
               DISPLAY "SE DETECTO UN ARCHIVO EXISTENTE, DE PROCEDER EL"
               AT LINE 1 COL 1 WITH BACKGROUND-COLOR 6
               " ARCHIVO ACTUAL SERA ELIMINADO" AT LINE 1 COL 48
                               WITH BACKGROUND-COLOR 6
               DISPLAY "ELIMINAR(1)|SALIR AL MENU(0) :" AT LINE 10 COL 1
                                                   WITH REVERSE-VIDEO
               ACCEPT ELIMINAR-OPC AT LINE 10 COL 31
               EVALUATE ELIMINAR-OPC
                   WHEN 1
                   PERFORM CERRAR-ARCHIVO
                   OPEN OUTPUT REG-LIBROS
                   PERFORM CERRAR-ARCHIVO
                   PERFORM LIMPIAR-PANTALLA
                   DISPLAY "ARCHIVO CREADO CON EXITO."
                                               WITH BACKGROUND-COLOR 2
                   ACCEPT OPC AT LINE 1 COL 27
                   WHEN 0 PERFORM CERRAR-ARCHIVO EXIT
           ELSE
               OPEN OUTPUT REG-LIBROS
               CLOSE REG-LIBROS
               PERFORM LIMPIAR-PANTALLA
               DISPLAY "ARCHIVO CREADO CON EXITO."
                                               WITH BACKGROUND-COLOR 2
               ACCEPT OPC AT LINE 1 COL 27
           END-IF.
 
       BUSCAR-LIBRO.
           PERFORM LIMPIAR-PANTALLA.
           PERFORM ABRIR-ARCHIVO-INPUT.
           MOVE SPACES TO DATOS-LIBRO.
           
           IF ESTA-REG
               DISPLAY "MENU DE BUSQUEDA" AT LINE 1 COL 1 
                                       WITH REVERSE-VIDEO
               DISPLAY "(I)Busqueda por id" AT LINE 3 COL 1
               DISPLAY "(N)Busqueda por nombre" AT LINE 4 COL 1
               DISPLAY "(E)Busqueda por editorial" AT LINE 5 COL 1
               DISPLAY "Ingrese opcion( )" AT LINE 7 COL 1 
                                       WITH REVERSE-VIDEO
               ACCEPT BUSCAR-OPC AT LINE 7 COL 16
               IF BUSCAR-OPC EQUALS "i" MOVE "I" TO BUSCAR-OPC END-IF
               IF BUSCAR-OPC EQUALS "n" MOVE "N" TO BUSCAR-OPC END-IF
               IF BUSCAR-OPC EQUALS "e" MOVE "E" TO BUSCAR-OPC END-IF
               
               EVALUATE BUSCAR-OPC
               WHEN "I"
               
               WHEN "N"
               
               WHEN "E"
               PERFORM BUSCAR-NOMBRE
               END-EVALUATE
               
               
               
               
               
           ELSE
               DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS"
                                 AT LINE 1 COL 1 WITH BACKGROUND-COLOR 4
               ACCEPT OPC AT LINE 1 COL 43
           END-IF.
      *************************************************************************         
      *BLOQUE DE CODIGO DE BUSQUEDAS
      *************************************************************************        
       BUSCAR-NOMBRE.
           PERFORM LIMPIAR-PANTALLA.
           PERFORM ABRIR-ARCHIVO-INPUT.
           MOVE SPACES TO DATOS-LIBRO.
           DISPLAY "Titulo:   " AT LINE 2 COL 1 WITH REVERSE-VIDEO
           DISPLAY "---------------------------------------------------"
                                               AT LINE 3 COL 1.
           
           DISPLAY
               "ID |TITULO            |EDITORIAL         |ESTADO     "
                                   WITH REVERSE-VIDEO AT LINE 3 COL 1.
           ACCEPT NOMBRE AT LINE 2 COL 14.
           
           
           START REG-LIBROS KEY IS = NOMBRE.
           READ REG-LIBROS END-READ
           DISPLAY DATOS-LIBRO AT LINE 4 COL 1
           ACCEPT OPC AT LINE 5  COL 1.
           
           
      *************************************************************************
       LIMPIAR-PANTALLA.
           PERFORM VARYING N FROM 01 BY 1 UNTIL N>24
               DISPLAY LIMPIAR AT LINE N COLUMN 1
           END-PERFORM.
               
       ABRIR-ARCHIVO-INPUT.
           OPEN INPUT REG-LIBROS.
 
       ABRIR-IO-ARCHIVO.
           OPEN I-O REG-LIBROS.
 
       CERRAR-ARCHIVO.
           CLOSE REG-LIBROS.

BLOQUE DE CODIGO ESPECIFICO:

  BUSCAR-NOMBRE.
           PERFORM LIMPIAR-PANTALLA.
           PERFORM ABRIR-ARCHIVO-INPUT.
           MOVE SPACES TO DATOS-LIBRO.
           DISPLAY "Titulo:   " AT LINE 2 COL 1 WITH REVERSE-VIDEO
           DISPLAY "---------------------------------------------------"
                                               AT LINE 3 COL 1.
           
           DISPLAY
               "ID |TITULO            |EDITORIAL         |ESTADO     "
                                   WITH REVERSE-VIDEO AT LINE 3 COL 1.
           ACCEPT NOMBRE AT LINE 2 COL 14.
           
           
           START REG-LIBROS KEY IS = NOMBRE.
           READ REG-LIBROS END-READ
           DISPLAY DATOS-LIBRO AT LINE 4 COL 1
           ACCEPT OPC AT LINE 5  COL 1.

Utilizé la misma logica para buscar por una key numerica, que funciona perfecto pero no con la secondary key NOMBRE

[JCantero]

@Marengo97, más o menos te lo dije en otro post.


Metidos en el tema, suponte que deseas seleccionar un intevalo de libros:

accept nombre-desde
accept nombre-hasta

VER-LIBROS. 
           PERFORM LIMPIAR-PANTALLA
           PERFORM ABRIR-Input-ARCHIVO
           IF F-NOEXISTE-REG THEN
             PERFORM LIMPIAR-PANTALLA
             DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS" AT LINE 1
                                                           COL 1
                                                           
             DISPLAY "PRESIONE ENTER PARA VOLVER AL MENU()" AT LINE 10
                                                           COL 1
             ACCEPT OPC AT LINE  11 COL 36
           ELSE
               PERFORM LIMPIAR-PANTALLA
 
               move nombre-desde to  nombre
               if nombre-hasta = " " then move hight-values to nombre-hasta end-if
 
               start reg-libros key is >= nombre end-start
               READ REG-LIBROS next record end-read
 
              PERFORM VARYING N FROM 1 BY 1 UNTIL fin-reg or nombre > nombre-hasta
                    DISPLAY DATOS-LIBRO AT LINE N COL 1
                    READ REG-LIBROS next record end-read
             END-PERFORM
             ADD 1 TO N
             DISPLAY "PRESIONE ENTER PARA REGRESAR AL MENU" AT LINE N
                                                          COL 1
           ACCEPT OPC AT LINE 15
           PERFORM CERRAR-ARCHIVO
           END-IF.

Se pueden hacer cosas interesantes como buscar mayúsculas y minúsculas, e incluso que contengan una cadena, "luna", "árbol".

- - - Updated - - -

Otra cosa.

 
  SELECT REG-LIBROS ASSIGN TO "REGISTRO-LIBROS.DAT"
                               ORGANIZATION IS INDEXED
                               RECORD KEY IS LIBRO-ID
                               ALTERNATE RECORD KEY IS NOMBRE with duplicates
                               ALTERNATE RECORD KEY IS EDITORIAL With duplicates
                               ACCESS MODE IS DYNAMIC
                               FILE STATUS FS-REGISTRO-LIBROS.
 
 

Ya que la editorial se puede repetir

[Marengo97]

No logro que funcione, no entiendo bien como funciona, debo de hacer un desde-nombre, hasta-nombre para recorrer ? Algo estoy pasando de alto, le dejo el bloque de codigo aunque lo modifique muchas veces sin exito

  BUSCAR-NOMBRE.
           PERFORM LIMPIAR-PANTALLA.
           PERFORM ABRIR-ARCHIVO-INPUT.
           MOVE SPACES TO DATOS-LIBRO.
           DISPLAY "Titulo:   " AT LINE 2 COL 1 WITH REVERSE-VIDEO
           DISPLAY "---------------------------------------------------"
                                               AT LINE 3 COL 1.
 
           DISPLAY
               "ID |TITULO            |EDITORIAL         |ESTADO     "
                                   WITH REVERSE-VIDEO AT LINE 3 COL 1.
           ACCEPT AUX-NOMBRE AT LINE 2 COL 14.
           MOVE AUX-NOMBRE TO HASTA-NOMBRE
           DISPLAY NOMBRE 
           START REG-LIBROS KEY IS >= NOMBRE
           READ REG-LIBROS NEXT RECORD END-READ 
           PERFORM VARYING N FROM 01 BY 1 UNTIL FIN-REG 
                                          OR NOMBRE > HASTA-NOMBRE
           READ REG-LIBROS NEXT RECORD END-READ
           DISPLAY DATOS-LIBRO AT LINE N COL 1
           END-PERFORM
           ACCEPT OPC AT LINE 5  COL 1.

[JCantero]

@Marengo97, puedes hacer una consulta desde hasta o bien puedes hacer una consulta que contenga una palabra o un string.

Eso ya depende de de lo que tú quieras hacer

- - - Updated - - -

Yo para ciertas consultas o listados pido un intervalo desde hasta.

Para otro tipo de consulta pido que contenga una palabra o un conjunto de palabras.

Claro está , cada cosa hay que implementarla

[Marengo97]

Seria mucha molestia si lo hiciera por mi para poder verlo? Se me acabaron las opciones, no lo puedo hacer funcionar, me muestra todo en espacios o todo en espacios vacios excepto en el area de NOMBRE, hagalo a su gusto quiero ver como debe de hacerse correctamente. Gracias de todas formas.

[JCantero]

@Marengo97, la opción del post 2 debe funcionar con nombre desde nombre hasta.

Ponlo en tu código y si no te funciona ponlo aquí para que lo veamos y poder solucionarlo

[Marengo97]

Asi lo tengo ahora:

 BUSCAR-NOMBRE.
           PERFORM LIMPIAR-PANTALLA.
           PERFORM ABRIR-ARCHIVO-INPUT.
           MOVE SPACES TO DATOS-LIBRO
           DISPLAY "Titulo:   " AT LINE 2 COL 1 WITH REVERSE-VIDEO
           DISPLAY "---------------------------------------------------"
                                               AT LINE 3 COL 1.
 
           DISPLAY
               "ID |TITULO            |EDITORIAL         |ESTADO     "
                                   WITH REVERSE-VIDEO AT LINE 3 COL 1.
           ACCEPT DESDE-NOMBRE AT LINE 2 COL 14.
           MOVE DESDE-NOMBRE TO NOMBRE.
           MOVE NOMBRE TO HASTA-NOMBRE.
           START REG-LIBROS KEY IS >= NOMBRE END-START.
           READ REG-LIBROS NEXT RECORD END-READ.
           PERFORM VARYING N FROM 01 BY 1 UNTIL FIN-REG OR
                                          NOMBRE > HASTA-NOMBRE
               DISPLAY DATOS-LIBRO AT LINE 4 COL 1 
 
               READ REG-LIBROS NEXT RECORD END-READ
           END-PERFORM.
               
               ACCEPT OPC AT LINE 10 COL 1.
           PERFORM CERRAR-ARCHIVO.

Te adjunto 3 capturas de pantallas:
Estas dos primeras son con "READ REG-LIBROS END-READ" en la linea 16
Sin título2.png
Sin título3.png
Muestra registros erroneos o simplemente espacios vacios, creo que los campos estan en sus valores por default.
Esta tercera es con "READ REG-LIBROS NEXT RECORD END-READ" tambien en la linea 16Sin titulo4.png
Aca, me muestra todo espacios vacios no importa cual registro sea.

[JCantero]

@Marengo97, he probado el código y funciona perfectamente.

Si te saca campos en blanco es porque no metiste nada.

Lo que hace este bucle es:

- pedir nombre
- hacer un start por ese nombre
- leer el primero y sacar siguientes que sean iguales a ese nombre.

Prueba a inicializar el fichero y meter todos los campos bien.

[JCantero]

@Marengo97, mira esto.

Te he cambiado el parrafo de registrar libro porque no funcionaba en el caso de que exista un libro.

Cuando se teclee un libro, hay que leerlo para sacar la informacion. De lo contrario si bajas con intro se reescribe el libro pero con datos en blanco.

al final he añadido una cosa mas elegante, hacias un write y si da error un rewrite. Para mi es mejor si existia rewrite y si no write.

       IDENTIFICATION DIVISION.
 
       PROGRAM-ID.                 LIBRERIA.
       AUTHOR.                     LUCAS GALEANO.
       DATE-WRITTEN                9/7/2023.
 
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT REG-LIBROS ASSIGN TO "REGISTRO-LIBROS.DAT"
                               ORGANIZATION IS INDEXED
                               RECORD KEY IS LIBRO-ID
                               ALTERNATE RECORD KEY IS NOMBRE
                               ALTERNATE RECORD KEY IS EDITORIAL
                               ACCESS MODE IS DYNAMIC
                               FILE STATUS FS-REGISTRO-LIBROS.
 
 
       DATA DIVISION.
       FILE SECTION.
 
       FD REG-LIBROS.
 
       01 DATOS-LIBRO.
           05 LIBRO-ID PIC 999     VALUE ZEROS.
           05 NOMBRE   PIC X(20)   VALUE SPACES.
           05 EDITORIAL PIC X(20)  VALUE SPACES.
           05 ESTADO   PIC X(12)   VALUE SPACES.
      *05 FECHA-INGRESO.
      *     10 DIA  PIC 99 VALUE ZEROS.
      *     10 MES  PIC X(10) VALUE SPACES.
      *     10 AÑO  PIC 9999 VALUE ZEROS.
      * 05 FECHA-ALQUILER.
      *     10 DDIA PIC 99 VALUE ZEROS.
      *     10 MMES PIC X(10) VALUE SPACES.
      *     10 AAÑO PIC 9999 VALUE ZEROS.
 
       WORKING-STORAGE SECTION.
      *Codigos de error del archivo.
       01 FS-REGISTRO-LIBROS PIC XX.
           88 ESTA-REG         VALUE "00" "02".
           88 N-ESTA-REG       VALUE "23".
           88 F-NOEXISTE-REG   VALUE "35".
           88 FIN-REG          VALUE "10".
           88 F-ABIERTO        VALUE "12".
      *Variables del programa.
       77 CONTINUAR PIC X.
       77 CONTINUAR-REG PIC X.
       77 ELIMINAR-OPC  PIC X.
       77 BUSCAR-OPC    PIC X.    
       77 OPC       PIC X.
       77 LIMPIAR   PIC X(80) VALUE SPACES.
       77 LIMPIAR-LINEA PIC X(80) VALUE SPACES.
       77 N         PIC 99.
       77 AUX-ID    PIC 999.
       77 AUX-NOMBRE PIC X(20).
       01 DESDE-NOMBRE PIC X(20).
       01 HASTA-NOMBRE PIC X(20).
 
       PROCEDURE DIVISION.
       DECLARATIVES.
      *Estados de error del archivo
       FILE-ERROR SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON REG-LIBROS.
           IF FS-REGISTRO-LIBROS EQUALS "35" THEN
               SET F-NOEXISTE-REG TO TRUE
           END-IF.
       END DECLARATIVES.
      *LOGICA PRINCIPAL
       MENU.
           PERFORM UNTIL CONTINUAR = "N"
           PERFORM LIMPIAR-PANTALLA
           DISPLAY "ADMINISTRADOR DE CATALOGO" AT LINE 1 COL 1 WITH
                                                           REVERSE-VIDEO
           DISPLAY " "                         AT LINE 3 COL 1
           DISPLAY "1.Registrar, Editar, Remplazar libro" AT LINE 4
                                                           COL 1
           DISPLAY "2.Eliminar libro"          AT LINE 5 COL 1
           DISPLAY "3.Ver catalogo"            AT LINE 6 COL 1
           DISPLAY "4.Crear nuevo registro"    AT LINE 7 COL 1
           DISPLAY "5.Buscar libro"            AT LINE 8   
           DISPLAY "0.Salir"                   AT LINE 9 COL 1
           DISPLAY " "                         AT LINE 10 COL 1
           DISPLAY "Ingrese tecla ( )"         AT LINE 11 COL 1 WITH
                                                           REVERSE-VIDEO
           ACCEPT OPC                          AT LINE 11 COL 16 WITH
                                               PROMPT UNDERLINE
           EVALUATE OPC
           WHEN 1 PERFORM REGISTRAR-LIBRO
           WHEN 2 PERFORM ELIMINAR-LIBRO
           WHEN 3 PERFORM VER-LIBROS
           WHEN 4 PERFORM CREAR-ARCHIVO
           WHEN 5 PERFORM BUSCAR-LIBRO
           WHEN 0 MOVE "N" TO CONTINUAR
           END-EVALUATE
           END-PERFORM.
           CLOSE REG-LIBROS.
           STOP RUN.
 
 
       REGISTRAR-LIBRO.
           MOVE SPACES TO DATOS-LIBRO.
           PERFORM LIMPIAR-PANTALLA.
           MOVE "S" TO CONTINUAR-REG.
      *************************************************************************     
      *INTERFAZ MENU DE INGRESO DE DATOS
      *************************************************************************
           DISPLAY "Numero de serie:" AT LINE 1 COL 1.
           DISPLAY "Nombre:"       AT LINE 2 COL 1.
           DISPLAY "Editorial:"    AT LINE 3 COL 1.
           DISPLAY "Estado:"       AT LINE 4 COL 1.
           DISPLAY
           "presione ENTER sin ingresar datos para salir al menu"
                                               AT LINE 7 COL 12
                                                     WITH REVERSE-VIDEO.
 
 
           DISPLAY "Numero de serie    :" AT LINE 1 COL 1 WITH
                                                          REVERSE-VIDEO.
           initialize DATOS-LIBRO                                                
           ACCEPT LIBRO-ID WITH PROMPT UNDERLINE UPDATE AT LINE 1
                                                       COL 25.
           
           IF LIBRO-ID EQUALS 000 MOVE "N" TO CONTINUAR-REG END-IF.
 
 
           IF CONTINUAR-REG EQUALS "S"
              PERFORM ABRIR-IO-ARCHIVO                                           
              read REG-LIBROS end-read
              if ESTA-REG THEN
                  DISPLAY NOMBRE              AT LINE 2 COL 25
                  DISPLAY EDITORIAL           AT LINE 3 COL 25
                  DISPLAY ESTADO              AT LINE 4 COL 25       
              end-if
              DISPLAY "Numero de serie    :" AT LINE 1 COL 1
              DISPLAY LIBRO-ID            AT LINE 1 COL 25
 
              DISPLAY "Nombre    :"     AT LINE 2 COL 1 
                                            WITH REVERSE-VIDEO
              ACCEPT NOMBRE               AT LINE 2 COL 25
              DISPLAY "Nombre:    "       AT LINE 2 COL 1
              DISPLAY NOMBRE              AT LINE 2 COL 25
 
              DISPLAY "Editorial    :"  AT LINE 3 COL 1 
                                            WITH REVERSE-VIDEO
              ACCEPT EDITORIAL            AT LINE 3 COL 25
              DISPLAY "Editorial    :"    AT LINE 3 COL 1
              DISPLAY EDITORIAL           AT LINE 3 COL 25
 
              DISPLAY "Estado    :"     AT LINE 4 COL 1 
                                            WITH REVERSE-VIDEO
              ACCEPT ESTADO               AT LINE 4 COL 25
              DISPLAY "Estado    :"       AT LINE 4 COL 1
              DISPLAY ESTADO              AT LINE 4 COL 25
      *************************************************************************
   
             if N-ESTA-REG then 
              WRITE DATOS-LIBRO end-write
             else
               REWRITE DATOS-LIBRO END-REWRITE
             end-if    
             if not ESTA-REG then
                   PERFORM LIMPIAR-PANTALLA
                   DISPLAY "ERROR AL REGISTRAR DATOS" AT LINE 1 COL 1
                                           WITH BACKGROUND-COLOR 4
             end-if 
            PERFORM CERRAR-ARCHIVO
           END-IF.
           
 
       VER-LIBROS.
           PERFORM ABRIR-ARCHIVO-INPUT.
           IF F-NOEXISTE-REG THEN
               PERFORM LIMPIAR-PANTALLA
               DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS"
                       WITH BACKGROUND-COLOR 4 AT LINE 1 COL 1
 
 
 
               DISPLAY "Presione ENTER para salir al menu"
                                               AT LINE 7 COL 12 WITH
                                               REVERSE-VIDEO
               ACCEPT OPC AT LINE  10 COL 34
           ELSE
               PERFORM LIMPIAR-PANTALLA
               INITIALIZE LIBRO-ID
               START REG-LIBROS KEY IS >= LIBRO-ID END-START
               READ REG-LIBROS NEXT RECORD END-READ
               DISPLAY
               "ID |TITULO            |EDITORIAL          |ESTADO     "
               WITH REVERSE-VIDEO AT LINE 1 COL 1
               PERFORM VARYING N FROM 02 BY 1 UNTIL FIN-REG
                   DISPLAY DATOS-LIBRO AT LINE N COL 1
                   READ REG-LIBROS NEXT RECORD END-READ
               END-PERFORM
               ADD 1 TO N
               DISPLAY "Presione ENTER para salir al menu"
                                               AT LINE N COL 1 WITH
                                               REVERSE-VIDEO
               ACCEPT OPC AT LINE N COL 34
               PERFORM CERRAR-ARCHIVO
           END-IF.
 
 
       ELIMINAR-LIBRO.
           PERFORM ABRIR-IO-ARCHIVO.
           PERFORM LIMPIAR-PANTALLA.
           MOVE SPACES TO DATOS-LIBRO
 
           DISPLAY "Indique por id el libro que desea eliminar:"
           WITH REVERSE-VIDEO AT LINE 1 COL 1.
           DISPLAY "Presione ENTER para salir al menu"
           WITH REVERSE-VIDEO AT LINE 7 COL 12.
                      
           ACCEPT LIBRO-ID AT LINE 1 COL 46 WITH PROMPT UNDERLINE UPDATE.
           
           IF LIBRO-ID NOT EQUALS 000    
           
           PERFORM LIMPIAR-PANTALLA
 
           START REG-LIBROS KEY IS = LIBRO-ID
           READ REG-LIBROS END-READ
           IF ESTA-REG
               DISPLAY
               "ID |TITULO            |EDITORIAL         |ESTADO     "
                                   WITH REVERSE-VIDEO AT LINE 1 COL 1
               DISPLAY DATOS-LIBRO AT LINE 2 COL 1
               DISPLAY "ELIMINAR(1)|VOLVER(0) :" AT LINE 5 COL 1
                                                   WITH REVERSE-VIDEO
               
               ACCEPT ELIMINAR-OPC AT LINE 5 COL 25
               EVALUATE ELIMINAR-OPC
                   WHEN 1
                   DISPLAY LIMPIAR-LINEA AT LINE 10 COL 1
                   DELETE REG-LIBROS INVALID KEY
                       DISPLAY "ERROR AL ELIMINAR" AT LINE 5 COL 1
                   END-DELETE
                   DISPLAY "REGISTRO ELIMINADO CON EXITO" AT LINE 5 
                                                COL 1
                                                WITH BACKGROUND-COLOR 2
                           ACCEPT OPC AT LINE 5 COL 29
                   WHEN 0 PERFORM ELIMINAR-LIBRO
           ELSE
               DISPLAY "EL REGISTRO NO EXISTE" AT LINE 1 COL 1
                                           WITH BACKGROUND-COLOR 4
                           ACCEPT OPC AT LINE 1 COL 22
           END-IF
           
           END-IF.
           PERFORM CERRAR-ARCHIVO.
           
 
       CREAR-ARCHIVO.
           PERFORM ABRIR-IO-ARCHIVO
           IF NOT F-NOEXISTE-REG THEN
               PERFORM LIMPIAR-PANTALLA
               DISPLAY "SE DETECTO UN ARCHIVO EXISTENTE, DE PROCEDER EL"
               AT LINE 1 COL 1 WITH BACKGROUND-COLOR 6
               " ARCHIVO ACTUAL SERA ELIMINADO" AT LINE 1 COL 48
                               WITH BACKGROUND-COLOR 6
               DISPLAY "ELIMINAR(1)|SALIR AL MENU(0) :" AT LINE 10 COL 1
                                                   WITH REVERSE-VIDEO
               ACCEPT ELIMINAR-OPC AT LINE 10 COL 31
               EVALUATE ELIMINAR-OPC
                   WHEN 1
                   PERFORM CERRAR-ARCHIVO
                   OPEN OUTPUT REG-LIBROS
                   PERFORM CERRAR-ARCHIVO
                   PERFORM LIMPIAR-PANTALLA
                   DISPLAY "ARCHIVO CREADO CON EXITO."
                                               WITH BACKGROUND-COLOR 2
                   ACCEPT OPC AT LINE 1 COL 27
                   WHEN 0 PERFORM CERRAR-ARCHIVO EXIT
           ELSE
               OPEN OUTPUT REG-LIBROS
               CLOSE REG-LIBROS
               PERFORM LIMPIAR-PANTALLA
               DISPLAY "ARCHIVO CREADO CON EXITO."
                                               WITH BACKGROUND-COLOR 2
               ACCEPT OPC AT LINE 1 COL 27
           END-IF.
 
       BUSCAR-LIBRO.
           PERFORM LIMPIAR-PANTALLA.
           PERFORM ABRIR-ARCHIVO-INPUT.
           MOVE SPACES TO DATOS-LIBRO.
           
           IF ESTA-REG
               DISPLAY "MENU DE BUSQUEDA" AT LINE 1 COL 1 
                                       WITH REVERSE-VIDEO
               DISPLAY "(I)Busqueda por id" AT LINE 3 COL 1
               DISPLAY "(N)Busqueda por nombre" AT LINE 4 COL 1
               DISPLAY "(E)Busqueda por editorial" AT LINE 5 COL 1
               DISPLAY "Ingrese opcion( )" AT LINE 7 COL 1 
                                       WITH REVERSE-VIDEO
               ACCEPT BUSCAR-OPC AT LINE 7 COL 16
               IF BUSCAR-OPC EQUALS "i" MOVE "I" TO BUSCAR-OPC END-IF
               IF BUSCAR-OPC EQUALS "n" MOVE "N" TO BUSCAR-OPC END-IF
               IF BUSCAR-OPC EQUALS "e" MOVE "E" TO BUSCAR-OPC END-IF
               
               EVALUATE BUSCAR-OPC
               WHEN "I"
               
               WHEN "N"
               
               WHEN "E"
               PERFORM BUSCAR-NOMBRE
               END-EVALUATE
               
               
               
               
               
           ELSE
               DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS"
                                 AT LINE 1 COL 1 WITH BACKGROUND-COLOR 4
               ACCEPT OPC AT LINE 1 COL 43
           END-IF.
      *************************************************************************         
      *BLOQUE DE CODIGO DE BUSQUEDAS
      *************************************************************************        
       BUSCAR-NOMBRE.
             PERFORM LIMPIAR-PANTALLA.
           PERFORM ABRIR-ARCHIVO-INPUT.
           MOVE SPACES TO DATOS-LIBRO
           DISPLAY "Titulo:   " AT LINE 2 COL 1 WITH REVERSE-VIDEO
           DISPLAY "---------------------------------------------------"
                                               AT LINE 3 COL 1.
 
           DISPLAY
               "ID |TITULO            |EDITORIAL         |ESTADO     "
                                   WITH REVERSE-VIDEO AT LINE 3 COL 1.
           ACCEPT DESDE-NOMBRE AT LINE 2 COL 14.
           MOVE DESDE-NOMBRE TO NOMBRE.
           MOVE NOMBRE TO HASTA-NOMBRE.
           START REG-LIBROS KEY IS >= NOMBRE END-START.
           READ REG-LIBROS NEXT RECORD END-READ.
           PERFORM VARYING N FROM 01 BY 1 UNTIL FIN-REG OR
                                          NOMBRE > HASTA-NOMBRE
               DISPLAY DATOS-LIBRO AT LINE 4 COL 1 
 
               READ REG-LIBROS NEXT RECORD END-READ
           END-PERFORM.
               
               ACCEPT OPC AT LINE 10 COL 1.
           PERFORM CERRAR-ARCHIVO.
      *************************************************************************
       LIMPIAR-PANTALLA.
           PERFORM VARYING N FROM 01 BY 1 UNTIL N>24
               DISPLAY LIMPIAR AT LINE N COLUMN 1
           END-PERFORM.
               
       ABRIR-ARCHIVO-INPUT.
           OPEN INPUT REG-LIBROS.
 
       ABRIR-IO-ARCHIVO.
           OPEN I-O REG-LIBROS.
 
       CERRAR-ARCHIVO.
           CLOSE REG-LIBROS.
           

[Marengo97]

Buenos dias Cantero, o buenas noches que aca esta por amanecer, si recien se me ocurrio la posibilidad de que el problema era el archivo...te explico, yo implemente las claves secundarias con un archivo YA PREVIAMENTE creado cuando solo utilizaba una MAIN KEY, o sea,LIBRO-ID, y jamas se me ocurrio que ese archivo previo entraria en conflicto si lo indexo con claves secundarias que previamente no declare en codigo, es decir los campos estaban pero no las llaves en el FILE CONTROL.....ahora funciona perfecto, no me la puedo creer.

Gracias por la paciencia