Files
MBS/PROYECTO/ctdir/ctprrp008.4gl
T

491 lines
16 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : CTPRRP008
OBJETIVO : Historial de precios reales
PROGRAMADOR : Tadeo A. Ferreras
FECHA : Julio 12, 1993.
-------------------------------------------------------------------------------
}
GLOBALS
"ctprgb000.4gl"
###### Definicion de variables a usar en la generacion del reporte ######
DEFINE p_porciento,porciento DECIMAL(8,3),
opt1 CHAR(4)
DEFINE selec5,selec2,selec1 CHAR(1000)
DEFINE anos CHAR(4)
DEFINE labor,t_cantidad DECIMAL(12,3)
DEFINE ano1,mes1,mes3,idx_1,idx_2 INTEGER
DEFINE salir,salir1,salir2,busqueda CHAR(1),
descrip_invent CHAR(30)
DEFINE fecha1,fecha2 DATE
DEFINE codgp,tipo_invent SMALLINT
DEFINE tmes INTEGER
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CONNECT to "smarmotech" USER usuarios USING clave
SELECT a.* INTO p_compania.* FROM companias a
CALL ctprrp008()
END MAIN
FUNCTION ctprrp008()
DEFINE histo RECORD
mes2 SMALLINT,
cod_n LIKE cttb00013.cod_n,
cod_grupo LIKE cttb00013.cod_grupo,
cod_tipo LIKE cttb00013.cod_tipo,
cod_sec LIKE cttb00013.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
costo_lq DECIMAL(12,4),
codigo VARCHAR(50)
END RECORD
OPTIONS
ERROR LINE 24,
FORM LINE 8
######## Abriendo el formulario para digitar criterio de busqueda ####
OPEN FORM ctfmrp008 FROM "ctfmrp008"
DISPLAY FORM ctfmrp008
##### Captura de informacion para criterio de busqueda #######
INPUT BY NAME ano1,mes1,p_porciento,salida,tipo_invent,busqueda
AFTER FIELD salida
IF salida IS NULL THEN
CALL msg(16)
NEXT FIELD salida
END IF
after field TIPO_INVENT
CASE
WHEN tipo_invent = 1
LET descrip_invent = "MATERIA PRIMA"
EXIT CASE
WHEN tipo_invent = 2
LET descrip_invent = "PRODUCTOS TERMINADOS"
EXIT CASE
WHEN tipo_invent = 3
LET descrip_invent = "REPUESTOS"
EXIT CASE
END CASE
AFTER FIELD ano1
IF ano1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD ano1
END IF
AFTER FIELD mes1
IF mes1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD mes1
END IF
IF mes1 > 12 THEN
LET numero_msg = 51
CALL msg(numero_msg)
NEXT FIELD mes1
END IF
SELECT fecha_inicio INTO fecha1 FROM prdtable WHERE ano = ano1 AND mes = 1
SELECT fecha_corte INTO fecha2 FROM prdtable WHERE ano = ano1 AND mes = mes1
AFTER FIELD p_porciento
IF p_porciento IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD p_porciento
END IF
AFTER INPUT
IF salida IS NULL THEN
LET salida='MA'
DISPLAY BY NAME salida
NEXT FIELD salida
END IF
END INPUT
###### Facicilidad para cancelar el reporte (OPcional) ############
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
CONSTRUCT BY NAME criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_Sec
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
###### Selecionando informacion a imprimir ############
IF salida ='MA' THEN
CALL defecto(usuarios,clave,impresor) RETURNING imprime,negrilla_on,negrillas_of,
doble_on,doble_off,comp_on,comp_off,
doce,normal,archivo,copia
LET opt1 = fgl_winquestion("Atencion","Desea Reporte por Pantalla?",
"no","yes|no","question",0)
IF opt1 = "yes" THEN
START REPORT histori TO screen
ELSE
START REPORT histori TO archivo
END IF
ELSE
CALL configureoutput(salida) RETURNING HANDLER
IF salida ='XLS' THEN
CALL fgl_report_configurexlsxdevice(null,null,null,false,false,null,1)
END IF
START REPORT histori TO XML HANDLER handler
END IF
DISPLAY "<< >>" AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE(REVERSE)
IF busqueda = "A" THEN
IF tipo_invent = 1 THEN
LET selec5 =
"SELECT DISTINCT c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
" b.descrip_esp,b.unidad_med,AVG(a.costo_lq) ",
"FROM cttb00013 a,intb00001 b,prdtable c ",
"WHERE 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.status_t IS NULL AND a.fecha_lq BETWEEN c.fecha_inicio AND ",
" c.fecha_corte AND c.ano = ? AND c.mes <= ? AND a.tipo_orden = 1 AND ",
criterio CLIPPED,
" GROUP BY c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp,b.unidad_med "
END IF
IF tipo_invent = 2 THEN #### PRODUCTOS TERMINADOS
LET selec5 =
"SELECT UNIQUE c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
" b.descrip_esp,b.unidad_med,AVG(a.costo_lq) ",
"FROM cttb00013 a,iptb00002 b,prdtable c ",
"WHERE 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.status_t IS NULL AND a.fecha_lq BETWEEN c.fecha_inicio AND ",
" c.fecha_corte AND c.ano = ? AND c.mes <= ? and a.tipo_orden = 2 AND ",
criterio CLIPPED,
" GROUP BY c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp,b.unidad_med "
END IF
IF tipo_invent = 3 THEN ### REPUESTOS
LET selec5 =
"SELECT UNIQUE c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
" b.descrip_esp,b.unidad_med,AVG(a.costo_lq) ",
"FROM cttb00013 a,irtb00002 b,prdtable c ",
"WHERE 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.status_t IS NULL AND a.fecha_lq BETWEEN c.fecha_inicio AND ",
" c.fecha_corte AND c.ano = ? AND c.mes <= ? and a.tipo_orden = 3 AND ",
criterio CLIPPED,
" GROUP BY c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp,b.unidad_med "
END IF
ELSE
IF tipo_invent = 1 THEN
LET selec5 =
"SELECT DISTINCT c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
" b.descrip_esp,b.unidad_med,AVG(a.costo_lq) ",
"FROM cttb00013 a,intb00001 b,prdtable c ",
"WHERE 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.status_t IS NULL AND a.fecha_lq BETWEEN c.fecha_inicio AND ",
" c.fecha_corte AND c.ano = ? AND c.mes <= ? AND a.tipo_orden = 1 AND ",
criterio CLIPPED,
" GROUP BY c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp,b.unidad_med "
END IF
IF tipo_invent = 2 THEN #### PRODUCTOS TERMINADOS
LET selec5 =
"SELECT UNIQUE c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
" b.descrip_esp,b.unidad_med,AVG(a.costo_lq) ",
"FROM historicoMTECH.dbo.cttb00013 a,historicoMTECH.dbo.iptb00002 b,historicoMTECH.dbo.prdtable c ",
"WHERE 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.status_t IS NULL AND a.fecha_lq BETWEEN c.fecha_inicio AND ",
" c.fecha_corte AND c.ano = ? AND c.mes <= ? and a.tipo_orden = 2 AND ",
criterio CLIPPED,
" GROUP BY c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp,b.unidad_med "
END IF
IF tipo_invent = 3 THEN ### REPUESTOS
LET selec5 =
"SELECT UNIQUE c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
" b.descrip_esp,b.unidad_med,AVG(a.costo_lq) ",
"FROM cttb00013 a,irtb00002 b,prdtable c ",
"WHERE 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.status_t IS NULL AND a.fecha_lq BETWEEN c.fecha_inicio AND ",
" c.fecha_corte AND c.ano = ? AND c.mes <= ? and a.tipo_orden = 3 AND ",
criterio CLIPPED,
" GROUP BY c.mes,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp,b.unidad_med "
END IF
END IF
DISPLAY "<< Buscando Informacion ... Espere Por Favor. >>"
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
PREPARE comando4 FROM selec5
DECLARE busca4 CURSOR FOR comando4
OPEN busca4 USING ano1,mes1
IF STATUS = NOTFOUND THEN
CALL fgl_winmessage("WARNING","NO EXISTEN REGISTROS CON ESA CONDICION","INFO")
EXIT PROGRAM
END IF
##### Creando el loop de busqueda ###########
FOREACH busca4 INTO histo.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET histo.codigo = histo.cod_n USING "&&&&&","-",histo.cod_grupo USING "&&&&&","-",
histo.cod_tipo USING "&&&&&","-",histo.cod_sec USING "&&&&&&&","-"
OUTPUT TO REPORT histori(histo.*)
END FOREACH
FINISH REPORT histori
IF salida ='MA' THEN
IF opt1 <> "yes" THEN
RUN imprime
END IF
END IF
END FUNCTION
####### Creando el formato para la salida de informacion #########
REPORT histori(x)
DEFINE x RECORD
mes2 SMALLINT,
cod_n LIKE cttb00013.cod_n,
cod_grupo LIKE cttb00013.cod_grupo,
cod_tipo LIKE cttb00013.cod_tipo,
cod_sec LIKE cttb00013.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
costo_lq DECIMAL(12,4),
codigo VARCHAR(50)
END RECORD,
converti CHAR(1)
DEFINE promedio DECIMAL(12,3)
DEFINE costo_st DECIMAL(12,4)
#DEFINE mes ARRAY[7] OF SMALLINT
DEFINE fecha3,fecha4,fecha5 DATE
DEFINE i INTEGER
DEFINE labor,gasto,labor1,gasto1,pprecio DECIMAL(12,2)
DEFINE cantidad1 ARRAY[200] OF DECIMAL(12,3)
DEFINE cantidad2 ARRAY[200] OF DECIMAL(12,3)
DEFINE unidad,descrp1,nomb,nombre CHAR(15)
DEFINE descr CHAR(20)
DEFINE total,total2,total3,total4,total5,total6,total7,total8,total9
DECIMAL(13,8)
DEFINE fact_hombre,cod_grupo,hora_hombre,valor_real,factor_conv
DECIMAL(13,8)
DEFINE total1 INTEGER
OUTPUT
LEFT MARGIN 00
ORDER BY x.cod_n,x.cod_grupo,x.cod_tipo,x.cod_sec,x.mes2
FORMAT
PAGE HEADER
LET l = (100 - LENGTH(p_compania.nombre CLIPPED)) /2
PRINT normal
PRINT COLUMN 1,"ctprrp008",
COLUMN l, p_compania.nombre CLIPPED,
COLUMN 96, "Pag. ",pageno using "###"
LET l = (100 - LENGTH("Sistema de Costos")) /2
PRINT COLUMN l, "Sistema de Costos",
COLUMN 96, today using "dd/mm/yy"
LET l = (100 - LENGTH("Historial de Precios Reales")) /2
PRINT COLUMN l, "Historial de Precios Reales",
COLUMN 96, time
PRINT negrillas_of
PRINT doce,comp_on
PRINT COLUMN 1, "DEl ",fecha1 USING "dd/mm/yy", " Al ",
fecha2 USING "dd/mm/yy"
PRINT COLUMN 1, "Porcentaje Mayor a ",p_porciento using "###.##"
PRINT COLUMN 1, descrip_invent
PRINT COLUMN 1,
"----------------------------------------------------------------------------",
"----------------------------------------------------------------------------",
"----------------------------------------------------------------------------",
"-----------------"
PRINT COLUMN 1,"Material ",
COLUMN 45,"Unidad",
COLUMN 52,"|",
COLUMN 60, "Costo"
PRINT COLUMN 60, "Stand";
LET i = 70
LET fecha5 = fecha1
###### Loop para impresion en forma tabular ########
FOR idx = 1 to 12
LET mes3 = month(fecha5)
PRINT COLUMN i," ",fecha5 USING "mmm/yy","|";
LET fecha5 = fecha5 + 31
LET i = i + 12
END FOR
LET i = i + 5 + 6
PRINT COLUMN i-7, "Promedio",
COLUMN i+3, "Variacion %"
PRINT COLUMN 1,
"----------------------------------------------------------------------------",
"----------------------------------------------------------------------------",
"----------------------------------------------------------------------------",
"-----------------"
LET idx = 1
BEFORE GROUP OF x.codigo
LET costo_st = 0
LET promedio = 0
FOR idx = 1 TO 12
LET cantidad1[idx] = 0
LET cantidad2[idx] = 0
END FOR
LET costo_st = 0
IF tipo_invent = 1 THEN
SELECT MAX(a.costo_st) INTO costo_st FROM intb00013 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 and
a.ano = ano1 and a.status_t is null
END IF
IF tipo_invent = 2 THEN
SELECT MAX(a.material + a.labor + a.gastos) INTO costo_st FROM iptb00004 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 and
a.ano = ano1 and a.status_t is NULL
LET pprecio = 0
SELECT AVG(a.precio) INTO pprecio FROM vetb00025 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 AND
a.ventas = 1
END IF
IF tipo_invent = 3 THEN
SELECT MAX(a.costo_st) INTO costo_st FROM irtb00013 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 and
a.ano = ano1 and a.status_t is null
END IF
{BUSCA EL COSTO DE LIQUIDACION DEL PRODUCTO}
SELECT AVG(a.costo_lq) INTO promedio FROM cttb00013 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 and a.tipo_orden = tipo_invent and
a.fecha between fecha1 and fecha2 and a.status_t is null
IF costo_st IS NULL THEN
LET costo_st = 0
END IF
IF promedio IS NULL THEN
LET promedio = 0
END IF
IF promedio > 0 THEN
LET porciento = ((promedio - costo_st)/promedio)*100
ELSE
LET porciento = 0
END IF
LET converti = "N"
IF porciento < 0 THEN
LET porciento = porciento * -1
LET converti = "S"
END IF
IF porciento >= p_porciento THEN
PRINT COLUMN 1, x.cod_n USING "&&&","-",x.cod_grupo USING "&&&&","-",
x.cod_tipo USING "&&&&","-",x.cod_sec USING "&&&&"," ",
x.descrip_esp clipped,
COLUMN 46,x.unidad_med clipped,
COLUMN 52,"|",
COLUMN 54,costo_st using "###,###.#####","|";
END IF
ON EVERY ROW
IF porciento >= p_porciento THEN
LET idx = x.mes2
LET cantidad1[idx] = 0
LET cantidad2[idx] = 0
LET cantidad1[idx] = x.costo_lq
LET cantidad2[idx] = cantidad1[idx]
END IF
AFTER GROUP OF x.codigo
IF porciento >= p_porciento THEN
LET i = 66
FOR idx = 1 TO 12
IF cantidad1[idx] IS NULL THEN
LET cantidad1[idx] = 0
END IF
IF cantidad2[idx] IS NULL THEN
LET cantidad2[idx] = 0
END IF
PRINT COLUMN i,cantidad2[idx] USING "###,##&.&&&", "|";
LET i = i + 9
LET cantidad2[idx] = 0
END FOR
IF converti = "S" THEN
LET porciento = porciento * -1
END IF
# LET promedio = AVG(x.costo_lq)
PRINT COLUMN i,promedio using "###,###.#####",
COLUMN i+14,promedio - costo_st using "(((,(((.####)",
COLUMN i+26+2, porciento using "###.##",
2 spaces, pprecio USING "##,###.##"
END IF
ON LAST ROW
PRINT COLUMN 1,
"============================================================================",
"============================================================================",
"=================================================================="
PRINT COLUMN 1,negrillas_of,normal
END REPORT