jsoto/MBS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
f140ab917ed832448c01688ea2fa07e90daeb55b
MBS/PROYECTO/indir/inprcs007.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

656 lines
19 KiB
Plaintext
Raw Blame History

{
-------------------------------------------------------------------------------
PROGRAMA : INPRCS007
OBJETIVO : CONSULTA DIAS DE PRODUCCION
PROGRAMADOR : Ing. Juan Francisco Soto
FECHA REALIZACION : Octubre 29, 1992.
-------------------------------------------------------------------------------
}
DATABASE smarmotech
GLOBALS "inprgb000.4gl"
DEFINE encontre_mov,retorna,salir,encontre,primera,
p_desplega,situacion CHAR(1)
DEFINE dias1,idx_b,idx_c,idx_o,
idx_f SMALLINT
DEFINE dia_orden,dias2,doc_ant INTEGER
DEFINE dia_orden1,dias DECIMAL(8,2)
DEFINE t_pendiente,pendiente,t_recibe,t_remanente,remanente,cantidad,
existencia,consumo
DECIMAL (12,2)
DEFINE selec6,select_con,select_bal ,
selec10 CHAR(1000)
DEFINE arr_pend ARRAY [30] OF RECORD
num_doc INTEGER,
ordenada CHAR(14),
recibida CHAR(14),
cantidad CHAR(14),
fecha_llegada DATE
END RECORD
DEFINE fechas_pend1 RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
num_oc INTEGER,
cantidad DECIMAL (10,2),
fecha DATE
END RECORD
DEFINE fechas_pend RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
num_oc INTEGER,
cantidad DECIMAL (10,2),
fech_ent DATE
END RECORD
DEFINE p_materiales RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descrip_esp CHAR(30),
unidad_med CHAR(3),
dia_llegada LIKE intb00002.dia_llegada
END RECORD
DEFINE consumos RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
balances LIKE intb00006.cantidad_2
END RECORD
DEFINE cant_movi RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
num_oc INTEGER,
existe1 DECIMAL (12,2),
fecha1 DATE
END RECORD
DEFINE balances RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
existe1 DECIMAL (12,2)
END RECORD
DEFINE estadis RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
existe1 CHAR(14),
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
dia_llegada LIKE intb00002.dia_llegada,
consumo1 CHAR(13),
dias_orden CHAR(4)
END RECORD
DEFINE datos_cons1 RECORD
fech_in DATE,
fech_fi DATE
END RECORD
MAIN
DEFER INTERRUPT
SELECT * INTO p_companias.* FROM companias
CALL inprcs007()
END MAIN
FUNCTION inprcs007()
#WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 6,
ERROR LINE 23,
COMMENT LINE 22
DISPLAY " "
AT 23,1
OPEN WINDOW fechas AT 13,6 WITH FORM "infmcs017" ATTRIBUTE (BORDER,FORM LINE
FIRST + 1,
MESSAGE LINE LAST)
INPUT BY NAME datos_cons1.fech_in,datos_cons1.fech_fi
AFTER FIELD fech_in
IF datos_cons1.fech_in IS NULL THEN
Select min(fecha) INTO datos_cons1.fech_in FROM intb00006
WHERE cod_mov = 99
DISPLAY BY NAME datos_cons1.fech_in
END IF
AFTER FIELD fech_fi
IF datos_cons1.fech_fi IS NULL THEN
LET datos_cons1.fech_fi = today
DISPLAY BY NAME datos_cons1.fech_fi
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
IF datos_cons1.fech_in IS NOT NULL AND datos_cons1.fech_fi IS NULL THEN
LET numero_msg = 64
CALL msg(numero_msg)
NEXT FIELD fech_in
END IF
IF datos_cons1.fech_in IS NULL AND datos_cons1.fech_fi IS NOT NULL THEN
LET numero_msg = 64
CALL msg(numero_msg)
NEXT FIELD fech_in
END IF
LET dias1 = datos_cons1.fech_fi - datos_cons1.fech_in
LET dias1 = dias1 + 1
DISPLAY BY NAME dias1
EXIT INPUT
END INPUT
MESSAGE " Espere Por Favor" ATTRIBUTE (BOLD)
# Query Para Cantidades Llegadas por Movimientos
LET selec6 =
"SELECT cod_n,cod_grupo,cod_tipo,cod_sec,orden_compra,sum(cantidad_2) ",
"FROM intb00006 ",
"WHERE status_t is null AND orden_compra is not null ",
"GROUP BY cod_n,cod_grupo,cod_tipo,cod_sec,orden_compra ",
"ORDER BY cod_n,cod_grupo,cod_tipo,cod_sec,orden_compra "
PREPARE busca_movi FROM selec6
DECLARE movi_orden SCROLL CURSOR FOR busca_movi
OPEN movi_orden
# Query Para Las Fechas de Entregas
LET selec10 =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.num_oc, ",
" sum(a.cantidad),a.fech_ent ",
"FROM cotb00025 a,cotb00014 b ",
"WHERE a.tipo = b.tipo and a.num_oc = b.num_oc and b.cierre = 'N' and ",
" a.status_t is null GROUP BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.num_oc, ",
" a.fech_ent ORDER BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec"
PREPARE busca_fechas FROM selec10
DECLARE fechas SCROLL CURSOR FOR busca_fechas
OPEN fechas
# Query Para el consumo de cada material
LET select_con =
"SELECT b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec,sum(cantidad_2) ",
"FROM intb00006 b ",
"WHERE b.status_t is null and b.cod_mov = 36 AND b.fecha between ? and ? ",
"GROUP BY b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec ORDER BY b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec "
PREPARE busca_cons FROM select_con
DECLARE material_consu SCROLL CURSOR FOR busca_cons
OPEN material_consu USING datos_cons1.fech_in,datos_cons1.fech_fi
# Query Para El Balance de Cada Material
LET select_bal =
"SELECT b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec,sum(b.cantidad_2) ",
"FROM intb00006 b ",
"WHERE b.status_t is null and b.fecha <= ? GROUP BY b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec ORDER BY b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec"
PREPARE busca_balan FROM select_bal
DECLARE material_balan SCROLL CURSOR FOR busca_balan
OPEN material_balan using datos_cons1.fech_fi
CLOSE WINDOW fechas
CLEAR SCREEN
LET retorna = null
OPEN FORM infmcs007 FROM "infmcs007"
DISPLAY FORM infmcs007
DISPLAY "inprcs007" AT 3,3
LET lj = (80 - LENGTH(p_companias.nombre CLIPPED))/2
DISPLAY p_companias.nombre CLIPPED AT 3,lj
ATTRIBUTE (REVERSE,BOLD)
DISPLAY "Dias de Inventarios" AT 4,30 ATTRIBUTE (BOLD)
LABEL vuelve:
DISPLAY BY NAME datos_cons1.* ATTRIBUTE (YELLOW)
CONSTRUCT criterio ON b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec
FROM cod_n,cod_grupo,cod_tipo,cod_sec
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
# Query de los materiales con su descripcion y datos generales
LET selec =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp,",
" a.unidad_med,b.dia_llegada ",
"FROM intb00001 a,intb00002 b ",
"WHERE ",criterio clipped," 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 and b.status_t is null ORDER BY 1,2,3,4 "
PREPARE busca_mat FROM selec
DECLARE material SCROLL CURSOR FOR busca_mat
OPEN material
LET idx_b = 1
LET idx_c = 1
LET idx = 1
LET consumo = 0
LET dias = 0
FETCH FIRST material INTO p_materiales.*
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
GOTO vuelve
END IF
LET estadis.descrip_esp = p_materiales.descrip_esp
LET estadis.unidad_med = p_materiales.unidad_med
LET estadis.cod_n = p_materiales.cod_n
LET estadis.cod_grupo = p_materiales.cod_grupo
LET estadis.cod_tipo = p_materiales.cod_tipo
LET estadis.cod_sec = p_materiales.cod_sec
LET estadis.dia_llegada = p_materiales.dia_llegada
CALL busqueda()
MENU "OPCION"
COMMAND "Siguiente"
"Para Ver Siguiente Registro Cumple Condicion o Presione < O > Para Ver Ordenes"
LET idx_b = 1
LET idx_c = 1
LET idx = 1
FETCH NEXT material INTO p_materiales.*
IF status = notfound THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
IF status < 0 THEN
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
LET estadis.descrip_esp = p_materiales.descrip_esp
LET estadis.unidad_med = p_materiales.unidad_med
LET estadis.cod_n = p_materiales.cod_n
LET estadis.cod_grupo = p_materiales.cod_grupo
LET estadis.cod_tipo = p_materiales.cod_tipo
LET estadis.cod_sec = p_materiales.cod_sec
LET estadis.dia_llegada = p_materiales.dia_llegada
CALL busqueda()
COMMAND "Anterior"
"Para Ver Anterior Registro Cumple Condicion o Presione < O > Para Ver Ordenes"
LET idx_b = 1
LET idx_c = 1
LET idx = 1
FETCH PREVIOUS material INTO p_materiales.*
IF status = notfound THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
IF status < 0 THEN
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
LET estadis.descrip_esp = p_materiales.descrip_esp
LET estadis.unidad_med = p_materiales.unidad_med
LET estadis.cod_n = p_materiales.cod_n
LET estadis.cod_grupo = p_materiales.cod_grupo
LET estadis.cod_tipo = p_materiales.cod_tipo
LET estadis.cod_sec = p_materiales.cod_sec
LET estadis.dia_llegada = p_materiales.dia_llegada
CALL busqueda()
COMMAND "Primero"
"Para Ver Primero Registro Cumple Condicion o Presione < O > Para Ver Ordenes"
LET idx_b = 1
LET idx_c = 1
LET idx = 1
FETCH FIRST material INTO p_materiales.*
IF status = notfound THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
IF status < 0 THEN
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
LET estadis.descrip_esp = p_materiales.descrip_esp
LET estadis.unidad_med = p_materiales.unidad_med
LET estadis.cod_n = p_materiales.cod_n
LET estadis.cod_grupo = p_materiales.cod_grupo
LET estadis.cod_tipo = p_materiales.cod_tipo
LET estadis.cod_sec = p_materiales.cod_sec
LET estadis.dia_llegada = p_materiales.dia_llegada
CALL busqueda()
COMMAND "Ultimo"
"Para Ver Ultimo Registro Cumple Condicion o Presione < O > Para Ver Ordenes"
LET idx_b = 1
LET idx_c = 1
LET idx = 1
FETCH LAST material INTO p_materiales.*
IF status = notfound THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
IF status < 0 THEN
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
LET estadis.descrip_esp = p_materiales.descrip_esp
LET estadis.unidad_med = p_materiales.unidad_med
LET estadis.cod_n = p_materiales.cod_n
LET estadis.cod_grupo = p_materiales.cod_grupo
LET estadis.cod_tipo = p_materiales.cod_tipo
LET estadis.cod_sec = p_materiales.cod_sec
LET estadis.dia_llegada = p_materiales.dia_llegada
CALL busqueda()
COMMAND "Ordenes"
DISPLAY "Buscando Informacion... Espere Por Favor" AT 23,1
ATTRIBUTE (BOLD)
LET p_desplega = "S"
CALL busca_orden()
COMMAND "Retornar"
LET retorna = "S"
EXIT MENU
END MENU
CLEAR FORM
GOTO vuelve
END FUNCTION
FUNCTION busqueda()
DISPLAY " " AT 23,1 ATTRIBUTE (BOLD)
LET primera = "S"
LET salir = "N"
LET estadis.existe1 = 0 using "---,---,---.##"
LET existencia = 0
LET estadis.dias_orden = 0 using "&&&"
LET t_pendiente = 0
LET pendiente = 0
LET t_recibe = 0
# Busqueda de la existencia de la materia prima
WHILE salir != "S"
FETCH ABSOLUTE idx_b material_balan INTO balances.*
IF status = notfound THEN
LET idx_b = 1
LET salir = "S"
EXIT WHILE
END IF
IF status < 0 THEN
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
LET idx_b = idx_b + 1
IF balances.cod_n = estadis.cod_n AND
balances.cod_grupo = estadis.cod_grupo AND
balances.cod_tipo = estadis.cod_tipo AND
balances.cod_sec = estadis.cod_sec THEN
LET estadis.existe1 = balances.existe1 using "---,---,---.##"
LET existencia = balances.existe1
LET salir = "S"
END IF
IF salir = "S" THEN
LET idx_b = 1
EXIT WHILE
END IF
END WHILE
# Buscando Consumo de material
LET salir = "N"
LET estadis.consumo1 = 0 using "---,---,---.##"
LET consumo = 0
WHILE salir != "S"
FETCH ABSOLUTE idx_c material_consu INTO consumos.*
IF status = notfound THEN
LET idx_c = 1
LET salir = "S"
EXIT WHILE
END IF
IF status < 0 THEN
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
LET idx_c = idx_c + 1
IF consumos.cod_n = estadis.cod_n AND
consumos.cod_grupo = estadis.cod_grupo AND
consumos.cod_tipo = estadis.cod_tipo AND
consumos.cod_sec = estadis.cod_sec THEN
LET salir = "S"
LET idx_c = 1
LET consumo = consumos.balances
LET estadis.consumo1 = consumo using "##,###,###.##"
EXIT WHILE
END IF
END WHILE
# Calculo Para los dias de produccion sin orden
LET consumo = consumo * -1
IF consumo > 0 THEN
LET dias = (existencia / consumo)
ELSE
LET dias = 0
END IF
LET dias = dias * dias1
LET dias = dias using "######"
LET dias2 = dias using "######"
DISPLAY BY NAME estadis.*,dias2 ATTRIBUTE (YELLOW)
END FUNCTION
FUNCTION busca_orden()
LET cantidad = 0
LET encontre = "N"
LET idx = 1
LET idx_o = 1
LET primera = "N"
LET remanente = 0
LET t_remanente = 0
LET doc_ant = 0
LET encontre_mov = "N"
LET situacion = "N"
LET t_recibe = 0
# Loop Para Buscar Las Fechas de Entrega de cada Orden Por Material
LET idx_f = 1
LET salir = "N"
WHILE salir != "S"
FETCH ABSOLUTE idx_f fechas INTO fechas_pend.*
IF STATUS = NOTFOUND THEN
LET idx_f = 1
EXIT WHILE
END IF
LET idx_f = idx_f + 1
LET remanente = 0
LET encontre_mov = "N"
IF estadis.cod_n = fechas_pend.cod_n AND
estadis.cod_grupo = fechas_pend.cod_grupo AND
estadis.cod_tipo = fechas_pend.cod_tipo AND
estadis.cod_sec = fechas_pend.cod_sec THEN
IF fechas_pend.num_oc != doc_ant THEN
LET doc_ant = fechas_pend.num_oc
LET encontre = "N"
END IF
LET cantidad = fechas_pend.cantidad + cantidad
LET arr_pend[idx].num_doc = fechas_pend.num_oc
LET arr_pend[idx].ordenada = fechas_pend.cantidad
using "##,###,###.##"
LET arr_pend[idx].recibida = null
LET arr_pend[idx].cantidad = cantidad using "---,---,---.##"
LET arr_pend[idx].fecha_llegada = fechas_pend.fech_ent
LET idx = idx + 1
LET t_recibe = 0
LET salir = "N"
WHILE salir != "S"
FETCH ABSOLUTE idx_o movi_orden INTO cant_movi.*
IF status = notfound THEN
LET idx_o = 1
EXIT WHILE
END IF
LET idx_o = idx_o + 1
IF cant_movi.cod_n = fechas_pend.cod_n AND
cant_movi.cod_grupo = fechas_pend.cod_grupo AND
cant_movi.cod_tipo = fechas_pend.cod_tipo AND
cant_movi.cod_sec = fechas_pend.cod_sec AND
encontre = "N" AND
cant_movi.num_oc = fechas_pend.num_oc THEN
LET remanente = cantidad - cant_movi.existe1
LET t_recibe = cant_movi.existe1
LET encontre = "S"
LET doc_ant = fechas_pend.num_oc
LET arr_pend[idx].num_doc = cant_movi.num_oc
LET arr_pend[idx].ordenada= 0 #encontre
LET arr_pend[idx].recibida= t_recibe using "##,###,###.##"
LET arr_pend[idx].cantidad= remanente using "---,---,---.##"
LET arr_pend[idx].fecha_llegada = null
LET cantidad = remanente
LET idx = idx + 1
EXIT WHILE
END IF
END WHILE
{IF t_recibe != 0 THEN
IF encontre = "S" THEN
LET arr_pend[idx].num_doc = cant_movi.num_oc
LET arr_pend[idx].ordenada = encontre
LET arr_pend[idx].recibida = t_recibe using "##,###,###.##"
LET arr_pend[idx].cantidad = remanente using "---,---,---.##"
LET arr_pend[idx].fecha_llegada = null
LET cantidad = remanente
LET idx = idx + 1
END IF
END IF}
END IF
END WHILE
# Calculo para los dias de produccion con ordenes
IF consumo > 0 THEN
IF cantidad > 0 THEN
LET dia_orden1 = ((existencia + cantidad) / consumo)
ELSE
LET dia_orden1 = (existencia / consumo)
END IF
{LET e = dia_orden1
LET d = dia_orden1 - e
IF d > 0.50 THEN
LET e = e + 1
LET dia_orden1 = e
ELSE
LET dia_orden = dia_orden1
LET dia_orden1 = dia_orden
END IF}
LET dia_orden1 = dia_orden1 * dias1
LET dia_orden = dia_orden1
LET estadis.dias_orden = dia_orden using "####"
END IF
DISPLAY BY NAME estadis.dias_orden
CALL set_count(idx - 1)
DISPLAY ARRAY arr_pend TO sp1.* ATTRIBUTE (BOLD)
DISPLAY " " AT 23,40
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
FOR idx = 1 to 4
LET arr_pend[idx].num_doc = null
LET arr_pend[idx].cantidad = null
LET arr_pend[idx].fecha_llegada = null
LET arr_pend[idx].ordenada = null
LET arr_pend[idx].recibida = null
DISPLAY arr_pend[idx].num_doc to sp1[idx].num_oc
DISPLAY arr_pend[idx].ordenada to sp1[idx].ordenada
DISPLAY arr_pend[idx].cantidad to sp1[idx].cantidad
DISPLAY arr_pend[idx].recibida to sp1[idx].recibida
DISPLAY arr_pend[idx].fecha_llegada to sp1[idx].fecha_llegada
END FOR
END FUNCTION
Reference in New Issue View Git Blame Copy Permalink