jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
073c2844494b6816569e14333a22946d13ec4cf6
MBS/PROYECTO/ipdir/ipprmt005.4gl
T
jpegueroandClaude Opus 5.5 a52b16b8b2 ipprmt005 (Clase): graba Inventario y oculta clases eliminadas 
- Alta y modificacion ahora graban cod_inv (Inventario); antes se leia en
  la consulta pero nunca se guardaba (igual en el 42m de produccion 3.20).
- La consulta excluye las clases con status_t = 'E' (eliminadas) y lee
  status_t, para que al consultar una eliminada salga REGISTRO NO EXISTE y
  funcione el control de Escoger sobre registros anulados.
- Impresora se deja sin tocar, como en 3.20: el combo no tiene opciones
  (tampoco en produccion) y guardarlo borraria valores existentes (80-83)
  que usa veconvierteorden para rutear impresion de ordenes.
- Configuracion de ejecucion con el usuario de la responsable (antes usaba
  el de jsoto, por eso grababa ese usuario como creador/modificador).

Verificado: consulta de clase eliminada (211) da REGISTRO NO EXISTE; alta
(212) graba Inventario y usuario jpeguero. Pendiente: probar Escoger y
eLiminar con la nueva version y confirmar en produccion que cod_inv solo
usa los valores del combo.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-16 17:00:54 -04:00

268 lines
10 KiB
Plaintext
Raw Blame History

{
------------------------------------------------------------------
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"
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT to "smarmotech" AS "MSSQL" USER usuarios USING clave
-- Migracion Genero 6.0: se elimina la conexion IFMX (EXTERIOR).
-- La replicacion de iptb00020 a exterior.dbo.iptb00020 ahora la hace
-- un trigger en marmotech.dbo.iptb00020 (ver ipprmt005_trg_exterior.sql).
CALL ipprmt005()
END MAIN
FUNCTION ipprmt005()
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.*
BEFORE INPUT
SET CONNECTION "MSSQL"
CALL categorias()
AFTER INPUT
IF int_flag THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET INT_FLAG = false
RETURN
END IF
IF p_iptb20.instalacion IS NULL THEN
CALL msg(16)
NEXT FIELD instalacion
END IF
IF p_iptb20.cod_cat IS NULL THEN
CALL msg(16)
NEXT FIELD p_iptb20.cod_cat
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
BEGIN WORK
INSERT INTO iptb00020 (cod_n,producto,us_crea,fech_crea,comentario,genera_orden,instalacion,cod_inv)
VALUES (p_iptb20.cod_n,p_iptb20.producto,usuarios,getdate(),p_iptb20.comentario,p_iptb20.genera_orden,p_iptb20.instalacion,p_iptb20.cod_inv)
INSERT INTO iptb00035 (cod_n,cod_cat) VALUES (p_iptb20.cod_n,p_iptb20.cod_cat)
COMMIT WORK
-- La replica a EXTERIOR la realiza el trigger en iptb00020.
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 a.cod_n,a.producto
BEFORE CONSTRUCT
CALL categorias()
AFTER CONSTRUCT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
EXIT CONSTRUCT
END CONSTRUCT
LET SELEC = " SELECT DISTINCT a.cod_n,a.producto,a.us_crea,a.us_mod,a.fech_crea,a.fech_mod,a.cod_inv,b.cod_cat,
a.comentario,a.genera_orden,a.instalacion,a.status_t FROM iptb00020 a LEFT OUTER JOIN iptb00035 b ON a.cod_n = b.cod_n ",
" WHERE a.status_t IS NULL AND ",
criterio clipped,
" ORDER BY a.cod_n"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO p_iptb20.cod_n,p_iptb20.producto,p_iptb20.us_crea,p_iptb20.us_mod,p_iptb20.fech_crea,
p_iptb20.fech_mod,p_iptb20.cod_inv, p_iptb20.cod_cat,p_iptb20.comentario,
p_iptb20.genera_orden,p_iptb20.instalacion,p_iptb20.status_t
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.cod_n,p_iptb20.producto,p_iptb20.us_crea,p_iptb20.us_mod,p_iptb20.fech_crea,
p_iptb20.fech_mod,p_iptb20.cod_inv, p_iptb20.cod_cat,p_iptb20.comentario,
p_iptb20.genera_orden,p_iptb20.instalacion
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO p_iptb20.cod_n,p_iptb20.producto,p_iptb20.us_crea,p_iptb20.us_mod,p_iptb20.fech_crea,
p_iptb20.fech_mod,p_iptb20.cod_inv, p_iptb20.cod_cat,p_iptb20.comentario,
p_iptb20.genera_orden,p_iptb20.instalacion,p_iptb20.status_t
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME p_iptb20.cod_n,p_iptb20.producto,p_iptb20.us_crea,p_iptb20.us_mod,p_iptb20.fech_crea,
p_iptb20.fech_mod,p_iptb20.cod_inv, p_iptb20.cod_cat,p_iptb20.comentario,
p_iptb20.genera_orden,p_iptb20.instalacion
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO p_iptb20.cod_n,p_iptb20.producto,p_iptb20.us_crea,p_iptb20.us_mod,p_iptb20.fech_crea,
p_iptb20.fech_mod,p_iptb20.cod_inv, p_iptb20.cod_cat,p_iptb20.comentario,
p_iptb20.genera_orden,p_iptb20.instalacion,p_iptb20.status_t
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME p_iptb20.cod_n,p_iptb20.producto,p_iptb20.us_crea,p_iptb20.us_mod,p_iptb20.fech_crea,
p_iptb20.fech_mod,p_iptb20.cod_inv, p_iptb20.cod_cat,p_iptb20.comentario,
p_iptb20.genera_orden,p_iptb20.instalacion
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO p_iptb20.cod_n,p_iptb20.producto,p_iptb20.us_crea,p_iptb20.us_mod,p_iptb20.fech_crea,
p_iptb20.fech_mod,p_iptb20.cod_inv, p_iptb20.cod_cat,p_iptb20.comentario,
p_iptb20.genera_orden,p_iptb20.instalacion,p_iptb20.status_t
DISPLAY BY NAME p_iptb20.*,p_iptb20.cod_cat
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO p_iptb20.cod_n,p_iptb20.producto,p_iptb20.us_crea,p_iptb20.us_mod,p_iptb20.fech_crea,
p_iptb20.fech_mod,p_iptb20.cod_inv, p_iptb20.cod_cat,p_iptb20.comentario,
p_iptb20.genera_orden,p_iptb20.instalacion,p_iptb20.status_t
DISPLAY BY NAME p_iptb20.cod_n,p_iptb20.producto,p_iptb20.us_crea,p_iptb20.us_mod,p_iptb20.fech_crea,
p_iptb20.fech_mod,p_iptb20.cod_inv, p_iptb20.cod_cat,p_iptb20.comentario,
p_iptb20.genera_orden,p_iptb20.instalacion
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.cod_inv,p_iptb20.comentario,p_iptb20.cod_cat,p_iptb20.genera_orden,p_iptb20.instalacion 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
IF p_iptb20.cod_cat IS NULL THEN
CALL msg(16)
NEXT FIELD p_iptb20.cod_cat
END IF
BEGIN WORK
UPDATE iptb00020 SET producto = p_iptb20.producto,
comentario = p_iptb20.comentario,
cod_inv = p_iptb20.cod_inv,
genera_orden = p_iptb20.genera_orden,
us_mod = SUSER_SNAME(),
fech_mod = GETDATE() ,
instalacion = p_iptb20.instalacion
WHERE cod_n = p_iptb20.cod_n
DELETE FROM iptb00035 WHERE cod_n = p_iptb20.cod_n
INSERT INTO iptb00035 (cod_cat,cod_n) VALUES (p_iptb20.cod_cat,p_iptb20.cod_n)
COMMIT WORK
-- La replica a EXTERIOR la realiza el trigger en iptb00020.
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
SET CONNECTION "MSSQL"
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
-- La replica del "borrado logico" a EXTERIOR la realiza el trigger.
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
Reference in New Issue View Git Blame Copy Permalink