Files
MBS/PROYECTO/codir/coprmt009.4gl
T
Abel LópezandClaude Sonnet 5 91eeef199e Corregir campo bodega oculto en busqueda de coprmt009
El CONSTRUCT del criterio de busqueda y un DISPLAY BY NAME en escoge()
referenciaban cotb00014.bodega/ordenes.bodega, que no existe como campo
visible en cofmmt009 (combo oculto, ya excluido en el INPUT BY NAME de
copcad009). Causaba "FORMS statement error -1102: Field (bodega) not
found in form" al usar Buscar Ordenes de Compras.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-08-28 16:06:50 -04:00

3298 lines
117 KiB
Plaintext

{
-------------------------------------------------------------------------
PROGRAMA : COPRMT009
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Ordenes de Compras
PROGRAMADOR : JUAN SOTO
FECHA REALIZACION : AGOSTO 1997
LTIMA MODIFICACION : 20/01/2025
--------------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"
#file:///E:/marmotechc/imagenes/genero_logo.png
DEFINE c_i_d, c_i_d1, nota, nota1 CHAR(30)
DEFINE simb_mon, opt1, proce CHAR(4)
DEFINE
nom_via CHAR(10),
zuso_req, xnota, knombre_cliente VARCHAR(100),
xuso_requisicion, xdetalle_orden STRING,
korden, ktipo_cliente, ksec_cliente INT
DEFINE opc1, salir CHAR(3)
DEFINE
cod_mon, control_item, xnum_req INTEGER,
pdescripcion CHAR(180),
chmensaje STRING,
fallo BOOLEAN
DEFINE j1, k1 INTEGER
DEFINE num_reg SMALLINT
DEFINE
requisiciones DYNAMIC ARRAY OF RECORD
num_req LIKE cotb00006.num_req,
fecha DATE,
num_emp LIKE adtb00003.num_emp,
nombre LIKE adtb00003.nom1_emp,
APELLIDO LIKE adtb00003.apell1_emp
END RECORD,
itbis DEC(12, 2),
moneda VARCHAR(20),
xtipo_orden VARCHAR(20)
DEFINE busca_parcial DYNAMIC ARRAY OF RECORD
secuencia INT,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
cantidad DEC(12, 5),
fech_emb DATE,
fech_ent DATE
END RECORD
DEFINE
flag BOOLEAN,
depa, cont INT
DEFINE suplidor RECORD LIKE cotb00001.*
DEFINE
tabla STRING,
anio STRING,
fecha DATETIME YEAR TO FRACTION
DEFINE
nullcontainer STRING,
precio DECIMAL(12, 2)
MAIN
DEFER INTERRUPT
CALL STARTLOG("COPRMT09.TXT")
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CONNECT TO "smarmotech" AS "MSSQL" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
SELECT a.itbi INTO itbis FROM vetb00019 a WHERE a.disponible = 'S'
CALL coprmt009()
END MAIN
FUNCTION coprmt009()
#WHENEVER ERROR CONTINUE
CLEAR SCREEN
OPTIONS FORM LINE 8,
ERROR LINE 24,
COMMENT LINE 22,
PROMPT LINE 23,
MESSAGE LINE 21
OPEN FORM cofmmt009 FROM "cofmmt009"
DISPLAY FORM cofmmt009
SELECT dia INTO dia_aduana FROM cotb00028
MENU
ON ACTION nuevo
CLEAR FORM
SET CONNECTION "MSSQL"
LET opc = "S"
LET existe = NULL
LET int_flag = FALSE
CALL copcad009()
ON ACTION buscar
CLEAR FORM
SET CONNECTION "MSSQL"
LET existe = NULL
LET int_flag = FALSE
CALL copcmf009()
ON ACTION salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION copcad009()
#WHENEVER ERROR CONTINUE
CLEAR FORM
INITIALIZE ordenes.* TO NULL
CALL lugarentregas()
INITIALIZE xuso_requisicion, depa TO NULL
LET ordenes.enviada = "N"
LET ordenes.cierre = "N"
LET ordenes.pago = "N"
LET desc1 = NULL
LET desc2 = NULL
LET desc3 = NULL
LET desc4 = NULL
LABEL incorrecta:
# Captura las informaciones generales de la orden de compras
CALL arr_ordenes.clear()
LABEL atras:
-- ordenes.bodega no se incluye: es un combo oculto (tabIndex=-1) en
-- cofmmt009 y "ordenes.*" fallaba con "Field (bodega) not found in form".
INPUT BY NAME ordenes.num_oc, ordenes.tipo, ordenes.fech_oc, ordenes.num_pr,
ordenes.cod_sp, ordenes.cod_sp_sec, ordenes.term_sp, ordenes.via,
ordenes.enviada, ordenes.fech_enviada, ordenes.pago, ordenes.fech_pago,
ordenes.cierre, ordenes.cod_pt, cod_mon, salida WITHOUT DEFAULTS
BEFORE INPUT
LET salida = "SVG"
LET ordenes.fech_oc = TODAY
DISPLAY BY NAME ordenes.fech_oc
NEXT FIELD tipo
ON ACTION suplidor
LET identifica = "O"
CALL busca_sup1()
LET int_flag = FALSE
IF existe = "N" THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET existe = NULL
NEXT FIELD cod_sp
END IF
DISPLAY BY NAME ordenes.cod_sp, ordenes.cod_sp_sec, suplidor.nom_sp
LET identifica = NULL
NEXT FIELD cod_sp
AFTER FIELD tipo
# Chequeo del numero del documento si el usuario elige numeracion manual
IF ordenes.tipo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
BEFORE FIELD term_sp
CALL busca_terminos()
BEFORE FIELD tipo
CALL tipoorden()
BEFORE FIELD cod_pt
CALL busca_puertos()
BEFORE FIELD cod_mon
CALL busca_monedas()
BEFORE FIELD via
CALL fvia()
AFTER FIELD cod_pt
LET puertos.cod_pt = 0
IF ordenes.cod_pt IS NOT NULL THEN
SELECT a.duracion
INTO puertos.duracion
FROM cotb00019 a
WHERE a.cod_pt = ordenes.cod_pt
END IF
AFTER FIELD fech_oc
IF ordenes.fech_oc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_oc
END IF
### AQUI CONTROLA LA FECHA DEL DOCUMENTO
{
LET p_fechas = ordenes.fech_oc
CALL prd()
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fech_oc
END IF
}
AFTER FIELD cod_sp
IF ordenes.cod_sp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
AFTER FIELD cod_sp_sec
# Chequeo del suplidor para el desplegue del nombre
IF ordenes.cod_sp_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sp_sec
ELSE
SELECT a.nom_sp, a.dir_sp, ciu_sp, a.cod_pais, b.nom_pais
INTO suplidor.nom_sp,
suplidor.dir_sp,
suplidor.ciu_sp,
suplidor.cod_pais,
paises.nom_pais
FROM cotb00001 a
LEFT OUTER
JOIN cotb00018 b
ON a.cod_pais = b.cod_pais
WHERE a.cod_sp = ordenes.cod_sp
AND a.cod_sp_sec = ordenes.cod_sp_sec
AND a.status_t IS NULL
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
END IF
DISPLAY BY NAME suplidor.nom_sp, paises.nom_pais
IF suplidor.cod_pais IS NULL THEN
CALL fgl_winmessage(
"ERROR",
"PROVEEDOR NO TIENE PAIS, FAVOR DE MODIFICAR EN MAESTRA",
"INFO")
NEXT FIELD cod_sp
END IF
END IF
AFTER FIELD fech_enviada
IF ordenes.fech_enviada IS NOT NULL THEN
IF ordenes.fech_enviada < ordenes.fech_oc THEN
LET numero_msg = 364
CALL msg(numero_msg)
# NEXT FIELD fech_enviada
END IF
END IF
AFTER FIELD fech_pago
IF ordenes.fech_pago IS NOT NULL THEN
IF ordenes.fech_pago < ordenes.fech_oc THEN
LET numero_msg = 364
CALL msg(numero_msg)
# NEXT FIELD fech_pago
END IF
END IF
AFTER INPUT
IF int_flag THEN
CALL msg(2)
LET int_flag = FALSE
RETURN
END IF
SELECT a.nom_sp, a.dir_sp, ciu_sp, a.cod_pais
INTO suplidor.nom_sp,
suplidor.dir_sp,
suplidor.ciu_sp,
suplidor.cod_pais
FROM cotb00001 a
WHERE a.cod_sp = ordenes.cod_sp
AND a.cod_sp_sec = ordenes.cod_sp_sec
AND a.status_t IS NULL
IF suplidor.cod_pais IS NULL THEN
CALL fgl_winmessage(
"ERROR",
"PROVEEDOR NO TIENE PAIS, FAVOR DE MODIFICAR EN MAESTRA",
"INFO")
NEXT FIELD cod_sp
END IF
IF cod_mon IS NULL THEN
NEXT FIELD cod_mon
END IF
# DESCRIPCION MONEDA
SELECT a.descrip_mon
INTO moneda
FROM cotb00031 a
WHERE a.cod_mon = cod_mon
IF ordenes.tipo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
END INPUT
# Captura de los articulos requeridos
LET salir = NULL
IF ordenes.cod_sp = 23 THEN
LET control_item = 16
ELSE
LET control_item = 14
END IF
IF opc = "S" THEN
CALL arr_ordenes.clear()
END IF
LET opc = "N"
INPUT ARRAY arr_ordenes WITHOUT DEFAULTS FROM consart.*
ON ACTION requisicion
IF INFIELD(num_req) THEN
LET curr = arr_curr()
LET scr_l = scr_line()
DISPLAY " tipo ", ordenes.tipo
CALL busca_requi(
arr_ordenes[curr].num_req,
ordenes.tipo,
arr_ordenes[curr].cod_n,
arr_ordenes[curr].cod_grupo,
arr_ordenes[curr].cod_tipo,
arr_ordenes[curr].cod_Sec,
arr_ordenes)
RETURNING arr_ordenes[curr].cod_n,
arr_ordenes[curr].cod_grupo,
arr_ordenes[curr].cod_tipo,
arr_ordenes[curr].cod_sec,
arr_ordenes[curr].descripcion,
arr_ordenes[curr].unidad,
arr_ordenes[curr].cantidad,
arr_ordenes[curr].precio,
m_articulos.dia_llegada,
arr_ordenes[curr].num_orden
DISPLAY arr_ordenes[curr].cod_n
DISPLAY arr_ordenes[curr].cod_grupo
DISPLAY arr_ordenes[curr].cod_tipo
DISPLAY arr_ordenes[curr].cod_sec
DISPLAY arr_ordenes[curr].descripcion
DISPLAY arr_ordenes[curr].unidad
DISPLAY arr_ordenes[curr].cantidad
DISPLAY arr_ordenes[curr].precio
DISPLAY arr_ordenes[curr].cod_n TO consart[scr_l].cod_n
DISPLAY arr_ordenes[curr].cod_grupo TO consart[scr_l].cod_grupo
DISPLAY arr_ordenes[curr].cod_tipo TO consart[scr_l].cod_tipo
DISPLAY arr_ordenes[curr].cod_sec TO consart[scr_l].cod_Sec
DISPLAY arr_ordenes[curr].descripcion
TO consart[scr_l].descripcion
DISPLAY arr_ordenes[curr].unidad TO consart[scr_l].unidad
DISPLAY arr_ordenes[curr].cantidad TO consart[scr_l].cantidad
DISPLAY arr_ordenes[curr].precio TO consart[scr_l].precio
IF INT_FLAG THEN
LET INT_FLAG = FALSE
END IF
DISPLAY arr_ordenes[curr].num_req TO consart[scr_l].num_req
END IF
ON ACTION parciales
IF arr_ordenes[arr_curr()].cantidad IS NOT NULL THEN
LET m_articulos.cod_n = arr_ordenes[arr_curr()].cod_n
LET m_articulos.cod_grupo = arr_ordenes[arr_curr()].cod_grupo
LET m_articulos.cod_tipo = arr_ordenes[arr_curr()].cod_tipo
LET m_articulos.cod_sec = arr_ordenes[arr_curr()].cod_sec
CALL parcial(
ordenes.fech_oc,
puertos.duracion,
ordenes.num_oc,
ordenes.tipo,
m_articulos.cod_n,
m_articulos.cod_grupo,
m_articulos.cod_tipo,
m_articulos.cod_sec,
arr_ordenes[arr_curr()].num_req,
arr_ordenes[arr_curr()].cantidad)
RETURNING busca_parcial
END IF
BEFORE ROW
LET curr = arr_curr()
LET scr_l = scr_line()
AFTER FIELD num_req
LET curr = arr_curr()
IF arr_ordenes[curr].num_req IS NOT NULL THEN
LET requi = arr_ordenes[curr].num_req
LET zuso_req = NULL
SELECT UNIQUE a.procesada, b.uso, b.depto_destino
INTO proce, zuso_req, depa
FROM cotb00008 a, cotb00006 b
WHERE a.num_req = arr_ordenes[curr].num_req
AND a.num_req = b.num_req
AND a.procesada = "N"
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num_req
END IF
LET xuso_requisicion = zuso_req CLIPPED
# Antepone el departamento DESTINO (al que se carga el gasto),
# tomado de cotb00006.depto_destino, en lugar del departamento
# que hizo la requisicion.
INITIALIZE zuso_req TO NULL
PREPARE query
FROM "SELECT nom_dpto FROM adtb00001 WHERE departamento = ? AND status_t IS NULL"
EXECUTE query USING depa INTO zuso_req
IF zuso_req IS NOT NULL AND zuso_req CLIPPED != "" THEN
LET xuso_requisicion =
"(", zuso_req CLIPPED, ") ", xuso_requisicion CLIPPED
END IF
CALL busca_requi(
arr_ordenes[curr].num_req,
ordenes.tipo,
arr_ordenes[curr].cod_n,
arr_ordenes[curr].cod_grupo,
arr_ordenes[curr].cod_tipo,
arr_ordenes[curr].cod_Sec,
arr_ordenes)
RETURNING arr_ordenes[curr].cod_n,
arr_ordenes[curr].cod_grupo,
arr_ordenes[curr].cod_tipo,
arr_ordenes[curr].cod_sec,
arr_ordenes[curr].descripcion,
arr_ordenes[curr].unidad,
arr_ordenes[curr].cantidad,
arr_ordenes[curr].precio,
m_articulos.dia_llegada,
arr_ordenes[curr].num_orden
DISPLAY arr_ordenes[curr].cod_n TO consart[scr_l].cod_n
DISPLAY arr_ordenes[curr].cod_grupo TO consart[scr_l].cod_grupo
DISPLAY arr_ordenes[curr].cod_tipo TO consart[scr_l].cod_tipo
DISPLAY arr_ordenes[curr].cod_sec TO consart[scr_l].cod_Sec
DISPLAY arr_ordenes[curr].descripcion
TO consart[scr_l].descripcion
DISPLAY arr_ordenes[curr].unidad TO consart[scr_l].unidad
DISPLAY arr_ordenes[curr].cantidad TO consart[scr_l].cantidad
DISPLAY arr_ordenes[curr].precio TO consart[scr_l].precio
IF INT_FLAG THEN
LET INT_FLAG = FALSE
END IF
NEXT FIELD cantidad
END IF
AFTER FIELD tipo_Costo
IF arr_ordenes[curr].tipo_costo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo_costo
END IF
AFTER FIELD precio
LET arr_ordenes[curr].valor =
arr_ordenes[curr].cantidad * arr_ordenes[curr].precio
IF arr_ordenes[curr].valor IS NULL
OR arr_ordenes[curr].valor = 0 THEN
LET numero_msg = 207
CALL msg(numero_msg)
NEXT FIELD cantidad
END IF
DISPLAY arr_ordenes[curr].valor
TO consart[scr_l].valor
ATTRIBUTE(CYAN)
AFTER FIELD porc_Desc
IF arr_ordenes[curr].porc_desc IS NOT NULL THEN
LET arr_ordenes[curr].monto_desc =
(arr_ordenes[curr].cantidad * arr_ordenes[curr].precio)
* (arr_ordenes[curr].porc_desc / 100)
DISPLAY arr_ordenes[curr].monto_desc
TO consart[scr_l].monto_desc
LET arr_ordenes[curr].valor =
arr_ordenes[curr].valor - arr_ordenes[curr].monto_desc
DISPLAY arr_ordenes[curr].valor TO consart[scr_l].valor
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
FOR idx = 1 TO arr_ordenes.getLength()
IF arr_ordenes[idx].porc_desc IS NOT NULL THEN
LET arr_ordenes[idx].monto_desc =
(arr_ordenes[idx].cantidad * arr_ordenes[idx].precio)
* (arr_ordenes[idx].porc_desc / 100)
DISPLAY arr_ordenes[idx].monto_desc
TO consart[scr_line()].monto_desc
LET arr_ordenes[idx].valor =
arr_ordenes[idx].valor - arr_ordenes[idx].monto_desc
DISPLAY arr_ordenes[idx].valor TO consart[scr_line()].valor
END IF
# CONTROL REPETICION DE CODIGOS DE LOS ITEMS: NO SE PUEDE ACTIVAR CONTROL QUE NO SE REPITAN ITEM,
# UNA REQUISICION DE COMPRAS PUEDE TENER UN ITEM, QUE OTRA REQUISICION TAMBIEN LO TENGA
#IF arr_ordenes[idx].cod_sec IS NOT NULL THEN
# CALL repite3()
#END IF
END FOR
END INPUT
LET valor_total = 0
LET flete1.ot_valor = 0
LET flete1.valor = 0
LET flete1.total_b = 0
LET flete1.descu_valor = 0
FOR idx = 1 TO arr_ordenes.getLength()
IF arr_ordenes[idx].valor IS NOT NULL THEN
LET arr_ordenes[idx].valor =
arr_ordenes[idx].cantidad * arr_ordenes[idx].precio
LET arr_ordenes[idx].monto_desc = 0
IF arr_ordenes[idx].porc_desc IS NOT NULL THEN
LET arr_ordenes[idx].monto_desc =
arr_ordenes[idx].valor * (arr_ordenes[idx].porc_desc / 100)
LET flete1.descu_valor =
flete1.descu_valor + arr_ordenes[idx].monto_desc
END IF
LET flete1.total_b =
(arr_ordenes[idx].cantidad * arr_ordenes[idx].precio)
+ flete1.total_b
LET valor_total =
valor_total
+ arr_ordenes[idx].valor
- arr_ordenes[idx].monto_desc
END IF
END FOR
# El ITBIS solo aplica a proveedores locales. En internacionales (tipo
# 22/24) no hay ITBIS: el campo flete1.valor se usa como FLETE y se captura
# en la ventana de notas (etiquetado FREIGH).
IF NOT es_internacional() THEN
LET opc1 =
fgl_winquestion(
"ITBIS", "DESEA INCLUIR ITBIS?", "YES", "YES|NO", "QUESTION", 0)
IF opc1 = "YES" THEN
LET flete1.valor = valor_total * (itbis / 100)
END IF
ELSE
LET flete1.valor = 0
END IF
LET programa = 9
LET int_flag = FALSE
CALL notas20()
LET opc = "N"
LABEL prob:
LET opc =
fgl_winquestion(
"INFORMACION",
"TODA LA INFORMACION ESTA CORRECTA?",
"YES",
"YES|NO",
"QUESTION",
0)
LET opc = UPSHIFT(opc)
IF (opc IS NULL) OR (opc != "YES" AND opc != "NO") THEN
GOTO prob
END IF
IF opc = "NO" THEN
GOTO incorrecta
END IF
LET fallo = FALSE
WHENEVER ERROR STOP
IF opc = "YES" THEN
SELECT MAX(a.num_oc) INTO ordenes.num_oc FROM cotb00014 a
IF ordenes.num_oc IS NULL THEN
LET ordenes.num_oc = 0
END IF
LET ordenes.num_oc = ordenes.num_oc + 1
LET numero_orden = ordenes.num_oc
DISPLAY BY NAME ordenes.num_oc
DISPLAY BY NAME ordenes.num_oc
LET ordenes.num_oc = numero_orden
# Asegura BRUTO/DESCUENTO/NETO consistentes antes de grabar
CALL recalcula_totales()
BEGIN WORK
UPDATE cotb00030
SET num_oc = numero_orden,
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
INSERT INTO cotb00014(
num_oc,
tipo,
fech_oc,
num_pr,
cod_sp,
cod_sp_Sec,
term_sp,
via,
fech_enviada,
pago,
fech_pago,
cierre,
cod_pt,
total_bruto,
c_flete,
otros_g,
descuento,
neto,
detalle,
us_crea,
fech_crea,
bodega)
VALUES(ordenes.num_oc,
ordenes.tipo,
ordenes.fech_oc,
ordenes.num_pr,
ordenes.cod_sp,
ordenes.cod_sp_sec,
ordenes.term_sp,
ordenes.via,
ordenes.fech_enviada,
ordenes.pago,
ordenes.fech_pago,
ordenes.cierre,
ordenes.cod_pt,
flete1.total_b,
flete1.valor,
flete1.ot_valor,
flete1.descu_valor,
flete1.total_1,
nota,
usuarios,
GETDATE(),
ordenes.bodega)
DELETE FROM cotb00029 WHERE num_oc = ordenes.num_oc
INSERT INTO cotb00029
VALUES(ordenes.num_oc,
ordenes.tipo,
ordenes.cod_sp,
ordenes.cod_sp_sec,
notas.ship_to,
notas.n_a_b,
notas.c_i_d,
c_i_d1,
notas.nota,
nota1,
desc1,
flete1.total_b,
desc2,
flete1.valor,
desc5,
flete1.descu_valor,
desc3,
flete1.ot_valor,
desc4,
NULL,
usuarios,
GETDATE(),
NULL,
NULL)
LET xdetalle_orden = NULL
LET flag = FALSE
LET cont = 0
FOR idx = 1 TO arr_count()
IF arr_ordenes[idx].cod_n IS NOT NULL
AND arr_ordenes[idx].cod_n <> 0 THEN
#ESTA PARTE DEL CODIGO ERA PARA MANDAR LOS SUPLIDORES A MAINTAINX AUTOMATICAMENTE
#QUED DESCARTADO EN LA REUNIN DEL 12/12/24, NEGRIN Y OSCAR LO HARN MANUAL
{ INITIALIZE work_order TO NULL
SELECT orden_trabajo INTO work_order FROM cotb00006 WHERE num_req = arr_ordenes[idx].num_req
AND status_t IS NULL
IF work_order IS NOT NULL THEN
LET flag = TRUE
END IF
IF flag = TRUE AND cont = 0 THEN
SELECT UNIQUE * INTO suplidor.* FROM cotb00001
WHERE cod_sp = ordenes.cod_sp AND cod_sp_sec = ordenes.cod_sp_sec
LET work_order = NULL
IF suplidor.id_maintainx IS NULL THEN
CALL ApiMaintainC('POST', NULL, suplidor.*, usuarios) RETURNING answer, answer2
IF answer IS NULL OR answer = 0 THEN
ROLLBACK WORK
ELSE
IF answer2 = 0 THEN
INITIALIZE answer2 TO NULL
END IF
UPDATE cotb00001 SET id_maintainx = answer,
contactID = answer2 WHERE cod_sp = suplidor.cod_sp AND
cod_sp_sec = suplidor.cod_sp_sec
LET cont = 1
END IF
END IF
END IF }
IF arr_ordenes[idx].tipo_costo = 'EN PUERTO' THEN
LET anio = YEAR(CURRENT)
LET fecha = CURRENT YEAR TO FRACTION
INITIALIZE nullcontainer, precio TO NULL
#CALCULANDO COSTO
IF arr_ordenes[idx].monto_desc IS NOT NULL THEN
LET precio =
arr_ordenes[idx].valor - arr_ordenes[idx].monto_desc
ELSE
LET precio = arr_ordenes[idx].valor
END IF
DISPLAY "Valor: ", precio
IF ordenes.tipo = '01' THEN #Materia prima
LET tabla = 'intb00013'
END IF
IF ordenes.tipo = '02' THEN #Productos terminados
LET tabla = 'iptb00004'
END IF
IF ordenes.tipo = '03' THEN #Repuesto
LET tabla = 'irtb00013'
END IF
PREPARE checking
FROM "SELECT * FROM "
|| tabla
|| " WHERE ano = YEAR(getdate()) and cod_n = ?
and cod_grupo = ? and cod_tipo = ? and cod_sec = ?"
EXECUTE checking
USING arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec
IF STATUS = NOTFOUND THEN
IF ordenes.tipo = '03' OR ordenes.tipo = '01' THEN
PREPARE insertar
FROM "INSERT INTO " || tabla || " (mes_ini,
mes_fin,
ano,
cod_n,
cod_grupo,
cod_tipo,
cod_sec,
costo_st,
status_t,
us_crea,
fech_crea,
us_mod,
fech_mod)
VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?)"
ELSE
PREPARE insertar
FROM "INSERT INTO " || tabla || " (ventas,
mes_ini,
mes_fin,
ano,
cod_n,
cod_grupo,
cod_tipo,
cod_sec,
material,
labor,
gasto,
status_t,
us_crea,
fech_crea,
us_mod,
fech_mod)
VALUES(1,?,?,?,?,?,?,?,?,0,0,?,?,?,?,?)"
END IF
EXECUTE insertar
USING '01',
'12',
anio,
arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec,
precio,
nullcontainer,
usuarios,
fecha,
nullcontainer,
nullcontainer
ELSE
IF ordenes.tipo = '03' OR ordenes.tipo = '01' THEN
PREPARE actualizar
FROM "UPDATE "
|| tabla
|| " set costo_st = ?, us_mod = ?, fech_mod = ? where cod_n = ? and cod_grupo = ?
and cod_tipo = ? and cod_sec = ? and ano = YEAR(GETDATE())"
ELSE
PREPARE actualizar
FROM "UPDATE "
|| tabla
|| " set material = ?, us_mod = ?, fech_mod = ? where cod_n = ? and cod_grupo = ?
and cod_tipo = ? and cod_sec = ? and ano = YEAR(GETDATE())"
END IF
EXECUTE actualizar
USING precio,
usuarios,
fecha,
arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec
END IF
END IF
INSERT INTO cotb00015
VALUES(ordenes.num_oc,
arr_ordenes[idx].num_req,
ordenes.tipo,
arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec,
NULL,
arr_ordenes[idx].cantidad,
arr_ordenes[idx].precio,
arr_ordenes[idx].porc_desc,
arr_ordenes[idx].monto_desc,
cod_mon,
NULL,
SUSER_SNAME(),
GETDATE(),
NULL,
NULL,
arr_ordenes[idx].num_orden,
arr_ordenes[idx].tipo_costo)
IF STATUS < 0 THEN
LET chmensaje =
SQLERRMESSAGE CLIPPED,
"NO ES POSIBLE GUARDAR LA TRANSACCION"
ROLLBACK WORK
LET fallo = TRUE
CALL fgl_Winmessage("ERROR", chmensaje, "STOP")
EXIT FOR
END IF
UPDATE cotb00006
SET estado = 'CERRADA',
us_mod = usuarios,
fech_mod = getdate()
WHERE num_req = arr_ordenes[idx].num_req
UPDATE cotb00008
SET procesada = 'S', us_mod = usuarios, fech_mod = getdate()
WHERE num_req = arr_ordenes[idx].num_req
AND cod_n = arr_ordenes[idx].cod_n
AND cod_grupo = arr_ordenes[idx].cod_grupo
AND cod_tipo = arr_ordenes[idx].cod_tipo
AND COD_SEC = arr_ordenes[idx].cod_sec
IF arr_ordenes[idx].num_orden IS NOT NULL THEN
LET xdetalle_orden =
arr_ordenes[idx].num_orden USING "<<<<<<",
" ",
ktipo_cliente USING "<<",
"-",
ksec_cliente USING "<<<<<<<",
" ",
knombre_cliente CLIPPED,
"; ",
xdetalle_orden CLIPPED
END IF
END IF
END FOR
# ENTREGAS PARCIALES
FOR idx = 1 TO busca_parcial.getLength()
IF busca_parcial[idx].cantidad IS NOT NULL THEN
{ INSERT INTO cotb00037 VALUES
(ordenes.num_oc,ordenes.tipo,ch_cod,NULL,
busca_parcial[idx].fech_emb,busca_parcial[idx].fech_emb,
busca_parcial[idx].cod_n,
busca_parcial[idx].cod_grupo,busca_parcial[idx].cod_tipo,
busca_parcial[idx].cod_sec,busca_parcial[idx].cantidad,
NULL,SUSER_SNAME(),GETDATE(),NULL,NULL)
}
INSERT INTO cotb00025(
num_oc,
tipo,
num_req,
cod_n,
cod_grupo,
cod_tipo,
cod_sec,
fech_ent,
cantidad,
us_crea,
fech_crea,
fech_emb,
fecha_a,
secuencia)
VALUES(ordenes.num_oc,
ordenes.tipo,
requi,
busca_parcial[idx].cod_n,
busca_parcial[idx].cod_grupo,
busca_parcial[idx].cod_tipo,
busca_parcial[idx].cod_sec,
busca_parcial[idx].fech_ent,
busca_parcial[idx].cantidad,
SUSER_SNAME(),
GETDATE(),
busca_parcial[idx].fech_emb,
busca_parcial[idx].fech_ent,
busca_parcial[idx].secuencia)
END IF
END FOR
COMMIT WORK
CALL recalcula_totales()
DISPLAY "ANTES DE LLAMAR LA ORDEN"
DISPLAY "flete1.total_b: ", flete1.total_b
DISPLAY "flete1.ot_valor: ", flete1.ot_valor
DISPLAY "flete1.valor: ", flete1.valor
DISPLAY "flete1.total_1", flete1.total_1
LET opt1 =
fgl_winquestion(
"Atencion",
"Desea Imprimir la orden?",
"cancel",
"YES|NO|",
"question",
0)
IF opt1 = "YES" THEN
CALL orden(
flete1.*,
arr_ordenes,
ordenes.*,
suplidor.nom_sp,
suplidor.dir_sp,
suplidor.ciu_sp,
paises.*,
notas.ship_to,
moneda,
salida,
xnota,
desc1,
desc2,
desc3,
desc4,
desc5,
xdetalle_orden,
xuso_requisicion)
END IF
CALL fgl_winmessage("MENSAJE", "ADICION EXITOSA", "STOP")
END IF
# INSERTA INFORMACION EN INFORMIX
{ SET CONNECTION "IFMX"
INSERT INTO cotb00014 VALUES(ordenes.*,flete1.valor,flete1.ot_valor,
null,null,usuarios,current,usuarios,current)
FOR idx = 1 TO arr_count()
IF arr_ordenes[idx].cod_n is not null and arr_ordenes[idx].cod_n <> 0 THEN
INSERT INTO cotb00015
VALUES (ordenes.num_oc,arr_ordenes[idx].num_req,
ordenes.tipo,arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec,
arr_ordenes[idx].cantidad,
arr_ordenes[idx].precio,
cod_mon,null,usuarios,current,null,null)
END IF
END FOR
#------------------------------------------------------------------------------------------------------
}
CALL busca_parte.clear()
LET flete1.total_b = 0
LET flete1.ot_valor = 0
LET int_flag = FALSE
END FUNCTION
FUNCTION copcmf009()
#WHENEVER ERROR CONTINUE
DEFINE container STRING
INITIALIZE xuso_requisicion, depa TO NULL
CALL lugarentregas()
# Aqui se prepara para la captura del criterio de seleccion
-- cotb00014.bodega excluido: es el mismo combo oculto (tabIndex=-1) en
-- cofmmt009 que ya se excluye en copcad009(); el CONSTRUCT fallaba con
-- "Field (bodega) not found in form".
CONSTRUCT criterio
ON cotb00014.num_oc,
cotb00014.tipo,
cotb00014.fech_oc,
cotb00014.num_pr,
cotb00014.cod_sp,
cotb00014.cod_sp_sec,
cotb00014.term_sp,
cotb00014.enviada,
cotb00014.fech_enviada,
cotb00014.pago,
cotb00014.fech_pago,
cotb00014.cierre
FROM num_oc,
tipo,
fech_oc,
num_pr,
cod_sp,
cod_sp_sec,
term_sp,
enviada,
fech_enviada,
pago,
fech_pago,
cierre
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET selec =
" SELECT UNIQUE cotb00014.num_oc,cotb00014.tipo,cotb00014.num_pr, ",
" cotb00014.cod_sp,cotb00014.cod_sp_sec,cotb00014.term_sp, ",
" cotb00014.via,cotb00014.enviada,cotb00014.fech_enviada, ",
" cotb00014.pago,cotb00014.fech_pago,cotb00014.cierre, ",
" cotb00014.cod_pt,cotb00015.cod_mon,cotb00014.fech_oc, ",
" cotb00014.c_flete,cotb00014.otros_g, cotb00014.bodega ",
" FROM cotb00014,outer cotb00015 ",
" WHERE cotb00014.num_oc = cotb00015.num_oc AND ",
" cotb00014.tipo = cotb00015.tipo AND ",
" cotb00014.status_t is null AND ",
criterio CLIPPED,
" ORDER BY cotb00014.num_oc"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos
INTO ordenes.num_oc,
ordenes.tipo,
ordenes.num_pr,
ordenes.cod_sp,
ordenes.cod_sp_sec,
ordenes.term_sp,
ordenes.via,
ordenes.enviada,
ordenes.fech_enviada,
ordenes.pago,
ordenes.fech_pago,
ordenes.cierre,
ordenes.cod_pt,
cod_mon,
ordenes.fech_oc,
flete1.valor,
flete1.ot_valor,
ordenes.bodega,
korden,
ktipo_cliente,
ksec_cliente,
knombre_cliente
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
# Funcion para la busqueda de lo suplidores, Terminos ded pago,
# descripcion del puesto y la via
CALL escoge()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
# Menu para la busqueda de las informaciones en forma direccional
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos
INTO ordenes.num_oc,
ordenes.tipo,
ordenes.num_pr,
ordenes.cod_sp,
ordenes.cod_sp_sec,
ordenes.term_sp,
ordenes.via,
ordenes.enviada,
ordenes.fech_enviada,
ordenes.pago,
ordenes.fech_pago,
ordenes.cierre,
ordenes.cod_pt,
cod_mon,
ordenes.fech_oc,
flete1.valor,
flete1.ot_valor,
ordenes.bodega,
korden,
ktipo_cliente,
ksec_cliente,
knombre_cliente
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL escoge()
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos
INTO ordenes.num_oc,
ordenes.tipo,
ordenes.num_pr,
ordenes.cod_sp,
ordenes.cod_sp_sec,
ordenes.term_sp,
ordenes.via,
ordenes.enviada,
ordenes.fech_enviada,
ordenes.pago,
ordenes.fech_pago,
ordenes.cierre,
ordenes.cod_pt,
cod_mon,
ordenes.fech_oc,
flete1.valor,
flete1.ot_valor,
ordenes.bodega,
korden,
ktipo_cliente,
ksec_cliente,
knombre_cliente
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL escoge()
COMMAND "Primero" "Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos
INTO ordenes.num_oc,
ordenes.tipo,
ordenes.num_pr,
ordenes.cod_sp,
ordenes.cod_sp_sec,
ordenes.term_sp,
ordenes.via,
ordenes.enviada,
ordenes.fech_enviada,
ordenes.pago,
ordenes.fech_pago,
ordenes.cierre,
ordenes.cod_pt,
cod_mon,
ordenes.fech_oc,
flete1.valor,
flete1.ot_valor,
ordenes.bodega,
korden,
ktipo_cliente,
ksec_cliente,
knombre_cliente
CALL escoge()
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos
INTO ordenes.num_oc,
ordenes.tipo,
ordenes.num_pr,
ordenes.cod_sp,
ordenes.cod_sp_sec,
ordenes.term_sp,
ordenes.via,
ordenes.enviada,
ordenes.fech_enviada,
ordenes.pago,
ordenes.fech_pago,
ordenes.cierre,
ordenes.cod_pt,
cod_mon,
ordenes.fech_oc,
flete1.valor,
flete1.ot_valor,
ordenes.bodega,
korden,
ktipo_cliente,
ksec_cliente,
knombre_cliente
CALL escoge()
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Imprime"
# DESCRIPCION MONEDA
INPUT BY NAME salida
BEFORE INPUT
LET salida = 'SCREEN'
DISPLAY BY NAME salida
AFTER INPUT
IF salida IS NULL THEN
CALL msg(16)
NEXT FIELD salida
END IF
EXIT INPUT
END INPUT
SELECT a.descrip_mon
INTO moneda
FROM cotb00031 a
WHERE a.cod_mon = cod_mon
DECLARE items_ord CURSOR FOR
SELECT a.num_req,
a.cod_n,
a.cod_grupo,
a.cod_tipo,
a.cod_sec,
a.cantidad,
a.tipo_costo,
a.precio,
a.cantidad * a.precio,
a.porc_desc,
a.monto_desc,
a.numero_orden
FROM cotb00015 a
WHERE a.num_oc = ordenes.num_oc
LET idx = 1
SELECT a.descripcion
INTO xtipo_orden
FROM cotb00010 a
WHERE a.tipo = ordenes.tipo
FOREACH items_ord
INTO arr_ordenes[idx].num_req,
arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec,
arr_ordenes[idx].cantidad,
arr_ordenes[idx].tipo_costo,
arr_ordenes[idx].precio,
arr_ordenes[idx].valor,
arr_ordenes[idx].porc_desc,
arr_ordenes[idx].monto_desc,
arr_ordenes[idx].num_orden
LET requi = arr_ordenes[idx].num_req
IF arr_ordenes[idx].monto_desc IS NOT NULL THEN
LET arr_ordenes[idx].valor =
arr_ordenes[idx].valor - arr_ordenes[idx].monto_desc
END IF
CALL producto(
xtipo_orden,
arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec)
RETURNING arr_ordenes[idx].descripcion,
arr_ordenes[idx].unidad
IF xdetalle_orden IS NOT NULL THEN
LET xdetalle_orden =
arr_ordenes[idx].num_orden USING "<<<<<<",
" ",
ktipo_cliente USING "<<",
"-",
ksec_cliente USING "<<<<<<<",
" ",
knombre_cliente CLIPPED,
"; ",
xdetalle_orden CLIPPED
END IF
LET idx = idx + 1
END FOREACH
DISPLAY ARRAY arr_ordenes TO consart.*
AFTER DISPLAY
SELECT ISNULL(a.nota, ' ')
INTO xnota
FROM cotb00029 a
WHERE a.num_oc = ordenes.num_oc
EXIT DISPLAY
END DISPLAY
DISPLAY "DATOS t1 ",
flete1.total_1,
" valor ",
flete1.valor,
" total_b ",
flete1.total_b
PREPARE query2
FROM "SELECT uso, depto_destino FROM cotb00006 WHERE num_req = ? AND status_t IS NULL"
EXECUTE query2 USING requi INTO xuso_requisicion, depa
# Antepone el departamento DESTINO (al que se carga el gasto),
# tomado de cotb00006.depto_destino.
LET container = NULL
PREPARE query3
FROM "SELECT nom_dpto FROM adtb00001 WHERE departamento = ? AND status_t IS NULL"
EXECUTE query3 USING depa INTO container
IF container IS NOT NULL AND container CLIPPED != "" THEN
LET xuso_requisicion =
"(", container CLIPPED, ") ", xuso_requisicion CLIPPED
END IF
DISPLAY xuso_requisicion
{ IF flete1.total_1 = flete1.total_b + flete1.ot_valor THEN
LET flete1.total_1 = flete1.total_b - flete1.ot_valor
ELSE
IF flete1.total_1 = flete1.total_b + flete1.ot_valor + flete1.valor THEN
LET flete1.total_1 = flete1.total_b - flete1.ot_valor + flete1.valor
END IF
END IF }
# ITBIS/flete (c_flete) y otros cargos (otros_g) se leen de la
# maestra cotb00014 (fuente confiable); el BRUTO y el DESCUENTO se
# recalculan desde los items y con ello el NETO. Esto corrige el
# caso en que el NETO se imprimia en .00 al reimprimir.
SELECT ISNULL(a.c_flete, 0), ISNULL(a.otros_g, 0)
INTO flete1.valor, flete1.ot_valor
FROM cotb00014 a
WHERE a.num_oc = ordenes.num_oc
AND a.tipo = ordenes.tipo
CALL recalcula_totales()
# La reimpresion no pasa por notas20(); fijar aqui las etiquetas
# (BRUTO/ITBIS/NETO vs FOB/FREIGH/C&F) segun el tipo de proveedor.
CALL set_etiquetas()
DISPLAY "ANTES DE LLAMAR LA ORDEN"
DISPLAY "flete1.total_b: ", flete1.total_b
DISPLAY "flete1.ot_valor: ", flete1.ot_valor
DISPLAY "flete1.valor: ", flete1.valor
DISPLAY "flete1.total_1", flete1.total_1
CALL orden(
flete1.*,
arr_ordenes,
ordenes.*,
suplidor.nom_sp,
suplidor.dir_sp,
suplidor.ciu_sp,
paises.*,
notas.ship_to,
moneda,
salida,
xnota,
desc1,
desc2,
desc3,
desc4,
desc5,
xdetalle_orden,
xuso_requisicion)
COMMAND "Escoger"
"<Esc> Continua Consultando <Delete> Cancela Operacion"
SELECT a.num_oc
FROM cgtb00017 a
WHERE a.num_oc = ordenes.num_oc AND a.status_t IS NULL
IF STATUS <> NOTFOUND THEN
CALL fgl_winmessage(
"ERROR",
"NO PUEDES MODIFICAR ORDEN, TIENE LIQUIDACION",
"INFO")
CONTINUE MENU
END IF
-- ordenes.bodega excluido (ver nota en copcad009()).
INPUT BY NAME ordenes.num_oc, ordenes.tipo, ordenes.fech_oc, ordenes.num_pr,
ordenes.cod_sp, ordenes.cod_sp_sec, ordenes.term_sp, ordenes.via,
ordenes.enviada, ordenes.fech_enviada, ordenes.pago, ordenes.fech_pago,
ordenes.cierre, ordenes.cod_pt, salida, cod_mon
WITHOUT DEFAULTS
ATTRIBUTE(YELLOW)
BEFORE INPUT
LET salida = "SVG"
ON KEY(CONTROL-W)
CASE
# Control de ventana para la busqueda de los suplidores
WHEN INFIELD(cod_sp)
LET identifica = "O"
CALL busca_sup1()
LET int_flag = FALSE
IF existe = "N" THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET existe = NULL
NEXT FIELD cod_sp
END IF
DISPLAY BY NAME ordenes.cod_sp,
ordenes.cod_sp_sec,
suplidor.nom_sp
LET identifica = NULL
NEXT FIELD cod_sp
WHEN INFIELD(cod_sp_sec)
LET identifica = "O"
CALL busca_sup1()
IF existe = "N" THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET existe = NULL
NEXT FIELD cod_sp
END IF
DISPLAY BY NAME ordenes.cod_sp,
ordenes.cod_sp_sec,
suplidor.nom_sp
LET identifica = NULL
NEXT FIELD cod_sp
END CASE
BEFORE FIELD num_oc
NEXT FIELD tipo
BEFORE FIELD term_sp
CALL busca_terminos()
BEFORE FIELD tipo
CALL tipoorden()
BEFORE FIELD cod_pt
CALL busca_puertos()
BEFORE FIELD cod_mon
CALL busca_monedas()
BEFORE FIELD via
CALL fvia()
AFTER FIELD tipo
# Chequeo del numero del documento si el usuario elige numeracion manual
IF ordenes.tipo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
BEFORE FIELD fech_oc
LET ordenes.fech_oc = TODAY USING "dd/mm/yyyy"
DISPLAY BY NAME ordenes.fech_oc
AFTER FIELD fech_oc
IF ordenes.fech_oc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_oc
END IF
### AQUI CONTROLA LA FECHA DEL DOCUMENTO
IF ordenes.fech_oc < TODAY THEN
LET numero_msg = 364
CALL msg(numero_msg)
NEXT FIELD fech_oc
END IF
LET p_fechas = ordenes.fech_oc
#CALL prd()
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fech_oc
END IF
AFTER FIELD cod_sp
IF ordenes.cod_sp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
AFTER FIELD cod_sp_sec
# Chequeo del suplidor para el desplegue del nombre
IF ordenes.cod_sp_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sp_sec
ELSE
SELECT a.nom_sp,
a.dir_sp,
ciu_sp,
a.cod_pais,
b.nom_pais
INTO suplidor.nom_sp,
suplidor.dir_sp,
suplidor.ciu_sp,
suplidor.cod_pais,
paises.nom_pais
FROM cotb00001 a
LEFT OUTER
JOIN cotb00018 b
ON a.cod_pais = b.cod_pais
WHERE a.cod_sp = ordenes.cod_sp
AND a.cod_sp_sec = ordenes.cod_sp_sec
AND a.status_t IS NULL
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
END IF
DISPLAY BY NAME suplidor.nom_sp, paises.nom_pais
IF suplidor.cod_pais IS NULL THEN
CALL fgl_winmessage(
"ERROR",
"PROVEEDOR NO TIENE PAIS, FAVOR DE MODIFICAR EN MAESTRA",
"INFO")
NEXT FIELD cod_sp
END IF
END IF
AFTER FIELD fech_enviada
IF ordenes.fech_enviada IS NOT NULL THEN
IF ordenes.fech_enviada < ordenes.fech_oc THEN
LET numero_msg = 364
CALL msg(numero_msg)
# NEXT FIELD fech_enviada
END IF
END IF
AFTER FIELD fech_pago
IF ordenes.fech_pago IS NOT NULL THEN
IF ordenes.fech_pago < ordenes.fech_oc THEN
LET numero_msg = 364
CALL msg(numero_msg)
# NEXT FIELD fech_pago
END IF
END IF
AFTER INPUT
IF INT_FLAG THEN
CALL msg(2)
LET INT_FLAG = FALSE
RETURN
END IF
SELECT a.nom_sp, a.dir_sp, ciu_sp, a.cod_pais
INTO suplidor.nom_sp,
suplidor.dir_sp,
suplidor.ciu_sp,
suplidor.cod_pais
FROM cotb00001 a
WHERE a.cod_sp = ordenes.cod_sp
AND a.cod_sp_sec = ordenes.cod_sp_sec
AND a.status_t IS NULL
IF suplidor.cod_pais IS NULL THEN
CALL fgl_winmessage(
"ERROR",
"PROVEEDOR NO TIENE PAIS, FAVOR DE MODIFICAR EN MAESTRA",
"INFO")
NEXT FIELD cod_sp
END IF
IF cod_mon IS NULL THEN
NEXT FIELD cod_mon
END IF
END INPUT
SELECT a.descripcion
INTO xtipo_orden
FROM cotb00010 a
WHERE a.tipo = ordenes.tipo
CALL arr_ordenes.clear()
DECLARE busca20 CURSOR FOR
SELECT a.num_oc,
a.num_req,
a.cod_n,
a.cod_grupo,
a.cod_tipo,
a.cod_Sec,
' ',
' ',
a.cantidad,
a.tipo_costo,
a.precio,
a.porc_desc,
a.monto_desc
FROM cotb00015 a
WHERE (a.num_oc = ordenes.num_oc AND a.tipo = ordenes.tipo)
AND a.status_t IS NULL
ORDER BY a.cod_n, a.cod_grupo, a.cod_tipo, a.cod_Sec
LET idx = 1
FOREACH busca20 INTO arr_ordenes[idx].*
IF arr_ordenes[idx].cod_n IS NOT NULL THEN
CALL producto(
xtipo_orden,
arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec)
RETURNING arr_ordenes[idx].descripcion,
arr_ordenes[idx].unidad
END IF
LET arr_ordenes[idx].valor =
(arr_ordenes[idx].cantidad * arr_ordenes[idx].precio)
- arr_ordenes[idx].monto_desc
LET idx = idx + 1
END FOREACH
CALL set_count(idx - 1)
INPUT ARRAY arr_ordenes
WITHOUT DEFAULTS
FROM consart.*
ATTRIBUTE(YELLOW, INSERT ROW = FALSE, AUTO APPEND = FALSE)
BEFORE ROW
LET curr = arr_curr()
LET scr_l = scr_line()
CALL dialog.setFieldActive('numero_orden', FALSE)
CALL dialog.setFieldActive('num_req', FALSE)
CALL dialog.setFieldActive('cod_n', FALSE)
CALL dialog.setFieldActive('cod_grupo', FALSE)
CALL dialog.setFieldActive('cod_tipo', FALSE)
CALL dialog.setFieldActive('cod_sec', FALSE)
CALL dialog.setFieldActive('descripcion', FALSE)
CALL dialog.setFieldActive('unidad', FALSE)
CALL dialog.setFieldActive('cantidad', FALSE)
CALL dialog.setFieldActive('precio', FALSE)
CALL dialog.setFieldActive('porc_desc', FALSE)
CALL dialog.setFieldActive('monto_desc', FALSE)
CALL dialog.setFieldActive('valor', FALSE)
CALL dialog.setFieldActive('numero_orden', FALSE)
AFTER FIELD num_req
LET curr = arr_curr()
IF arr_ordenes[curr].num_req IS NOT NULL THEN
LET requi = arr_ordenes[curr].num_req
SELECT UNIQUE a.procesada
INTO proce
FROM cotb00008 a
WHERE a.num_req = arr_ordenes[curr].num_req
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num_req
END IF
CALL busca_requi(
arr_ordenes[curr].num_req,
ordenes.tipo,
arr_ordenes[curr].cod_n,
arr_ordenes[curr].cod_grupo,
arr_ordenes[curr].cod_tipo,
arr_ordenes[curr].cod_Sec,
arr_ordenes)
RETURNING arr_ordenes[curr].cod_n,
arr_ordenes[curr].cod_grupo,
arr_ordenes[curr].cod_tipo,
arr_ordenes[curr].cod_sec,
arr_ordenes[curr].descripcion,
arr_ordenes[curr].unidad,
arr_ordenes[curr].cantidad,
arr_ordenes[curr].precio,
m_articulos.dia_llegada,
arr_ordenes[curr].num_orden
DISPLAY arr_ordenes[curr].cod_n TO consart[scr_l].cod_n
DISPLAY arr_ordenes[curr].cod_grupo
TO consart[scr_l].cod_grupo
DISPLAY arr_ordenes[curr].cod_tipo
TO consart[scr_l].cod_tipo
DISPLAY arr_ordenes[curr].cod_sec
TO consart[scr_l].cod_Sec
DISPLAY arr_ordenes[curr].descripcion
TO consart[scr_l].descripcion
DISPLAY arr_ordenes[curr].unidad
TO consart[scr_l].unidad
DISPLAY arr_ordenes[curr].cantidad
TO consart[scr_l].cantidad
DISPLAY arr_ordenes[curr].precio
TO consart[scr_l].precio
NEXT FIELD cantidad
END IF
AFTER FIELD precio
LET arr_ordenes[curr].valor =
arr_ordenes[curr].cantidad * arr_ordenes[curr].precio
IF arr_ordenes[curr].valor IS NULL
OR arr_ordenes[curr].valor = 0 THEN
LET numero_msg = 207
CALL msg(numero_msg)
NEXT FIELD cantidad
END IF
DISPLAY arr_ordenes[curr].valor
TO consart[scr_l].valor
ATTRIBUTE(CYAN)
AFTER FIELD porc_Desc
IF arr_ordenes[curr].porc_desc IS NOT NULL THEN
LET arr_ordenes[curr].monto_desc =
(arr_ordenes[curr].cantidad
* arr_ordenes[curr].precio)
* (arr_ordenes[curr].porc_desc / 100)
DISPLAY arr_ordenes[curr].monto_desc
TO consart[scr_l].monto_desc
LET arr_ordenes[curr].valor =
arr_ordenes[curr].valor
- arr_ordenes[curr].monto_desc
DISPLAY arr_ordenes[curr].valor TO consart[scr_l].valor
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
EXIT INPUT
END INPUT
LET valor_total = 0
LET flete1.ot_valor = 0
LET flete1.valor = 0
LET flete1.total_b = 0
LET flete1.descu_valor = 0
FOR idx = 1 TO arr_ordenes.getLength()
IF arr_ordenes[idx].valor IS NOT NULL THEN
LET arr_ordenes[idx].valor =
arr_ordenes[idx].cantidad * arr_ordenes[idx].precio
LET arr_ordenes[idx].monto_desc = 0
IF arr_ordenes[idx].porc_desc IS NOT NULL THEN
LET arr_ordenes[idx].monto_desc =
arr_ordenes[idx].valor
* (arr_ordenes[idx].porc_desc / 100)
LET flete1.descu_valor =
flete1.descu_valor + arr_ordenes[idx].monto_desc
END IF
LET flete1.total_b =
(arr_ordenes[idx].cantidad * arr_ordenes[idx].precio)
+ flete1.total_b
LET valor_total =
valor_total
+ arr_ordenes[idx].valor
- arr_ordenes[idx].monto_desc
END IF
# CONTROL REPETICION DE CODIGOS DE LOS ITEMS
IF arr_ordenes[idx].cod_sec IS NOT NULL THEN
CALL repite3()
END IF
END FOR
# El ITBIS solo aplica a proveedores locales. En internacionales
# (tipo 22/24) no hay ITBIS: flete1.valor se usa como FLETE.
LET opc1 = "NO"
IF NOT es_internacional() THEN
LET opc1 =
fgl_winquestion(
"ITBIS",
"DESEA INCLUIR ITBIS?",
"YES",
"YES|NO",
"QUESTION",
0)
IF opc1 = "YES" THEN
LET flete1.valor = valor_total * (itbis / 100)
END IF
END IF
LET programa = 9
LET int_flag = FALSE
CALL notas20()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET fallo = FALSE
# Asegura BRUTO/DESCUENTO/NETO consistentes antes de grabar
CALL recalcula_totales()
BEGIN WORK
UPDATE cotb00014
SET (num_oc,
tipo,
fech_oc,
num_pr,
cod_sp,
cod_sp_sec,
term_sp,
via,
enviada,
fech_enviada,
pago,
fech_pago,
cierre,
cod_pt,
bodega,
total_bruto,
c_flete,
otros_g,
descuento,
neto)
= (ordenes.*,
flete1.total_b,
flete1.valor,
flete1.ot_valor,
flete1.descu_valor,
flete1.total_1)
WHERE num_oc = ordenes.num_oc
IF STATUS < 0 THEN
ROLLBACK WORK
CALL fgl_winmessage(
"MENSAJE",
"HA OCURRIDO UN ERROR INSERTANDO EN TABLA MAESTRA",
"STOP")
LET fallo = TRUE
EXIT MENU
END IF
DELETE FROM cotb00029 WHERE num_oc = ordenes.num_oc
INSERT INTO cotb00029
VALUES(ordenes.num_oc,
ordenes.tipo,
ordenes.cod_sp,
ordenes.cod_sp_sec,
notas.ship_to,
notas.n_a_b,
notas.c_i_d,
c_i_d1,
notas.nota,
nota1,
desc1,
flete1.total_b,
desc2,
flete1.valor,
desc5,
flete1.descu_valor,
desc3,
flete1.ot_valor,
desc4,
NULL,
usuarios,
GETDATE(),
NULL,
NULL)
DELETE FROM cotb00015 WHERE num_oc = ordenes.num_oc
FOR idx = 1 TO arr_count()
IF arr_ordenes[idx].cod_n IS NOT NULL
AND arr_ordenes[idx].cod_n <> 0 THEN
IF arr_ordenes[idx].tipo_costo = 'EN PUERTO' THEN
LET anio = YEAR(CURRENT)
LET fecha = CURRENT YEAR TO FRACTION
INITIALIZE nullcontainer TO NULL
IF ordenes.tipo = '01' THEN #Materia prima
LET tabla = 'intb00013'
END IF
IF ordenes.tipo = '02' THEN #Productos terminados
LET tabla = 'iptb00004'
END IF
IF ordenes.tipo = '03' THEN #Repuesto
LET tabla = 'irtb00013'
END IF
PREPARE checking
FROM "SELECT * FROM "
|| tabla
|| " WHERE ano = YEAR(getdate()) and cod_n = ?
and cod_grupo = ? and cod_tipo = ? and cod_sec = ?"
EXECUTE checking
USING arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec
IF STATUS = NOTFOUND THEN
IF ordenes.tipo = '03' OR ordenes.tipo = '01' THEN
PREPARE insertar
FROM "INSERT INTO " || tabla || " (mes_ini,
mes_fin,
ano,
cod_n,
cod_grupo,
cod_tipo,
cod_sec,
costo_st,
status_t,
us_crea,
fech_crea,
us_mod,
fech_mod)
VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?)"
ELSE
PREPARE insertar
FROM "INSERT INTO " || tabla || " (ventas,
mes_ini,
mes_fin,
ano,
cod_n,
cod_grupo,
cod_tipo,
cod_sec,
material,
labor,
gasto,
status_t,
us_crea,
fech_crea,
us_mod,
fech_mod)
VALUES(1,?,?,?,?,?,?,?,?,0,0,?,?,?,?,?)"
END IF
EXECUTE insertar
USING '01',
'12',
anio,
arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec,
arr_ordenes[idx].precio,
nullcontainer,
usuarios,
fecha,
nullcontainer,
nullcontainer
ELSE
IF ordenes.tipo = '03' OR ordenes.tipo = '01' THEN
PREPARE actualizar
FROM "UPDATE "
|| tabla
|| " set costo_st = ?, us_mod = ?, fech_mod = ? where cod_n = ? and cod_grupo = ?
and cod_tipo = ? and cod_sec = ? and ano = YEAR(GETDATE())"
ELSE
PREPARE actualizar
FROM "UPDATE "
|| tabla
|| " set material = ?, us_mod = ?, fech_mod = ? where cod_n = ? and cod_grupo = ?
and cod_tipo = ? and cod_sec = ? and ano = YEAR(GETDATE())"
END IF
EXECUTE actualizar
USING arr_ordenes[idx].precio,
usuarios,
fecha,
arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec
END IF
END IF
INSERT INTO cotb00015
VALUES(ordenes.num_oc,
arr_ordenes[idx].num_req,
ordenes.tipo,
arr_ordenes[idx].cod_n,
arr_ordenes[idx].cod_grupo,
arr_ordenes[idx].cod_tipo,
arr_ordenes[idx].cod_sec,
NULL,
arr_ordenes[idx].cantidad,
arr_ordenes[idx].precio,
arr_ordenes[idx].porc_desc,
arr_ordenes[idx].monto_desc,
cod_mon,
NULL,
SUSER_SNAME(),
GETDATE(),
NULL,
NULL,
NULL,
arr_ordenes[idx].tipo_costo)
IF STATUS < 0 THEN
ROLLBACK WORK
CALL fgl_winmessage(
"MENSAJE",
"HA OCURRIDO UN ERROR INSERTANDO EN DETALLE",
"STOP")
LET fallo = TRUE
EXIT FOR
END IF
UPDATE cotb00008
SET procesada = 'S',
us_mod = usuarios,
fech_mod = getdate()
WHERE num_req = arr_ordenes[idx].num_req
END IF
END FOR
IF fallo = FALSE THEN
COMMIT WORK
CALL fgl_winmessage("MENSAJE", "ADICION EXITOSA", "STOP")
LET opt1 =
fgl_winquestion(
"Atencion",
"Desea Imprimir la orden?",
"cancel",
"YES|NO|",
"question",
0)
IF opt1 = "YES" THEN
PREPARE query4
FROM "SELECT uso, depto_destino FROM cotb00006 WHERE num_req = ? AND status_t IS NULL"
EXECUTE query4 USING requi INTO xuso_requisicion, depa
# Antepone el departamento DESTINO (al que se carga el gasto),
# tomado de cotb00006.depto_destino.
LET container = NULL
PREPARE query5
FROM "SELECT nom_dpto FROM adtb00001 WHERE departamento = ? AND status_t IS NULL"
EXECUTE query5 USING depa INTO container
IF container IS NOT NULL AND container CLIPPED != "" THEN
LET xuso_requisicion =
"(", container CLIPPED, ") ", xuso_requisicion CLIPPED
END IF
DISPLAY xuso_requisicion
SELECT ISNULL(a.c_flete, 0), ISNULL(a.otros_g, 0)
INTO flete1.valor, flete1.ot_valor
FROM cotb00014 a
WHERE a.num_oc = ordenes.num_oc
AND a.tipo = ordenes.tipo
CALL recalcula_totales()
DISPLAY "ANTES DE LLAMAR LA ORDEN"
DISPLAY "flete1.total_b: ", flete1.total_b
DISPLAY "flete1.ot_valor: ", flete1.ot_valor
DISPLAY "flete1.valor: ", flete1.valor
DISPLAY "flete1.total_1", flete1.total_1
CALL orden(
flete1.*,
arr_ordenes,
ordenes.*,
suplidor.nom_sp,
suplidor.dir_sp,
suplidor.ciu_sp,
paises.*,
notas.ship_to,
moneda,
salida,
xnota,
desc1,
desc2,
desc3,
desc4,
desc5,
xdetalle_orden,
xuso_requisicion)
END IF
END IF
CALL msg(13)
COMMAND KEY("N") "aNular"
SELECT DISTINCT a.num_oc
FROM cgtb00017 a
WHERE a.num_oc = ordenes.num_oc AND a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET opc =
fgl_winquestion(
"ANULAR",
"ESTA SEGURO DE ANULAR ORDEN?",
"YES",
"YES|NO",
"QUESTION",
0)
# Actualizacion de la eliminacion logica de las tablas que intervienen el la
# orden de compras
IF opc = "YES" THEN
BEGIN WORK
UPDATE cotb00014
SET status_t = "N",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE @num_oc = ordenes.num_oc AND @tipo = ordenes.tipo
UPDATE cotb00015
SET status_t = "N",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE @num_oc = ordenes.num_oc AND @tipo = ordenes.tipo
UPDATE cotb00029
SET status_t = "N",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE @num_oc = ordenes.num_oc AND @tipo = ordenes.tipo
UPDATE cotb00025
SET status_t = "E",
us_mod = usuarios,
fech_mod = getdate()
WHERE num_oc = ordenes.num_oc
DECLARE busca_req CURSOR FOR
SELECT DISTINCT a.num_req
FROM cotb00015 a
WHERE a.num_oc = ordenes.num_oc
AND a.tipo = ordenes.tipo
FOREACH busca_req INTO xnum_req
UPDATE cotb00006
SET estado = 'ABIERTA',
fech_mod = getdate(),
us_mod = usuarios
WHERE num_req = xnum_req
UPDATE cotb00008
SET procesada = 'N',
us_mod = usuarios,
fech_mod = getdate()
WHERE num_req = xnum_req
END FOREACH
COMMIT WORK
LET numero_msg = 39
CALL msg(numero_msg)
END IF
ELSE
CALL fgl_winmessage(
"INFO", "NO PUEDE ANULAR ORDEN, ESTA LIQUIDADA", "INFO")
END IF
COMMAND "Retornar" "Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
# Esta funcion no se esta utilizando actualmente al 08/09/93
# Su funcion es de enumerar las ordenes de forma automatica
FUNCTION determina1()
OPEN WINDOW realiza AT 10, 10 WITH 5 ROWS, 43 COLUMNS ATTRIBUTE(BORDER)
MENU "OPCION"
COMMAND "Automatica" "Enumera de Forma Automatica"
SELECT UNIQUE MAX(num_oc) INTO ordenes.num_oc FROM cotb00014
IF ordenes.num_oc IS NULL THEN
LET ordenes.num_oc = 1
END IF
LET manual = "N"
EXIT MENU
COMMAND "Manual" "El usuario tiene que enumerar el documento"
LET manual = "S"
EXIT MENU
END MENU
CLOSE WINDOW realiza
END FUNCTION
FUNCTION busca_sup1()
OPEN WINDOW busqueda
AT 10, 10
WITH FORM "cofmwd005"
ATTRIBUTE(BORDER, FORM LINE FIRST + 2, COMMENT LINE LAST)
CONSTRUCT criterio ON cotb00001.nom_sp FROM cotb00001.nom_sp
LET selec =
"SELECT cod_sp,cod_sp_sec,nom_sp FROM cotb00001 ",
" WHERE ",
" status_t is null AND ",
criterio CLIPPED,
"ORDER BY 3 "
PREPARE busco FROM selec
DECLARE local CURSOR FOR busco
LET idx = 1
FOREACH local INTO buscar_wd[idx].*
IF status = NOTFOUND THEN
LET existe = "N"
EXIT FOREACH
END IF
LET despl_wd[idx].codigo =
buscar_wd[idx].cod_sp USING "&&",
"-",
buscar_wd[idx].cod_sp_sec USING "&&&&"
LET despl_wd[idx].nom_sp = buscar_wd[idx].nom_sp CLIPPED
LET idx = idx + 1
IF idx > 200 THEN
EXIT FOREACH
END IF
END FOREACH
CALL set_count(idx - 1)
DISPLAY ARRAY despl_wd TO s_muestra.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GOTO sale
END IF
LET curr = arr_curr()
IF identifica = "O" THEN
LET ordenes.cod_sp = despl_wd[curr].codigo[1, 2]
LET ordenes.cod_sp_sec = despl_wd[curr].codigo[4, 7]
LET suplidor.nom_sp = despl_wd[curr].nom_sp
END IF
LABEL sale:
CLOSE WINDOW busqueda
END FUNCTION
FUNCTION escoge()
SELECT a.nom_sp, a.dir_sp, ciu_sp, a.cod_pais, b.nom_pais
INTO suplidor.nom_sp,
suplidor.dir_sp,
suplidor.ciu_sp,
suplidor.cod_pais,
paises.nom_pais
FROM cotb00001 a LEFT OUTER JOIN cotb00018 b ON a.cod_pais = b.cod_pais
WHERE a.cod_sp = ordenes.cod_sp
AND a.cod_sp_sec = ordenes.cod_sp_sec
AND a.status_t IS NULL
# SELECT nom_sp INTO suplidor.nom_sp FROM cotb00001
# WHERE cod_sp = ordenes.cod_sp AND
# cod_sp_sec = ordenes.cod_sp_sec AND
# status_t is null
CALL busca_monedas()
CALL busca_puertos()
CALL busca_terminos()
CALL lugarentregas()
CALL fvia()
CALL tipoorden()
SELECT a.descrip_mon INTO moneda FROM cotb00031 a WHERE a.cod_mon = cod_mon
SELECT a.ship_to,
a.n_a_b,
a.c_i_d,
a.c_i_d1,
a.nota,
a.nota1,
a.desc_flete,
a.total_flete,
a.desc_otro,
a.total_otro,
a.descripcion,
a.total_valor,
a.desc_valor
INTO notas.ship_to,
notas.n_a_b,
c_i_d,
c_i_d1,
nota,
nota1,
desc1, # bruto
flete1.total_b,
desc3,
flete1.ot_valor,
desc4,
flete1.valor,
desc2
FROM cotb00029 a
WHERE a.num_oc = ordenes.num_oc
DISPLAY BY NAME ordenes.tipo,
ordenes.num_oc THRU ordenes.cod_pt,
suplidor.nom_sp,
ordenes.term_sp,
ordenes.via,
cod_mon,
suplidor.nom_sp,
ordenes.fech_oc,
ordenes.enviada,
ordenes.fech_enviada,
ordenes.via,
ordenes.pago,
ordenes.fech_pago
-- ordenes.bodega excluido (ver nota en copcad009()): no esta en el
-- formulario, DISPLAY BY NAME fallaba con "Field (bodega) not found in form".
IF ordenes.cod_sp = 22 OR ordenes.cod_sp = 24 THEN
LET flete1.total_1 =
flete1.total_b + flete1.ot_valor + flete1.valor - flete1.descu_valor
ELSE
LET flete1.total_1 =
flete1.total_b + flete1.ot_valor + flete1.valor - flete1.descu_valor
END IF
END FUNCTION
FUNCTION repite3()
LET verdad = NULL
LET codigo1 =
arr_ordenes[curr].cod_n USING "&&&&",
"-",
arr_ordenes[curr].cod_grupo USING "&&&&",
"-",
arr_ordenes[curr].cod_tipo USING "&&&&&",
"-",
arr_ordenes[curr].cod_sec USING "&&&&&&&&"
FOR idx = 1 TO num_reg {curr}
IF idx != curr THEN
LET codigo =
arr_ordenes[idx].cod_n USING "&&&&",
"-",
arr_ordenes[idx].cod_grupo USING "&&&&",
"-",
arr_ordenes[idx].cod_tipo USING "&&&&&",
"-",
arr_ordenes[idx].cod_sec USING "&&&&&&&&"
IF codigo1 = codigo THEN
LET verdad = "S"
LET numero_msg = 21
CALL msg(numero_msg)
ELSE
IF verdad != "S" THEN
LET verdad = "N"
END IF
END IF
END IF
END FOR
END FUNCTION
{FUNCTION notas9()
OPEN WINDOW apl_notas AT 10,10 WITH FORM "cofmwd012"
ATTRIBUTE (BORDER,FORM LINE FIRST + 1, comment line last -1)
INPUT BY NAME notas.ship_to,notas.n_a_b,c_i_d,c_i_d1,nota,nota1
WITOUT DEFAULTS
BEFORE FIELD ship_to
IF ordenes.cod_sp = 23 THEN
LET notas.ship_to = p_companias.nombre CLIPPED
LET notas.n_a_b = NULL
LET c_i_d = NULL
LET c_i_d1 = NULL
DISPLAY BY NAME notas.ship_to
NEXT FIELD nota
ELSE
LET notas.ship_to = p_companias.nombre CLIPPED
DISPLAY BY NAME notas.ship_to
END IF
AFTER FIELD ship_to
IF ordenes.cod_sp != 23 THEN
IF notas.ship_to IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD ship_to
END IF
ELSE
LET notas.ship_to = p_companias.nombre CLIPPED
LET notas.n_a_b = NULL
LET c_i_d = NULL
LET c_i_d1 = NULL
DISPLAY BY NAME notas.ship_to
NEXT FIELD nota
END IF
BEFORE FIELD n_a_b
IF ordenes.cod_sp = 23 THEN
LET notas.ship_to = p_companias.nombre CLIPPED
LET notas.n_a_b = NULL
LET c_i_d = NULL
LET c_i_d1 = NULL
DISPLAY BY NAME notas.ship_to
NEXT FIELD nota
END IF
AFTER FIELD n_a_b
IF ordenes.cod_sp != 23 THEN
IF notas.n_a_b IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD n_a_b
END IF
ELSE
LET notas.ship_to = p_companias.nombre CLIPPED
LET notas.n_a_b = NULL
LET c_i_d = NULL
LET c_i_d1 = NULL
DISPLAY BY NAME notas.ship_to
NEXT FIELD nota
END IF
BEFORE FIELD c_i_d
IF ordenes.cod_sp = 23 THEN
LET notas.ship_to = p_companias.nombre CLIPPED
LET notas.n_a_b = NULL
LET c_i_d = NULL
LET c_i_d1 = NULL
DISPLAY BY NAME notas.ship_to
NEXT FIELD nota
END IF
AFTER FIELD c_i_d
IF ordenes.cod_sp != 23 THEN
IF c_i_d IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD c_i_d
END IF
ELSE
LET notas.ship_to = p_companias.nombre CLIPPED
LET notas.n_a_b = NULL
LET c_i_d = NULL
LET c_i_d1 = NULL
DISPLAY BY NAME notas.ship_to
NEXT FIELD nota
END IF
AFTER INPUT
LET notas.nota = nota,nota1
LET notas.c_i_d= c_i_d,c_i_d1
EXIT INPUT
END INPUT
IF int_flag THEN
LET int_flag = FALSE
END IF
DELETE FROM cotb00029 WHERE num_oc = 0 OR num_oc IS NULL
INSERT INTO cotb00029 VALUES (ordenes.num_oc,ordenes.tipo,ordenes.cod_sp,
ordenes.cod_sp_sec,notas.ship_to,notas.n_a_b,
notas.c_i_d,notas.nota,NULL,SUSER_SNAME(),GETDATE(),
NULL,NULL)
CLOSE WINDOW apl_notas
END FUNCTION}
REPORT orden9(x)
DEFINE
x RECORD
num_oc LIKE cotb00014.num_oc,
cod_n LIKE cotb00015.cod_n,
cod_grupo LIKE cotb00015.cod_grupo,
cod_tipo LIKE cotb00015.cod_tipo,
cod_sec LIKE cotb00015.cod_sec,
cantidad LIKE cotb00008.cantidad,
precio LIKE cotb00008.precio,
valor DECIMAL(12, 2)
END RECORD,
descripcion CHAR(70),
nombre_m CHAR(20)
DEFINE doble_on,
doble_off,
negrillas_on,
negrillas_off,
comp_on,
comp_off,
doble_st_on,
doble_st_off,
cuarto_off,
cuarto,
cuarto1,
cuarto2,
normal,
doce
CHAR(2)
DEFINE hora CHAR(5)
DEFINE l SMALLINT
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 3
ORDER BY x.num_oc, x.cod_n, x.cod_grupo, x.cod_tipo, x.cod_sec
FORMAT
PAGE HEADER
LET doble_on = ASCII 14
LET doble_off = ASCII 20
LET doble_st_on = ASCII 27, ASCII 71
LET doble_st_off = ASCII 27, ASCII 72
LET negrillas_on = ASCII 27, ASCII 69
LET negrillas_off = ASCII 27, ASCII 70
LET cuarto = ASCII 27, ASCII 49
LET cuarto1 = ASCII 27, ASCII 48
LET cuarto2 = ASCII 27, ASCII 50
LET cuarto_off = ASCII 27, ASCII 50
LET comp_on = ASCII 15
LET comp_off = ASCII 18
LET doce = ASCII 27, ASCII 77
LET normal = ASCII 27, ASCII 80
LET hora = TIME
BEFORE GROUP OF x.num_oc
LET l = (40 - LENGTH(p_companias.nombre CLIPPED)) / 2
PRINT doce
PRINT COLUMN l + 7,
doble_on,
negrillas_on,
p_companias.nombre CLIPPED,
doble_off,
negrillas_off
PRINT COLUMN 25, "Ave. Central, Madre Vieja Norte"
PRINT COLUMN 24, "San Cristobal, Dominican Republic"
PRINT COLUMN 21, "Tel. (809)528-0650, Fax. (809)528-0640"
PRINT COLUMN 26, " RNC:101-52126-2"
SKIP 1 LINE
PRINT COLUMN 46,
doble_on,
negrillas_on,
"Order No. ",
ordenes.num_oc USING "<<&&&&",
doble_off,
negrillas_off
#----------------------------------------------------------------------------
# CUANDO LA ORDEN ES INTERNACIONAL EL TIPO DE ORDEN ES DIFERENTE A 01
#----------------------------------------------------------------------------
PRINT COLUMN 49,
"DATE : ",
ordenes.fech_oc USING "dd/mm/yyyy",
negrillas_off
LET notas.c_i_d = notas.c_i_d CLIPPED
LET l = LENGTH(notas.c_i_d)
SKIP 2 LINE
PRINT COLUMN 2, "SHIP TO : ", notas.ship_to CLIPPED
SKIP 1 LINE
PRINT COLUMN 2, "Via : ", nom_via CLIPPED
SKIP 2 LINES
PRINT COLUMN 1,
negrillas_on,
"PURCHASE ORDER/ORDEN DE COMPRA",
negrillas_off
PRINT COLUMN 2,
"------------------------------------",
COLUMN 49,
negrillas_on,
"DELIVERY DATE : ",
negrillas_off,
ordenes.fech_enviada USING "dd/mm/yyyy"
PRINT COLUMN 1,
negrillas_on,
"TO/A: ",
negrillas_off,
suplidor.nom_sp CLIPPED,
" (",
ordenes.cod_sp USING "&&",
"-",
ordenes.cod_sp_sec USING "&&&&",
") "
#COLUMN 57, notas.n_a_b
PRINT COLUMN 8,
suplidor.dir_sp CLIPPED,
" ",
suplidor.ciu_sp CLIPPED
#---------------------------
# QUITE ESTE RENGLON PORQUE NO TIENE ESTO EN ESTA ORDEN
#----------------------------
# PRINT COLUMN 92,notas.c_i_d CLIPPED
#----------------------------
PRINT comp_on
SELECT a.descrip_term
INTO pagos.descrip_term
FROM cotb00024 a
WHERE a.term_sp = ordenes.term_sp
PRINT COLUMN 1,
negrillas_on,
"TERMS: ",
negrillas_off,
doce,
pagos.descrip_term
PRINT COLUMN 1, "PROFORMA: ", ordenes.num_pr
PRINT COLUMN 1,
negrillas_off,
"----------------------------------------------------------------------------------",
"-------------------------------"
PRINT doce
PRINT COLUMN 4,
"QUANTITY",
COLUMN 17,
"DESCRIPCION / DESCRIPCION ",
COLUMN 90,
"UNIT PRICE",
COLUMN 107,
"TOTAL"
PRINT COLUMN 4, "CANTIDAD", COLUMN 90, "PRECIO UNITARIO"
PRINT COLUMN 1,
"==============================================================================",
"===================================",
negrillas_off
ON EVERY ROW
LET descripcion = NULL
LET articulos.descrip_esp = NULL
LET articulos.descrip_ing = NULL
LET nombre_m = NULL
IF ordenes.tipo = 1 THEN
SELECT a.descrip_esp, a.unidad_med
INTO pdescripcion, articulos.unidad_med
FROM intb00001 a
WHERE a.cod_n = x.cod_n
AND a.cod_grupo = x.cod_grupo
AND a.cod_tipo = x.cod_tipo
AND a.cod_sec = x.cod_sec
END IF
IF ordenes.tipo = 3 THEN
SELECT a.descrip_esp, a.unidad_med
INTO pdescripcion, articulos.unidad_med
FROM irtb00002 a
WHERE a.cod_n = x.cod_n
AND a.cod_grupo = x.cod_grupo
AND a.cod_tipo = x.cod_tipo
AND a.cod_sec = x.cod_sec
END IF
IF ordenes.tipo = 2 THEN
SELECT a.descrip_esp, a.unidad_med
INTO pdescripcion, articulos.unidad_med
FROM iptb00002 a
WHERE a.cod_n = x.cod_n
AND a.cod_grupo = x.cod_grupo
AND a.cod_tipo = x.cod_tipo
AND a.cod_sec = x.cod_sec
END IF
PRINT COLUMN 1,
x.cantidad USING "###,###.##",
COLUMN 12,
x.cod_n USING "&&",
"-",
x.cod_grupo USING "&&&&",
"-",
x.cod_tipo USING "&&&&",
"-",
x.cod_sec USING "&&&&",
" ",
articulos.unidad_med,
" ",
pdescripcion[1, 50],
COLUMN 87,
x.precio USING "##,###,###.###",
COLUMN 102,
x.valor USING "##,###,###.##"
IF notas.n_a_b IS NOT NULL THEN
PRINT COLUMN 27,
comp_on,
"(NAB:",
notas.n_a_b CLIPPED,
")",
comp_off
END IF
AFTER GROUP OF x.num_oc
PRINT COLUMN 102, "--------------"
PRINT COLUMN 40,
"FOB ",
desc1,
COLUMN 102,
GROUP SUM(x.cantidad * x.precio) USING "##,###,###.##"
IF flete1.valor IS NOT NULL AND flete1.valor > 0 THEN
PRINT COLUMN 40,
"FREIGHT ",
desc2 CLIPPED,
COLUMN 102,
flete1.valor USING "##,###,###.##"
END IF
IF flete1.ot_valor IS NOT NULL AND flete1.ot_valor > 0 THEN
PRINT COLUMN 40,
"OTHERS CHARGES ",
desc3,
COLUMN 102,
flete1.ot_valor USING "##,###,###.##"
END IF
PRINT COLUMN 102, "--------------"
PRINT COLUMN 40,
"C&F ",
desc4,
COLUMN 64,
simb_mon,
COLUMN 102,
flete1.total_1 USING "##,###,###.##"
PRINT COLUMN 102, "=============="
SKIP 1 LINE
IF notas.c_i_d IS NOT NULL THEN
SKIP 1 LINE
PRINT COLUMN 22, "C. I. D.: ", notas.c_i_d CLIPPED
END IF
IF notas.nota IS NOT NULL THEN
SKIP 1 LINE
PRINT COLUMN 22, "NOTE: ", notas.nota
END IF
PAGE TRAILER
PRINT COLUMN 7,
"----------------------------",
COLUMN 45,
"----------------------------"
PRINT COLUMN 10, "PREPARADO POR", COLUMN 50, "PRESIDENTE"
ON LAST ROW
PRINT comp_off
END REPORT
FUNCTION desplega_cod()
DISPLAY arr_ordenes[curr].num_req TO consart[scr_l].num_req
DISPLAY arr_ordenes[curr].cod_n TO consart[scr_l].cod_n
DISPLAY arr_ordenes[curr].cod_grupo TO consart[scr_l].cod_grupo
DISPLAY arr_ordenes[curr].cod_tipo TO consart[scr_l].cod_tipo
DISPLAY arr_ordenes[curr].cod_sec TO consart[scr_l].cod_sec
DISPLAY arr_ordenes[curr].cantidad TO consart[scr_l].cantidad
DISPLAY arr_ordenes[curr].precio TO consart[scr_l].precio
DISPLAY arr_ordenes[curr].valor TO consart[scr_l].valor
SELECT descrip_esp, unidad_med
INTO m_articulos.descrip_esp, m_articulos.unidad_med
FROM intb00001
WHERE cod_n = arr_ordenes[curr].cod_n
AND cod_grupo = arr_ordenes[curr].cod_grupo
AND cod_tipo = arr_ordenes[curr].cod_tipo
AND cod_sec = arr_ordenes[curr].cod_sec
{
SELECT a.cod_nab,a.descrip_esp INTO m_articulos.cod_nab,descrip1
FROM cotb00005 a,intb00002 b
WHERE b.cod_n=arr_ordenes[curr].cod_n and
b.cod_grupo=arr_ordenes[curr].cod_grupo and
b.cod_tipo=arr_ordenes[curr].cod_tipo and
b.cod_sec=arr_ordenes[curr].cod_sec and a.cod_nab = b.cod_nab
DISPLAY BY NAME m_articulos.cod_nab,descrip1,articulos.descrip_esp,
articulos.unidad_med
}
DISPLAY BY NAME descrip1, m_articulos.descrip_esp, m_articulos.unidad_med
END FUNCTION
FUNCTION busca_req()
OPEN WINDOW busqueda11
AT 10, 3
WITH FORM "cofmwd020"
ATTRIBUTE(BORDER, FORM LINE FIRST + 1, COMMENT LINE LAST)
LET selec =
"SELECT DISTINCT c.num_oc,a.num_req,c.fech_req,c.cod_emp_sec,b.nom1_emp, ",
" b.apell1_emp ",
"FROM cotb00008 a,adtb00003 b,cotb00006 c ",
"WHERE a.num_req = c.num_req and a.procesada = 'N' AND ",
" c.cod_emp_sec = b.num_emp ORDER BY a.num_req "
PREPARE comando FROM selec
DECLARE requisi CURSOR FOR comando
IF status = NOTFOUND THEN
LET existe = "N"
ELSE
LET existe = "S"
END IF
LET idx = 1
FOREACH requisi INTO requisiciones[idx].*
LET idx = idx + 1
END FOREACH
IF idx = 1 THEN
LET existe = "N"
GOTO salir
END IF
CALL set_count(idx - 1)
DISPLAY ARRAY requisiciones TO busca_req.*
LET curr1 = arr_curr()
LET arr_ordenes[curr].num_req = requisiciones[curr1].num_req
LABEL salir:
CLOSE WINDOW busqueda11
END FUNCTION
FUNCTION notas20()
OPEN WINDOW apl1_notas
AT 2, 3
WITH FORM "cofmwd014"
ATTRIBUTE(BORDER, FORM LINE FIRST + 1, COMMENT LINE LAST - 1)
# desc1 bruto, desc_fete
# desc3 descuento, desc_ortro
# desc4 neto, descripcion
# desc2 itbis, desc_valor
LET xnota = NULL
CALL set_etiquetas()
LET int_flag = FALSE
SELECT a.ship_to,
a.n_a_b,
a.c_i_d,
a.c_i_d1,
a.nota,
a.nota1,
a.desc_flete,
a.total_flete,
a.desc_otro,
a.total_otro,
a.descripcion,
a.total_valor,
a.desc_valor,
a.desc_descuento,
a.descuento_valor
INTO notas.ship_to,
notas.n_a_b,
c_i_d,
c_i_d1,
nota,
nota1,
desc1, # bruto
flete1.total_b,
desc3,
flete1.ot_valor,
desc4,
flete1.valor,
desc2,
desc5,
flete1.descu_valor
FROM cotb00029 a
WHERE a.num_oc = ordenes.num_oc
# En una orden INTERNACIONAL ya existente (modificacion), el FLETE se
# recupera de la maestra cotb00014.c_flete (fuente confiable) en lugar de
# cotb00029. En ordenes nuevas (num_oc aun NULL) se conserva el valor en
# memoria; en locales el campo es ITBIS y no se toca aqui.
IF ordenes.num_oc IS NOT NULL AND ordenes.num_oc > 0
AND es_internacional() THEN
SELECT ISNULL(a.c_flete, 0)
INTO flete1.valor
FROM cotb00014 a
WHERE a.num_oc = ordenes.num_oc
AND a.tipo = ordenes.tipo
END IF
# Las etiquetas siempre se fijan por tipo de proveedor (cotb00029 pudo
# traer otras almacenadas).
CALL set_etiquetas()
LET notas.ship_to = p_companias.nombre CLIPPED
IF programa = 20 THEN
INPUT BY NAME notas.ship_to,
notas.n_a_b,
c_i_d,
c_i_d1,
nota,
nota1,
desc1,
flete1.total_b,
desc2,
flete1.valor,
desc3,
flete1.ot_valor,
desc4,
desc5,
flete1.descu_valor
WITHOUT DEFAULTS
BEFORE FIELD ship_to
IF ordenes.cod_sp = 23 THEN
LET notas.ship_to = p_companias.nombre CLIPPED
LET notas.n_a_b = NULL
LET c_i_d = NULL
LET c_i_d1 = NULL
DISPLAY BY NAME notas.ship_to
NEXT FIELD nota
ELSE
LET notas.ship_to = p_companias.nombre CLIPPED
DISPLAY BY NAME notas.ship_to
END IF
AFTER FIELD ship_to
IF ordenes.cod_sp != 23 THEN
IF notas.ship_to IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD ship_to
END IF
ELSE
LET notas.ship_to = p_companias.nombre CLIPPED
LET notas.n_a_b = NULL
LET c_i_d = NULL
LET c_i_d1 = NULL
DISPLAY BY NAME notas.ship_to
NEXT FIELD nota
END IF
BEFORE FIELD n_a_b
IF ordenes.cod_sp = 23 THEN
LET notas.ship_to = p_companias.nombre CLIPPED
LET notas.n_a_b = NULL
LET c_i_d = NULL
LET c_i_d1 = NULL
DISPLAY BY NAME notas.ship_to
NEXT FIELD nota
END IF
AFTER INPUT
LET notas.nota = nota, nota1
LET notas.c_i_d = c_i_d, c_i_d1
EXIT INPUT
END INPUT
END IF
IF programa = 9 THEN
DISPLAY BY NAME flete1.total_b,
flete1.valor,
flete1.ot_valor,
flete1.total_1,
flete1.descu_valor
INPUT BY NAME notas.ship_to,
notas.n_a_b,
c_i_d,
c_i_d1,
nota,
nota1,
desc1,
desc2,
flete1.valor,
desc3,
flete1.ot_valor,
desc4,
desc5,
flete1.descu_valor
WITHOUT DEFAULTS
BEFORE INPUT
IF ordenes.cod_sp = 22 OR ordenes.cod_sp = 24 THEN
LET flete1.total_1 =
flete1.ot_valor
+ flete1.total_b
+ flete1.valor
- flete1.descu_valor
ELSE
LET flete1.total_1 =
flete1.total_b
+ flete1.ot_valor
+ flete1.valor
- flete1.descu_valor
END IF
DISPLAY BY NAME flete1.total_1
BEFORE FIELD valor
IF flete1.valor IS NULL THEN
LET flete1.valor = 0
END IF
AFTER FIELD valor
IF flete1.valor IS NULL THEN
LET flete1.valor = 0
END IF
AFTER FIELD ot_valor
IF flete1.ot_valor IS NULL THEN
LET flete1.ot_valor = 0
END IF
AFTER FIELD descu_valor
IF flete1.descu_valor IS NULL THEN
LET flete1.descu_valor = 0
END IF
AFTER INPUT
IF int_flag THEN
EXIT INPUT
END IF
LET xnota = nota CLIPPED, " ", nota1 CLIPPED
EXIT INPUT
END INPUT
END IF
IF int_flag THEN
GOTO salir
END IF
LET notas.nota = nota, nota1
LET notas.c_i_d = c_i_d, c_i_d1
IF flete1.total_b IS NULL THEN
LET flete1.total_b = 0
END IF
IF flete1.valor IS NULL THEN
LET flete1.valor = 0
END IF
IF flete1.ot_valor IS NULL THEN
LET flete1.ot_valor = 0
END IF
IF flete1.descu_valor IS NULL THEN
LET flete1.descu_valor = 0
END IF
LET flete1.total_1 = flete1.total_b + flete1.valor + flete1.ot_valor - flete1.descu_valor
DISPLAY BY NAME flete1.total_1
SLEEP 2
IF programa = 20 THEN
INPUT ARRAY arr_orden20 FROM sc_orden20.*
BEFORE ROW
LET j1 = ARR_CURR()
LET k1 = SCR_LINE()
AFTER FIELD valor1
IF arr_orden20[j1].cantidad IS NULL
OR arr_orden20[j1].valor1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cantidad
END IF
{
LET flete1.total_b = 0
FOR idx = 1 TO ARR_COUNT()
IF flete1.valor > 0 THEN
LET flete1.total_b = flete1.total_b + arr_orden20[idx].valor1
END IF
END FOR
LET flete1.total_1 = flete1.total_b + flete1.valor + flete1.ot_valor
DISPLAY BY NAME flete1.total_1
}
END INPUT
IF int_flag THEN
LET int_flag = FALSE
END IF
END IF
DISPLAY "BRUTO ", flete1.total_b
LABEL salir:
CLOSE WINDOW apl1_notas
END FUNCTION
FUNCTION busca_terminos()
DEFINE
ptermino ui.combobox,
ktermino SMALLINT,
kdescripcion CHAR(30)
LET ptermino = ui.combobox.forname("formonly.term_sp")
CALL ptermino.clear()
DECLARE pagar CURSOR FOR
SELECT term_sp, descrip_term
FROM cotb00024
WHERE status_t IS NULL
ORDER BY descrip_term
FOREACH pagar INTO ktermino, kdescripcion
CALL ptermino.additem(ktermino, kdescripcion)
END FOREACH
END FUNCTION
FUNCTION fvia()
DEFINE pvia ui.combobox
LET pvia = ui.combobox.forname("formonly.via")
CALL pvia.clear()
LET pvia = ui.combobox.forname("formonly.via")
CALL pvia.additem(1, "MARITIMA")
CALL pvia.additem(2, "AEREA")
CALL pvia.additem(3, "TERRESTRE")
END FUNCTION
FUNCTION busca_puertos()
DEFINE
ppuertos ui.combobox,
kpuerto SMALLINT,
kdescripcion CHAR(30)
DECLARE puerto CURSOR FOR
SELECT cod_pt, nom_pt
FROM cotb00019
WHERE status_t IS NULL
ORDER BY nom_pt
LET ppuertos = ui.combobox.forname("formonly.cod_pt")
CALL ppuertos.clear()
FOREACH puerto INTO kpuerto, kdescripcion
CALL ppuertos.additem(kpuerto, kdescripcion)
END FOREACH
END FUNCTION
FUNCTION busca_monedas()
DEFINE
pmoneda ui.combobox,
kmoneda SMALLINT,
kdescripcion CHAR(30)
DECLARE moneda CURSOR FOR
SELECT a.cod_mon, a.descrip_mon
FROM cotb00031 a
WHERE a.status_t IS NULL
ORDER BY a.descrip_mon
LET pmoneda = ui.combobox.forname("formonly.cod_mon")
CALL pmoneda.clear()
FOREACH moneda INTO kmoneda, kdescripcion
CALL pmoneda.additem(kmoneda, kdescripcion)
END FOREACH
END FUNCTION
FUNCTION tipoCosto(cb ui.ComboBox)
{DEFINE tipoCosto ui.combobox
LET tipoCosto = ui.combobox.forname("formonly.tipo_costo")
CALL tipoCosto.clear()
LET tipoCosto = ui.combobox.forname("formonly.tipo_costo")}
CALL cb.additem('FOB', 'FOB')
CALL cb.additem('EN PUERTO', 'EN PUERTO')
END FUNCTION
FUNCTION es_internacional()
# --------------------------------------------------------------------------
# Un proveedor es INTERNACIONAL cuando su TIPO (cotb00001.cod_sp, definido en
# la tabla de tipos cotb00047) es 22 o 24. En esos casos la orden usa el
# esquema FOB / FLETE / C&F (sin ITBIS), en vez de BRUTO / ITBIS / NETO.
# Fuente unica de verdad para distinguir local vs internacional.
# --------------------------------------------------------------------------
RETURN (ordenes.cod_sp = 22 OR ordenes.cod_sp = 24)
END FUNCTION
FUNCTION set_etiquetas()
# --------------------------------------------------------------------------
# Fija las etiquetas de los totales (desc1..desc5) segun el tipo de proveedor.
# Estas etiquetas se imprimen en coprmt009.4rp (xdesc1..xdesc5).
# desc1 = bruto/FOB desc2 = itbis/flete desc3 = otros cargos
# desc4 = neto/C&F desc5 = descuento
# --------------------------------------------------------------------------
IF es_internacional() THEN
LET desc1 = 'FOB'
LET desc5 = 'DISCOUNT'
LET desc3 = 'OTHERS CHARGES'
LET desc4 = 'C&F'
LET desc2 = 'FREIGH'
ELSE
LET desc1 = 'BRUTO'
LET desc5 = 'DESCUENTO'
LET desc3 = 'OTROS CARGOS'
LET desc4 = 'NETO'
LET desc2 = 'ITBIS'
END IF
END FUNCTION
FUNCTION recalcula_totales()
# --------------------------------------------------------------------------
# Recalcula el BRUTO (flete1.total_b) y el DESCUENTO (flete1.descu_valor) a
# partir de los items cargados en arr_ordenes (cotb00015) y, con ello, el
# NETO (flete1.total_1).
#
# NETO = BRUTO + OTROS CARGOS + (ITBIS o FLETE) - DESCUENTO
#
# NO modifica flete1.valor (ITBIS en ordenes locales / FREIGHT en las
# internacionales) ni flete1.ot_valor (otros cargos): esos se capturan y se
# guardan aparte en cotb00014 (c_flete y otros_g). Se debe llamar justo
# antes de guardar o imprimir para garantizar un NETO correcto en ordenes
# locales e internacionales, sin depender de cotb00029 (cuyo layout no es
# confiable).
# --------------------------------------------------------------------------
DEFINE i INTEGER
LET flete1.total_b = 0
LET flete1.descu_valor = 0
FOR i = 1 TO arr_ordenes.getLength()
IF arr_ordenes[i].cantidad IS NOT NULL
AND arr_ordenes[i].precio IS NOT NULL THEN
LET flete1.total_b =
flete1.total_b
+ (arr_ordenes[i].cantidad * arr_ordenes[i].precio)
IF arr_ordenes[i].monto_desc IS NOT NULL THEN
LET flete1.descu_valor =
flete1.descu_valor + arr_ordenes[i].monto_desc
END IF
END IF
END FOR
IF flete1.valor IS NULL THEN
LET flete1.valor = 0
END IF
IF flete1.ot_valor IS NULL THEN
LET flete1.ot_valor = 0
END IF
LET flete1.total_1 =
flete1.total_b
+ flete1.ot_valor
+ flete1.valor
- flete1.descu_valor
END FUNCTION