jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
f140ab917ed832448c01688ea2fa07e90daeb55b
MBS/PROYECTO/indir/inprmt013.4gl
T
jpeguero efdf8953dd Reorganiza MATERIA PRIMA a PROYECTO y avanza inprmt002/005/013/046 
- Mueve todo el contenido de PROYECTOS/indir y varias funciones
  compartidas de PROYECTOS/otrodir hacia PROYECTO, siguiendo
  instruccion de Johnny (PROYECTOS se va a eliminar).
- inprmt002: agrega campo Desglose faltante, corrige typo "eLiminar".
- inprmt005: agrega formulario y 3 campos faltantes (Consumo,
  Requiere Autorizacion, Requisiciones), corrige typo "eLiminar".
- inprmt013: agrega formulario, titulo, corrige typo "eLiminar".
- inprmt046: agrega formulario y varias funciones/dependencias
  faltantes (cincodmov, clasf_bloque, medidas, defecto,
  buscaEmp, consultaTransportista, busca_departamento);
  corrige nombres de campo desalineados con el codigo
  (depto_a, bodega) y los convierte a ComboBox donde el
  codigo lo requiere.
- Corrige dependencia faltante de FORMULARIOS_IN a la libreria
  Database (bloqueaba todo el modulo de MATERIA PRIMA).
2026-08-26 13:31:09 -04:00

480 lines
18 KiB
Plaintext
Raw Blame History

{
-------------------------------------------------------------------------------
PROGRAMA : INPRMT013
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Costos Standards
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Octubre 08, 1992
-------------------------------------------------------------------------------
}
GLOBALS "inprgb000.4gl"
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT to "smarmotech" USER usuarios USING clave
SELECT * INTO p_companias.* FROM companias
CALL inprmt013()
END MAIN
FUNCTION inprmt013()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM infmmt013 FROM "infmmt013"
DISPLAY FORM infmmt013
CALL pantalla()
DISPLAY "inprmt013" AT 4,3
DISPLAY "Costo Standard" AT 6,33
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Ctrl-C> Cancela Operacion"
CLEAR FORM
LET int_flag = false
CALL inpcad013()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Ctrl-C> Cancela Operacion"
LET int_flag = false
CALL inpcmf013()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION inpcad013()
#WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME costos.mes_ini THRU costos.costo_st
## Verifica que el costo exista en el catalogo de costos. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD mes_ini
IF costos.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 = costos.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 costos.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 = costos.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 costos.ano IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD ano
END IF
AFTER FIELD cod_sec
SELECT mes_ini,mes_fin,ano,cod_n,cod_grupo,cod_tipo,cod_sec
FROM intb00013
WHERE mes_ini = costos.mes_ini AND
mes_fin = costos.mes_fin AND
ano = costos.ano AND
cod_n = costos.cod_n AND
cod_grupo = costos.cod_grupo AND
cod_tipo = costos.cod_tipo AND
cod_sec = costos.cod_sec
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD mes_ini
END IF
IF ( costos.cod_n = 0 AND costos.cod_grupo = 0 AND
costos.cod_tipo = 0 AND costos.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = costos.cod_n AND
b.cod_grupo = costos.cod_grupo AND
b.cod_tipo = costos.cod_tipo AND
b.cod_sec = costos.cod_sec 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_n
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME articulos.descrip_esp,articulos.unidad_med
END IF
AFTER FIELD costo_st
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
IF costos.costo_st IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_st
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF costos.costo_st IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_st
ELSE
INSERT INTO intb00013 VALUES (costos.mes_ini,costos.mes_fin,
costos.ano,costos.cod_n,costos.cod_grupo,
costos.cod_tipo,costos.cod_sec,costos.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
LET costos.mes_ini = NULL
LET costos.mes_fin = NULL
LET costos.ano = NULL
LET costos.cod_n = NULL
LET costos.cod_grupo = NULL
LET costos.cod_tipo = NULL
LET costos.cod_sec = NULL
LET costos.costo_st = NULL
NEXT FIELD mes_ini
END IF
END INPUT
END FUNCTION
FUNCTION inpcmf013()
#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_n,c.cod_grupo,
c.cod_tipo,c.cod_sec,c.costo_st
FROM mes_ini,mes_fin,ano,
cod_n,cod_grupo,
cod_tipo,cod_sec,costo_st
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = "SELECT UNIQUE c.mes_ini,c.mes_fin,c.ano, ",
" d.cod_n,d.cod_grupo,d.cod_tipo, ",
" d.cod_sec,c.costo_st,c.us_crea,",
"c.fech_crea, ",
" c.us_mod,c.fech_mod ",
" FROM intb00013 c, intb00001 d where ",
"c.cod_n = d.cod_n and ",
"c.cod_grupo = d.cod_grupo and ",
"c.cod_tipo = d.cod_tipo and ",
"c.cod_sec = d.cod_sec and ",
"c.status_t is null and ",
criterio clipped,
" ORDER BY 4,5,6,7"
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 costos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = costos.cod_n AND
b.cod_grupo = costos.cod_grupo AND
b.cod_tipo = costos.cod_tipo AND
b.cod_sec = costos.cod_sec
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
MENU "OPCIONES"
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO costos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = costos.cod_n AND
b.cod_grupo = costos.cod_grupo AND
b.cod_tipo = costos.cod_tipo AND
b.cod_sec = costos.cod_sec
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO costos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = costos.cod_n AND
b.cod_grupo = costos.cod_grupo AND
b.cod_tipo = costos.cod_tipo AND
b.cod_sec = costos.cod_sec
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO costos.*
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
a.cod_n = costos.cod_n AND
a.cod_grupo = costos.cod_grupo AND
a.cod_tipo = costos.cod_tipo AND
a.cod_sec = costos.cod_sec
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO costos.*
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = costos.cod_n AND
b.cod_grupo = costos.cod_grupo AND
b.cod_tipo = costos.cod_tipo AND
b.cod_sec = costos.cod_sec
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
INPUT BY NAME costos.costo_st,
costos.us_crea,
costos.fech_crea,
costos.us_mod,
costos.fech_mod WITHOUT DEFAULTS
AFTER FIELD costo_st
IF costos.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 <Ctrl-C>
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE intb00013 SET costo_st = costos.costo_st,
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE cod_n = costos.cod_n and
cod_grupo = costos.cod_grupo and
cod_tipo = costos.cod_tipo and
cod_sec = costos.cod_sec and
ano = costos.ano and
mes_ini = costos.mes_ini and
mes_fin = costos.mes_fin
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "Eliminar"
UPDATE intb00013 SET status_t = "E"
WHERE cod_n = costos.cod_n and
cod_grupo = costos.cod_grupo and
cod_tipo = costos.cod_tipo and
cod_sec = costos.cod_sec and
ano = costos.ano and
mes_ini = costos.mes_ini and
mes_fin = costos.mes_fin
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
Reference in New Issue View Git Blame Copy Permalink