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

219 lines
6.3 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : IPPRMT005
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Grupos iptb00020. Clases
PROGRAMADOR : Ing. Juan Soto.
FECHA REALIZACION : Noviembre 29, 2013.
------------------------------------------------------------------
}
GLOBALS "ipprgb000.4gl"
DEFINE intb32 RECORD LIKE iptb00029.*
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ipprmt005()
END MAIN
FUNCTION ipprmt005()
CONNECT to "decomarmol" AS "MSSQL" USER usuarios USING clave
CONNECT TO "marmotech" AS "IFMX"
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM ipfmmt012 FROM "ipfmmt019"
DISPLAY FORM ipfmmt012
MENU
ON ACTION nuevo
let int_flag = false
CLEAR FORM
let int_flag = false
CALL ippcad012()
ON ACTION buscar
CALL ippcmf012()
ON ACTION salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION ippcad012()
## Captura los datos que va a contener el registro
#WHENEVER ERROR CONTINUE
INPUT BY NAME p_iptb20.*
AFTER INPUT
IF int_flag THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET INT_FLAG = false
RETURN
END IF
END INPUT
SET CONNECTION "MSSQL"
SELECT MAX(a.cod_n) INTO p_iptb20.cod_n
FROM iptb00020 a
IF p_iptb20.cod_n IS NULL THEN
LET p_iptb20.cod_n = 0
END IF
LET p_iptb20.cod_n = p_iptb20.cod_n + 1
DISPLAY p_iptb20.cod_n TO cod_n
INSERT INTO iptb00020 (cod_n,producto,us_crea,fech_crea,comentario)
VALUES (p_iptb20.cod_n,p_iptb20.producto,usuarios,getdate(),p_iptb20.comentario)
SET CONNECTION "IFMX"
INSERT INTO iptb00020 (cod_n,producto,us_crea) VALUES (p_iptb20.cod_n,p_iptb20.producto,usuarios)
LET numero_msg = 1
CALL msg(numero_msg)
END FUNCTION
FUNCTION ippcmf012()
DEFINE encontrados INTEGER
## Aqui se prepara para la captura del criterio de seleccion
#WHENEVER ERROR CONTINUE
SET CONNECTION "MSSQL"
CONSTRUCT BY NAME criterio ON iptb00020.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT DISTINCT * FROM iptb00020 ",
" WHERE ",
criterio clipped,
" ORDER BY cod_n"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO p_iptb20.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
END IF
DISPLAY BY NAME p_iptb20.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO p_iptb20.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME p_iptb20.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO p_iptb20.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME p_iptb20.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO p_iptb20.*
DISPLAY BY NAME p_iptb20.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO p_iptb20.*
DISPLAY BY NAME p_iptb20.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
# Verifica que el movimiento sea del usuario creador
IF p_iptb20.status_t IS NOT NULL THEN
CALL msg(36)
EXIT MENU
END IF
INPUT BY NAME p_iptb20.producto,p_iptb20.comentario WITHOUT DEFAULTS
AFTER INPUT
#### Verifica si el usuario presiono la tecla <Ctrl-C>
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
EXIT INPUT
END IF
UPDATE iptb00020 SET producto = p_iptb20.producto,
comentario = p_iptb20.comentario,
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE cod_n = p_iptb20.cod_n
SET CONNECTION "IFMX"
UPDATE iptb00020 SET producto = p_iptb20.producto,
us_mod = usuarios,
fech_mod = current
WHERE cod_n = p_iptb20.cod_n
SET CONNECTION "MSSQL"
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
SET CONNECTION "MSSGL"
LET encontrados = 0
SELECT count(*) INTO encontrados
FROM iptb00002
WHERE cod_n = p_iptb20.cod_n AND status_t IS NULL
IF encontrados = 0 THEN
UPDATE iptb00020 SET status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE cod_n = p_iptb20.cod_n
SET CONNECTION "IFMX"
UPDATE iptb00020 SET status_t = "E",
us_mod = usuarios
WHERE cod_n = p_iptb20.cod_n
LET numero_msg = 39
CALL msg(numero_msg)
ELSE
LET numero_msg = 383
CALL msg(numero_msg)
END IF
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION