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

248 lines
7.5 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : IRPRRP031
OBJETIVO : RESUMEN CATALOGO DE REPUESTOS
PROGRAMADOR : Juan F. Soto
FECHA REALIZACION : Octubre 16, 1996.
-------------------------------------------------------------------------------
}
GLOBALS "irprgb000.4gl"
DEFINE ano_c,p_mes,dias SMALLINT,
fecha1,fecha2 DATE
MAIN
DEFER INTERRUPT
SELECT * INTO p_companias.* FROM companias
CALL irprrp031()
END MAIN
FUNCTION irprrp031()
### 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,
unidad_med LIKE intb00001.unidad_med,
existencia LIKE irtb00006.cantidad_2
END RECORD
#WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
CLEAR SCREEN
OPEN FORM irfmrp031 FROM "irfmrp031"
DISPLAY FORM irfmrp031
CALL pantalla()
DISPLAY "irprrp031" AT 4,3
DISPLAY "Repuestos Sin Consumo En X Dias" AT 6,22
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
INPUT BY NAME fecha1,fecha2
AFTER FIELD fecha1
IF fecha1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha1
END IF
AFTER FIELD fecha2
IF fecha2 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha2
END IF
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
### 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
LET SELEC =
"SELECT UNIQUE b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec, ",
" b.descrip_esp[1,30],b.unidad_med ",
"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) ",
" AND (a.fecha between ? AND ?) ",
" AND (a.num_doc = a.num_doc AND a.cod_mov = a.cod_mov) ",
"ORDER BY 1,2,3,4 "
DISPLAY "<< Buscando Informacion ... Espere Por Favor >>" AT 17,14
ATTRIBUTE (BOLD)
PREPARE busca FROM selec
DECLARE accion CURSOR FOR busca
OPEN accion USING fecha1,fecha2
LET selec1 =
"SELECT COUNT(*) ",
"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) ",
" AND (a.fecha between ? AND ?) ",
" AND (a.num_doc = a.num_doc AND a.cod_mov = a.cod_mov) "
PREPARE comando1 FROM selec1
DECLARE busca1 CURSOR FOR comando1
OPEN busca1 USING fecha1,fecha2
START REPORT reporte31 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"
LET materia.existencia = 0
# Busca la existencia del repuesto actual
SELECT SUM(a.cantidad_2) INTO materia.existencia
FROM irtb00006 a
WHERE (a.cod_n = materia.cod_n AND
a.cod_grupo = materia.cod_grupo AND
a.cod_tipo = materia.cod_tipo AND
a.cod_sec = materia.cod_sec) AND
(a.status_t IS NULL)
IF materia.existencia IS NULL THEN
LET materia.existencia = 0
END IF
OUTPUT TO REPORT reporte31(materia.*)
END WHILE
FINISH REPORT reporte31
CLEAR SCREEN
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
REPORT reporte31(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,
unidad_med LIKE intb00001.unidad_med,
existencia LIKE irtb00006.cantidad_2
END RECORD,
doble_on,doble_off,negrillas_on,negrillas_off,comp_on,comp_off,
normal,doce CHAR(3),
hora CHAR(5)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 4
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 negrillas_on = ASCII 027, ASCII 098
#LET negrillas_off = ASCII 027, ASCII 099
#LET comp_on = ASCII 31
#LET comp_off = ASCII 029
#LET doce = ASCII 030
#LET normal = ASCII 029
LET hora = time
PRINT COLUMN 1, comp_off,doce ,negrillas_on
PRINT COLUMN 1, "irprrp031",
COLUMN 25, " M A R M O T E C H S. A.",
COLUMN 90, "Pag. ",PAGENO USING "###"
PRINT COLUMN 25, " Sistema de Inventario de Repuestos ",
COLUMN 90, TODAY USING "dd/mm/yyyy"
PRINT COLUMN 25, " RESUMEN CATALOGO REPUESTOS ",
COLUMN 90, hora
PRINT COLUMN 1, "Desde ", fecha1 USING "DD/MM/yyyy",
" HASTA ", fecha2 USING "DD/MM/yyyy"
#PRINT comp_on
PRINT COLUMN 1, "--------------------------------------------------",
"----------------------------------------------"
PRINT COLUMN 130, "CANTIDAD"
PRINT COLUMN 85, "EXISTENCIA"
PRINT COLUMN 1, "CODIGO",
COLUMN 12, "DESCRIPCION ",
COLUMN 45, "UNIDAD",
COLUMN 85, "ACTUAL"
PRINT COLUMN 1, "--------------------------------------------------",
"----------------------------------------------"
PRINT COLUMN 1, 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 ,
COLUMN 45, x.unidad_med ,
COLUMN 85, x.existencia USING "##,###.##"
ON LAST ROW
SKIP 1 LINE
PRINT COLUMN 3, "Total Registros Impresos ",
COLUMN 96, COUNT(*) USING "#,###,###.##"
PRINT COLUMN 1, "====================================================",
"================================================="
PRINT comp_off,normal
END REPORT