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

358 lines
12 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : INPRRP027
OBJETIVO : REPORTE DOCUMETOS POR SUPLIDOR
PROGRAMADOR : JUAN F. SOTO
FECHA REALIZACION : Junio 07, 1995
-------------------------------------------------------------------------------
}
GLOBALS "irprgb000.4gl"
DEFINE p_printer SMALLINT
MAIN
DEFER INTERRUPT
SELECT * INTO p_companias.* FROM companias
CALL irprrp027()
END MAIN
FUNCTION irprrp027()
##### Definicion de la variables a imprimir
DEFINE transacc 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,
num_doc LIKE irtb00006.num_doc,
fecha LIKE irtb00006.fecha,
cantidad_1 LIKE irtb00006.cantidad_1,
cantidad_2 LIKE irtb00006.cantidad_2,
maquina LIKE irtb00006.maquina,
cod_mov LIKE irtb00006.cod_mov,
conduce_no LIKE irtb00006.conduce_no,
fact_no LIKE irtb00006.fact_no,
orden_compra LIKE irtb00006.orden_compra,
cod_sp LIKE irtb00006.cod_sp,
cod_sp_sec LIKE irtb00006.cod_sp_sec,
depto_de LIKE irtb00006.sec_de,
depto_a LIKE irtb00006.sec_a,
descrip_mov CHAR(30),
descrip_esp CHAR(30),
unidad_med CHAR(4),
status_t CHAR(1),
suplidor CHAR(6)
END RECORD
OPTIONS
PROMPT LINE 13,
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
CLEAR SCREEN
OPEN FORM irfmrp027 FROM "irfmrp027"
DISPLAY FORM irfmrp027
CALL pantalla()
DISPLAY "irprrp027" AT 4,3
DISPLAY "Documentos Por Suplidor " AT 6,28
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
DISPLAY " "
at 19,14
####### Creando criterio de busqueda
CONSTRUCT BY NAME criterio ON a.cod_sp,a.cod_sp_sec,
a.fecha,a.cod_mov,a.num_doc
##### Creando la facilidad para cancelar opreacion mediante DELETE
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LABEL vuelve:
PROMPT "Elija Printer: 1- AP Series 2- Epson LQ-1070 " FOR p_printer
IF p_printer !=1 and p_printer != 2 THEN
LET numero_msg = -1301
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
##### Selecionando la informacion requerida para la salida de
##### informacion
LET selec =
"SELECT a.cod_n, a.cod_grupo, a.cod_tipo, a.cod_sec,a.num_doc, ",
" a.fecha,a.cantidad_1,a.cantidad_2,a.maquina,a.cod_mov, ",
" a.conduce_no, a.fact_no,a.orden_compra,a.cod_sp,a.cod_sp_sec, ",
" a.sec_de,a.sec_a,b.descrip_mov,c.descrip_esp,c.unidad_med, ",
" a.status_t ",
"FROM irtb00006 a,irtb00005 b,intb00001 c ",
"WHERE 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.cod_mov = b.cod_mov AND ",criterio clipped,
" ORDER BY 10,14,15,5"
DISPLAY "<< Buscando Informacion ... Espere Por Favor. >>"
AT 17,14 ATTRIBUTE (REVERSE,BOLD)
LET selec1 = "SELECT COUNT(*) ",
"FROM irtb00006 a,irtb00005 b,intb00001 c ",
"WHERE 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.cod_mov = b.cod_mov AND ",criterio clipped
PREPARE busca FROM selec
DECLARE accion CURSOR FOR busca
OPEN accion
PREPARE comando FROM selec1
DECLARE busca1 CURSOR FOR comando
OPEN busca1
FETCH busca1 INTO regi
LET p_param = "S"
IF p_printer = 1 THEN
START REPORT reporte27 TO PIPE "lp -dcentral"
ELSE
START REPORT reporte27 TO "C:\\archivo"
END IF
WHILE STATUS != NOTFOUND
FETCH accion INTO transacc.*
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 transacc.suplidor = transacc.cod_sp using "&&",transacc.cod_sp_Sec
using "&&&&"
OUTPUT TO REPORT reporte27(transacc.*)
END WHILE
FINISH REPORT reporte27
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
###### Proceso de generacion del reporte.
REPORT reporte27(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,
num_doc LIKE irtb00006.num_doc,
fecha LIKE irtb00006.fecha,
cantidad_1 LIKE irtb00006.cantidad_1,
cantidad_2 LIKE irtb00006.cantidad_2,
maquina LIKE irtb00006.maquina,
cod_mov LIKE irtb00006.cod_mov,
conduce_no LIKE irtb00006.conduce_no,
fact_no LIKE irtb00006.fact_no,
orden_compra LIKE irtb00006.orden_compra,
cod_sp LIKE irtb00006.cod_sp,
cod_sp_sec LIKE irtb00006.cod_sp_sec,
depto_de LIKE irtb00006.sec_de,
depto_a LIKE irtb00006.sec_a,
descrip_mov CHAR(30),
descrip_esp CHAR(30),
unidad_med CHAR(4),
status_t CHAR(1),
suplidor CHAR(6)
END RECORD
DEFINE nombre_suplidor CHAR(30)
DEFINE p RECORD
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
descrip_mov LIKE irtb00005.descrip_mov
END RECORD
DEFINE nombre CHAR(8),
und CHAR(3) ,
doble_on CHAR(3),
doble_off CHAR(3),
normal CHAR(3),
doce CHAR(3),
negrillas_on CHAR(3),
negrillas_off CHAR(3),
comprimido_on CHAR(3),
comprimido_off CHAR(3),
primera CHAR(1),
hora CHAR(5),
status1 CHAR(18),
dia,mes smallint,
nom_dia,nom_mes CHAR(10)
OUTPUT
LEFT MARGIN 0
###### Formateando la salida de la informacion
FORMAT
PAGE HEADER
IF p_printer = 2 THEN
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 normal = ASCII 27, ASCII 80
LET doce = ASCII 27, ASCII 77
LET comprimido_on = ASCII 15
LET comprimido_off = ASCII 18
ELSE
LET doble_on = ASCII 001
LET negrillas_on = ASCII 027, ASCII 098
LET negrillas_off = ASCII 27, ASCII 099
LET normal = ASCII 029
LET doce = ASCII 030
LET comprimido_on = ASCII 031
LET comprimido_off = ASCII 030
END IF
LET hora = time
LET dia = WEEKDAY(x.fecha)
LET mes = MONTH(x.fecha)
LET primera = "S"
CALL busca_mes()
LET nom_mes = nombre_mes[mes]
CALL busca_dia()
LET nom_dia = nombre_dia[dia]
PRINT COLUMN 3, normal,comprimido_off,negrillas_on
PRINT COLUMN 1, "irprrp027",
COLUMN 17, " M A R M O T E C H S. A.",
COLUMN 72, "Pag. ",pageno using "###"
PRINT COLUMN 17, " Sistema de Inventario de Repuestos",
COLUMN 72, today using "dd/mm/yyyy"
PRINT COLUMN 17, " Documento Por Suplidor ",
COLUMN 75, hora
PRINT COLUMN 18, "FECHA: ", nom_dia clipped,", ",
day(x.fecha) using "&&"," de ",nom_mes clipped," del ",
year(x.fecha) USING "&&&&"
PRINT COLUMN 1, negrillas_off,doce
SKIP 1 LINES
BEFORE GROUP OF x.cod_mov
PRINT COLUMN 1, negrillas_on,x.cod_mov using "&&"," ",
x.descrip_mov,negrillas_off
BEFORE GROUP OF x.suplidor
SELECT a.nom_sp INTO nombre_suplidor FROM cotb00001 a
WHERE a.cod_sp = x.cod_sp AND a.cod_sp_sec = x.cod_sp_sec
SKIP 1 LINE
PRINT COLUMN 1 , negrillas_on,"Suplidor: ",
x.cod_sp using "&&","-",x.cod_sp_sec
using "&&&&"," ",nombre_suplidor,
negrillas_off
PRINT COLUMN 20, "Orden",
COLUMN 52, "Codigo"
PRINT COLUMN 1, "Documento",
COLUMN 11 , "Fecha",
COLUMN 20 , "Compras",
COLUMN 28 , "Conduce",
COLUMN 40 , "Factura"
BEFORE GROUP OF x.num_doc
LET status1 = NULL
IF x.status_t IS NOT NULL AND x.status_t != " " THEN
LET status1 = "** ANULADO **"
END IF
IF x.cod_sp is null THEN
LET nombre_suplidor = null
ELSE
##### Selecionando el nombre del suplidor del articulo
END IF
PRINT COLUMN 1, negrillas_on,status1,
negrillas_off,doce
PRINT COLUMN 1, x.num_doc using "&&&&&&",
COLUMN 11, x.fecha using "dd/mm/yyyy",
COLUMN 20, x.orden_compra using "<<<<",
COLUMN 28, x.conduce_no,
COLUMN 40, x.fact_no
SKIP 1 LINE
PRINT COLUMN 59, "C a n t i d a d"
PRINT COLUMN 70, "Entregada/"
PRINT COLUMN 1 , "Codigo",
COLUMN 15, "Descripcion",
COLUMN 45, "Unidad",
COLUMN 70, "Recibida"
SKIP 1 LINE
ON EVERY ROW
PRINT COLUMN 1, x.cod_n USING "&","-",
COLUMN 3, x.cod_grupo USING "&","-",
COLUMN 5, x.cod_tipo USING "&&","-",
COLUMN 8, x.cod_sec USING "&&&",
COLUMN 15, x.descrip_esp,
COLUMN 45, x.unidad_med,
COLUMN 50, x.cantidad_1 USING "##,###,###.##",
COLUMN 65, x.cantidad_2 USING "##,###,###.##"
AFTER GROUP OF x.num_doc
PRINT COLUMN 1, "-------------------------------------------",
"-------------------------------------------",
"-------------------------------------------"
AFTER GROUP OF x.cod_mov
SKIP TO TOP OF PAGE
ON LAST ROW
PRINT COLUMN 3, normal
END REPORT
##### Igualandon los dias de la semana a la descripcion del mismo
FUNCTION busca_dia()
LET nombre_dia[1] = "Domingo"
LET nombre_dia[2] = "Lunes"
LET nombre_dia[3] = "Martes"
LET nombre_dia[4] = "Miercoles"
LET nombre_dia[5] = "Jueves"
LET nombre_dia[6] = "Viernes"
LET nombre_dia[7] = "Sabado"
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
####### Igualando el numero del mes a la descripcion del mismo
FUNCTION busca_mes()
LET nombre_mes[1] = "Enero"
LET nombre_mes[2] = "Febrero"
LET nombre_mes[3] = "Marzo"
LET nombre_mes[4] = "Abril"
LET nombre_mes[5] = "Mayo"
LET nombre_mes[6] = "Junio"
LET nombre_mes[7] = "Julio"
LET nombre_mes[8] = "Agosto"
LET nombre_mes[9] = "Septiembre"
LET nombre_mes[10] = "Octubre"
LET nombre_mes[11] = "Noviembre"
LET nombre_mes[12] = "Diciembre"
RUN "type C:\\archivo > %USPRINT%" END FUNCTION