Files
MBS/PROYECTO/indir/inprmt006.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

633 lines
19 KiB
Plaintext

{
-------------------------------------------------------------------------
PROGRAMA : INPRMT006
OBJETIVO : Programa Captura Documento Movimiento:REPORTE ENTRADA
de Inventario de Materia Prima.
PROGRAMADOR : Juan Fco. Soto (Johnny)
FECHA REALIZACION : Agosto 06,1992.
MODIFICADO POR : Ing. Juan Fco. Soto
FECHA : Agosto 24, 1993.
DESCRIPCION : Agregar el tipo a la busqueda de las ordenes
-------------------------------------------------------------------------
}
GLOBALS
"inprgb000.4gl"
MAIN
DEFER INTERRUPT
SELECT * INTO p_companias.* FROM companias
CALL inprmt006()
END MAIN
FUNCTION inprmt006()
DEFINE fecha CHAR(8)
CLEAR SCREEN
OPTIONS
ERROR LINE 24,
FORM LINE 4,
COMMENT LINE 22,
PROMPT LINE 23
LET fecha = today USING "dd/mm/yy"
DISPLAY p_companias.nombre CLIPPED AT 1,lj ATTRIBUTE (REVERSE,YELLOW)
DISPLAY fecha AT 1,70 ATTRIBUTE (YELLOW)
DISPLAY "Reporte De Entrada" AT 2,31
DISPLAY "<Esc> Adiciona Registro" AT 3,2 ATTRIBUTE (YELLOW,REVERSE)
DISPLAY "<Ctrl-C> Cancela Operacion" AT 3,54 ATTRIBUTE (YELLOW,REVERSE)
DISPLAY "inprmt006" AT 1,3 ATTRIBUTE (YELLOW)
OPEN FORM infmmt006 FROM "infmmt006"
DISPLAY FORM infmmt006
# Se prepara las instruccion para la actualizacion de la maestra de
# inventario materia prima
LET actual = "UPDATE intb00002 SET existencia = existencia + ? ",
"WHERE cod_n = ? and cod_grupo = ? and cod_tipo = ? and ",
" cod_sec = ? "
CALL inpcad006()
END FUNCTION
FUNCTION inpcad006()
DEFINE cerrada CHAR(1) # Variable para actualizar el cierre de una orden
DEFINE total_cantidad,porciento,recibida,ordenada,r_cantidad1,r_cantidad
DECIMAL(12,3)
WHENEVER ERROR CONTINUE
LET int_flag = FALSE
INITIALIZE datos_gen.* TO NULL
PREPARE actualiza FROM actual
LET datos_gen.fecha = today using "dd/mm/yy"
LABEL otra_vez:
LABEL vuelve:
IF (OPC = "S" OR OPC = "s") OR opc is null THEN
INITIALIZE datos_gen.* TO NULL
END IF
LET datos_gen.cod_mov = cod_mov_ant
LET cerrada = "N"
LET total_cantidad = 0
# Captura de informacion del reporte de entrada
INPUT BY NAME datos_gen.cod_mov THRU datos_gen.bodega WITHOUT DEFAULTS
# Control de la fecha del documento para que el usuario no pueda introducir
# un documento con fecha atrasada
AFTER FIELD fecha
LET p_fechas = datos_gen.fecha
CALL prd(p_fechas)
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fecha
END IF
AFTER FIELD bodega
SELECT *FROM intb00009 WHERE cod_bodega = datos_gen.bodega
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
BEFORE FIELD num_doc
LET datos_gen.bodega = 1
DISPLAY BY NAME datos_gen.bodega
LET datos_gen.fecha = today
DISPLAY BY NAME datos_gen.fecha
# Chequea que el codigo del movimiento exista en la tabla
AFTER FIELD cod_mov
LET cod_mov_ant = datos_gen.cod_mov
IF datos_gen.cod_mov IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_mov
ELSE
SELECT descrip_mov INTO datos_gen.descrip_mov FROM intb00005
WHERE cod_mov = datos_gen.cod_mov and
status_t is null
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
END IF
DISPLAY BY NAME datos_gen.descrip_mov
# Verifica que el numero del documente de entrada no este en el archivo de
# movimientos.
AFTER FIELD num_doc
IF datos_gen.num_doc IS NULL then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
ELSE
SELECT UNIQUE cod_sp,cod_sp_sec,tipo,orden_compra,conduce_no,fact_no,fecha
INTO datos_gen.cod_sp,datos_gen.cod_sp_sec,datos_gen.tipo,
datos_gen.orden_compra,datos_gen.conduce_no,datos_gen.fact_no,
datos_gen.fecha FROM intb00006
WHERE tipo = datos_gen.tipo and num_doc = datos_gen.num_doc and
cod_mov = datos_gen.cod_mov and status_t is null
IF status >= 0 THEN
IF STATUS != NOTFOUND THEN
SELECT UNIQUE nom_sp INTO datos_gen.nom_sp FROM cotb00001
WHERE cod_sp=datos_gen.cod_sp AND cod_sp_sec=datos_gen.cod_sp_sec
LET numero_msg = 12
CALL msg(numero_msg)
DISPLAY BY NAME datos_gen.cod_sp,datos_gen.cod_sp_sec,
datos_gen.tipo,datos_gen.orden_compra,
datos_gen.conduce_no,datos_gen.fact_no,datos_gen.fecha,
datos_gen.nom_sp
NEXT FIELD num_doc
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
IF OPC = "S" OR OPC = "s" or opc is null THEN
INITIALIZE
datos_gen.cod_sp,datos_gen.cod_sp_sec,
datos_gen.tipo,datos_gen.orden_compra,
datos_gen.conduce_no,datos_gen.fact_no,
datos_gen.nom_sp
TO NULL
DISPLAY BY NAME datos_gen.cod_sp,datos_gen.cod_sp_sec,
datos_gen.tipo,datos_gen.orden_compra,
datos_gen.conduce_no,datos_gen.fact_no,
datos_gen.nom_sp
END IF
END IF
AFTER FIELD orden_compra
# Verifica que la orden de compra este en el archivo y
# ademas obliga a que el usuario tenga que digitar este campo
IF datos_gen.orden_compra IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD orden_compra
ELSE
SELECT cod_sp,cod_sp_sec,cierre INTO datos_gen.cod_sp,datos_gen.cod_sp_sec,
cerrada
FROM cotb00014 WHERE tipo = datos_gen.tipo AND
num_oc = datos_gen.orden_compra AND
status_t is null
IF status >= 0 THEN
IF cerrada = "S" THEN
LET numero_msg = 74
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
SELECT UNIQUE nom_sp INTO datos_gen.nom_sp FROM cotb00001 WHERE
cod_sp = datos_gen.cod_sp and
cod_sp_sec = datos_gen.cod_sp_sec and
status_t is null
DISPLAY BY NAME datos_gen.nom_sp,datos_gen.cod_sp,datos_gen.cod_sp_sec
END IF
IF cerrada is null THEN
LET cerrada = "N"
END IF
AFTER FIELD fact_no
# Verifica que el numero de la factura no se repita con el mismo numero de
# documento.
IF datos_gen.conduce_no is null AND datos_gen.fact_no is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD conduce_no
END IF
IF datos_gen.conduce_no is not null AND datos_gen.fact_no is not null THEN
LET numero_msg = 29
CALL msg(numero_msg)
NEXT FIELD conduce_no
END IF
# Chequea que el numero de factura no se repita con el numero de la orden,
# y el codigo del movimientos
IF datos_gen.fact_no IS NOT NULL THEN
SELECT UNIQUE num_doc FROM intb00006 WHERE num_doc = datos_gen.num_doc and
tipo = datos_gen.tipo and
orden_compra = datos_gen.orden_compra and
fact_no = datos_gen.fact_no and
cod_mov = datos_gen.cod_mov and
status_t is null
IF status >= 0 THEN
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
# Valida en nulo las variables del arreglo para desplegar
FOR idx = 1 to arr_count()
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_1 = null
LET movi[idx].cantidad_2 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
END FOR
SLEEP 2
RETURN
END IF
IF datos_gen.num_doc IS NULL then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
ELSE
# Chequea que el numero del documento exista en el archivo de transacciones
# Cuando el usuario presione <Esc>
SELECT UNIQUE num_doc FROM intb00006 WHERE num_doc = datos_gen.num_doc and
cod_mov = datos_gen.cod_mov and
status_t is null
IF status >= 0 THEN
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
END IF
SELECT UNIQUE * FROM intb00006 WHERE num_doc = datos_gen.num_doc and
tipo = datos_gen.tipo and
orden_compra = datos_gen.orden_compra and
fact_no = datos_gen.fact_no and
cod_mov = datos_gen.cod_mov and
status_t is null
IF status >= 0 THEN
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
# Chequea que el conduce y la factura no este en blanco
IF datos_gen.conduce_no is null AND datos_gen.fact_no is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD conduce_no
END IF
EXIT INPUT
END INPUT
INITIALIZE ant_art.* TO NULL
IF opc = "S" or opc = "s" OR opc IS NULL THEN
FOR idx = 1 to arr_count()
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_2 = null
LET movi[idx].cantidad_1 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
END FOR
END IF
# Si las informaciones estan correctas cuando se digite el proximo documento
# busca la orden especificada
IF opc = "S" or opc = "s" or opc is null THEN
DECLARE materiales CURSOR FOR
SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.cantidad,a.cantidad,
b.unidad_med,b.descrip_esp
FROM cotb00015 a,intb00001 b
WHERE a.tipo = datos_gen.tipo and
a.num_oc = datos_gen.orden_compra and
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
LET idx = 1
FOREACH materiales INTO movi[idx].*
LET movi[idx].cantidad_2 = null
LET idx = idx + 1
END FOREACH
# CAPTURA ARREGLO DE LOS CODIGOS DE MATERIA PRIMA
CALL set_count(idx - 1)
END IF
INPUT ARRAY movi WITHOUT DEFAULTS FROM s_movi1.*
BEFORE ROW
LET p_act = arr_curr()
LET scr_l = scr_line()
AFTER FIELD cantidad_2
# Verifica que la cantidad recibida mas las que se han recibida de
# la orden no exceda de un 10% de la cantidad total de la orden
IF movi[p_act].cantidad_2 IS NOT NULL THEN
SELECT sum(cantidad_2) INTO recibida FROM intb00006
WHERE orden_compra = datos_gen.orden_compra and
tipo = datos_gen.tipo and cod_n = movi[p_act].cod_n and
cod_grupo=movi[p_act].cod_grupo and cod_tipo=movi[p_act].cod_tipo
and cod_sec = movi[p_act].cod_sec and status_t is null
SELECT cantidad INTO ordenada FROM cotb00015
WHERE num_oc = datos_gen.orden_compra and
tipo = datos_gen.tipo and cod_n = movi[p_act].cod_n and
cod_grupo=movi[p_act].cod_grupo and cod_tipo=movi[p_act].cod_tipo
and cod_sec = movi[p_act].cod_sec and status_t is null
IF recibida is null THEN
LET recibida = 0
END IF
IF ordenada is null THEN
LET ordenada = 0
END IF
LET porciento = ordenada * 0.10
LET recibida = recibida + movi[p_act].cantidad_2
LET r_cantidad = ordenada + porciento
IF recibida > r_cantidad THEN
LET numero_msg = 28
CALL msg(numero_msg)
NEXT FIELD cantidad_2
END IF
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
FOR idx = 1 to arr_count()
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_1 = null
LET movi[idx].cantidad_2 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
END FOR
SLEEP 2
RETURN
END IF
# Verifica que la cantidad recibida mas las que se han recibida de
# la orden no exceda de un 10% de la cantidad total de la orden
IF movi[p_act].cantidad_2 IS NOT NULL THEN
IF movi[p_act].cantidad_1 != movi[p_act].cantidad_2 THEN
SELECT sum(cantidad_2) INTO recibida FROM intb00006
WHERE orden_compra = datos_gen.orden_compra and
tipo = datos_gen.tipo and
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec and
status_t is null
SELECT cantidad INTO ordenada FROM cotb00015
WHERE num_oc = datos_gen.orden_compra and
tipo = datos_gen.tipo and
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec and
status_t is null
IF recibida is null THEN
LET recibida = 0
END IF
IF ordenada is null THEN
LET ordenada = 0
END IF
LET porciento = ordenada * 0.10
LET recibida = recibida + movi[p_act].cantidad_2
LET r_cantidad = ordenada + porciento
IF recibida > r_cantidad THEN
LET numero_msg = 28
CALL msg(numero_msg)
END IF
END IF
END IF
FOR idx = 1 to arr_count()
IF movi[idx].cantidad_2 is not null THEN
LET total_cantidad = movi[idx].cantidad_2 + total_cantidad
END IF
END FOR
EXIT INPUT
END INPUT
IF datos_gen.cod_mov = 34 THEN
INPUT BY NAME ultimo.*
ELSE
INITIALIZE ultimo.* TO NULL
DISPLAY BY NAME ultimo.*
END IF
PROMPT "Toda la Informacion Esta Correcta? (S/N)" FOR CHAR opc
IF OPC = "S" or OPC = "s" THEN
# Busca la cantidad recibida de la orden especificada
SELECT sum(cantidad_2) INTO recibida FROM intb00006
WHERE orden_compra = datos_gen.orden_compra and
tipo = datos_gen.tipo and
status_t is null
# Busca la cantidad ordenada de la orden especificada
SELECT sum(cantidad) INTO ordenada FROM cotb00015
WHERE num_oc = datos_gen.orden_compra and
tipo = datos_gen.tipo and
status_t is null
IF recibida is null THEN
LET recibida = 0
END IF
IF ordenada is null THEN
LET ordenada = 0
END IF
# Calculo de los porcentaje limites de las ordenes
LET porciento = ordenada * 0.10
LET recibida = recibida + total_cantidad
LET r_cantidad = ordenada - porciento
LET r_cantidad1 = ordenada + porciento
# Si la cantiad recibida producto de la sumatoria y subtracion del 10%
# es mayor o igual a la cantidad recibida y menor o igual a la cantidad de
# la orden cierra la orden
IF recibida >= r_cantidad and recibida <= r_cantidad1 THEN
LET cerrada = "S"
END IF
FOR idx = 1 TO arr_count()
IF movi[idx].cantidad_2 is not null THEN
INSERT INTO intb00006 VALUES
(datos_gen.num_doc,datos_gen.fecha,datos_gen.fact_no,
datos_gen.conduce_no,datos_gen.orden_compra,datos_gen.tipo,
datos_gen.cod_sp,
datos_gen.cod_sp_sec,datos_gen.cod_mov,movi[idx].cod_n,
movi[idx].cod_grupo,
movi[idx].cod_tipo,movi[idx].cod_sec,movi[idx].cantidad_1,
movi[idx].cantidad_2,null,null,null,
ultimo.cond_recep,ultimo.uso_tiempo,datos_gen.bodega,
null,suser_sname(),getdate(),null,null)
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
# Actualiza la existencia en la maestra de la materia prima
EXECUTE actualiza USING movi[idx].cantidad_2,
movi[idx].cod_n,movi[idx].cod_grupo,
movi[idx].cod_tipo,movi[idx].cod_sec
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
END FOR
# Actualiza la tabla de ordenes para cerrarla si la variable cerrada = "S"
IF cerrada = "S" THEN
UPDATE cotb00014 set cierre = cerrada
WHERE num_oc = datos_gen.orden_compra and
tipo = datos_gen.tipo
END IF
FOR idx = 1 to arr_count()
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_1 = null
LET movi[idx].cantidad_2 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
DISPLAY movi[idx].cod_n to s_movi1[idx].cod_n
DISPLAY movi[idx].cod_grupo to s_movi1[idx].cod_grupo
DISPLAY movi[idx].cod_tipo to s_movi1[idx].cod_tipo
DISPLAY movi[idx].cod_sec to s_movi1[idx].cod_sec
DISPLAY movi[idx].descrip_esp to s_movi1[idx].descrip_esp
DISPLAY movi[idx].unidad_med to s_movi1[idx].unidad_med
END FOR
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
ELSE
GOTO otra_vez
END IF
GOTO vuelve
END FUNCTION