Files
MBS/PROYECTO/ipdir/ipprmt011.4gl
T
jpegueroandClaude Sonnet 5 b6085d4140 Mueve ipdir (Productos Terminados) de PROYECTOS a PROYECTO
Instruccion de Johnny: todos los directorios de fuentes de inventario
deben migrarse de la carpeta temporal PROYECTOS a la carpeta real
PROYECTO, ya que PROYECTOS sera eliminada.

Se elimino tambien un archivo suelto sin relacion llamado "ipdir"
que existia en PROYECTO (del commit inicial) y bloqueaba el nombre
de la carpeta.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-09-04 09:29:01 -04:00

226 lines
6.3 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : IPPRMT011
OBJETIVO : MARCAS DE LOS PRODUCTOS
PROGRAMADOR : JUAN SOTO
FECHA REALIZACION : Septiembre 6, 1997.
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO ALEJO
------------------------------------------------------------------
}
GLOBALS "ipprgb000.4gl"
FUNCTION ipprmt011()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
HELP KEY CONTROL-W,
MESSAGE LINE 24,
COMMENT LINE 21
OPEN FORM ipfmmt011 FROM "ipfmmt011"
DISPLAY FORM ipfmmt011
CALL pantalla()
DISPLAY "ipprmt011" AT 4,3
DISPLAY "Mantenimiento Marcas De Los Productos " at 6,22
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Delete> Cancela Operacion"
HELP 5
LET INT_FLAG = FALSE
CLEAR FORM
LET INT_FLAG = FALSE
CALL ippcad011()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Delete> Cancela Operacion"
HELP 6
CALL ippcmf011()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ippcad011()
MESSAGE ""
## Captura los datos que va a contener el registro
INPUT BY NAME p_iptb19.*
AFTER FIELD marca
SELECT UNIQUE a.* INTO p_iptb19.* FROM iptb00019 a
WHERE a.marca = p_iptb19.marca
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
DISPLAY BY NAME p_iptb19.* ATTRIBUTE(CYAN)
NEXT FIELD marca
END IF
DISPLAY BY NAME p_iptb19.nombre_marca ATTRIBUTE(CYAN)
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
SELECT UNIQUE a.* INTO p_iptb19.*
FROM iptb00019 a
WHERE a.marca = p_iptb19.marca
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD marca
END IF
DISPLAY BY NAME p_iptb19.nombre_marca ATTRIBUTE(CYAN)
INSERT INTO iptb00019 VALUES (p_iptb19.*)
UPDATE iptb00019 SET us_crea = user,
fech_crea = current
WHERE @marca = p_iptb19.marca
LET numero_msg = 1
CALL msg(numero_msg)
NEXT FIELD marca
AFTER FIELD fech_mod
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION ippcmf011()
## Aqui se prepara para la captura del criterio de seleccion
MESSAGE ""
CLEAR FORM
CONSTRUCT criterio ON iptb00019.* FROM iptb00019.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE * FROM iptb00019 WHERE ",
" status_t is null AND ",
criterio clipped,
" ORDER BY 1,2,3,4"
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO p_iptb19.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME p_iptb19.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO p_iptb19.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME p_iptb19.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO p_iptb19.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME p_iptb19.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO p_iptb19.*
DISPLAY BY NAME p_iptb19.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO p_iptb19.*
DISPLAY BY NAME p_iptb19.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Delete> Cancela Operacion"
INPUT BY NAME p_iptb19.nombre_marca
WITHOUT DEFAULTS
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE iptb00019 SET nombre_marca = p_iptb19.nombre_marca,
us_mod = USER,
fech_mod = CURRENT
WHERE marca = p_iptb19.marca
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
"Elimina registro que esta en la pantalla"
UPDATE iptb00019 SET status_t = "E",
us_mod = user,
fech_mod = current
WHERE @marca = p_iptb19.marca
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
# CALL ayuda()
EXIT MENU
END MENU
END FUNCTION