427 lines
14 KiB
Plaintext
427 lines
14 KiB
Plaintext
{
|
|
-------------------------------------------------------------------------------
|
|
PROGRAMA : CCPRRP024
|
|
OBJETIVO : Estadisticas de Devoluciones por Mes y Ano
|
|
PROGRAMADOR : Tadeo A. Ferreras
|
|
FECHA REALIZACION : Enero 20, 1993
|
|
-------------------------------------------------------------------------------
|
|
}
|
|
GLOBALS "ccprgb000.4gl"
|
|
|
|
DEFINE prima_us DECIMAL(8,2)
|
|
DEFINE precio1 DECIMAL(12,2)
|
|
|
|
DEFINE devol RECORD
|
|
cod_n SMALLINT,
|
|
cod_grupo SMALLINT,
|
|
cod_tipo SMALLINT,
|
|
cod_sec SMALLINT,
|
|
descrip_esp CHAR(30),
|
|
unidad_med CHAR(3),
|
|
fact_no LIKE iptb00006.fact_no,
|
|
mes SMALLINT,
|
|
cantidad_vr DECIMAL(12,3),
|
|
valor_vr DECIMAL(14,2),
|
|
codigo CHAR(7)
|
|
END RECORD
|
|
|
|
DEFINE entrada RECORD
|
|
ano SMALLINT,
|
|
mes SMALLINT
|
|
END RECORD
|
|
|
|
DEFINE ano_anterior, ano_tras_anterior SMALLINT
|
|
|
|
FUNCTION ccprrp024()
|
|
|
|
DEFINE select_pt,select_vr,select_vp,select_vap,select_pres CHAR(1000)
|
|
DEFINE idx_pt,idx_vr,idx_vp,idx_vap,idx_pres,mes_inicial,x SMALLINT
|
|
DEFINE salir_pt,salir_vr,salir_vp,salir_vap,salir_pres,doble_proceso CHAR(1)
|
|
DEFINE mes_proceso, mes_vp, mes_vap CHAR(4)
|
|
DEFINE mes_proceso1 CHAR(2)
|
|
DEFINE fecha_final DATE
|
|
|
|
DEFINE pt RECORD
|
|
cod_n SMALLINT,
|
|
cod_grupo SMALLINT,
|
|
cod_tipo SMALLINT,
|
|
cod_sec SMALLINT,
|
|
descrip_esp CHAR(30),
|
|
unidad_med CHAR(30)
|
|
END RECORD
|
|
|
|
DEFINE vr RECORD
|
|
cantidad DECIMAL(12,3),
|
|
valor DECIMAL(14,2),
|
|
cod_n SMALLINT,
|
|
cod_grupo SMALLINT,
|
|
cod_tipo SMALLINT,
|
|
cod_sec SMALLINT,
|
|
fact_no LIKE iptb00006.fact_no,
|
|
mes SMALLINT
|
|
END RECORD
|
|
|
|
DEFINE vp RECORD
|
|
cantidad DECIMAL(12,3),
|
|
valor DECIMAL(14,2),
|
|
cod_n SMALLINT,
|
|
cod_grupo SMALLINT,
|
|
cod_tipo SMALLINT,
|
|
cod_sec SMALLINT,
|
|
mes CHAR(4),
|
|
tipo_devol1 CHAR(1)
|
|
END RECORD
|
|
|
|
DEFINE vap RECORD
|
|
cantidad DECIMAL(12,3),
|
|
valor DECIMAL(14,2),
|
|
cod_n SMALLINT,
|
|
cod_grupo SMALLINT,
|
|
cod_tipo SMALLINT,
|
|
cod_sec SMALLINT,
|
|
mes CHAR(4),
|
|
tipo_devol1 CHAR(1)
|
|
END RECORD
|
|
|
|
DEFINE pres RECORD
|
|
cantidad DECIMAL(12,3),
|
|
valor DECIMAL(14,2),
|
|
cod_n SMALLINT,
|
|
cod_grupo SMALLINT,
|
|
cod_tipo SMALLINT,
|
|
cod_sec SMALLINT,
|
|
mes CHAR(4),
|
|
tipo_devol1 CHAR(1)
|
|
END RECORD
|
|
DEFINE ano1 CHAR(4)
|
|
|
|
# WHENEVER ERROR CONTINUE
|
|
|
|
OPTIONS
|
|
FORM LINE 8,
|
|
ERROR LINE 23,
|
|
COMMENT LINE 21
|
|
|
|
OPEN FORM ccfmrp024 FROM "ccfmrp024"
|
|
DISPLAY FORM ccfmrp024
|
|
CALL pantalla()
|
|
DISPLAY "ccprrp024" AT 4,3
|
|
DISPLAY "Devoluciones por Mes, Ano y Producto" AT 6,22
|
|
|
|
LET tipo_papel = 1
|
|
CALL msgrp000(tipo_papel)
|
|
|
|
INPUT BY NAME entrada.*
|
|
AFTER FIELD ano
|
|
IF entrada.ano is null OR entrada.ano = 0 THEN
|
|
LET numero_msg = 16
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD ano
|
|
END IF
|
|
|
|
SELECT fecha_in, status_t INTO mes_inicial, salir_pt
|
|
FROM vetb00018 WHERE anos = entrada.ano
|
|
|
|
IF status = NOTFOUND THEN
|
|
LET numero_msg = 129
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD ano
|
|
ELSE
|
|
IF salir_pt = "E" THEN
|
|
LET numero_msg = 130
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD ano
|
|
END IF
|
|
END IF
|
|
|
|
AFTER FIELD mes
|
|
IF entrada.mes is null OR entrada.mes = 0 THEN
|
|
LET numero_msg = 16
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD mes
|
|
END IF
|
|
|
|
LET mes_proceso = entrada.mes using "&&"
|
|
LET mes_vp = entrada.mes - 100 using "&&&&"
|
|
LET mes_vap = entrada.mes - 200 using "&&&&"
|
|
LET ano1 = entrada.ano USING "&&&&"
|
|
|
|
SELECT UNIQUE fecha_corte INTO fecha_final
|
|
FROM prdtable WHERE ano = entrada.ano AND mes = entrada.mes
|
|
|
|
END INPUT
|
|
IF int_flag THEN
|
|
LET numero_msg = 2
|
|
CALL msg(numero_msg)
|
|
LET int_flag = false
|
|
RETURN
|
|
END IF
|
|
|
|
CONSTRUCT criterio ON b.cod_n, b.cod_grupo, b.cod_tipo, b.cod_sec
|
|
FROM cod_n, cod_grupo, cod_tipo, cod_sec
|
|
|
|
IF int_flag THEN
|
|
LET numero_msg = 2
|
|
CALL msg(numero_msg)
|
|
LET int_flag = false
|
|
RETURN
|
|
END IF
|
|
|
|
# Busca los codigos de los productos terminados
|
|
|
|
LET select_pt =
|
|
"SELECT b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec,d.descrip_esp,d.unidad_med ",
|
|
"FROM iptb00002 b, intb00001 d ",
|
|
"WHERE b.status_t is null and (b.cod_n=d.cod_n and b.cod_grupo=d.cod_grupo ",
|
|
"AND b.cod_tipo = d.cod_tipo and b.cod_sec = d.cod_sec and ",criterio clipped,
|
|
" ) ORDER BY 1,2,3,4 "
|
|
|
|
DISPLAY " " AT 19,14
|
|
DISPLAY "<< Buscando Productos Terminados. >>" AT 19,14
|
|
|
|
PREPARE busca_pt FROM select_pt
|
|
DECLARE movi_pt CURSOR FOR busca_pt
|
|
OPEN movi_pt
|
|
|
|
IF int_flag THEN
|
|
LET numero_msg = 2
|
|
CALL msg(numero_msg)
|
|
LET int_flag = false
|
|
RETURN
|
|
END IF
|
|
|
|
# Busca las devoluciones reales de ano actual hasta el mes indicado
|
|
|
|
LET select_vr =
|
|
" SELECT sum(b.cantidad_2),sum(b.cantidad_2*1),b.cod_n,b.cod_grupo, ",
|
|
" b.cod_tipo, b.cod_sec, b.fact_no, a.mes ",
|
|
"FROM iptb00006 b,prdtable a ",
|
|
"WHERE b.status_t IS NULL AND (b.cod_mov IN (12,13)) AND a.ano = ? AND ",
|
|
" a.mes <= ? AND ",criterio CLIPPED," AND ",
|
|
" (b.fecha BETWEEN a.fecha_inicio AND a.fecha_corte) ",
|
|
"GROUP BY 3,4,5,6,7,8 ORDER BY 3,4,5,6,7,8 "
|
|
|
|
DISPLAY " " AT 19,14
|
|
DISPLAY "<< Buscando Informaciones del Ano Actual. >>" AT 19,14
|
|
|
|
PREPARE busca_vr FROM select_vr
|
|
DECLARE movi_vr SCROLL CURSOR FOR busca_vr
|
|
OPEN movi_vr USING entrada.ano, entrada.mes
|
|
|
|
IF int_flag THEN
|
|
LET numero_msg = 2
|
|
CALL msg(numero_msg)
|
|
LET int_flag = false
|
|
RETURN
|
|
END IF
|
|
|
|
START REPORT devol1 TO "C:\\archivo"
|
|
DISPLAY " " AT 19,14
|
|
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
|
|
AT 19,14 ATTRIBUTE (REVERSE)
|
|
|
|
LET idx_pt = 1
|
|
LET salir_pt = "N"
|
|
WHILE salir_pt != "S"
|
|
FETCH movi_pt INTO pt.*
|
|
|
|
IF STATUS = NOTFOUND THEN
|
|
LET salir_pt = "S"
|
|
LET idx_pt = 1
|
|
EXIT WHILE
|
|
END IF
|
|
|
|
IF int_flag THEN
|
|
LET numero_msg = 2
|
|
CALL msg(numero_msg)
|
|
LET int_flag = false
|
|
RETURN
|
|
END IF
|
|
|
|
LET idx_pt = idx_pt + 1
|
|
|
|
LET devol.codigo = pt.cod_n USING "&",
|
|
pt.cod_grupo USING "&",
|
|
pt.cod_tipo USING "&&",
|
|
pt.cod_sec USING "&&&"
|
|
LET devol.cod_n = pt.cod_n
|
|
LET devol.cod_grupo = pt.cod_grupo
|
|
LET devol.cod_tipo = pt.cod_tipo
|
|
LET devol.cod_sec = pt.cod_sec
|
|
LET devol.descrip_esp = pt.descrip_esp
|
|
LET devol.unidad_med = pt.unidad_med
|
|
LET devol.cantidad_vr = 0
|
|
LET devol.valor_vr = 0
|
|
|
|
# Busca las devol de los productos terminados para cada mes del ano actual
|
|
|
|
LET idx_vr = 1
|
|
LET salir_vr = "N"
|
|
WHILE salir_vr != "S"
|
|
FETCH ABSOLUTE idx_vr movi_vr INTO vr.*
|
|
|
|
IF STATUS = NOTFOUND THEN
|
|
LET salir_vr = "S"
|
|
LET idx_vr = 1
|
|
EXIT WHILE
|
|
END IF
|
|
|
|
IF int_flag THEN
|
|
LET numero_msg = 2
|
|
CALL msg(numero_msg)
|
|
LET int_flag = false
|
|
LET salir_pt = "S"
|
|
RETURN
|
|
END IF
|
|
|
|
IF vr.cod_n = devol.cod_n AND
|
|
vr.cod_grupo = devol.cod_grupo AND
|
|
vr.cod_tipo = devol.cod_tipo AND
|
|
vr.cod_sec = devol.cod_sec THEN
|
|
|
|
IF vr.fact_no IS NULL OR vr.fact_no = " " THEN
|
|
SELECT a.precio INTO precio1 FROM vetb00025 a
|
|
WHERE a.cod_n = vr.cod_n AND a.cod_grupo = vr.cod_grupo AND
|
|
a.cod_tipo = vr.cod_tipo AND a.cod_sec=vr.cod_sec AND
|
|
a.sec_cliente IS NULL AND a.ventas = "1" AND
|
|
a.status_t IS NULL
|
|
ELSE
|
|
SELECT a.precio INTO precio1 FROM vetb00003 a
|
|
WHERE a.cod_n = vr.cod_n AND a.cod_grupo = vr.cod_grupo AND
|
|
a.cod_tipo = vr.cod_tipo AND a.cod_sec=vr.cod_sec AND
|
|
a.factura = vr.fact_no AND a.status_t IS NULL
|
|
END IF
|
|
IF precio1 IS NULL THEN
|
|
LET precio1 = 0
|
|
END IF
|
|
IF vr.cantidad IS NULL THEN
|
|
LET vr.cantidad = 0
|
|
END IF
|
|
|
|
|
|
LET devol.cantidad_vr = vr.cantidad
|
|
LET devol.valor_vr = (vr.valor * precio1)
|
|
LET devol.mes = vr.mes
|
|
LET devol.fact_no = vr.fact_no
|
|
|
|
OUTPUT TO REPORT devol1(devol.*,fecha_final,ano1)
|
|
END IF
|
|
|
|
LET idx_vr= idx_vr + 1
|
|
END WHILE
|
|
END WHILE
|
|
|
|
FINISH REPORT devol1
|
|
CLEAR SCREEN
|
|
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
|
|
|
|
REPORT devol1(x,fecha1,ano2)
|
|
DEFINE x RECORD
|
|
cod_n SMALLINT,
|
|
cod_grupo SMALLINT,
|
|
cod_tipo SMALLINT,
|
|
cod_sec SMALLINT,
|
|
descrip_esp CHAR(30),
|
|
unidad_med CHAR(30),
|
|
fact_no LIKE iptb00006.fact_no,
|
|
mes SMALLINT,
|
|
cantidad_vr DECIMAL(12,3),
|
|
valor_vr DECIMAL(14,2),
|
|
codigo CHAR(7)
|
|
END RECORD
|
|
|
|
DEFINE fecha1 DATE
|
|
DEFINE ano2 CHAR(4)
|
|
DEFINE vendedor,imp,imp1 CHAR (1)
|
|
DEFINE descrip_devol1 CHAR(22)
|
|
DEFINE doble_on CHAR(2)
|
|
DEFINE doble_off CHAR(2)
|
|
DEFINE negrillas_on CHAR(2)
|
|
DEFINE negrillas_off CHAR(2)
|
|
DEFINE comp_on CHAR(2)
|
|
DEFINE comp_off CHAR(2)
|
|
DEFINE doce CHAR(2)
|
|
DEFINE normal CHAR(2)
|
|
DEFINE hora CHAR(5)
|
|
DEFINE descrip CHAR(15)
|
|
DEFINE pt_impresos SMALLINT
|
|
DEFINE total_cantidad_vr, total_valor_vr, total_cantidad_vp,
|
|
total_valor_vp, total_cantidad_vap, total_valor_vap,
|
|
total_cantidad_pres, total_valor_pres DECIMAL (14,2)
|
|
|
|
OUTPUT
|
|
TOP MARGIN 0
|
|
LEFT MARGIN 0
|
|
BOTTOM MARGIN 2
|
|
|
|
ORDER BY x.codigo,x.mes,x.fact_no
|
|
|
|
FORMAT
|
|
PAGE HEADER
|
|
LET doble_on = ASCII 14
|
|
LET doble_off = ASCII 20
|
|
LET negrillas_on = ASCII 27, ASCII 69
|
|
LET negrillas_off = ASCII 27, ASCII 70
|
|
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
|
|
|
|
LET lj = (79 - LENGTH(p_companias.nombre CLIPPED))/2
|
|
PRINT COLUMN 1, comp_off
|
|
PRINT COLUMN 1, "ccprrp024",
|
|
COLUMN lj, p_companias.nombre CLIPPED,
|
|
COLUMN 72, "Pag. ",pageno using "###"
|
|
PRINT COLUMN 17, " Sistema de Ventas ",
|
|
COLUMN 72, today using "dd/mm/yy"
|
|
PRINT COLUMN 17, " Devoluciones por Mes, Ano y Producto ",
|
|
COLUMN 75, hora
|
|
PRINT COLUMN 17, " AL ", fecha1 USING "dd/mm/yy"
|
|
SKIP 1 LINE
|
|
|
|
PRINT COLUMN 1, "--------------------------------------------------",
|
|
"-----------------------------"
|
|
|
|
PRINT COLUMN 52, "UNIDADES",
|
|
COLUMN 71, "VALOR RD$"
|
|
|
|
PRINT COLUMN 1, "--------------------------------------------------",
|
|
"-----------------------------"
|
|
|
|
BEFORE GROUP OF x.codigo
|
|
PRINT COLUMN 1, negrillas_on, x.cod_n using "&","-",
|
|
x.cod_grupo using "&","-",x.cod_tipo using "&&","-",
|
|
x.cod_sec using "&&&"," ", x.descrip_esp CLIPPED,
|
|
negrillas_off
|
|
|
|
AFTER GROUP OF x.mes
|
|
LET descrip = null
|
|
SELECT a.descrip INTO descrip FROM mestable a
|
|
WHERE a.mes = x.mes
|
|
|
|
LET descrip = descrip CLIPPED," ",ano2[3,4]
|
|
|
|
IF x.cantidad_vr is null THEN
|
|
LET x.cantidad_vr = 0
|
|
END IF
|
|
|
|
IF x.valor_vr is null THEN
|
|
LET x.valor_vr = 0
|
|
END IF
|
|
|
|
PRINT COLUMN 1, descrip,
|
|
COLUMN 46, GROUP SUM(x.cantidad_vr) using "##,###,###.###",
|
|
COLUMN 66, GROUP SUM(x.valor_vr) using "###,###,###.##"
|
|
|
|
AFTER GROUP OF x.codigo
|
|
PRINT COLUMN 1, negrillas_on,
|
|
COLUMN 17, "TOTAL ",
|
|
COLUMN 48, GROUP SUM(x.cantidad_vr) using "##,###,###.###",
|
|
COLUMN 68, GROUP SUM(x.valor_vr) using "###,###,###.##",
|
|
negrillas_off
|
|
|
|
ON LAST ROW
|
|
PRINT comp_off
|
|
END REPORT
|