MBS/PROYECTOS/irdir/irprmt013.4gl

#  SISTEMA     : SISTEMA DE REPUESTOS
#  PROGRAMA    : IRPRMT013
#  FUNCION     : CREAR,CONSULTAR,MODIFICAR, Y/O ELIMINAR REGISTRO DE LA
#                MAESTRA DE SUB-GRUPOS DE REPUESTOS
#  AUTOR       : TADEO A. FERRERAS F.
#  FECHA       : MARZO 27, 1995

GLOBALS
 "irprgb000.4gl"
  DEFINE datos_loc1 RECORD
   codigo     LIKE irtb00010.codigo,
   nombre     LIKE irtb00010.nombre,
   status_t   LIKE irtb00010.status_t,
   us_crea    LIKE irtb00010.us_crea,
   fech_crea  LIKE irtb00010.fech_crea,
   us_mod     LIKE irtb00010.us_mod,
   fech_mod   LIKE irtb00010.fech_mod
  END RECORD

MAIN                
   DEFER INTERRUPT
   SELECT * INTO p_companias.* FROM companias
   CALL irprmt013()
END MAIN

  FUNCTION irprmt013()
  CLEAR SCREEN
   OPTIONS
    FORM LINE 9
   CALL pantalla() 
   DISPLAY "irprmt013" AT 4,3 
   DISPLAY "   Sub-Grupos   " AT 6,32 attribute(blue)
         LET int_flag = FALSE 

  OPEN FORM  irfmmt013 FROM "irfmmt013"
  DISPLAY FORM irfmmt013                      
  CLEAR FORM
   MENU "OPCIONES"
       COMMAND "Adicionar"   
               "<Esc> Adiciona Registro    <Ctrl-C> Cancela Operacion"
           LET int_flag = FALSE
           CLEAR FORM 
           CALL locadd1()   
       COMMAND "Consultar-modificar"
               "<Esc> Realiza Busqueda     <Ctrl-C> Cancela Operacion"
           LET INT_FLAG = FALSE
           CALL locmod1()   
       COMMAND "Salir" "Retorna Menu Anterior"
           EXIT MENU
     END MENU
   END FUNCTION
     
 FUNCTION locadd1()
  INPUT BY NAME datos_loc1.*
  AFTER FIELD codigo
    IF datos_loc1.codigo IS NULL THEN
     LET numero_msg = 16
     call msg(numero_msg)
     next field codigo
    end if

   SELECT codigo FROM irtb00010 WHERE codigo = datos_loc1.codigo
     
    IF STATUS != NOTFOUND THEN
     LET numero_msg = 12
     CALL msg(numero_msg)
     NEXT FIELD codigo
    END IF

   AFTER FIELD nombre
    IF datos_loc1.nombre IS NULL THEN
     LET numero_msg = 16
     call msg(numero_msg)
     next field nombre
    end if
  end input

  IF INT_FLAG THEN
    LET numero_msg = 2
    CALL msg(numero_msg)
    LET INT_FLAG = FALSE
    RETURN
  END IF

   INSERT INTO irtb00010
    VALUES(datos_loc1.codigo,datos_loc1.nombre,null,user,current,null,null)
   LET numero_msg = 1
   CALL msg(numero_msg)
  END FUNCTION

  FUNCTION locmod1()
  CONSTRUCT criterio ON codigo,nombre FROM codigo,nombre

 LET selec = "SELECT *FROM irtb00010 WHERE ", criterio clipped, "ORDER BY 1"

  IF STATUS = NOTFOUND THEN
  IF STATUS < 0 THEN
   CALL integridad()
    IF bandera = 1 THEN
     LET bandera = 0
     RETURN
    END IF
  END IF
  END IF

  PREPARE busqueda FROM selec
  DECLARE busca SCROLL CURSOR FOR busqueda
  OPEN busca
  FETCH FIRST busca INTO datos_loc1.*
  DISPLAY BY NAME datos_loc1.*
  MENU "Mant."
   COMMAND "Siguiente" "Ver sigte. registro que satisfaga condicion"
    FETCH NEXT busca INTO datos_loc1.*
    IF STATUS = NOTFOUND THEN
     LET numero_msg = 4
     CALL msg(numero_msg)
    END IF
    DISPLAY BY NAME datos_loc1.*
   COMMAND "Anterior" "Ver registro anterior que satisfaga condicion"
    FETCH PREVIOUS busca INTO datos_loc1.*
    IF STATUS = NOTFOUND THEN
     LET numero_msg = 5
     CALL msg(numero_msg)
    END IF
    DISPLAY BY NAME datos_loc1.*
   COMMAND "Primero" "Ver registro anterior que satisfaga condicion"
    FETCH FIRST busca INTO datos_loc1.*
     LET numero_msg = 5
     CALL msg(numero_msg)
    DISPLAY BY NAME datos_loc1.*
   COMMAND "Ultimo" "Ver registro anterior que satisfaga condicion"
    FETCH LAST busca INTO datos_loc1.*
     LET numero_msg = 4
     CALL msg(numero_msg)
    DISPLAY BY NAME datos_loc1.*
   COMMAND "Escoger" "Elige registro para modifica"
   INPUT by NAME datos_loc1.nombre thru datos_loc1.fech_mod WITHOUT DEFAULTS

   AFTER FIELD nombre
    IF datos_loc1.nombre IS NULL THEN
     LET numero_msg = 16
     CALL msg(numero_msg)
     NEXT FIELD nombre
    END IF

  END INPUT

  IF INT_FLAG THEN
   LET numero_msg = 2
   CALL msg(numero_msg)
   LET INT_FLAG = FALSE
   EXIT MENU
   RETURN
  END IF

  UPDATE irtb00010 SET nombre = datos_loc1.nombre,      
                     fech_mod = current,us_mod = user
  WHERE codigo = datos_loc1.codigo
              
  LET numero_msg = 13 
  CALL msg(numero_msg)

  COMMAND KEY ("L") "eLiminar" "Eliminar registro que satisfaga condicion"
   UPDATE irtb00010 SET status_t = "E",fech_mod = today,us_mod = user
   WHERE codigo = datos_loc1.codigo 

   LET numero_msg = 39
   CALL msg(numero_msg)
  COMMAND "Retornar"
  EXIT MENU
  END MENU
 END FUNCTION