Files
MBS/PROYECTOS/irdir/irprrp028.4gl
T

243 lines
7.6 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : IRPRRP028
OBJETIVO : CATALOGO DE REPUESTOS CON EXISTENCIA EN CERO (0)
PROGRAMADOR : Tadeo A. Ferreras.
FECHA REALIZACION : Octubre 13, 1995.
-------------------------------------------------------------------------------
}
GLOBALS "irprgb000.4gl"
MAIN
DEFER INTERRUPT
SELECT * INTO p_companias.* FROM companias
CALL irprrp028()
END MAIN
FUNCTION irprrp028()
### Variable de los datos del reporte
DEFINE materia RECORD
cod_n LIKE intb00002.cod_n,
cod_grupo LIKE intb00002.cod_grupo,
cod_tipo LIKE intb00002.cod_tipo,
cod_sec LIKE intb00002.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
descrip_ing LIKE intb00001.descrip_ing,
unidad_med LIKE intb00001.unidad_med,
existencia LIKE irtb00002.existencia
END RECORD
#WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
CLEAR SCREEN
OPEN FORM irfmrp28 FROM "irfmrp006"
DISPLAY FORM irfmrp28
CALL pantalla()
DISPLAY "irprrp028" AT 4,3
DISPLAY "Repuestos Con Existencia En Cero (0)" AT 6,22
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
INPUT BY NAME decide
AFTER FIELD decide
IF decide IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD decide
END IF
END INPUT
CONSTRUCT criterio ON b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec
FROM cod_n,cod_grupo,cod_tipo,cod_sec
### Proceso Para Cancelar Reportes
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
## Buscando Informacion Dependiendo del tipo deseado
IF decide = "A" THEN
LET SELEC =
"SELECT UNIQUE b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec, ",
" b.descrip_esp[1,30],b.descrip_ing[1,30],b.unidad_med, ",
" SUM(a.cantidad_2) ",
"FROM intb00001 b,irtb00006 a ",
"WHERE (b.cod_n = a.cod_n AND b.cod_grupo = a.cod_grupo AND ",
" b.cod_tipo = a.cod_tipo AND b.cod_sec = a.cod_sec) AND ",
criterio clipped," and (a.status_t IS NULL) AND (b.status_t IS NULL) ",
"GROUP BY 1,2,3,4,5,6,7 ORDER BY 3,5 "
DISPLAY "<< Buscando Informacion ... Espere Por Favor >>" AT 17,14
ATTRIBUTE (BOLD)
ELSE
LET SELEC =
"SELECT UNIQUE b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec, ",
" b.descrip_esp[1,30],b.descrip_ing[1,30],b.unidad_med, ",
" SUM(a.cantidad_2) ",
"FROM intb00001 b,irtb00006 a ",
"WHERE (b.cod_n = a.cod_n AND b.cod_grupo = a.cod_grupo AND ",
" b.cod_tipo = a.cod_tipo AND b.cod_sec = a.cod_sec) AND ",
criterio clipped," and (a.status_t IS NULL) AND (b.status_t IS NULL) ",
"GROUP BY 1,2,3,4,5,6,7 ORDER BY 3,1,2,4 "
DISPLAY "<< Buscando Informacion ... Espere Por Favor >>" AT 17,14
ATTRIBUTE (BOLD)
END IF
PREPARE busca FROM selec
DECLARE accion CURSOR FOR busca
OPEN accion
LET selec1 = "SELECT COUNT(*) FROM intb00001 b ",
"WHERE ",criterio clipped, " and b.cod_n in (5) "
PREPARE comando1 FROM selec1
DECLARE busca1 CURSOR FOR comando1
OPEN busca1
START REPORT reporte_28 TO "C:\\archivo"
DISPLAY "<< Reporte Generandose... Espere Por Favor >>" AT 17,14
ATTRIBUTE (BOLD)
FETCH busca1 INTO regi
DISPLAY " " AT 17,14
LET p_param = "S"
WHILE status != notfound
FETCH accion INTO materia.*
IF status = NOTFOUND THEN
EXIT WHILE
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
CALL termometro(regi,p_param)
LET p_param = "N"
IF materia.existencia IS NULL OR
materia.existencia = 0 THEN
OUTPUT TO REPORT reporte_28(materia.*)
END IF
END WHILE
FINISH REPORT reporte_28
CLEAR SCREEN
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
REPORT reporte_28(x)
DEFINE x RECORD
cod_n LIKE intb00002.cod_n,
cod_grupo LIKE intb00002.cod_grupo,
cod_tipo LIKE intb00002.cod_tipo,
cod_sec LIKE intb00002.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
descrip_ing LIKE intb00001.descrip_ing,
unidad_med LIKE intb00001.unidad_med,
existencia LIKE irtb00002.existencia
END RECORD,
l SMALLINT,
varia CHAR(20),
nombre1,descripcion CHAR(60),
primera CHAR(1),
doble_on,doble_off,negrillas_on,negrillas_off,comp_on,comp_off,
normal,doce CHAR(2),
hora CHAR(5)
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 normal = ASCII 27, ASCII 80
LET hora = time
IF decide = "N" THEN
LET varia = "N u m e r i c o"
ELSE
LET varia = "A l f a b e t i c o"
END IF
LET l = (82 - LENGTH(varia))/2
PRINT COLUMN 1, normal,negrillas_on
PRINT COLUMN 1, "irprrp028",
COLUMN 17, " M A R M O T E C H S. A.",
COLUMN 73, "Pag. ",PAGENO USING "###"
PRINT COLUMN 17, " Sistema de Inventario de Repuestos ",
COLUMN 73, TODAY USING "dd/mm/yy"
PRINT COLUMN 17, " Repuestos Con Existencia En Cero (0)",
COLUMN 76, hora
PRINT COLUMN l, varia clipped
PRINT COLUMN 1, "Fecha de Corte: ", TODAY USING "dd/mm/yy"
PRINT COLUMN 1, "--------------------------------------------------",
"------------------------------"
PRINT COLUMN 1, "Codigo",
COLUMN 12, "Descripcion Espanol",
COLUMN 45, "Descripcion Ingles",
COLUMN 75, "Unidad"
PRINT COLUMN 1, "--------------------------------------------------",
"------------------------------"
PRINT COLUMN 1, negrillas_off
BEFORE GROUP OF x.cod_tipo
LET nombre1 = " "
### Buscandoi el nombre de la maquina a que pertenece el repuesto
SELECT a.nombre INTO nombre1 FROM irtb00009 a
WHERE a.status_t IS NULL AND a.codigo = x.cod_tipo
IF nombre1 IS NULL OR nombre1 = " " THEN
LET nombre1 = "MAQUINA NO EXISTE"
END IF
PRINT COLUMN 1, negrillas_on,nombre1 CLIPPED,negrillas_off
ON EVERY ROW
PRINT COLUMN 1, x.cod_n USING "&","-",x.cod_grupo USING "&","-",
x.cod_tipo USING "&&","-",x.cod_sec USING "&&&",
COLUMN 12, x.descrip_esp CLIPPED,
COLUMN 45, x.descrip_ing CLIPPED,
COLUMN 77, x.unidad_med CLIPPED
AFTER GROUP OF x.cod_tipo
SKIP 1 LINE
PRINT COLUMN 3, "Total del grupo = ",GROUP count(*) USING "####"
SKIP 1 LINE
ON LAST ROW
SKIP 1 LINE
PRINT COLUMN 3, "Total de Registros Impresos = ", count(*) USING "####"
PRINT COLUMN 1, "====================================================",
"================================================="
END REPORT