Files
DECOMARMOL/PROYECTOS COSTOS/irdir/irprmt012.4gl
T
2026-09-22 20:38:51 -04:00

165 lines
4.1 KiB
Plaintext

GLOBALS
"irprgb000.4gl"
DEFINE datos_loc RECORD
codigo LIKE irtb00004.codigo,
nombre LIKE irtb00004.nombre,
status_t LIKE irtb00004.status_t,
us_crea LIKE irtb00004.us_crea,
fech_crea LIKE irtb00004.fech_crea,
us_mod LIKE irtb00004.us_mod,
fech_mod LIKE irtb00004.fech_mod
END RECORD
FUNCTION irprmt012()
CLEAR SCREEN
WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 9
CALL pantalla()
DISPLAY "irprmt012" AT 4,3
DISPLAY " Departamentos " AT 6,32 attribute(blue)
LET int_flag = FALSE
OPEN FORM irfmmt012 FROM "irfmmt012"
DISPLAY FORM irfmmt012
CLEAR FORM
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
LET int_flag = FALSE
CLEAR FORM
CALL locadd()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
LET INT_FLAG = FALSE
CALL locmod()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION locadd()
INPUT BY NAME datos_loc.*
AFTER FIELD codigo
IF datos_loc.codigo IS NULL THEN
LET numero_msg = 16
call msg(numero_msg)
next field codigo
end if
SELECT codigo FROM irtb00004 WHERE codigo = datos_loc.codigo
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD codigo
END IF
AFTER FIELD nombre
IF datos_loc.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 irtb00004
VALUES(datos_loc.codigo,datos_loc.nombre,null,user,current,null,null)
LET numero_msg = 1
CALL msg(numero_msg)
END FUNCTION
FUNCTION locmod()
CONSTRUCT criterio ON codigo,nombre FROM codigo,nombre
LET selec = "SELECT *FROM irtb00004 ",
"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_loc.*
DISPLAY BY NAME datos_loc.*
MENU "Mant."
COMMAND "Siguiente" "Ver sigte. registro que satisfaga condicion"
FETCH NEXT busca INTO datos_loc.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME datos_loc.*
COMMAND "Anterior" "Ver registro anterior que satisfaga condicion"
FETCH PREVIOUS busca INTO datos_loc.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME datos_loc.*
COMMAND "Primero" "Ver registro anterior que satisfaga condicion"
FETCH FIRST busca INTO datos_loc.*
LET numero_msg = 5
CALL msg(numero_msg)
DISPLAY BY NAME datos_loc.*
COMMAND "Ultimo" "Ver registro anterior que satisfaga condicion"
FETCH LAST busca INTO datos_loc.*
LET numero_msg = 4
CALL msg(numero_msg)
DISPLAY BY NAME datos_loc.*
COMMAND "Escoger" "Elige registro para modifica"
INPUT by NAME datos_loc.nombre thru datos_loc.fech_mod WITHOUT DEFAULTS
AFTER FIELD nombre
IF datos_loc.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 irtb00004 SET nombre = datos_loc.nombre,
fech_mod = current,us_mod = user
WHERE codigo = datos_loc.codigo
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("L") "eLiminar" "Eliminar registro que satisfaga condicion"
UPDATE irtb00004 SET status_t = "E",fech_mod = today,us_mod = user
WHERE codigo = datos_loc.codigo
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
EXIT MENU
END MENU
END FUNCTION