Commit inicial: fuentes MBS ERP (Genero 6) + .gitignore + docs/SETUP_PC_MBS.md

This commit is contained in:
2026-08-18 20:59:52 -04:00
commit 454973e269
5978 changed files with 2664094 additions and 0 deletions
+319
View File
@@ -0,0 +1,319 @@
{
------------------------------------------------------------------
PROGRAMA : ISPRMT002
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Maestra Suministro.
PROGRAMADOR : Ing. Juan Fco. Soto
FECHA REALIZACION : Octubre 21, 1993.
------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
DEFINE p_rowid,l_rowid,m_rowid INTEGER,
opt VARCHAR(3)
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
DISPLAY "usuario ",usuarios, " clave ",clave
CONNECT TO "smarmotech" USER usuarios USING clave
CALL isprmt002()
END MAIN
FUNCTION isprmt002()
CLEAR SCREEN
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmmt002 FROM "isfmmt002"
DISPLAY FORM isfmmt002
# CALL pantalla()
DISPLAY "isprmt002" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Catalogo Suministros" at 6,30 ATTRIBUTE(BLACK)
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
CLEAR FORM
LET INT_FLAG = FALSE
CALL ispcad002()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
LET INT_FLAG = FALSE
CALL ispcmf002()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ispcad002()
DEFINE fech_ant CHAR(8)
#WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME m_articulos.cod_n THRU m_articulos.cod_sec,m_articulos.descrip_esp,m_articulos.unidad_med,
m_articulos.pto_reorden THRU m_articulos.fech_mod
BEFORE INPUT
LET m_articulos.cod_n = 2
LET m_articulos.cod_grupo = 0
LET m_articulos.cod_tipo = 0
LET m_articulos.bodega = 1
LET m_articulos.dia_llegada=0
LET m_articulos.existencia=0
LET m_articulos.gravamen=0
LET m_articulos.pto_reorden=0
LET m_articulos.unidad_med='UD'
DISPLAY BY NAME m_articulos.cod_n,m_articulos.cod_grupo,m_articulos.cod_tipo,
m_articulos.bodega,m_articulos.dia_llegada,m_articulos.existencia,
m_articulos.gravamen,m_articulos.pto_reorden,m_articulos.unidad_med
## Verifica que el codigo no exista en el catalogo de m_articulos. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD cod_sec
IF ( m_articulos.cod_n = 0 AND m_articulos.cod_grupo = 0 AND
m_articulos.cod_tipo = 0 AND m_articulos.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
SELECT max(num_doc),max(fecha) INTO datos_gen.num_doc,datos_gen.fecha
FROM istb00006 WHERE cod_mov = 99
IF status = notfound THEN
LET datos_gen.num_doc = 0
LET datos_gen.fecha = today
END IF
LET datos_gen.num_doc = datos_gen.num_doc + 1
AFTER FIELD cod_nab
IF m_articulos.cod_nab IS NOT NULL THEN
SELECT * FROM cotb00005 WHERE
cod_nab = m_articulos.cod_nab and
status_t is null
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_nab
END IF
END IF
END IF
AFTER FIELD bodega
IF m_articulos.bodega IS NOT NULL THEN
SELECT * FROM intb00009 WHERE
cod_bodega = m_articulos.bodega
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
END IF
END IF
AFTER FIELD dia_llegada
IF m_articulos.dia_llegada IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD dia_llegada
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
SELECT MAX(a.cod_sec) INTO m_articulos.cod_sec FROM istb00002 a
WHERE a.cod_n = m_articulos.cod_n AND
a.cod_grupo = m_articulos.cod_grupo AND
a.cod_tipo = m_articulos.cod_tipo
IF m_articulos.cod_sec IS NULL THEN
LET m_articulos.cod_sec = 0
END IF
LET m_articulos.cod_sec = m_articulos.cod_sec +1
DISPLAY BY NAME m_articulos.cod_sec
INSERT INTO istb00002 (cod_n,cod_grupo,cod_tipo,cod_Sec,pto_reorden,existencia,cod_nab,base,bodega,
categoria,dia_llegada,gravamen,us_crea,fech_crea,descrip_esp,unidad_med )
VALUES (m_articulos.cod_n,m_articulos.cod_grupo,
m_articulos.cod_tipo,m_articulos.cod_sec,m_articulos.pto_reorden,
m_articulos.existencia,m_articulos.cod_nab,m_articulos.base,
m_articulos.bodega, m_articulos.categoria,
m_articulos.dia_llegada,m_articulos.gravamen,
usuarios,getdate(),m_articulos.descrip_esp,m_articulos.unidad_med)
# Verifica el Status que retorna luego de insertar el registro en la tabla.
# Si el Status es diferente de cero quiere decir que hubo problemas durante
# la creacion del registro, entonces despliega un mensaje de alerta para que
# el usuario sepa que hubo problemas en la creacion del registro.
SELECT * FROM istb00006 WHERE
cod_mov = 99 AND
cod_n = m_articulos.cod_n AND
cod_grupo = m_articulos.cod_grupo AND
cod_tipo = m_articulos.cod_tipo AND
cod_sec = m_articulos.cod_sec
IF status = notfound THEN
INSERT INTO istb00006 (num_doc,fecha,cod_mov,cod_n,cod_grupo,cod_tipo,
cod_sec,cantidad_2,bodega,us_crea,fech_crea)
VALUES (1,datos_gen.fecha,99,m_articulos.cod_n,m_articulos.cod_grupo,
m_articulos.cod_tipo,m_articulos.cod_sec,m_articulos.existencia,
m_articulos.bodega,usuarios,getdate())
END IF
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
END FUNCTION
FUNCTION ispcmf002()
#WHENEVER ERROR CONTINUE
CLEAR FORM
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT BY NAME criterio ON istb00002.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE *,rowid FROM istb00002 WHERE ",
" status_t is null AND ",
criterio clipped,
" ORDER BY 1,2,3,4"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO m_articulos.*,m_rowid
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
END IF
DISPLAY BY NAME m_articulos.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO m_articulos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME m_articulos.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO m_articulos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME m_articulos.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO m_articulos.*
DISPLAY BY NAME m_articulos.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO m_articulos.*
DISPLAY BY NAME m_articulos.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
INPUT BY NAME m_articulos.descrip_esp,m_articulos.unidad_med,m_articulos.pto_reorden THRU
m_articulos.fech_mod WITHOUT DEFAULTS
AFTER FIELD pto_reorden
NEXT FIELD existencia
AFTER FIELD cod_nab
IF m_articulos.cod_nab IS NOT NULL THEN
SELECT * FROM cotb00005 WHERE
cod_nab = m_articulos.cod_nab
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_nab
END IF
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE istb00002 SET descrip_esp = m_articulos.descrip_esp,
unidad_med = m_articulos.unidad_med,
pto_reorden = m_articulos.pto_reorden,
existencia = m_articulos.existencia,
cod_nab = m_articulos.cod_nab,
bodega = m_articulos.bodega,
dia_llegada = m_articulos.dia_llegada,
gravamen = m_articulos.gravamen,
base = m_articulos.base,
categoria = m_articulos.categoria,
us_mod = usuarios,
fech_mod = GETDATE()
WHERE rowid = m_rowid
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("L") "eLiminar"
LET opt = fgl_Winquestion("ELIMINAR","ESTA SEGURO DE ELIMINAR ESTE REGISTRO?","NO","YES|NO","QUESTION",0)
IF opt = "YES" THEN
UPDATE istb00002 SET status_t = "E",
us_mod = usuarios,
fech_mod = getdate()
WHERE cod_n = m_articulos.cod_n AND
cod_grupo = m_articulos.cod_grupo AND
cod_tipo = m_articulos.cod_tipo AND
cod_sec = m_articulos.cod_sec
LET numero_msg = 39
CALL msg(numero_msg)
END IF
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION