Files
MBS/PROYECTO/ccdir/ccprrp010.4gl
T

239 lines
7.6 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : CCPRRP010
OBJETIVO : Analisis Descuento Por Pronto Pago
PROGRAMADOR : Tadeo A. Ferreras F.
FECHA REALIZACION : Mayo 12,1993.
MODIFICADO :
------------------------------------------------------------------
}
GLOBALS
"ccprgb000.4gl"
DEFINE datos_imp RECORD
fecha_inic DATE,
fecha_fin DATE
END RECORD
DEFINE prt_desc RECORD
num_doc LIKE cctb00001.num_doc,
valor LIKE cctb00001.valor,
monto_desc LIKE cctb00001.monto_desc,
fecha_orig LIKE cctb00001.fecha_orig,
aplica_a LIKE cctb00001.aplica_a,
fecha_factura LIKE vetb00002.fecha_factura,
tipo_cliente LIKE vetb00002.tipo_cliente,
sec_cliente LIKE vetb00002.sec_cliente,
factura LIKE vetb00002.factura,
neto LIKE vetb00002.neto,
nombre LIKE vetb00004.nombre
END RECORD
FUNCTION ccprrp010()
OPTIONS
FORM LINE 10
#WHENEVER ERROR CONTINUE
CLEAR SCREEN
OPEN FORM ccfmrp010 FROM "ccfmrp010"
CALL pantalla()
DISPLAY "ccprrp010" at 4,4 attribute(blue)
DISPLAY "Analisis Descuentos por Pronto Pago" at 6,23
DISPLAY form ccfmrp010
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
INPUT BY NAME datos_imp.*
AFTER FIELD fecha_inic
IF datos_imp.fecha_inic is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_inic
END IF
AFTER FIELD fecha_fin
IF datos_imp.fecha_fin is null THEN
LET datos_imp.fecha_fin = today
DISPLAY BY NAME datos_imp.fecha_fin
END IF
IF datos_imp.fecha_fin < datos_imp.fecha_inic THEN
LET numero_msg = 86
CALL msg(numero_msg)
NEXT FIELD fecha_fin
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET selec =
"SELECT b.num_doc,b.valor,b.monto_desc,b.fecha_orig,b.aplica_a, ",
"a.fecha_factura,a.tipo_cliente,a.sec_cliente,a.factura,a.neto,",
"c.nombre ",
"FROM cctb00001 b, vetb00004 c, outer vetb00002 a ",
"WHERE b.aplica_a = a.factura and a.tipo_cliente = c.tipo_cliente and ",
"b.sec_cliente = c.sec_cliente and ",
"b.tipo_doc = 'PG' and ",
"b.monto_desc != 0 and ",
"b.fecha_orig between ? and ? "
PREPARE comando FROM selec
DECLARE buscar CURSOR FOR comando
OPEN buscar USING datos_imp.fecha_inic,datos_imp.fecha_fin
DISPLAY "Buscando Informacion ... Espere por favor" at 19,14
attribute(reverse,bold)
IF status < 0 THEN
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
END IF
END IF
START REPORT prt_desc1 TO "C:\\archivo"
DISPLAY " " AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>" AT 19,14
ATTRIBUTE(REVERSE)
WHILE STATUS != NOTFOUND
FETCH buscar INTO prt_desc.*
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
OUTPUT TO REPORT prt_desc1(prt_desc.*,datos_imp.fecha_inic,datos_imp.fecha_fin)
END WHILE
FINISH REPORT prt_desc1
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
REPORT prt_desc1(x,fecha1,fecha2)
DEFINE x RECORD
num_doc LIKE cctb00001.num_doc,
valor LIKE cctb00001.valor,
monto_desc LIKE cctb00001.monto_desc,
fecha_orig LIKE cctb00001.fecha_orig,
aplica_a LIKE cctb00001.aplica_a,
fecha_factura LIKE vetb00002.fecha_factura,
tipo_cliente LIKE vetb00002.tipo_cliente,
sec_cliente LIKE vetb00002.sec_cliente,
factura LIKE vetb00002.factura,
neto LIKE vetb00002.neto,
nombre LIKE vetb00004.nombre
END RECORD,
difer INTEGER,
fecha,fecha1,fecha2 DATE,
i,c INTEGER,
total1,total2,total3 DECIMAL(11,2)
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,normal CHAR(2)
DEFINE hora CHAR(5)
DEFINE l SMALLINT
DEFINE varia CHAR(10)
DEFINE p_cliente,m_cliente SMALLINT
DEFINE g_cliente,n_cliente SMALLINT
DEFINE p_neto DECIMAL(10,2)
DEFINE p_factura SMALLINT
DEFINE p_fecha_factura DATE
DEFINE p_nombre CHAR(30)
OUTPUT
LEFT MARGIN 0
ORDER BY x.num_doc
FORMAT
PAGE HEADER
LET doble_on = ASCII 001
LET doble_off = ASCII 002
LET negrillas_on = ASCII 27, ASCII 69
LET negrillas_off = ASCII 27, ASCII 69
LET normal = ASCII 029
LET comp_on = ASCII 15
LET comp_off = ASCII 18
LET doce = ASCII 30
LET hora = time
LET fecha = today
LET lj = (78 - LENGTH(p_companias.nombre CLIPPED))/2
PRINT COLUMN 1,comp_off,
COLUMN 2,"ccprrp010",
COLUMN lj, p_companias.nombre CLIPPED,
COLUMN 71,"Pag. ",pageno using "##"
PRINT COLUMN 22, "Sistema de Cuentas por Cobrar",
COLUMN 71,today using "dd/mm/yy"
PRINT COLUMN 18,"Analisis de Descuentos por Pronto Pago",
COLUMN 74,hora
PRINT COLUMN 22,"Fecha del ",fecha1 using "dd/mm/yy",
" Al ",fecha2 using "dd/mm/yy"
SKIP 1 LINE
PRINT COLUMN 1,comp_on,negrillas_on
PRINT COLUMN 2,
"______________________________________________________________________________________________________________________________________"
PRINT COLUMN 2,"Factura",
COLUMN 18,"Fecha",
Column 34,"Monto Neto",
Column 56,"Recibo",
Column 73,"Fecha",
COLUMN 93,"Valor",
COLUMN 109,"Desc.",
COLUMN 120,"Dias"
PRINT COLUMN 2,
"______________________________________________________________________________________________________________________________________",
negrillas_off
SKIP 1 LINE
ON EVERY ROW
LET difer = x.fecha_orig - x.fecha_factura
IF total1 is null THEN LET total1 = 0 END IF
IF total2 is null THEN LET total2 = 0 END IF
IF total3 is null THEN LET total3 = 0 END IF
PRINT COLUMN 1,x.factura using "&&&&&&",
COLUMN 18,x.fecha_factura using "dd/mm/yy",
COLUMN 30,x.neto using "###,###,###.##",
COLUMN 49,x.num_doc using "######",
COLUMN 69,x.fecha_orig using "dd/mm/yy",
COLUMN 82,x.valor using "###,###,###.##",
COLUMN 99,x.monto_desc using "###,###,###.##",
COLUMN 118,difer using "###"
PRINT COLUMN 1, negrillas_on,
COLUMN 2, x.tipo_cliente using "&&","-",x.sec_cliente using "&&&&",
" ",x.nombre,negrillas_off
IF c is null THEN LET c = 0 END IF
LET c = c + 1
LET total1 = total1 + p_neto
LET total2 = total2 + x.valor
LET total3 = total3 + x.monto_desc
ON LAST ROW
PRINT COLUMN 1,negrillas_on,
COLUMN 30, "-------------",
COLUMN 83, "-------------",
COLUMN 100, "-------------"
PRINT COLUMN 1,"Totales..",
COLUMN 27,total1 using "###,###,###.##",
COLUMN 80,total2 using "###,###,###.##",
COLUMN 97,total3 using "###,###,###.##"
SKIP 1 LINE
PRINT COLUMN 1,negrillas_on,
"Total registro ",
COLUMN 27, c using "######",negrillas_off,comp_off
END REPORT