Files
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

299 lines
8.2 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : IPPRMT004
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Maestra de Origen Producto
PROGRAMADOR : Juan Fco. Soto
FECHA REALIZACION : AGOSTO 1997
------------------------------------------------------------------
}
GLOBALS "ipprgb000.4gl"
DEFINE nombre_costo,nombre_cta,nombre_dpto CHAR(40)
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT to "smarmotech" AS "MSSQL" USER usuarios USING clave
SELECT * INTO p_companias.* FROM companias
CALL ipprmt004()
END MAIN
FUNCTION ipprmt004()
CLEAR SCREEN
OPTIONS
FORM LINE 8,
ERROR LINE 24,
COMMENT LINE 23
OPEN FORM ipfmmt004 FROM "ipfmmt004"
DISPLAY FORM ipfmmt004
DISPLAY "ipprmt004" AT 4,3
DISPLAY "Catalogo Origen Producto" AT 6,29
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Delete> Cancela Operacion"
CLEAR FORM
LET INT_FLAG = FALSE
INITIALIZE p_iptb22.* TO NULL
LET tipo_p = "A"
CALL ippcad004()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Delete> Cancela Operacion"
CLEAR FORM
LET INT_FLAG = FALSE
INITIALIZE p_iptb22.* TO NULL
LET tipo_p = "C"
CALL ippcmf004()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ippcad004()
DEFINE fech_ant CHAR(8)
# WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
IF tipo_p = "A" THEN
INPUT BY NAME p_iptb22.cod_cia
AFTER FIELD cod_cia
IF p_iptb22.cod_cia is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_cia
END IF
SELECT UNIQUE a.* INTO p_iptb22.* FROM iptb00022 a
WHERE a.cod_cia = p_iptb22.cod_cia
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
DISPLAY BY NAME p_iptb22.*
NEXT FIELD cod_cia
END IF
AFTER INPUT
IF INT_FLAG THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET INT_FLAG = FALSE
RETURN
END IF
IF p_iptb22.cod_cia IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_cia
END IF
END INPUT
END IF
INPUT BY NAME p_iptb22.descripcion THRU p_iptb22.cuenta_costo WITHOUT DEFAULTS
AFTER FIELD descripcion
IF p_iptb22.descripcion is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descripcion
END IF
AFTER FIELD cuenta_costo
IF p_iptb22.cuenta_costo IS NOT NULL THEN
SELECT a.descripcion INTO nombre_costo FROM iptb00002 a
WHERE a.cuenta_no = p_iptb22.cuenta_no
IF STATUS = NOTFOUND THEN
CALL msg(3)
NEXT FIELD cuenta_costo
END IF
END IF
AFTER FIELD departamento
IF p_iptb22.departamento is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
SELECT UNIQUE a.nom_dpto INTO nombre_dpto FROM adtb00001 a
WHERE a.departamento = p_iptb22.departamento AND a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
DISPLAY BY NAME nombre_dpto
AFTER FIELD cuenta_no
IF p_iptb22.cuenta_no is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
SELECT UNIQUE a.descripcion INTO nombre_cta FROM cgtb00001 a
WHERE a.cuenta_no = p_iptb22.cuenta_no AND a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
DISPLAY BY NAME nombre_cta
AFTER INPUT
IF INT_FLAG THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET INT_FLAG = FALSE
RETURN
END IF
IF p_iptb22.cod_cia IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_cia
END IF
IF p_iptb22.descripcion IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descripcion
END IF
IF p_iptb22.departamento IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
IF p_iptb22.cuenta_no IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
END INPUT
IF INT_FLAG THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET INT_FLAG = FALSE
RETURN
END IF
IF tipo_p = "A" THEN
INSERT INTO iptb00022 VALUES (p_iptb22.*)
UPDATE iptb00022 SET (us_crea,fech_crea) = (SUSER_SNAME(),GETDATE())
WHERE cod_cia = p_iptb22.cod_cia
LET numero_msg = 1
CALL msg(numero_msg)
ELSE
UPDATE iptb00022 SET iptb00022.* = p_iptb22.*
WHERE cod_cia = p_iptb22.cod_cia
UPDATE iptb00022 SET (us_mod,fech_mod) = (SUSER_SNAME(),GETDATE())
WHERE cod_cia = p_iptb22.cod_cia
LET numero_msg = 13
CALL msg(numero_msg)
END IF
END FUNCTION
FUNCTION ippcmf004()
#WHENEVER ERROR CONTINUE
CLEAR FORM
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON iptb00022.cod_cia,iptb00022.descripcion,
iptb00022.departamento,iptb00022.cuenta_no
FROM cod_cia,descripcion,departamento,cuenta_no
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = "SELECT UNIQUE * FROM iptb00022 ",
"WHERE ",criterio clipped," ORDER BY 2,3,4,5"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO p_iptb22.*
CALL despl4()
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
MENU "OPCIONES "
COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO p_iptb22.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL despl4()
COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO p_iptb22.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL despl4()
COMMAND "Primero" "Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO p_iptb22.*
CALL despl4()
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO p_iptb22.*
CALL despl4()
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger" "<Esc> Actualiza Registro <Delete> Cancela Operacion"
CALL ippcad004()
COMMAND KEY ("L") "eLiminar"
DELETE FROM iptb00022 WHERE @cod_cia = p_iptb22.cod_cia
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar" "Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
FUNCTION despl4()
LET nombre_dpto = NULL
LET nombre_cta = NULL
SELECT UNIQUE a.nom_dpto INTO nombre_dpto FROM adtb00001 a
WHERE a.departamento = p_iptb22.departamento
SELECT UNIQUE a.descripcion INTO nombre_cta FROM cgtb00001 a
WHERE a.cuenta_no = p_iptb22.cuenta_no
SELECT UNIQUE a.descripcion INTO nombre_costo FROM cgtb00001 a
WHERE a.cuenta_no = p_iptb22.cuenta_costo
DISPLAY BY NAME p_iptb22.cuenta_no,p_iptb22.descripcion,p_iptb22.us_crea,p_iptb22.fech_crea,
p_iptb22.us_crea,p_iptb22.fech_mod,p_iptb22.cuenta_costo, nombre_dpto,nombre_cta,
nombre_costo
END FUNCTION