Files
MBS/PROYECTO/codir/coprcs010.4gl
T

251 lines
8.0 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : COPRRP010
OBJETIVO : Validacion del Documento de la Orden de Compra
PROGRAMADOR : JUAN SOTO
FECHA REALIZACION : AGOSTO 1997
ASESOR : JOSE ALFREDO PAULINO
-------------------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT to "smarmotech" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
CALL coprcs010()
END MAIN
FUNCTION coprcs010()
DEFINE curr,linea integer
DEFINE select_fech,select_movi,select_ent1,select_ent CHAR(1000)
DEFINE j,idxj,idx_o,idx_e,idx_p,idx_m SMALLINT
DEFINE esta,encontre,salir2,salir1,salir CHAR(1)
DEFINE recibida,pendiente DECIMAL(12,2)
DEFINE cod_n1,cod_grupo1,cod_tipo1,cod_sec1 SMALLINT
DEFINE suplidor,descripcion CHAR(45)
DEFINE fecha1,fecha2 DATE
DEFINE unidad_med CHAR(10)
DEFINE total1 DECIMAL(12,2)
DEFINE tipo1 CHAR(2)
DEFINE datos_compra RECORD
tipo LIKE cotb00014.tipo,
num_oc LIKE cotb00014.num_oc,
fech_oc LIKE cotb00014.fech_oc,
cod_sp LIKE cotb00001.cod_sp,
cod_sp_sec LIKE cotb00001.cod_sp_sec,
cantidad DECIMAL(12,2),
precio DECIMAL(12,3),
base LIKE intb00002.base
END RECORD
DEFINE arr_compra DYNAMIC ARRAY OF RECORD
tipo LIKE cotb00014.tipo,
num_oc LIKE cotb00014.num_oc,
fech_oc LIKE cotb00014.fech_oc,
cod_sp LIKE cotb00001.cod_sp,
cod_sp_sec LIKE cotb00001.cod_sp_sec,
cantidad DECIMAL(12,2),
precio DECIMAL(12,2),
valor DECIMAL(12,2),
cantidad_recibida DEC(12,5),
fecha_recibida DATE
END RECORD
DEFINE datos_oc RECORD
num_oc LIKE cotb00014.num_oc,
tipo LIKE cotb00014.tipo,
cantidad DECIMAL(12,2)
END RECORD
#WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 24
OPEN FORM cofmcs010 FROM "cofmcs010"
DISPLAY FORM cofmcs010
LABEL volver:
INPUT BY NAME tipo1,cod_n1,cod_grupo1,cod_tipo1,cod_sec1,fecha1,fecha2
WITHOUT DEFAULTS
AFTER FIELD tipo1
IF tipo1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo1
END IF
AFTER FIELD fecha1
IF fecha1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha1
END IF
BEFORE FIELD fecha2
LET fecha2 = TODAY
DISPLAY BY NAME fecha2
AFTER FIELD fecha2
IF fecha2 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha2
END IF
IF fecha1 > fecha2 THEN
LET numero_msg = 149
CALL msg(numero_msg)
NEXT FIELD fecha1
END IF
AFTER FIELD cod_sec1
IF cod_n1 IS NULL OR cod_grupo1 IS NULL OR
cod_tipo1 IS NULL OR cod_sec1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n1
END IF
IF tipo1 = "01" THEN
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a
WHERE a.cod_n = cod_n1 AND a.cod_grupo =cod_grupo1 AND
a.cod_tipo = cod_tipo1 AND a.cod_sec = cod_sec1
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n1
END IF
END IF
IF tipo1 = "03" THEN
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM irtb00002 a
WHERE a.cod_n = cod_n1 AND a.cod_grupo =cod_grupo1 AND
a.cod_tipo = cod_tipo1 AND a.cod_sec = cod_sec1
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n1
END IF
END IF
IF tipo1 = "02" THEN
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM iptb00002 a
WHERE a.cod_n = cod_n1 AND a.cod_grupo =cod_grupo1 AND
a.cod_tipo = cod_tipo1 AND a.cod_sec = cod_sec1
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n1
END IF
END IF
LET descripcion = articulos.descrip_esp CLIPPED
DISPLAY BY NAME descripcion,articulos.unidad_med ATTRIBUTE(CYAN)
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
DECLARE ent_curs CURSOR FOR
SELECT c.tipo,c.num_oc,c.fech_oc,c.cod_sp,c.cod_sp_sec,
a.cantidad,a.precio,1
FROM cotb00014 c,cotb00015 a
WHERE a.cod_n= cod_n1 AND a.cod_grupo = cod_grupo1 AND
a.cod_tipo = cod_tipo1 AND a.cod_sec= cod_sec1 AND
c.fech_oc BETWEEN fecha1 AND fecha2 AND c.status_t is null AND
a.num_oc = c.num_oc AND a.tipo = c.tipo
UNION
SELECT c.tipo,c.num_oc,c.fech_oc,c.cod_sp,c.cod_sp_sec,
a.cantidad,a.precio,1
FROM cotb00033 c,cotb00034 a
WHERE a.cod_n= cod_n1 AND a.cod_grupo = cod_grupo1 AND
a.cod_tipo = cod_tipo1 AND a.cod_sec= cod_sec1 AND
c.fech_oc BETWEEN fecha1 AND fecha2 AND c.status_t is null AND
a.num_oc = c.num_oc AND a.tipo = c.tipo
ORDER BY c.fech_oc,c.tipo,c.num_oc
DISPLAY "<< Estoy Buscando Las Ordenes de Compras >>"
AT 20,14 ATTRIBUTE (REVERSE,BOLD)
LET j = 1
LET total1 = 0
LET salir = "N"
FOREACH ent_curs INTO datos_compra.*
IF datos_compra.cantidad IS NULL THEN
LET datos_compra.cantidad = 0
END IF
#IF datos_compra.cantidad <> 0 THEN
LET arr_compra[j].num_oc = datos_compra.num_oc
LET arr_compra[j].tipo = datos_compra.tipo
LET arr_compra[j].fech_oc = datos_compra.fech_oc
LET arr_compra[j].cod_sp = datos_compra.cod_sp
LET arr_compra[j].cod_sp_sec = datos_compra.cod_sp_sec
IF datos_compra.base IS NOT NULL THEN
LET arr_compra[j].precio =
datos_compra.precio/datos_compra.base
ELSE
LET arr_compra[j].precio = datos_compra.precio
END IF
LET arr_compra[j].cantidad = datos_compra.cantidad
LET arr_compra[j].valor = arr_compra[j].cantidad *
arr_compra[j].precio
LET total1 = total1 + arr_compra[j].valor
LET j = j + 1
#END IF
END FOREACH
IF j = 0 THEN
LET numero_msg = 3
CALL msg(numero_msg)
CLEAR FORM
GOTO volver
END IF
CALL SET_COUNT(j - 1)
DISPLAY BY NAME total1
INPUT ARRAY arr_compra WITHOUT DEFAULTS FROM s_compra.*
BEFORE ROW
LET curr = ARR_CURR()
LET linea = SCR_LINE()
AFTER FIELD tipo
SELECT a.nom_sp INTO suplidor FROM cotb00001 a
WHERE a.cod_sp = arr_compra[curr].cod_sp AND
a.cod_sp_sec = arr_compra[curr].cod_sp_sec AND
a.status_t IS NULL
DISPLAY BY NAME suplidor
END INPUT
IF int_flag THEN
LET int_flag = FALSE
RETURN
END IF
GOTO volver
END FUNCTION