Files
MBS/PROYECTOS/isdir/isprmt016.4gl
T

666 lines
19 KiB
Plaintext

{
--------------------------------------------------------------------------
PROGRAMA : ISPRMT016
OBJETIVO : Programa Captura Documento Movimiento:
DEVOLUCION A SUPLIDOR
de Inventario de Suministro.
PROGRAMADOR : Juan Fco. Soto (Johnny)
FECHA REALIZACION : Octubre 22, 1993.
--------------------------------------------------------------------------
}
GLOBALS
"isprgb000.4gl"
FUNCTION isprmt016()
DEFINE fecha CHAR(10)
DEFINE hora CHAR(5)
CLEAR SCREEN
OPTIONS
ERROR LINE 24,
FORM LINE 4,
COMMENT LINE 22,
PROMPT LINE 23
LET fecha = today USING "dd/mm/yyyy"
LET hora = time
DISPLAY "R A Y . O . V A C D O M I N I C A N A" AT 1,21
ATTRIBUTE (REVERSE,BLUE)
DISPLAY fecha AT 1,70 ATTRIBUTE (RED)
DISPLAY hora AT 2,73 ATTRIBUTE (RED)
DISPLAY "Suministro(s) Devuelto(s) al Suplidor" AT 2,21 ATTRIBUTE(BLACK)
DISPLAY "isprmt016" AT 1,3 ATTRIBUTE (RED)
DISPLAY "<Esc> Adiciona Registro" AT 3,2 ATTRIBUTE (RED,REVERSE)
DISPLAY "<Supr> Cancela Operacion" AT 3,56 ATTRIBUTE (RED,REVERSE)
OPEN FORM isfmmt016 FROM "isfmmt016"
DISPLAY FORM isfmmt016
LET actual = "UPDATE istb00002 SET existencia = existencia + ? ",
"WHERE cod_n = ? and ",
"cod_grupo = ? and ",
"cod_tipo = ? and ",
"cod_sec = ? "
CALL isprad016()
END FUNCTION
FUNCTION isprad016()
DEFINE idx1 SMALLINT
DEFINE r_cantidad,recibida,ordenada,total_cantidad,porciento DECIMAL(12,2)
DEFINE devuelta CHAR(1)
#WHENEVER ERROR CONTINUE
LET int_flag = FALSE
LET OPC = null
INITIALIZE datos_gen.* TO NULL
PREPARE actualiza FROM actual
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 datos_gen.cod_mov = 38
LET datos_gen.fecha = today
LET devuelta = "N"
INPUT BY NAME datos_gen.num_doc,datos_gen.tipo,datos_gen.orden_compra,
datos_gen.fecha,datos_gen.bodega
WITHOUT DEFAULTS
AFTER FIELD bodega
SELECT *FROM istb00009 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
AFTER FIELD fecha
LET datos_gen.bodega = 1
DISPLAY BY NAME datos_gen.bodega
IF datos_gen.fecha is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
LET p_fechas = datos_gen.fecha using "ddmmyyyy"
CALL prd(p_fechas)
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fecha
END IF
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 * FROM istb00005 WHERE cod_mov = datos_gen.cod_mov and
status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 34
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
SELECT UNIQUE cod_sp,cod_sp_sec,fecha,tipo,orden_compra
INTO datos_gen.cod_sp,datos_gen.cod_sp_sec,
datos_gen.fecha,datos_gen.tipo,datos_gen.orden_compra
FROM istb00006
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
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
LET numero_msg = 12
CALL msg(numero_msg)
DISPLAY BY NAME datos_gen.cod_sp,datos_gen.fecha,
datos_gen.nom_sp,datos_gen.cod_sp_sec,
datos_gen.tipo,datos_gen.orden_compra
NEXT FIELD num_doc
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
END IF
IF OPC = "S" OR OPC = "s" OR OPC is null THEN
INITIALIZE datos_gen.cod_sp, datos_gen.nom_sp,
datos_gen.cod_sp_sec,datos_gen.tipo,
datos_gen.orden_compra
TO NULL
DISPLAY BY NAME datos_gen.cod_sp,
datos_gen.nom_sp,datos_gen.cod_sp_sec,
datos_gen.tipo,datos_gen.orden_compra
END IF
END IF
AFTER FIELD tipo
IF datos_gen.tipo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo
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 unique a.orden_compra FROM istb00006 a
WHERE a.tipo = datos_gen.tipo AND
a.orden_compra = datos_gen.orden_compra
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 73
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 cod_sp,cod_sp_sec,cierre INTO datos_gen.cod_sp,datos_gen.cod_sp_sec,
devuelta
FROM cotb00014 WHERE tipo = datos_gen.tipo AND
num_oc = datos_gen.orden_compra
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD orden_compra
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
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 1
RETURN
END IF
IF datos_gen.num_doc IS NULL then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
ELSE
SELECT UNIQUE num_doc FROM istb00006 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
CLEAR SCREEN
RETURN
end if
END IF
END IF
# 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 INTO datos_gen.cod_sp,datos_gen.cod_sp_sec
FROM cotb00014 WHERE tipo = datos_gen.tipo AND
num_oc = datos_gen.orden_compra
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD orden_compra
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
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
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].*
IF status = notfound THEN
EXIT FOREACH
END IF
IF OPC = "S" OR opc = "s" or opc is null THEN
LET movi[idx].cantidad_1 = null
END IF
LET idx = idx + 1
END FOREACH
CALL set_count(idx - 1)
END IF
LABEL volver:
INPUT ARRAY movi WITHOUT DEFAULTS FROM s_movi1.*
AFTER FIELD cantidad_1
LET p_act = arr_curr()
LET scr_l = scr_line()
IF movi[p_act].cantidad_1 is not null THEN
SELECT pto_reorden,existencia INTO chequea.* FROM istb00002
WHERE
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
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
IF movi[p_act].cantidad_1 > chequea.existe THEN
LET numero_msg = 30
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET cant = chequea.existe - movi[p_act].cantidad_1
IF cant <= chequea.pto THEN
LET numero_msg = 31
CALL msg(numero_msg)
LET cant = 0
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
SELECT sum(cantidad_2) INTO recibida FROM istb00006
WHERE tipo = datos_gen.tipo and
orden_compra = datos_gen.orden_compra 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
IF recibida is null THEN
LET numero_msg = 73
CALL msg(numero_msg)
NEXT FIELD cantidad_1
END IF
SELECT cantidad INTO ordenada FROM cotb00015
WHERE tipo = datos_gen.tipo and
num_oc = datos_gen.orden_compra 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
IF ordenada is null THEN
LET ordenada = 0
END IF
LET porciento = ordenada * 0.10
IF movi[p_act].cantidad_1 > recibida THEN
LET numero_msg = 33
CALL msg(numero_msg)
NEXT FIELD cantidad_1
END IF
LET r_cantidad = recibida + porciento
IF movi[p_act].cantidad_1 > r_cantidad THEN
LET numero_msg = 33
CALL msg(numero_msg)
NEXT FIELD cantidad_1
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 1
RETURN
END IF
IF movi[p_act].cantidad_1 is not null THEN
SELECT pto_reorden,existencia INTO chequea.* FROM istb00002
WHERE
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
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
IF movi[p_act].cantidad_1 > chequea.existe THEN
LET numero_msg = 30
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET cant = chequea.existe - movi[p_act].cantidad_1
IF cant <= chequea.pto THEN
LET numero_msg = 31
CALL msg(numero_msg)
LET cant = 0
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
SELECT sum(cantidad_2) INTO recibida FROM istb00006
WHERE tipo = datos_gen.tipo and
orden_compra = datos_gen.orden_compra 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
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 73
CALL msg(numero_msg)
NEXT FIELD cantidad_1
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
SELECT cantidad INTO ordenada FROM cotb00015
WHERE tipo = datos_gen.tipo and
num_oc= datos_gen.orden_compra 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
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 r_cantidad = recibida + porciento
IF movi[p_act].cantidad_1 > r_cantidad THEN
LET numero_msg = 33
CALL msg(numero_msg)
NEXT FIELD cantidad_1
END IF
END IF
LET total_cantidad = 0
FOR idx = 1 to arr_count()
IF movi[idx].cantidad_1 is not null THEN
LET total_cantidad = movi[idx].cantidad_1 + total_cantidad
END IF
END FOR
IF movi[p_act].cod_n is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_grupo is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_tipo is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_sec is null THEN
CALL limpia()
END IF
EXIT INPUT
END INPUT
PROMPT "Toda la Informacion Esta Correcta? (S/N)" FOR CHAR opc
IF OPC = "S" or OPC = "s" THEN
SELECT sum(cantidad_2) INTO recibida FROM istb00006
WHERE orden_compra = datos_gen.orden_compra
SELECT sum(cantidad) INTO ordenada FROM cotb00015
WHERE num_oc = datos_gen.orden_compra
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 r_cantidad = ordenada + porciento
IF total_cantidad >= r_cantidad THEN
LET devuelta = "S"
END IF
FOR idx = 1 TO arr_count()
IF movi[idx].cantidad_1 is not null THEN
LET movi[idx].cantidad_1 = movi[idx].cantidad_1 * -1
INSERT INTO istb00006 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_2,
movi[idx].cantidad_1,null,null,null,
ultimo.cond_recep,ultimo.uso_tiempo,datos_gen.bodega,
null,user,current,null,null)
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
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
IF devuelta = "S" OR devuelta = "D" THEN
UPDATE cotb00014 set cierre = "D"
WHERE tipo = datos_gen.tipo AND
num_oc = datos_gen.orden_compra
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