Files
MBS/PROYECTOS/irdir/irprmt066.4gl
T

218 lines
6.7 KiB
Plaintext

{
--------------------------------------------------------------------------
PROGRAMA : IRPRMT066
OBJETIVO : Programa Para Anular en Forma Logica Movimientos de
Inventario de Repuestos.
PROGRAMADOR : Juan Soto
FECHA : Diciembre 4, 1996
--------------------------------------------------------------------------
}
GLOBALS
"irprgb000.4gl"
DEFINE anular RECORD
cod_mov SMALLINT,
num_doc INTEGER,
fecha DATE,
cod_sp SMALLINT,
cod_sp_sec SMALLINT
END RECORD
DEFINE descrip_mov CHAR(30)
DEFINE opc1 CHAR(1),
orden_compras INT, answer STRING, APIexistencia DECIMAL(12,2)
MAIN
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_companias.* FROM companias a
CALL irprmt066()
END MAIN
FUNCTION irprmt066()
DEFINE fecha CHAR(8)
DEFINE hora CHAR(5),
chcodigo CHAR(100)
OPTIONS
ERROR LINE 24,
FORM LINE 4,
COMMENT LINE 22,
PROMPT LINE 23
OPEN WINDOW anular AT 8,4 WITH FORM "irfmwd066" ATTRIBUTE (BORDER,FORM LINE
FIRST + 1,PROMPT LINE LAST)
INPUT BY NAME anular.cod_mov,anular.num_doc ATTRIBUTE (BOLD)
AFTER FIELD cod_mov
IF anular.cod_mov is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
SELECT a.descrip_mov INTO descrip_mov FROM irtb00005 a
WHERE a.cod_mov = anular.cod_mov AND a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
DISPLAY BY NAME descrip_mov
AFTER FIELD num_doc
IF anular.num_doc is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
SELECT UNIQUE a.num_doc FROM irtb00006 a
WHERE a.cod_mov = anular.cod_mov AND a.num_doc = anular.num_doc AND
a.status_t IS NULL
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
SELECT MAX(a.fecha),MAX(a.cod_sp),MAX(a.cod_sp_sec),MAX(a.orden_compra)
INTO anular.fecha,anular.cod_sp,anular.cod_sp_sec,orden_compras
FROM irtb00006 a
WHERE a.cod_mov = anular.cod_mov AND a.num_doc = anular.num_doc AND
a.status_t IS NULL
DISPLAY BY NAME anular.fecha,anular.cod_sp,anular.cod_sp_sec,orden_compras
LET p_fechas = anular.fecha USING "dd/mm/yyyy"
LET bandera = 0
CALL prd(p_fechas,usuarios) RETURNING bandera
IF bandera = 1 THEN
CALL fgl_winmessage("ERROR","NO PUEDE ANULAR DOCUMENTO, ESTA FUERA DE CORTE","STOP")
EXIT INPUT
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLOSE WINDOW anular
RETURN
END IF
PROMPT "Quiere Proceder Anulacion de Este Dcto. (S/N)? " FOR CHAR opc1
LET opc1 = upshift(opc1)
IF opc1 = "S" THEN
SELECT a.status_mov INTO status_m FROM irtb00005 a
WHERE a.cod_mov = anular.cod_mov
DECLARE busca CURSOR FOR
SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.cantidad_2
FROM irtb00006 a
WHERE a.num_doc=anular.num_doc and
a.cod_mov=anular.cod_mov
# a.fecha > "01012008"
LET decide = "N"
LET idx = 1
FOREACH busca INTO movi2[idx].cod_n,movi2[idx].cod_grupo,
movi2[idx].cod_tipo,movi2[idx].cod_sec,
movi2[idx].cantidad_2
IF status_m = "1" THEN
SELECT SUM(a.cantidad_2) INTO chequea.existe FROM irtb00006 a
WHERE a.cod_n = movi2[idx].cod_n and
a.cod_grupo = movi2[idx].cod_grupo and
a.cod_tipo=movi2[idx].cod_tipo and
a.cod_sec = movi2[idx].cod_sec and
a.status_t is null
IF chequea.existe IS NULL THEN
LET chequea.existe = 0
END IF
LET chequea.existe = chequea.existe - movi2[idx].cantidad_2
IF chequea.existe < 0 THEN
LET chcodigo = "SI ANULA ESTE DOCUMENTO ESTE CODIGO SERA NEGATIVO, ANULACION ABORTADA ",
movi2[idx].cod_n," ",movi2[idx].cod_grupo," ",
movi2[idx].cod_tipo," ",movi2[idx].cod_sec
CALL fgl_winmessage("ERROR",chcodigo,"stop")
LET bandera = 1
EXIT FOREACH
END IF
END IF
LET idx = idx + 1
END FOREACH
IF bandera = 1 THEN
GOTO salir
END IF
BEGIN WORK
UPDATE irtb00006 set status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE cod_mov = anular.cod_mov AND
num_doc = anular.num_doc
FOR idx = 1 TO movi2.getLength() - 1
INITIALIZE answer TO NULL
select id_maintainX INTO answer from irtb00002 WHERE
cod_n = movi2[idx].cod_n AND cod_grupo = movi2[idx].cod_grupo
AND cod_tipo = movi2[idx].cod_tipo AND cod_sec = movi2[idx].cod_sec
DISPLAY answer
IF answer IS NULL THEN
DISPLAY "AQUI 1"
ROLLBACK WORK
ELSE
select sum(cantidad_2) INTO APIexistencia from irtb00006
WHERE cod_n = movi2[idx].cod_n and cod_grupo = movi2[idx].cod_grupo
and cod_tipo = movi2[idx].cod_tipo and cod_sec = movi2[idx].cod_sec
AND status_t IS NULL
LET m_articulos.cod_n = movi2[idx].cod_n
LET m_articulos.cod_grupo = movi2[idx].cod_grupo
LET m_articulos.cod_tipo = movi2[idx].cod_tipo
LET m_articulos.cod_sec = movi2[idx].cod_sec
LET m_articulos.descrip_esp = movi2[idx].descrip_esp
LET m_articulos.existencia = APIexistencia
LET m_articulos.exist_min = 0
CALL ApiMaintainR('PATCH',answer, m_articulos.*, usuarios) RETURNING answer
IF answer != 1 THEN
DISPLAY "AQUI 6"
ROLLBACK WORK
ELSE
DISPLAY "SUCCESS"
END IF
END IF
END FOR
IF orden_compras IS NOT NULL THEN
UPDATE cotb00014 SET cierre = 'N',us_mod = SUSER_SNAME(),
fech_mod = getdate()
WHERE num_oc = orden_compras
END IF
COMMIT WORK
LET numero_msg = 39
CALL msg(numero_msg)
END IF
LABEL salir:
CLOSE WINDOW anular
END FUNCTION