Files
MBS/PROYECTOS/isdir/isprrp009.4gl
T

247 lines
7.7 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : ISPRRP009
OBJETIVO : REPORTE EXISTENCIAS
PROGRAMADOR : Ing. Juan Soto
FECHA REALIZACION : Octubre 21, 1993
-------------------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprrp009()
DEFINE mes CHAR(2)
DEFINE idx_ant,idx_cos,idx_act SMALLINT
DEFINE ano_act CHAR(4)
DEFINE salir,primera CHAR(1)
DEFINE balance_in DECIMAL(12,2)
DEFINE existe RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
base LIKE istb00002.base,
fecha DATE,
cantidad DECIMAL(10,2),
codigo CHAR(10)
END RECORD
DEFINE costos RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
fecha CHAR(2),
costo_st LIKE istb00013.costo_st
END RECORD
DEFINE actual RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
balance LIKE istb00006.cantidad_2
END RECORD
DEFINE anterior RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
balance LIKE istb00006.cantidad_2
END RECORD
DEFINE select_cost,select_act,select_ant CHAR(1000)
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmrp009 FROM "isfmrp009"
DISPLAY FORM isfmrp009
CALL pantalla()
DISPLAY "isprrp009" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Existencia Anterior y Actual" AT 6,26 ATTRIBUTE(BLACK)
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
CALL defecto(impresor) RETURNING imprime, letras.*, archivo
LABEL vuelve:
INPUT BY NAME datos_cons.fech_in,datos_cons.fech_fi
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER INPUT
EXIT INPUT
END INPUT
IF datos_cons.fech_in IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
GOTO vuelve
END IF
IF datos_cons.fech_fi IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
GOTO vuelve
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET ano_act = year(datos_cons.fech_fi)
CONSTRUCT criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec
FROM cod_n,cod_grupo, cod_tipo,cod_sec
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER CONSTRUCT
EXIT CONSTRUCT
END CONSTRUCT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET select_cost =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp, ",
" b.unidad_med,c.base,a.fecha,a.cantidad_2 ",
"FROM istb00006 a,intb00001 b,OUTER istb00002 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.cod_n = c.cod_n and a.cod_grupo = c.cod_grupo and ",
" a.cod_tipo = c.cod_tipo and a.cod_sec = c.cod_sec and ",
" a.fecha <= ? AND a.status_t is null AND ",criterio CLIPPED
DISPLAY "<< Buscandi Informacion... Espere Por Favor" AT 19,14
PREPARE busca_costo FROM select_cost
DECLARE accion CURSOR FOR busca_costo
OPEN accion USING datos_cons.fech_fi
START REPORT paul TO archivo
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>" AT 19,14
FOREACH accion INTO existe.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF existe.base IS NULL THEN
LET existe.base = 1
END IF
LET existe.codigo = existe.cod_n USING "&","-",
existe.cod_grupo USING "&","-",
existe.cod_tipo USING "&&","-",
existe.cod_sec USING "&&&"
OUTPUT TO REPORT paul(existe.*)
END FOREACH
FINISH REPORT paul
RUN imprime
CLEAR SCREEN
END FUNCTION
REPORT paul(x)
DEFINE x RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
base LIKE istb00002.base,
fecha DATE,
cantidad DECIMAL(10,2),
codigo CHAR(10)
END RECORD
DEFINE costo,total_c,total_p DECIMAL (12,2)
DEFINE hora CHAR(5)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 2
ORDER BY x.codigo,x.fecha
FORMAT
PAGE HEADER
LET hora = time
PRINT letras.negrillas_off,letras.comp_on
PRINT COLUMN 1, "isprrp009",
COLUMN 27, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 100, "Pag. ",pageno using "###"
PRINT COLUMN 27, " Sistema de Inventario de Suministros",
COLUMN 100, today using "dd/mm/yyyy"
PRINT COLUMN 27, " Existencia Anterior y Actual",
COLUMN 103, hora
SKIP 1 LINES
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"-------"
PRINT COLUMN 51, "Existencia",
COLUMN 68, "Existencia",
COLUMN 84, "Costo",
COLUMN 97, "Total"
PRINT COLUMN 1, "Suministro",
COLUMN 51, "Al ",datos_cons.fech_in using "dd/mm/yyyy",
COLUMN 68, "Al ", datos_cons.fech_fi using "dd/mm/yyyy",
COLUMN 84, "Standard",
COLUMN 97, "Al ",datos_cons.fech_fi using "dd/mm/yyyy"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"-------"
PRINT letras.negrillas_off
BEFORE GROUP OF x.codigo
SELECT MAX(a.costo_st) INTO costo FROM istb00013 a
WHERE a.status_t IS NULL AND 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 = YEAR(datos_cons.fech_fi) AND
a.mes_fin = 12
IF costo IS NULL THEN
LET costo = 0
END IF
PRINT COLUMN 1, x.codigo," ",x.descrip_esp CLIPPED;
AFTER GROUP OF x.codigo
PRINT COLUMN 48, GROUP SUM(x.cantidad)
WHERE x.fecha <=datos_cons.fech_in
USING "###,###,###.##",
COLUMN 65, GROUP SUM(x.cantidad) USING "###,###,###.##",
COLUMN 81, costo USING "###,###.##",
COLUMN 95, GROUP SUM(x.cantidad) * costo
USING "###,###,###.##"
ON LAST ROW
print letras.negrillas_on
PRINT COLUMN 1,"Total de Registros ---> ",COUNT(*) USING "###,###"
print letras.negrillas_off,letras.comp_off
END REPORT