jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
79eff57d70a25633aea6f1b524571b87cd697594
MBS/PROYECTO/ipdir/piking.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

773 lines
22 KiB
Plaintext
Raw Blame History

{
FUNCTION : piking.4gl
DESARROLLADO POR: ING. JUAN SOTO
FECHA : 1/10/20218
OBJETIVO : Visualizar las transferencias que se realizan
}
IMPORT util
SCHEMA smarmotech
DEFINE
piking DYNAMIC ARRAY OF RECORD
transportista STRING,
bodega SMALLINT,
nombre_b CHAR(25),
bodega2 SMALLINT,
nombre_b2 CHAR(25),
num_doc INTEGER,
fecha DATE,
cod_mov SMALLINT,
nombre VARCHAR(100),
usuario CHAR(60),
recibo CHAR(1),
impresion CHAR(1),
cod_mov_transferencia SMALLINT,
cod_transp SMALLINT,
sec_transp SMALLINT,
placa VARCHAR(50),
numero_doc INT
END RECORD,
ximpresion CHAR(1)
DEFINE
l_sql_seq STRING,
prep_seq_piking SMALLINT
DEFINE movi10Dest_JSON DYNAMIC ARRAY OF RECORD
area, cod_n, cod_Grupo, cod_tipo, cod_sec INT,
id_bodega, id_seccion1 INT,
id_tramo1 INT,
id_fila, id_pos INT,
cantidad1, cantidad2 DECIMAL(12, 5)
END RECORD
DEFINE
movi2 DYNAMIC ARRAY OF RECORD
area SMALLINT,
descripcion_area VARCHAR(30),
cod_n LIKE intb00003.cod_n,
cod_grupo LIKE intb00003.cod_grupo,
cod_tipo LIKE intb00003.cod_tipo,
cod_sec LIKE intb00003.cod_sec,
cantidad_1 DEC(12, 5),
cantidad_2 DEC(12, 5),
cantidad_p DEC(12, 5),
unidad_med LIKE iptb00002.unidad_med,
descrip_esp CHAR(80),
existencia DEC(12, 5),
disponible DEC(12, 5),
codigo_bloque CHAR(15),
id_kit INT
END RECORD,
negrilla_on,
negrillas_of,
doble_on,
doble_off,
comp_on,
comp_off,
doce,
NORMAL
CHAR(3),
imprime, gclave, gusuario, archivo, DESCRIP_TRANSP, copia CHAR(100),
gimpresor, idx1, idx, p_act, numero_msg SMALLINT,
tituloBodega STRING,
otros_mov1 RECORD
num_doc INT,
cod_cia SMALLINT,
cod_mov SMALLINT,
fact_no CHAR(25),
cod_transp SMALLINT,
sec_transp SMALLINT,
cod_tarifa SMALLINT,
placa CHAR(25),
conduce_no CHAR(25),
fecha DATE,
descrip_mov CHAR(30),
bodega SMALLINT,
bodega2 SMALLINT,
bodega_d CHAR(30),
num_bultos SMALLINT,
detalle CHAR(30),
cod_sp SMALLINT,
cod_sp_sec INT,
descrip4 CHAR(30),
cod_mov_transferencia INT
END RECORD
DEFINE otros_mov RECORD
num_doc LIKE iptb00006.num_doc,
cod_cia LIKE iptb00006.cod_cia,
cod_mov LIKE iptb00006.cod_mov,
fact_no LIKE iptb00006.fact_no,
cod_transp LIKE iptb00006.cod_transp,
sec_transp LIKE iptb00006.sec_transp,
cod_tarifa LIKE iptb00006.cod_tarifa,
placa LIKE iptb00006.placa,
fecha LIKE iptb00006.fecha,
conduce_no LIKE iptb00006.conduce_no,
descrip_mov CHAR(80),
bodega LIKE iptb00006.bodega,
bodega_destino SMALLINT,
detalle LIKE iptb00006.detalle,
cod_sp LIKE iptb00006.cod_sp,
cod_sp_sec LIKE iptb00006.cod_sp_sec,
departamento SMALLINT,
nombre_depto CHAR(30),
cod_mov1 SMALLINT,
entrada INT,
descrip_mov1 CHAR(40),
descrip4 CHAR(30),
factura INT
END RECORD
FUNCTION piking(usuario, clave, impresor, xbodega, sucursal)
DEFINE
letras RECORD
negrillas_on CHAR(6),
negrillas_off CHAR(6),
doble_on CHAR(6),
doble_off CHAR(6),
comp_on CHAR(6),
comp_off CHAR(6),
doce CHAR(6),
normal CHAR(6)
END RECORD,
usuario, clave CHAR(50),
impresor, xbodega, sucursal SMALLINT
LET gusuario = usuario
LET gclave = clave
LET gimpresor = impresor
DECLARE busca_piking CURSOR FOR
SELECT DISTINCT d.nombre,
a.bodega,
e.descripcion,
a.bodega_d,
' ',
a.num_doc,
a.fecha,
a.cod_mov,
c.descrip_mov,
a.us_crea,
a.cond_recep,
'N',
c.codigo_mov_transferencia,
a.cod_transp,
a.sec_transp,
a.placa,
a.numero_doc
FROM iptb00033 a
LEFT OUTER
JOIN vetb00015 d
ON a.cod_transp = d.cod_transp
AND a.sec_transp = d.sec_transp,
iptb00005 c,
intb00009 e,
iptb00048 b
WHERE a.bodega_d = b.bodega
AND b.usuario = usuario
AND e.cod_bodega = a.bodega_d
AND a.cond_recep = 'N'
AND a.cod_mov = c.cod_mov
AND c.control_transferencia = "SI"
AND a.status_t IS NULL
LET idx = 1
FOREACH busca_piking INTO piking[idx].*
SELECT a.descripcion
INTO piking[idx].nombre_b2
FROM intb00009 a
WHERE a.cod_bodega = piking[idx].bodega2
#BRIAN LO PUSO
SELECT a.descripcion
INTO piking[idx].nombre_b
FROM intb00009 a
WHERE a.cod_bodega = piking[idx].bodega
LET otros_mov1.cod_mov_transferencia = piking[idx].cod_mov_transferencia
LET idx = idx + 1
END FOREACH #fin foreach busca_piking
IF idx > 1 THEN
# FORMULARIO RELACION DE TRANSFERENCIA POR RECIBIR
OPEN WINDOW ipfmwd007 AT 1, 1 WITH FORM "ipfmwd013"
LET int_flag = FALSE
INPUT ARRAY piking WITHOUT DEFAULTS FROM spiking.*
ON ACTION visualiza
LET p_Act = arr_curr()
CALL buscadata(p_act)
CALL itemsTransferencia()
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
EXIT INPUT
END IF
END INPUT
IF int_flag THEN
LET int_flag = FALSE
CLOSE WINDOW ipfmwd007
RETURN
END IF
FOR idx1 = 1 TO piking.getLength()
LET ximpresion = 'N'
IF piking[idx1].recibo = "S" THEN
CALL buscadata(idx1)
IF piking[idx1].impresion = 'S' THEN
LET ximpresion = 'S'
END IF
CALL adicionaTransf()
END IF
END FOR
CLOSE WINDOW ipfmwd007
END IF
LET int_flag = FALSE
END FUNCTION
FUNCTION itemsTransferencia()
DEFINE
xcodmov, xbodega STRING,
xnumdoc INT
DISPLAY "BUSCA DATA ",
otros_mov1.num_doc,
" ",
otros_mov.cod_mov,
" ",
otros_mov.bodega
OPEN WINDOW w1 WITH FORM "ipfmwd013a"
DECLARE busca_items CURSOR FOR
SELECT a.cod_n,
a.cod_grupo,
a.cod_tipo,
a.cod_sec,
a.cantidad_1,
a.cantidad_2,
b.unidad_med,
b.descrip_esp,
a.costo,
a.bodega_d
FROM iptb00033 a, iptb00002 b
WHERE a.num_doc = otros_mov1.num_doc
AND a.cod_mov = otros_mov.cod_mov
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 a.bodega = otros_mov.bodega
AND a.bodega_d = otros_mov.bodega_destino
AND a.status_t IS NULL
AND a.cond_recep = 'N'
LET idx = 1
LET xcodmov =
"(", otros_mov.cod_mov USING "&&&&", ")", otros_mov.descrip_mov CLIPPED
LET xnumdoc = otros_mov1.num_doc
LET xbodega =
"(", otros_mov.bodega USING "<<<", ")", otros_mov.descrip4 CLIPPED
DISPLAY BY NAME xcodmov, xnumdoc, xbodega
FOREACH busca_items
INTO movi2[idx].cod_n,
movi2[idx].cod_grupo,
movi2[idx].cod_tipo,
movi2[idx].cod_sec,
movi2[idx].cantidad_1,
movi2[idx].cantidad_2,
movi2[idx].unidad_med,
movi2[idx].descrip_esp,
otros_mov1.bodega2
LET idx = idx + 1
END FOREACH #fin del foreach busca_items into movi2
DISPLAY ARRAY movi2 TO detallepiking.*
ON ACTION imprimir ATTRIBUTE(TEXT = "Imprime", IMAGE = "printer2")
CALL defecto(
gusuario, gclave, gimpresor)
RETURNING imprime,
negrilla_on,
negrillas_of,
doble_on,
doble_off,
comp_on,
comp_off,
doce,
normal,
archivo,
copia
START REPORT formu4 TO archivo
FOR idx = 1 TO movi2.getLength()
OUTPUT TO REPORT formu4(otros_mov.*, movi2[idx].*)
END FOR
FINISH REPORT formu4
RUN imprime
CALL fgl_winmessage("INFO", "IMPRESION TERMINADA", "INFO")
AFTER DISPLAY
EXIT DISPLAY
END DISPLAY
CLOSE WINDOW w1
END FUNCTION
FUNCTION adicionaTransf()
DEFINE
jsonMovi STRING,
out_msg VARCHAR(1000),
procedimiento STRING,
out_result INT,
cod_mensaje INT,
idseccion,
idtramo,
idfila,
idpos,
p_cod_n,
p_cod_grupo,
p_cod_tipo,
p_cod_sec,
p_numero_doc,
p_num_oc,
p_cod_sp,
p_cod_sp_sec,
p_cod_transp,
p_sec_transp,
p_area,
p_numreq,
p_secVend,
p_bodega_d,
p_retrabajo,
p_Departamento,
p_factura
INT,
p_cantidad_1, p_cantidad_2, costoItem DECIMAL(12, 5),
out_cantidad_item, out_cantidad_ubicacion DECIMAL(18, 5),
p_detalle, p_direccion VARCHAR(100),
p_placa VARCHAR(20),
p_fecha DATE,
p_cerrada, p_aplicadev, pcontrol_depto VARCHAR(1),
p_codigoBloque VARCHAR(25)
LET p_fecha = TODAY
INITIALIZE p_area TO NULL
LET p_cerrada = 'N'
LET costoItem = 0
------------------------------------------------------------------
SELECT a.cod_seccion, a.cod_tramo, a.cod_fila, a.cod_pos
INTO idseccion, idtramo, idfila, idpos
FROM companias a
WHENEVER ERROR CONTINUE
BEGIN WORK
# Serializa la obtencion del numero de documento para evitar duplicados
# bajo concurrencia (con RCSI los lectores ya no toman lock compartido).
# La lectura va DENTRO del BEGIN WORK con UPDLOCK+HOLDLOCK para que el
# lock se sostenga hasta el COMMIT y un segundo usuario espere su turno.
IF NOT prep_seq_piking THEN
LET l_sql_seq =
"SELECT num_doc FROM iptb00007 WITH (UPDLOCK, HOLDLOCK)",
" WHERE bodega = ? AND cod_mov = ?"
PREPARE p_seq_piking FROM l_sql_seq
LET prep_seq_piking = TRUE
END IF
LET otros_mov.num_doc = NULL
EXECUTE p_seq_piking
USING otros_mov.bodega_destino,
otros_mov1.cod_mov_transferencia
INTO otros_mov.num_doc
IF otros_mov.num_doc IS NULL THEN
LET otros_mov.num_doc = 0
INSERT INTO iptb00007(
num_doc, cod_mov, bodega)
VALUES(0,
otros_mov1.cod_mov_transferencia,
otros_mov.bodega_destino)
END IF
LET otros_mov.num_doc = otros_mov.num_doc + 1
UPDATE iptb00007
SET num_doc = otros_mov.num_doc
WHERE cod_mov = otros_mov1.cod_mov_transferencia
AND bodega = otros_mov.bodega_destino
DECLARE transferencia_pend CURSOR FOR
SELECT a.cod_n,
a.cod_grupo,
a.cod_tipo,
a.cod_sec,
a.cantidad_1,
a.cantidad_2,
a.detalle,
a.numero_doc,
a.num_oc,
a.cod_sp,
a.cod_sp_sec,
a.cod_transp,
a.sec_transp,
a.placa
FROM iptb00033 a
WHERE a.num_doc = otros_mov1.num_doc
AND a.bodega = otros_mov.bodega
AND a.cod_mov = otros_mov.cod_mov
AND a.bodega_d = otros_mov.bodega_destino
AND a.cond_recep = 'N'
FOREACH transferencia_pend
INTO p_cod_n,
p_cod_grupo,
p_cod_tipo,
p_cod_sec,
p_cantidad_1,
p_cantidad_2,
p_detalle,
p_numero_doc,
p_num_oc,
p_cod_sp,
p_cod_sp_sec,
p_cod_transp,
p_sec_transp,
p_placa
LET p_cantidad_2 = p_cantidad_2 * -1
# CONSTRUIR JSON DEL ITEM
INITIALIZE movi10Dest_JSON TO NULL
INITIALIZE jsonMovi TO NULL
LET movi10Dest_JSON[1].area = p_area
LET movi10Dest_JSON[1].cod_n = p_cod_n
LET movi10Dest_JSON[1].cod_grupo = p_cod_grupo
LET movi10Dest_JSON[1].cod_tipo = p_cod_tipo
LET movi10Dest_JSON[1].cod_sec = p_cod_sec
LET movi10Dest_JSON[1].id_bodega = otros_mov.bodega_destino
LET movi10Dest_JSON[1].id_seccion1 = idseccion
LET movi10Dest_JSON[1].id_tramo1 = idtramo
LET movi10Dest_JSON[1].id_fila = idfila
LET movi10Dest_JSON[1].id_pos = idpos
LET movi10Dest_JSON[1].cantidad1 = p_cantidad_1
LET movi10Dest_JSON[1].cantidad2 = p_cantidad_2
LET jsonMovi = util.JSON.stringify(movi10Dest_JSON)
# EJECUTAR EL MISMO SP
INITIALIZE out_result TO NULL
INITIALIZE cod_mensaje TO NULL
INITIALIZE out_cantidad_item TO NULL
INITIALIZE out_cantidad_ubicacion TO NULL
INITIALIZE out_msg TO NULL
LET pcontrol_depto = 'NO'
LET procedimiento =
"EXEC sp_insert_inventario ",
"?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ",
"?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ",
"?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ",
"?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ",
"?, ?, ?, ?"
PREPARE smt FROM procedimiento
IF STATUS <> 0 THEN
ROLLBACK WORK
DISPLAY "ERROR PREPARE SP: ", STATUS
CALL msg(1679)
RETURN
END IF
EXECUTE smt
USING p_num_oc IN,
p_cod_n IN,
p_cod_grupo IN,
p_cod_tipo IN,
p_cod_sec IN,
p_area IN,
p_cantidad_1 IN,
p_cantidad_2 IN,
otros_mov1.cod_mov_transferencia IN,
otros_mov.num_doc IN,
otros_mov.num_doc IN, # tmpnumero
otros_mov.num_doc IN, # entrada
p_fecha IN,
otros_mov.conduce_no IN, # conduce
p_cod_sp IN,
p_cod_sp_sec IN,
p_cod_transp IN,
p_sec_transp IN,
p_placa IN,
p_detalle IN,
otros_mov.bodega_destino IN,
p_cerrada IN, # pcerrada
gusuario IN,
p_numreq IN, # numreq
p_codigoBloque IN, # codigo_bloque
p_secVend IN, # secvend
p_direccion IN, # direccion
p_bodega_d IN, # bodega_d
p_retrabajo IN, # retrabajo
p_aplicadev IN, # aplicaDev
p_Departamento IN, # departamento
pcontrol_depto IN, # pcontrol_depto
p_factura IN, # factura
p_numero_doc IN,
costoItem IN,
otros_mov.cod_mov IN,
otros_mov1.num_doc IN,
otros_mov.bodega IN,
jsonMovi IN,
out_result OUT,
cod_mensaje OUT,
out_cantidad_item OUT,
out_cantidad_ubicacion OUT,
out_msg OUT
IF STATUS <> 0 THEN
ROLLBACK WORK
DISPLAY "ERROR SQL EJECUTANDO SP: ", STATUS
DISPLAY "ITEM: ",
p_cod_n,
"-",
p_cod_grupo,
"-",
p_cod_tipo,
"-",
p_cod_sec
CALL msg(1679)
RETURN
END IF
DISPLAY "data piking: ", out_msg
IF out_result <> 0 THEN
ROLLBACK WORK
DISPLAY "ERROR RECEPCION TRANSFERENCIA"
DISPLAY "ITEM: ",
p_cod_n,
"-",
p_cod_grupo,
"-",
p_cod_tipo,
"-",
p_cod_sec
DISPLAY "CODIGO: ", cod_mensaje
DISPLAY "CANTIDAD ITEM: ", out_cantidad_item
DISPLAY "CANTIDAD UBICACION: ", out_cantidad_ubicacion
CALL msg(cod_mensaje)
RETURN
END IF
END FOREACH
# TODOS LOS ITEMS FUERON RECIBIDOS
UPDATE iptb00033
SET cond_recep = "S", us_mod = gusuario, fech_mod = GETDATE()
WHERE cod_mov = otros_mov.cod_mov
AND num_doc = otros_mov1.num_doc
AND bodega = otros_mov.bodega
AND bodega_d = otros_mov.bodega_destino
AND cond_recep = "N"
IF STATUS <> 0 THEN
ROLLBACK WORK
CALL msg(1679)
RETURN
END IF
COMMIT WORK
IF ximpresion = 'S' THEN
# IMPRESION
DECLARE busca_data CURSOR FOR
SELECT a.cod_n,
a.cod_grupo,
a.cod_tipo,
a.cod_Sec,
a.cantidad_1,
a.cantidad_2,
b.descrip_Esp,
b.unidad_med,
a.num_doc,
a.fecha,
a.cod_mov,
c.descrip_mov,
a.bodega,
a.placa,
a.cod_transp,
a.sec_transp
FROM iptb00006 a, iptb00002 b, iptb00005 c
WHERE a.num_doc = otros_mov.num_doc
AND a.cod_mov = otros_mov1.cod_mov_transferencia
AND a.bodega = otros_mov.bodega_destino
AND a.cod_mov = c.cod_mov
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
CALL defecto(
gusuario, gclave, gimpresor)
RETURNING imprime,
negrilla_on,
negrillas_of,
doble_on,
doble_off,
comp_on,
comp_off,
doce,
normal,
archivo,
copia
START REPORT formu4 TO archivo
FOREACH busca_data
INTO movi2[idx].cod_n,
movi2[idx].cod_grupo,
movi2[idx].cod_tipo,
movi2[idx].cod_sec,
movi2[idx].cantidad_1,
movi2[idx].cantidad_2,
movi2[idx].descrip_esp,
movi2[idx].unidad_med,
otros_mov.num_doc,
otros_mov.fecha,
otros_mov.cod_mov,
otros_mov.descrip_mov,
otros_mov.bodega,
otros_mov.placa,
otros_mov.cod_transp,
otros_mov.sec_transp
OUTPUT TO REPORT formu4(otros_mov.*, movi2[idx].*)
END FOREACH
FINISH REPORT formu4
RUN imprime
END IF
CALL fgl_Winmessage("INFO", "TRANSFERENCIA ADICIONADA CON EXITO", "INFO")
END FUNCTION
FUNCTION buscadata(i)
DEFINE i INT
SELECT UNIQUE a.detalle,
b.descrip_mov,
a.cod_cia,
a.bodega,
a.bodega_d,
c.nombre,
a.cod_transp,
a.sec_transp,
b.codigo_mov_transferencia,
a.placa
INTO otros_mov.detalle,
otros_mov.descrip_mov,
otros_mov.cod_cia,
otros_mov.bodega,
otros_mov.bodega_destino,
DESCRIP_TRANSP,
otros_mov.cod_transp,
otros_mov.sec_transp,
otros_mov1.cod_mov_transferencia,
otros_mov.placa
FROM iptb00033 a, iptb00005 b, vetb00015 c
WHERE a.num_doc = piking[i].num_doc
AND a.cod_mov = piking[i].cod_mov
AND a.cod_mov = b.cod_mov
AND a.bodega = piking[i].bodega
AND a.status_t IS NULL
AND a.cond_recep = 'N'
AND c.cod_transp = a.cod_transp
AND c.sec_transp = a.sec_transp
LET otros_mov.detalle = otros_mov1.detalle
LET otros_mov.cod_cia = otros_mov1.cod_cia
LET otros_mov1.num_Doc = piking[i].num_doc
LET otros_mov.fecha = piking[i].fecha
LET otros_mov.cod_mov = piking[i].cod_mov
LET otros_mov.bodega = piking[i].bodega
LET otros_mov.bodega_destino = piking[i].bodega2
LET tituloBodega = piking[i].nombre_b2
END FUNCTION
FUNCTION pendienteRecibir(xbodega)
DEFINE xbodega, j INT
DECLARE cuenta CURSOR FOR
SELECT DISTINCT d.nombre,
a.bodega,
e.descripcion,
a.bodega_d,
' ',
a.num_doc,
a.fecha,
a.cod_mov,
c.descrip_mov,
a.us_crea,
a.cond_recep,
c.codigo_mov_transferencia,
a.cod_transp,
a.sec_transp,
a.placa
FROM iptb00033 a, iptb00005 c, intb00009 e, vetb00015 d
WHERE a.bodega_d = xbodega
AND e.cod_bodega = a.bodega_d
AND a.cond_recep = 'N'
AND a.cod_mov = c.cod_mov
AND c.control_transferencia = "SI"
AND a.cod_transp = d.cod_transp
AND a.sec_transp = d.sec_transp
AND a.status_t IS NULL
LET j = 0
FOREACH cuenta
LET j = j + 1
END FOREACH
RETURN j
END FUNCTION
Reference in New Issue View Git Blame Copy Permalink