Files
MBS/PROYECTOS/irdir/irprmt013.4gl
T

173 lines
4.4 KiB
Plaintext

# 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