jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
79eff57d70a25633aea6f1b524571b87cd697594
MBS/PROYECTO/ipdir/ipprmt064.4gl
T
jpegueroandClaude Sonnet 5 b6085d4140 Mueve ipdir (Productos Terminados) de PROYECTOS a PROYECTO 
Instruccion de Johnny: todos los directorios de fuentes de inventario
deben migrarse de la carpeta temporal PROYECTOS a la carpeta real
PROYECTO, ya que PROYECTOS sera eliminada.

Se elimino tambien un archivo suelto sin relacion llamado "ipdir"
que existia en PROYECTO (del commit inicial) y bloqueaba el nombre
de la carpeta.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-09-04 09:29:01 -04:00

341 lines
12 KiB
Plaintext
Raw Blame History

{
--------------------------------------------------------------------------
PROGRAMA : IPPRMT064
OBJETIVO : Programa Para Anular en Forma Logica Movimientos de
Inventario de Producto Terminado Tabla iptb00006
FECHA : Octubre 1997
PROGRAMADOR : JUAN SOTO
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO ALEJO
--------------------------------------------------------------------------
}
GLOBALS
"ipprgb000.4gl"
DEFINE anular RECORD
cod_mov SMALLINT,
bodega SMALLINT,
num_doc INTEGER,
fecha DATE,
cod_sp SMALLINT,
cod_sp_sec SMALLINT
END RECORD
define prtb09 RECORD LIKE prtb00009.*
DEFINE descrip_mov CHAR(30)
DEFINE opc1 CHAR(3),conducex CHAR(10),ordenx INTEGER,
pcontrol_existencia VARCHAR(2)
MAIN
DEFER INTERRUPT
CALL STARTLOG("ipmt064.text")
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CONNECT to "marmotech" AS "SQL_E" USER usuarios USING clave
CONNECT to "smarmotech" AS "SQL_C" USER usuarios USING clave
SELECT * INTO p_companias.* FROM companias
CALL ipprmt064()
END MAIN
FUNCTION ipprmt064()
DEFINE fecha CHAR(8)
DEFINE hora CHAR(5),
bodegad,pnum_oc,prequisi,num_doc_destino,codigo_dest,pnum_doc,
pnum_doc_trans,bodega_trans,cod_mov_trans,numero_req INT,
codigo_destino,err_mensaje,bodega_destino STRING
CLEAR SCREEN
OPTIONS
ERROR LINE 24,
FORM LINE 4,
COMMENT LINE 22,
PROMPT LINE 23
OPEN WINDOW anular AT 8,4 WITH FORM "ipfmwd003" ATTRIBUTE (BORDER,FORM LINE
FIRST + 1,PROMPT LINE LAST)
INPUT BY NAME anular.cod_mov,anular.bodega,anular.num_doc ATTRIBUTE (BOLD)
BEFORE INPUT
CALL bodegas(1)
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
LET codigo_dest = NULL
SELECT a.descrip_mov,codigo_mov_transferencia
INTO descrip_mov,codigo_dest FROM iptb00005 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
IF codigo_dest IS NOT NULL THEN
SELECT '('+ CAST(a.cod_mov AS CHAR(10))+')'+a.descrip_mov INTO codigo_Destino
FROM iptb00005 a WHERE a.cod_mov = codigo_dest
END IF
DISPLAY BY NAME descrip_mov,codigo_Destino
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
LET bodegad = NULL
LET pnum_Doc = NULL
SELECT UNIQUE a.num_doc,a.bodega_d,a.numero_doc INTO pnum_doc,bodegad,numero_req FROM iptb00006 a
WHERE a.cod_mov = anular.cod_mov AND a.num_doc = anular.num_doc AND
a.bodega = anular.bodega AND
a.status_t IS NULL AND
a.fecha > '01/01/2009'
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
LET bodega_destino = NULL
IF codigo_destino IS NOT NULL THEN
SELECT DISTINCT b.num_doc, a.descripcion INTO num_doc_destino,bodega_destino FROM intb00009 a,iptb00006 b
WHERE a.cod_bodega = bodegad AND b.num_doc_transferencia = anular.num_doc AND
b.bodega_procedencia = anular.bodega
DISPLAY BY NAME bodega_destino,num_doc_destino
END IF
#-> aCTUALZI el monitoreo de las ordenes de corte vg Saturday, March 03, 2001
IF anular.cod_mov = 20 THEN
SELECT UNIQUE a.num_oc INTO conducex FROM iptb00006 a
WHERE a.num_doc = anular.num_doc and a.cod_mov = 20 and
a.bodega = anular.bodega
and a.status_t IS NULL
LET ordenx = conducex
END IF
# REPORTE ENTRADA
IF anular.cod_mov = 10 THEN
SELECT UNIQUE a.rep_entrada FROM cgtb00017 a
WHERE a.rep_entrada = anular.num_doc
AND a.bodega = anular.bodega
and a.status_t IS NULL
IF STATUS <> NOTFOUND THEN
CALL msg(504)
NEXT FIELD num_doc
END IF
END IF
# BUSCAR NUMERO DE DOCUMENTO INICIAL TRANSFERENCIA BODEGA ORIGEN DEL MOVIMIENTO
LET pnum_doc_trans = NULL
LET bodega_trans = NULL
LET cod_mov_trans = NULL
SELECT DISTINCT a.num_doc_transferencia,a.bodega_procedencia,a.cod_mov_transferencia
INTO pnum_doc_trans,bodega_trans,cod_mov_trans
FROM iptb00006 a WHERE a.num_doc = anular.num_Doc AND a.bodega = anular.bodega AND
a.cod_mov = anular.cod_mov AND a.status_t IS NULL
# VERIFICA SI EL CONDUCE ESTA FACTURADO
IF anular.cod_mov = 30 OR anular.cod_mov = 55 OR anular.cod_mov = 31 THEN
SELECT a.factura FROM vetb00002 a,vetb00060 b
WHERE a.conduce = anular.num_doc AND
a.ventas = b.ventas AND
b.cod_mov = anular.cod_mov AND
a.tipo_cliente = b.tipo_cliente AND
a.bodega = anular.bodega AND
a.status_t IS NULL
IF STATUS <> NOTFOUND THEN
LET numero_msg =501
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
END IF
SELECT UNIQUE a.fecha,a.cod_sp,a.cod_sp_sec
INTO anular.fecha,anular.cod_sp,anular.cod_sp_sec
FROM iptb00006 a
WHERE a.cod_mov = anular.cod_mov AND a.num_doc = anular.num_doc AND
a.fecha > '12/31/2008' AND
a.bodega = anular.bodega and
a.status_t IS NULL
DISPLAY BY NAME anular.fecha,anular.cod_sp,anular.cod_sp_sec
LET p_fechas = anular.fecha
CALL prd(p_fechas,usuarios) RETURNING bandera
IF bandera = 1 THEN
NEXT FIELD cod_mov
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLOSE WINDOW anular
EXIT INPUT
END IF
LET opc1 = fgl_winquestion("WARING","PROCEDO ANULAR ESTE DOCUMENTO?","NO","yes|no","question",0)
LET opc1 = upshift(opc1)
IF opc1 = "YES" THEN
SELECT a.status_mov INTO status_m FROM iptb00005 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 iptb00006 a
WHERE a.num_doc=anular.num_doc and a.cod_mov=anular.cod_mov #and fecha> '12/31/2008'
AND a.bodega = anular.bodega
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 ISNULL(SUM(a.cantidad_2),0) INTO p_iptb06.cantidad_2 FROM iptb00006 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.bodega = anular.bodega and
a.status_t is NULL
DISPLAY "DATA: ", p_iptb06.cantidad_2
LET p_iptb06.cantidad_2 = p_iptb06.cantidad_2 - movi2[idx].cantidad_2
# busca el control de la existencia
SELECT a.control_existencia INTO pcontrol_existencia FROM iptb00002 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
IF pcontrol_existencia = "SI" THEN
IF p_iptb06.cantidad_2 < 0 THEN
LET err_mensaje="EL ITEM ",movi2[idx].cod_n USING "&&&&","-",movi2[idx].cod_grupo USING "&&&&","-",
movi2[idx].cod_tipo USING "&&&&",'-',movi2[idx].cod_Sec USING "&&&&&&",
" ESTA EN NEGATIVO"
CALL fgl_winmessage("INFO",err_mensaje,"INFO")
END IF
END IF
IF pcontrol_existencia = "SI" THEN
IF p_iptb06.cantidad_2 < 0 THEN
LET err_mensaje = NULL
LET err_mensaje="EL ITEM ",movi2[idx].cod_n USING "&&&&","-",movi2[idx].cod_grupo USING "&&&&","-",
movi2[idx].cod_tipo USING "&&&&",'-',movi2[idx].cod_Sec USING "&&&&&&",
" VA A EXCEDER EXISTENCIA SI ANULAS ESTE DOCUMENTO"
CALL fgl_winmessage("INFO",err_mensaje,"INFO")
RETURN
END IF
END IF
END IF
LET idx = idx + 1
END FOREACH
IF (anular.cod_mov = 33 OR anular.cod_mov = 34) THEN
UPDATE iptb00017 set status_t = "E",us_mod = SUSER_SNAME(),fech_mod = GETDATE()
WHERE @cod_mov = anular.cod_mov AND @num_doc = anular.num_doc AND
bodega = anular.bodega
END IF
IF anular.cod_mov = 30 OR anular.cod_mov = 31 OR anular.cod_mov = 55 OR anular.cod_mov = 56 OR anular.cod_mov = 12
OR anular.cod_mov = 13
THEN
SET CONNECTION "SQL_E"
# VERIFICA QUE EL MOVIMIENTO DE ALMACEN NO ESTE APLICADO EN CUENTAS POR COBRAR
SELECT DISTINCT a.num_doc FROM cctb00001 a
WHERE a.banco = anular.cod_mov AND a.num_cheque = anular.num_doc AND a.bodega = anular.bodega AND
a.status_t IS null
IF STATUS <> NOTFOUND THEN
CALL msg(364)
NEXT FIELD cod_mov
END IF
SET CONNECTION "SQL_C"
# VERIFICA QUE EL MOVIMIENTO DE ALMACEN NO ESTE APLICADO EN CUENTAS POR COBRAR
SELECT DISTINCT a.num_doc FROM cctb00001 a
WHERE a.banco = anular.cod_mov AND a.num_cheque = anular.num_doc AND a.bodega = anular.bodega AND
a.status_t IS null
IF STATUS <> NOTFOUND THEN
CALL msg(364)
NEXT FIELD cod_mov
END IF
LET prequisi = 0
LET pnum_oc = 0
SELECT UNIQUE a.num_oc,a.num_req INTO pnum_oc,prequisi
FROM iptb00006 a
WHERE a.cod_mov = anular.cod_mov AND a.num_doc = anular.num_doc AND
a.fecha > '12/31/2008' AND bodega = anular.bodega
BEGIN WORK
UPDATE prtb00012 SET cerrada = "N",us_mod = SUSER_SNAME(),fech_mod = GETDATE()
WHERE num_oc = pnum_oc and fecha > '12/31/2008' AND status_t IS null
UPDATE cctb00025 set estado_despacho = 'NO DESPACHADA'
WHERE num_req = prequisi
COMMIT WORK
END IF
IF numero_req > 0 THEN
UPDATE iptb00057 SET estado = 'AUTORIZADA',us_mod = usuarios,fech_mod = getdate()
WHERE iptb00057.cod_mov = anular.cod_mov AND numero_doc = numero_Req AND bodega = anular.bodega
END IF
BEGIN WORK
IF codigo_dest IS NULL THEN
UPDATE iptb00006 set status_t = "E",us_mod = SUSER_SNAME(),fech_mod = GETDATE()
WHERE iptb00006.cod_mov = anular.cod_mov AND iptb00006.num_doc = anular.num_doc AND
iptb00006.FECHA > "12/31/2008" AND bodega = anular.bodega
UPDATE iptb00062 set status_t = "E",us_mod = SUSER_SNAME(),fech_mod = GETDATE()
WHERE iptb00062.cod_mov = anular.cod_mov AND iptb00062.num_doc = anular.num_doc AND
bodega = anular.bodega
UPDATE iptb00025 set status_t = "E"
WHERE cod_mov = anular.cod_mov AND num_doc = anular.num_doc AND
bodega = anular.bodega
UPDATE iptb00033 set status_t = "E",us_mod = SUSER_SNAME(),fech_mod = GETDATE()
WHERE cod_mov = anular.cod_mov AND num_doc = anular.num_doc AND
bodega = anular.bodega
END IF
IF pnum_doc_trans IS NOT NULL THEN
UPDATE iptb00033 SET cond_recep = 'N',status_t = 'E',us_mod=usuarios,fech_mod=getdate()
WHERE num_doc = pnum_doc_trans AND cod_mov = cod_mov_trans AND
bodega = bodega_trans
END IF
IF codigo_dest IS NOT NULL THEN
UPDATE iptb00006 set status_t = "E",us_mod = SUSER_SNAME(),fech_mod = GETDATE()
WHERE iptb00006.cod_mov = anular.cod_mov AND iptb00006.num_doc = anular.num_doc AND
iptb00006.FECHA > "12/31/2008" AND bodega = anular.bodega
UPDATE iptb00062 set status_t = "E",us_mod = SUSER_SNAME(),fech_mod = GETDATE()
WHERE iptb00062.cod_mov = anular.cod_mov AND iptb00062.num_doc = anular.num_doc AND
bodega = anular.bodega
UPDATE iptb00006 set status_t = "E",us_mod = SUSER_SNAME(),fech_mod = GETDATE()
WHERE iptb00006.cod_mov = codigo_dest AND iptb00006.num_doc_transferencia = anular.num_doc AND
iptb00006.FECHA > "12/31/2008" AND bodega_procedencia = anular.bodega
UPDATE iptb00033 set status_t = "E",us_mod = SUSER_SNAME(),fech_mod = GETDATE()
WHERE cod_mov = anular.cod_mov AND num_doc = anular.num_doc AND
bodega = anular.bodega
END IF
COMMIT WORK
CALL fgl_winmessage("INFO","REGISTRO ELIMINADO","INFO")
NEXT FIELD cod_mov
END IF
END INPUT
CLOSE WINDOW anular
END FUNCTION
Reference in New Issue View Git Blame Copy Permalink