jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
jsoto
2026-08-18 20:59:52 -04:00
commit 454973e269
5978 changed files with 2664094 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
PROYECTO/ctdir/ctprmt022.4gl
+367
View File
@@ -0,0 +1,367 @@
{
-------------------------------------------------------------------------------
PROGRAMA : CTPRMT022
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Costos Estandares de los semi-elaborados
PROGRAMADOR : Ing. Juan F. Soto
FECHA REALIZACION : Junio 30, 1994.
-------------------------------------------------------------------------------
}
GLOBALS "ctprgb000.4gl"
DEFINE costos1 RECORD
mes_ini INTEGER,
mes_fin INTEGER,
ano CHAR(4),
cod_prod INTEGER,
costo_st LIKE cttb00026.costo_st,
status_t CHAR(1),
us_crea CHAR(9),
fech_crea LIKE cttb00026.fech_crea,
us_mod CHAR(9),
fech_mod LIKE cttb00026.fech_mod
END RECORD
DEFINE descripcion CHAR(30)
DEFINE unidad_med CHAR(4)
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CONNECT to "smarmotech" USER usuarios USING clave
SELECT a.* INTO p_compania.* FROM companias a
CALL ctprmt022()
END MAIN
FUNCTION ctprmt022()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM infmmt FROM "ctfmmt022"
DISPLAY FORM infmmt
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
CLEAR FORM
LET int_flag = false
CALL ctpcad022()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
LET int_flag = false
CALL ctpcmf022()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ctpcad022()
#WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME costos1.mes_ini THRU costos1.costo_st
## Verifica que el costo exista en el catalogo de costos1. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD mes_ini
IF costos1.mes_ini IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD mes_ini
ELSE
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos1.mes_ini and status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD mes_ini
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME descrip1
END IF
AFTER FIELD mes_fin
IF costos1.mes_fin IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD mes_fin
ELSE
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos1.mes_fin and status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD mes_fin
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME descrip2
END IF
AFTER FIELD ano
IF costos1.ano IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD ano
END IF
AFTER FIELD cod_prod
IF costos1.cod_prod IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_prod
END IF
SELECT UNIQUE b.cod_prod FROM cttb00026 b
WHERE b.mes_ini = costos1.mes_ini AND b.mes_fin = costos1.mes_fin AND
b.ano = costos1.ano AND b.cod_prod = costos1.cod_prod
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD mes_ini
END IF
SELECT a.descripcion,a.unidad_med INTO descripcion,unidad_med
FROM cttb00001 a
WHERE a.cod_prod = costos1.cod_prod AND a.status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_prod
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME descripcion,unidad_med
AFTER FIELD costo_st
IF costos1.costo_st IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_st
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
INSERT INTO cttb00026 VALUES (costos1.mes_ini,costos1.mes_fin,
costos1.ano,costos1.cod_prod,costos1.costo_st,
null,SUSER_SNAME(),GETDATE(),null, null)
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
END FUNCTION
FUNCTION ctpcmf022()
#WHENEVER ERROR CONTINUE
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON c.mes_ini,c.mes_fin,c.ano,c.cod_prod
FROM mes_ini,mes_fin,ano,cod_prod
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = "SELECT UNIQUE c.*,d.descripcion,d.unidad_med ",
"FROM cttb00026 c, cttb00001 d ",
"WHERE c.cod_prod = d.cod_prod AND d.status_t IS NULL AND ",
criterio clipped," ORDER BY 3,1,2,4"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
FETCH FIRST datos INTO costos1.*,descripcion,unidad_med
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos1.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos1.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
DISPLAY BY NAME costos1.*,descripcion,unidad_med
MENU "OPCIONES"
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO costos1.*,descripcion,unidad_med
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos1.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos1.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
DISPLAY BY NAME costos1.*,descripcion,unidad_med
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO costos1.*,descripcion,unidad_med
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos1.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos1.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
DISPLAY BY NAME costos1.*,descripcion,unidad_med
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO costos1.*,descripcion,unidad_med
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos1.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos1.mes_fin and status_t is null
DISPLAY BY NAME descrip2
DISPLAY BY NAME costos1.*,descripcion,unidad_med
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO costos1.*,descripcion,unidad_med
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos1.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos1.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
DISPLAY BY NAME costos1.*,descripcion,unidad_med
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
INPUT BY NAME costos1.costo_st WITHOUT DEFAULTS
AFTER FIELD costo_st
IF costos1.costo_st IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_st
END IF
## Verifica si el usuario presiono la tecla <Supr>
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE cttb00026 SET (costo_st,us_mod,fech_mod) =
(costos1.costo_st,SUSER_SNAME(),GETDATE())
WHERE @cod_prod = costos1.cod_prod
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("L") "eLiminar"
UPDATE cttb00026 SET (status_t,us_mod,fech_mod) =
("E",SUSER_SNAME(),GETDATE())
WHERE @cod_prod = costos1.cod_prod
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION