jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
454973e269661eb5df04027400a9f1751bcb0706
MBS/PROYECTO/cgdir/edprrp033.4gl
T

770 lines
23 KiB
Plaintext
Raw Blame History

{
-------------------------------------------------------------------------------
PROGRAMA : EDPRRP033
OBJETIVO : Consumo de Repuestos del Tool Room
PROGRAMADOR : Juan F. Soto
FECHA REALIZACION : Junio 13, 1996.
-------------------------------------------------------------------------------
}
DATABASE rayovac
GLOBALS
DEFINE p_ano,cuenta1,p,cuenta,regi,numero_msg,idx_ac,ano,idx_a,idx_c SMALLINT,
fecha_2 CHAR(8),
detalle CHAR(30),
p_fecha,fecha1, fecha2 DATE ,
entra CHAR(14),
entra1 CHAR(5),
tipo_papel SMALLINT,
opt1,salir,opt,afecta,p_param CHAR(1),
descrip_cta CHAR(40),
nombre_v CHAR(20),
p_cuenta INTEGER,
prt_control CHAR(13),
criterio CHAR(400)
DEFINE movimiento RECORD
cta_debito LIKE irtb00005.cuenta_1,
cta_credito LIKE irtb00005.cuenta_2,
departamento LIKE irtb00005.cuenta_3,
cantidad DECIMAL(12,2)
END RECORD
DEFINE datos_cons RECORD
fech_in DATE,
fech_fi DATE
END RECORD
END GLOBALS
MAIN
DEFER INTERRUPT
CALL irprrp009()
CALL edprrp033()
END MAIN
FUNCTION edprrp033()
DEFINE selec1 CHAR(1000)
DEFINE prt RECORD
debito LIKE irtb00005.cuenta_1,
credito LIKE irtb00005.cuenta_2,
departamento LIKE irtb00005.cuenta_3,
valor DECIMAL(12,2)
END RECORD
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21,
PROMPT LINE 14
##### Abriendo y desplegando el formulario de captura de datos
OPEN FORM edfmrp033 FROM "edfmrp033"
DISPLAY FORM edfmrp033
CALL pantalla()
DISPLAY "edprrp033" AT 4,3
DISPLAY "Consumo Repuesto del Tool Room " AT 6,22
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
###### Aceptando los valores para el rango de fecha
INPUT BY NAME entra,fecha1,fecha2,afecta,detalle WITHOUT DEFAULTS
AFTER FIELD entra
IF entra IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD entra
END IF
SELECT unique ref FROM cgtb00004
WHERE ref = entra
IF STATUS != NOTFOUND THEN
LET numero_msg = 2
CALL msg(numero_msg)
#NEXT FIELD entra
END IF
LET entra1 = entra
BEFORE FIELD fecha1
SELECT MAX(fecha) INTO p_fecha FROM cgtb00004
WHERE ref[1,5] = entra1
IF p_fecha is not null THEN
LET fecha1 = p_fecha + 1
DISPLAY BY NAME fecha1
END IF
AFTER FIELD fecha1
IF fecha1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
# NEXT FIELD fecha1
END IF
IF fecha1 <= p_fecha THEN
LET numero_msg = 179
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
IF fecha1 > fecha2 THEN
LET numero_msg = 149
CALL msg(numero_msg)
# NEXT FIELD fecha1
END IF
###### Selecionando en rango de fecha de la tabla de periodo para el fecha2
SELECT UNIQUE ref FROM cgtb00004 where ref = entra
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
# NEXT FIELD fecha2
END IF
END INPUT
##### Creando la facilidad para cancelar proceso con DELETE O SUPR
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
# Busca la informacion requerida
DISPLAY "<< Buscando Informacion ... Espere Por Favor. >>" AT 19,14
ATTRIBUTE (REVERSE,BOLD)
LET p_ano = YEAR(fecha2)
LET selec1 =
"SELECT d.cuenta_1,d.cuenta_2,d.cuenta_3,SUM(c.cantidad_2*e.costo_st),",
"MAX(e.mes_ini) ",
"FROM irtb00006 c, irtb00005 d, irtb00013 e ",
"WHERE (c.cod_mov = d.cod_mov) AND ",
" (d.cuenta_1 IS NOT NULL OR ",
" d.cuenta_2 IS NOT NULL OR ",
" d.cuenta_3 IS NOT NULL) AND ",
" (c.cod_n = e.cod_n AND ",
" c.cod_grupo = e.cod_grupo AND ",
" c.cod_tipo = e.cod_tipo AND ",criterio clipped,
" AND c.cod_sec = e.cod_sec) AND ",
" (e.ano = ? AND e.mes_fin = 12) AND ",
" c.fecha BETWEEN ? AND ? AND ",
" c.status_t IS NULL ",
" GROUP BY 1,2,3 "
PREPARE comando20 FROM selec1
DECLARE busca CURSOR FOR comando20
OPEN busca USING p_ano,fecha1,fecha2
DISPLAY " "
AT 19,14
##### Envia la Informacion al printer de contabilidad
##### Loop para enviar informacion al reporte
START REPORT opera1 TO PIPE prt_control
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
WHILE status != notfound
FETCH busca INTO movimiento.*
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
LET prt.valor = movimiento.cantidad
LET prt.debito = movimiento.cta_debito
LET prt.credito = movimiento.cta_credito
LET prt.departamento = movimiento.departamento
OUTPUT TO REPORT opera1(prt.*)
IF status = notfound THEN
LET status = 0
END IF
END WHILE
FINISH REPORT opera1
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
#### Funcion para dar salida ordenada a la informacion requerida de
#### una entrada de diario de nominas local
{
Esta funcion se utiliza para desplegar mensajes de los reportes de
los sistemas de Ray-O-Vac Dominicana.
Realizada por Lic. Abner Montalvo y Johnny Soto Agosto 21, 1992
}
FUNCTION msgrp000(tipo_papel)
DEFINE tipo_papel SMALLINT,
longitud CHAR(11),
linea_papel CHAR(50)
CASE
WHEN tipo_papel = 1
LET longitud = " 9 1/2 x 11"
WHEN tipo_papel = 2
LET longitud = "14 7/8 x 11"
END CASE
LET linea_papel = "Coloque papel ",longitud," en la impresora."
DISPLAY linea_papel
AT 15,14
DISPLAY "Asegurese de que la impresora este encendida."
AT 16,14
DISPLAY "<Esc> Ejecuta impresion <Supr> Cancela impresion"
AT 18,14
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
FUNCTION pantalla()
DEFINE fecha CHAR(8),
hora char(5)
LET fecha = today USING "dd/mm/yy"
LET hora = time
DISPLAY "R A Y . O . V A C D O M I N I C A N A, S. A." AT 4,17
ATTRIBUTE (REVERSE,YELLOW)
DISPLAY fecha AT 4,70 ATTRIBUTE (YELLOW)
DISPLAY "Sistema de Contabilidad General" AT 5,24
DISPLAY hora AT 6,73 ATTRIBUTE(YELLOW)
CALL fgl_drawbox(5,79,3,1)
CALL fgl_drawbox(1,79,22,1)
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
REPORT opera1(x)
DEFINE x RECORD
debito LIKE irtb00005.cuenta_1,
credito LIKE irtb00005.cuenta_2,
departamento LIKE irtb00005.cuenta_3,
valor DECIMAL(12,2)
END RECORD
DEFINE doble_on CHAR(3),
doble_off CHAR(3),
negrillas_on CHAR(6),
negrillas_off CHAR(6),
comp_on CHAR(3),
comp_off CHAR(3) ,
doce CHAR(3),
normal CHAR(2) ,
hora CHAR(5),
tvalor DECIMAL(14,3),
depto1 LIKE irtb00005.cuenta_3
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 2
FORMAT
PAGE HEADER
IF opt = "2" THEN
LET doble_on = ASCII 001
LET doble_off = ASCII 002
LET negrillas_on = ASCII 027, ASCII 098
LET negrillas_off = ASCII 027, ASCII 099
LET comp_on = ASCII 031
LET comp_off = ASCII 029
LET doce = ASCII 030
LET normal = ASCII 27, ASCII 80
ELSE
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
END IF
LET hora = time
PRINT COLUMN 1, comp_off,"edprrp033",
COLUMN 23, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 80, "Pag. ",pageno using "###"
PRINT COLUMN 35, "Sistema de Contabilidad",
COLUMN 80, today using "dd/mm/yy"
PRINT COLUMN 29, "Consumo de Repuesto del Tool Room",
COLUMN 83, hora
PRINT COLUMN 34, "Del ",fecha1 USING "dd/mm/yy", " Al ",fecha2
USING "dd/mm/yy"
PRINT doce
SKIP 1 LINES
PRINT COLUMN 01,"Entrada de Diario No.",
doble_on,entra,doble_off
PRINT COLUMN 1,"Observaciones: _____________________________________"
PRINT COLUMN 1," _____________________________________"
PRINT COLUMN 1,
"--------------------------------------------------",
"----------------------------------------",
negrillas_on
PRINT COLUMN 2, "Cuenta ",
COLUMN 11, "Dpto",
COLUMN 18, "Concepto",
COLUMN 60, "Debe",
COLUMN 74, "Haber",negrillas_off
PRINT COLUMN 1,
"--------------------------------------------------",
"----------------------------------------"
IF tvalor IS NULL THEN
LET tvalor = 0
END IF
ON EVERY ROW
IF x.valor < 0 THEN
LET x.valor = x.valor * -1
END IF
LET depto1 = null
SELECT a.descripcion INTO descrip_cta
FROM cgtb00001 a
WHERE a.cuenta_no = x.debito
PRINT COLUMN 2, x.debito;
SELECT a.depto
FROM cgtb00001 a
WHERE a.cuenta_no = x.debito and
a.depto = "S"
IF STATUS != NOTFOUND THEN
LET depto1 = x.departamento
PRINT COLUMN 10, depto1;
LET STATUS = 0
END IF
PRINT COLUMN 18, descrip_cta clipped,
COLUMN 50, x.valor using "###,###,##&.&&"
IF afecta = "S" THEN
INSERT INTO cgtb00004 VALUES
(fecha2,1,entra,x.debito,depto1,null,null,null,null,
detalle,null,x.valor ,0,null,user,current,null,null)
END IF
LET depto1 = null
SELECT a.descripcion INTO descrip_cta
FROM cgtb00001 a
WHERE a.cuenta_no = x.credito
PRINT COLUMN 2, x.credito;
SELECT a.depto
FROM cgtb00001 a
WHERE a.cuenta_no = x.credito and
a.depto = "S"
IF STATUS != NOTFOUND THEN
LET depto1 = x.departamento
PRINT COLUMN 10, depto1;
LET STATUS = 0
END IF
PRINT COLUMN 18, descrip_cta,
COLUMN 65, x.valor using "###,###,##&.&&"
IF afecta = "S" THEN
INSERT INTO cgtb00004 VALUES
(fecha2,1,entra,x.credito,depto1,null,null,null,
null,detalle,null,0,x.valor,null,user,current,
null,null)
END IF
LET tvalor = tvalor + x.valor
PRINT COLUMN 18, "-------------- o ----------------"
ON LAST ROW
PRINT COLUMN 1,negrillas_on
PRINT COLUMN 50,"--------------",
COLUMN 65,"--------------"
PRINT COLUMN 35,"Totales-->",
COLUMN 50,tvalor USING "###,###,##&.&&",
COLUMN 65,tvalor USING "###,###,##&.&&",negrillas_off
LET tvalor = 0
SKIP 2 LINE
PRINT COLUMN 1, detalle
PRINT COLUMN 1,comp_off,negrillas_off
SKIP 4 LINE
END REPORT
{
Esta funcion se utiliza para desplegar mensajes de errores en todos
los sistemas de Ray-O-Vac Dominicana.
Esta funcion busca el mensaje deseado en la tabla "msgtable" y lo
despliega en la linea de mensajes
}
FUNCTION msg(numero_msg)
DEFINE numero_msg SMALLINT
DEFINE descripcion CHAR (60)
SELECT desc_msg INTO descripcion FROM msgtable
WHERE cod_msg = numero_msg
IF status = NOTFOUND THEN
LET numero_msg = 22
SELECT desc_msg INTO descripcion FROM msgtable
WHERE cod_msg = numero_msg
ERROR descripcion ATTRIBUTE(BOLD)
ELSE
ERROR descripcion ATTRIBUTE(BOLD)
LET numero_msg = 0
END IF
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
{
-------------------------------------------------------------------------------
PROGRAMA : IRPRRP009
OBJETIVO : Operacion por Tipo de Movimiento
PROGRAMADOR : Tadeo A. Ferreras
FECHA REALIZACION : Febrero 25, 1993
-------------------------------------------------------------------------------
}
FUNCTION irprrp009()
DEFINE salir1,salir CHAR(1)
DEFINE select_ac,select_ant,select_p CHAR(1000)
DEFINE p_mes,idx_ac,ano,idx_a,idx_c SMALLINT
DEFINE ano_act,c_ano CHAR(4)
DEFINE fecha_2 CHAR(8)
DEFINE fecha_ini_per CHAR(8)
DEFINE acumulado_a RECORD
cod_mov LIKE intb00005.cod_mov,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_Sec SMALLINT,
consumo LIKE irtb00006.cantidad_2
END RECORD
DEFINE acumulado_ac RECORD
cod_mov LIKE intb00005.cod_mov,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_Tipo SMALLINT,
cod_Sec SMALLINT,
consumo decimal(12,2),
cantidad LIKE vetb00014.cantidad
END RECORD
DEFINE costos RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_Sec SMALLINT,
mes CHAR(2),
gasto_ind DECIMAL(12,2)
END RECORD
DEFINE acumulado 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,
cod_mov LIKE irtb00006.cod_mov,
descrip_mov LIKE intb00005.descrip_mov,
consumo DECIMAL(12,2),
gasto_ind DECIMAL(12,2)
END RECORD
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21,
PROMPT LINE 14
OPEN FORM irfmrp009 FROM "irfmrp009"
DISPLAY FORM irfmrp009
CALL pantalla()
DISPLAY "irprrp009" AT 4,3
DISPLAY "Operacion Por Tipo Movimiento " AT 6,25
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
INPUT BY NAME c_ano,p_mes
SELECT @fecha_inicio,@fecha_corte
INTO datos_cons.fech_in,datos_cons.fech_fi
FROM prdtable
WHERE @ano = c_ano and @mes = p_mes
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET fecha1 = datos_cons.fech_in
LET fecha2 = datos_cons.fech_fi
CONSTRUCT criterio ON c.cod_mov,c.cod_n,c.cod_grupo,c.cod_tipo,c.cod_sec
FROM cod_mov,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
LABEL vuelve:
PROMPT "(1) Epson LQ-1070 (2) Unisys AP1324 " FOR CHAR opt
IF opt != "1" AND
opt != "2" THEN
LET numero_msg = -1301
CALL msg(numero_msg)
GOTO vuelve
END IF
IF opt = "1" THEN
LET prt_control = "lp -dlpt12"
ELSE
LET prt_control = "lp -dcentral"
END IF
LET select_ac =
"SELECT c.cod_n,c.cod_grupo,c.cod_tipo,c.cod_sec,a.descrip_esp, ",
" a.unidad_med,c.cod_mov,b.descrip_mov,SUM(c.cantidad_2) ",
"FROM intb00001 a,irtb00005 b,irtb00006 c ",
"WHERE (", criterio clipped," 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 (b.cod_mov = c.cod_mov) and ",
" (c.fecha between ? and ?) and c.status_t is null ",
"GROUP BY 1,2,3,4,5,6,7,8 ORDER BY 7,1,2,3,4"
LET p_param = "S"
DISPLAY "<< Estoy Buscando Acumulado Del Periodo Dado >>"
AT 17,14 ATTRIBUTE (REVERSE,BOLD)
PREPARE busca_ant FROM select_ac
DECLARE actual SCROLL CURSOR FOR busca_ant
OPEN actual USING datos_cons.fech_in,datos_cons.fech_fi
LET p_cuenta = 0
FOREACH actual INTO acumulado.*
LET p_cuenta = p_cuenta + 1
END FOREACH
LET regi = p_cuenta + 1
START REPORT opera TO PIPE prt_control
FOREACH actual INTO acumulado.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET acumulado.gasto_ind = 0
SELECT a.costo_st INTO acumulado.gasto_ind FROM irtb00013 a
WHERE (a.cod_n = acumulado.cod_n and a.cod_grupo = acumulado.cod_grupo and
a.cod_tipo = acumulado.cod_tipo and a.cod_sec=acumulado.cod_sec) and
(a.mes_ini <= p_mes) and a.mes_fin >= p_mes and a.ano = c_ano and
a.status_t is null
IF acumulado.gasto_ind IS NULL THEN
LET acumulado.gasto_ind = 0
END IF
CALL termometro(regi,p_param)
LET p_param = "N"
OUTPUT TO REPORT opera(acumulado.*)
END FOREACH
FINISH REPORT opera
CLEAR SCREEN
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
REPORT opera(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,
cod_mov LIKE irtb00006.cod_mov,
descrip_mov LIKE intb00005.descrip_mov,
consumo DECIMAL(12,2),
gasto_ind DECIMAL(12,2)
END RECORD
DEFINE l SMALLINT
DEFINE c_ano1 char(4)
DEFINE doble_on CHAR(2)
DEFINE doble_off CHAR(2)
DEFINE negrillas_on CHAR(6)
DEFINE negrillas_off CHAR(6)
DEFINE comp_on CHAR(3)
DEFINE comp_off CHAR(2)
DEFINE doce CHAR(3)
DEFINE normal CHAR(2)
DEFINE hora CHAR(5)
DEFINE total_p,total_m DECIMAL(12,2)
DEFINE total_material,total_labor,total_gasto_ind,t_t_total,t_t_t_total,
t_total_material,t_total_labor,t_total_gasto_ind,t_cantidad
DECIMAL (12,2)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 2
# ORDER BY x.cod_mov,x.cod_n,x.cod_grupo,x.cod_tipo,x.cod_sec
FORMAT
PAGE HEADER
IF opt = "2" THEN
LET doble_on = ASCII 001
LET doble_off = ASCII 002
LET negrillas_on = ASCII 027, ASCII 098
LET negrillas_off = ASCII 027, ASCII 099
LET comp_on = ASCII 031
LET comp_off = ASCII 029
LET doce = ASCII 031
#LET doce = ASCII 030
LET normal = ASCII 27, ASCII 80
ELSE
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
END IF
LET hora = time
PRINT COLUMN 1, doce
PRINT COLUMN 1, "edprrp033",
COLUMN 27, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 93, "Pag. ",pageno using "###"
PRINT COLUMN 27, " Sistema de Contabilidad General ",
COLUMN 93, today using "dd/mm/yy"
PRINT COLUMN 27, " Consumo de Repuesto del Tool Room",
COLUMN 96, hora
SKIP 1 LINES
PRINT COLUMN 1, "Desde ",datos_cons.fech_in using "dd/mm/yy",
" Hasta ", datos_cons.fech_fi using "dd/mm/yy"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
PRINT COLUMN 1, "Articulo",
COLUMN 65, "Cantidad",
COLUMN 80, "Costo",
COLUMN 96, "Total"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
BEFORE GROUP OF x.cod_mov
PRINT COLUMN 1, x.cod_mov using "&&"," ",x.descrip_mov
SKIP 1 LINE
PRINT COLUMN 4, "Productos "
ON EVERY ROW
IF x.consumo < 0 THEN
LET x.consumo = x.consumo * -1
END IF
IF x.consumo is null THEN
LET x.consumo = 0
END IF
PRINT COLUMN 1, x.cod_n USING "&","-",x.cod_grupo USING "&","-",
x.cod_tipo USING "&&","-",x.cod_sec USING "&&&",
" ",x.descrip_esp CLIPPED,
COLUMN 53, x.unidad_med CLIPPED,
COLUMN 60, x.consumo USING "###,###.##",
COLUMN 70, x.gasto_ind using "#,###,###.##",
COLUMN 85, x.consumo * x.gasto_ind using "(((,(((,((#.##"
AFTER GROUP OF x.cod_mov
PRINT negrillas_on
PRINT COLUMN 85, "----------------"
PRINT COLUMN 3, "Total Mvto. ---->",
COLUMN 85,GROUP SUM(x.consumo*x.gasto_ind) USING "###,###,###.##"
PRINT COLUMN 85, "================"
PRINT negrillas_off
SKIP TO TOP OF PAGE
ON LAST ROW
PRINT negrillas_on
PRINT COLUMN 85, "----------------"
PRINT COLUMN 3, "Total Gral. ---->",
COLUMN 85,SUM(x.consumo*x.gasto_ind) USING "###,###,###.##"
PRINT COLUMN 85, "================"
PRINT negrillas_off
LET total_material = 0
PRINT COLUMN 1, comp_on
END REPORT
{
============================================================================
PROGRAMA : TERMOMETRO
OBJETIVO : DESPLEGAR TERMOMETRO PORCENTUAL PARA LOS REPORTES
PROGRAMADOR : JUAN F. SOTO
FECHA : MARZO 10, 1995
============================================================================
}
FUNCTION termometro(registros,primera)
DEFINE registros INTEGER
DEFINE i,veces SMALLINT
DEFINE porcentaje,vez DECIMAL(8,2)
DEFINE primera CHAR(1)
IF primera = "S" THEN
LET primera = "N"
LET p = 27
CALL fgl_drawbox(3,8,19,18)
CALL fgl_drawbox(3,35,19,26)
IF registros <= 33 THEN
FOR i = 1 TO 33
LET cuenta1 = 1
DISPLAY " " AT 20,p ATTRIBUTE(REVERSE,BOLD)
LET p = p + 1
END FOR
END IF
END IF
IF registros > 33 THEN
LET vez = registros / 33
LET veces = vez USING "#####"
IF cuenta >= veces THEN
LET cuenta = 0
IF p <= 58 THEN
DISPLAY " " AT 20,p ATTRIBUTE(REVERSE,BOLD)
END IF
LET p = p + 1
END IF
LET porcentaje = (cuenta1/registros) * 100
DISPLAY porcentaje using "###","%" AT 20,19 ATTRIBUTE(BOLD)
LET cuenta = cuenta + 1
LET cuenta1 = cuenta1 + 1
END IF
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
Reference in New Issue View Git Blame Copy Permalink