Files
MBS/PROYECTOS/ipdir - 21102021/ipprrp006.4gl
T

253 lines
7.3 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : IPPRRP002
OBJETIVO : CATALOGO DE PRODUCTOS TERMINADOS
PROGRAMADOR : JUAN SOTO
FECHA REALIZACION : Febrero 1997
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO ALEJO
-------------------------------------------------------------------------------
}
GLOBALS "ipprgb000.4gl"
DEFINE l INTEGER
DEFINE precio DECIMAL(8,3)
MAIN
DEFER INTERRUPT
SELECT * INTO p_companias.* FROM companias
CALL ipprrp006()
END MAIN
FUNCTION ipprrp006()
DEFINE producto RECORD
cod_n LIKE iptb00002.cod_n,
cod_grupo LIKE iptb00002.cod_grupo,
cod_tipo LIKE iptb00002.cod_tipo,
cod_sec LIKE iptb00002.cod_sec,
descrip_esp LIKE iptb00002.descrip_esp,
unidad_med LIKE iptb00002.unidad_med,
ventas CHAR(1)
END RECORD,
codigo CHAR(4),
codigo_n smallint,
nombre_imp CHAR(11)
#WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
CLEAR SCREEN
OPEN FORM ipfmrp006 FROM "ipfmrp002"
DISPLAY FORM ipfmrp006
CALL pantalla()
DISPLAY "ipprrp006" AT 4,3
DISPLAY "Catalogo Productos Con Precio" AT 6,25
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
INPUT BY NAME decide,producto.ventas
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET nombre_ant = "E"
CONSTRUCT criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.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
IF decide = "A" THEN
LET SELEC =
"SELECT UNIQUE a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp, ",
" a.unidad_med ",
"FROM iptb00002 a ",
"WHERE a.status_t is NULL AND ",criterio clipped,
" ORDER BY 5,1,2,3,4"
ELSE
LET SELEC =
"SELECT UNIQUE a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp, ",
" a.unidad_med ",
"FROM iptb00002 a ",
"WHERE a.status_t is NULL AND ",criterio clipped,
" ORDER BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp "
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
DISPLAY "Buscando Informacion ... Espere Por Favor" AT 19,14
ATTRIBUTE (REVERSE,BOLD)
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
DECLARE accion CURSOR FOR busca
DISPLAY " " AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
START REPORT reporte6 TO "C:\\archivo"
FOREACH accion INTO producto.*
OUTPUT TO REPORT reporte6(producto.*)
END FOREACH
FINISH REPORT reporte6
CLEAR SCREEN
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
REPORT reporte6(x)
DEFINE x RECORD
cod_n LIKE iptb00002.cod_n,
cod_grupo LIKE iptb00002.cod_grupo,
cod_tipo LIKE iptb00002.cod_tipo,
cod_sec LIKE iptb00002.cod_sec,
descrip_esp LIKE iptb00002.descrip_esp,
unidad_med LIKE iptb00002.unidad_med,
ventas CHAR(1)
END RECORD
DEFINE nom CHAR(30)
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 hora CHAR(5),
prec_m,prec_l DECIMAL(12,2)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 2
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 hora = time
LET l = (100 - LENGTH(p_companias.nombre CLIPPED))/2
PRINT COLUMN 1, doce,negrillas_on
PRINT COLUMN 1, "ipprrp006",
COLUMN l, p_companias.nombre CLIPPED,
COLUMN 93, "Pag.",pageno using "###"
PRINT COLUMN 1,
COLUMN 34, "Sistema de Productos Terminados",
COLUMN 93, today using "dd/mm/yy"
PRINT COLUMN 34, "Catalogo de Productos Con Precio",
COLUMN 96, hora
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
PRINT COLUMN 2, "Codigo",
COLUMN 14, "Descripcion",
COLUMN 52, "Unidad Med.",
COLUMN 83, "Precio"
PRINT COLUMN 83, "Lista "
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
PRINT negrillas_off
{ BEFORE GROUP OF x.ventas
IF x.ventas IS NULL OR x.ventas = " " THEN
PRINT "PRODUCTOS SIN PRECIOS"
END IF
IF x.ventas = "1" THEN
PRINT "PRECIO LOCAL"
END IF
IF x.ventas = "2" THEN
PRINT "PRECIO EXPORTACION"
END IF
BEFORE GROUP OF x.cod_n
INITIALIZE p_iptb20.* TO NULL
SELECT a.* INTO p_iptb20.* FROM iptb00020 a
WHERE a.cod_n = x.cod_n
IF p_iptb20.producto IS NULL THEN
LET p_iptb20.producto = "SIN DESCRIPCION"
END IF
PRINT negrillas_on
PRINT COLUMN 1, p_iptb20.producto CLIPPED,negrillas_off
}
ON EVERY ROW
LET precio = 0
SELECT MAX(a.precio) INTO precio 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 = x.ventas AND
a.status_t IS NULL AND a.sec_cliente IS NULL
IF precio IS NULL THEN
LET precio = 0
END IF
PRINT COLUMN 2, x.cod_n USING "&&","-",
COLUMN 4, x.cod_grupo USING "&&","-",
COLUMN 6, x.cod_tipo USING "&&&","-",
COLUMN 9, x.cod_sec USING "&&&",
COLUMN 14, x.descrip_esp," ",
COLUMN 52, x.unidad_med CLIPPED,
COLUMN 81, precio USING "###,###.##"
AFTER GROUP OF x.cod_n
PRINT negrillas_on
PRINT "Total Items Por Producto: ", GROUP COUNT(*) USING "<<<,<<<,<<<"
PRINT negrillas_off
ON LAST ROW
PRINT negrillas_on
PRINT "Total Items En Maestra: ", COUNT(*) USING "<<<,<<<,<<<"
PRINT negrillas_off
PRINT COLUMN 2, ASCII 27, ASCII 80
END REPORT