Files

446 lines
14 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : CPPRRP008
OBJETIVO : Estado De Cuentas Con Partidas Pendientes
PROGRAMADOR : Tadeo A. Ferreras
FECHA REALIZACION : Junio 1, 1993
-------------------------------------------------------------------------------
}
GLOBALS "cpprgb000.4gl"
DEFINE prima DECIMAL(10,2)
DEFINE cod_sup SMALLINT
DEFINE mov CHAR(1)
DEFINE idx_1, idx_2, idx_3 SMALLINT
DEFINE fecha_inicial, fecha_final DATE
DEFINE salir, salir1, salir3, tipo_venta CHAR(1)
DEFINE selec5, selec6 CHAR(1500)
DEFINE valor2,valor3 DECIMAL(18,2)
DEFINE tot_gen1 RECORD
totald DECIMAL(10,2),
totalc DECIMAL(10,2),
totalg DECIMAL(10,2)
END RECORD
DEFINE mvtos RECORD
cod_sp SMALLINT,
cod_sp_sec SMALLINT,
nom_sup CHAR(45),
dir_sup CHAR(30),
ciu_sup CHAR(30),
tipo_doc CHAR(2),
num_doc CHAR(10),
fecha_doc DATE,
aplica_a LIKE cptb00001.aplica_a,
cliente CHAR(6),
balance DECIMAL(12,2)
END RECORD
FUNCTION cpprrp008()
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM cpfmrp008 FROM "cpfmrp008"
DISPLAY FORM cpfmrp008
CALL pantalla()
DISPLAY "cpprrp008" AT 4,3
DISPLAY "Estado Cuenta Con Partidas Pendientes" AT 6,21
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
INPUT BY NAME fecha_final,prima,cod_sup
BEFORE FIELD fecha_final
LET fecha_final = today
AFTER FIELD fecha_final
IF fecha_final is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_final
END IF
AFTER FIELD cod_sup
IF cod_sup IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sup
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
IF fecha_final is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_final
END IF
IF cod_sup IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sup
END IF
EXIT INPUT
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
# Busca Balances de los suplidores
CONSTRUCT criterio ON a.cod_sp_sec FROM cod_sp_sec
# Busca los documentos que esten en el rango de fechas especificado
LET selec4 =
"SELECT UNIQUE a.cod_sp, a.cod_sp_sec,b.nom_sp,b.dir_sp,b.ciu_sp,a.tipo_doc, ",
" a.num_doc,MIN(a.fecha_orig) ",
"FROM cptb00001 a,cotb00001 b ",
"WHERE (a.cod_sp = ? and a.cod_sp = b.cod_sp AND ",criterio clipped,
" AND a.cod_sp_sec = b.cod_sp_sec) AND a.status_t is null and ",
#" (a.fecha_orig <= ?) and (a.tipo_doc NOT IN ('CK')) ",
" (a.fecha_orig <= ?) ",
" GROUP BY 1,2,3,4,5,6,7 ORDER BY 1,2,7,6 "
DISPLAY "<< Buscando Informacion ... Espere Por Favor. >>" AT 19,14
ATTRIBUTE (REVERSE,BOLD)
DISPLAY "<< Buscando los Movimientos del Rango >>" AT 19,14
ATTRIBUTE (REVERSE,BOLD)
PREPARE movi FROM selec4
DECLARE mvtos_cli SCROLL CURSOR FOR movi
OPEN mvtos_cli USING cod_sup,fecha_final
START REPORT report181 TO "C:\\archivo"
DISPLAY "<< " AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>" AT 19,14
ATTRIBUTE (REVERSE)
LET salir = "N"
WHILE salir != "S"
FETCH mvtos_cli INTO mvtos.*
IF status = NOTFOUND THEN
LET salir = "S"
EXIT WHILE
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET idx_1 = idx_1 + 1
LET mvtos.cliente = mvtos.cod_sp using "&&",
mvtos.cod_sp_sec using "&&&&"
LET mvtos.balance = 0
IF mvtos.cod_sp = 23 OR prima IS NULL THEN
LET prima = 1
END IF
IF mvtos.tipo_doc = "CK" THEN
DECLARE busca CURSOR FOR
SELECT a.aplica_a
FROM cptb00001 a
WHERE a.num_doc = mvtos.num_doc AND
a.tipo_doc = "CK"
FOREACH busca INTO mvtos.aplica_a
OUTPUT TO REPORT report181(mvtos.*,cod_sup)
END FOREACH
ELSE
OUTPUT TO REPORT report181(mvtos.*,cod_sup)
END IF
END WHILE
FINISH REPORT report181
CLEAR SCREEN
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
REPORT report181(x,cod1)
DEFINE x RECORD
cod_sp SMALLINT,
cod_sp_sec SMALLINT,
nom_sup CHAR(45),
dir_sup CHAR(30),
ciu_sup CHAR(30),
tipo_doc CHAR(2),
num_doc CHAR(10),
fecha_doc DATE,
aplica_a LIKE cptb00001.aplica_a,
cliente CHAR(6),
balance DECIMAL(12,2)
END RECORD
DEFINE cod1,dias SMALLINT
DEFINE direccion,p_descrip CHAR(30)
DEFINE p_casa,p_zona,p_numero CHAR(10)
DEFINE doble_on CHAR(2)
DEFINE doble_off CHAR(2)
DEFINE negrillas_on CHAR(6)
DEFINE negrillas_off CHAR(6)
DEFINE comp_on CHAR(2)
DEFINE comp_off CHAR(2)
DEFINE doce CHAR(2)
DEFINE normal CHAR(2)
DEFINE hora CHAR(5)
DEFINE tipo CHAR(2)
DEFINE imp_cli CHAR(1)
DEFINE credito, debito, tcredito, tdebito, tbalance,t_valor1,t_valor2,
limite,b_balance,v1_30,v31_45,v46_60,vm_60,p_valor,t_valor3
DECIMAL(12,2)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 2
PAGE LENGTH 66
#ORDER BY x.cliente,x.num_doc,x.fecha_doc
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
LET lj = (108 - LENGTH(p_companias.nombre CLIPPED))/2
PRINT COLUMN 1, comp_on
PRINT COLUMN 1, "cpprrp008",
COLUMN lj, p_companias.nombre CLIPPED,
COLUMN 101, "Pag. ",pageno using "###"
PRINT COLUMN 40, "Sistema de Cuentas por Pagar",
COLUMN 101, today using "dd/mm/yy"
PRINT COLUMN 34, "Estado de Cuenta Con Partidas Pendientes",
COLUMN 104, hora
PRINT COLUMN 48, "Al ", fecha_final using "dd/mm/yy"
# , negrillas_off clipped
IF cod1 < 23 AND prima = 1 THEN
PRINT COLUMN 53, "US$"
ELSE
PRINT COLUMN 53, "RD$"
END IF
SKIP 1 LINES
BEFORE GROUP OF x.cliente
LET v1_30 = 0
LET v31_45 = 0
LET v46_60 = 0
LET vm_60 = 0
IF tdebito IS NULL THEN
LET tdebito = 0
END IF
IF tcredito IS NULL THEN
LET tcredito = 0
END IF
IF tbalance IS NULL THEN
LET tbalance = 0
END IF
IF x.balance IS NULL THEN
LET x.balance = 0
END IF
IF limite IS NULL THEN
LET limite = 0
END IF
IF prima > 1 THEN
PRINT COLUMN 1,"Prima: ", prima using "###.##"
END IF
PRINT COLUMN 1,
"--------------------------------------------------",
"--------------------------------------------------",
"-----------"
, negrillas_on clipped
PRINT COLUMN 1, "Suplidor:",
COLUMN 10, x.cod_sp using "&&","-",
x.cod_sp_sec using "&&&&",
COLUMN 18, x.nom_sup clipped
# COLUMN 81, "Balance Al: ", fecha_inicial using "dd/mm/yy"
PRINT COLUMN 1,negrillas_on clipped,
COLUMN 10, x.dir_sup clipped," ",x.ciu_sup clipped,
COLUMN 93, x.balance * prima using "(((,(((,(((.##)",
negrillas_off clipped
PRINT COLUMN 1,
"--------------------------------------------------",
"--------------------------------------------------",
"-----------"
LET b_balance = 0
# SKIP 1 LINE
PRINT COLUMN 4, "D O C U M E N T O"
PRINT COLUMN 1, "|----------------------|"
PRINT COLUMN 3, "Numero",
COLUMN 11, "Tipo",
COLUMN 17, "Fecha",
# COLUMN 29, "APLICADO A",
COLUMN 63, "Pendiente",
COLUMN 99, "Balance"
PRINT COLUMN 1,
"--------------------------------------------------",
"--------------------------------------------------" ,
"-----------"
LET debito = 0
LET credito = 0
ON EVERY ROW
LET t_valor1 = 0
LET t_valor2 = 0
LET t_valor3 = 0
IF x.tipo_doc = "CP" THEN
SELECT sum(a.valor) INTO t_valor1 FROM cptb00001 a
WHERE a.status_t IS NULL AND a.num_doc = x.num_doc AND
a.aplica_a IS NULL AND a.tipo_doc = "CP" AND
a.fecha_orig <= fecha_final AND a.cod_sp = x.cod_sp AND
a.cod_sp_sec = x.cod_sp_sec
IF t_valor1 IS NULL THEN
LET t_valor1 = 0
END IF
SELECT sum(a.valor) INTO t_valor2 FROM cptb00001 a
WHERE a.status_t IS NULL AND a.num_doc = x.num_doc AND
a.aplica_a IS NOT NULL AND a.tipo_doc = "CP" AND
a.fecha_orig <= fecha_final AND a.cod_sp = x.cod_sp AND
a.cod_sp_sec = x.cod_sp_sec
IF t_valor2 IS NULL THEN
LET t_valor2 = 0
END IF
LET t_valor3 = t_valor1 - t_valor2
ELSE
IF x.tipo_doc != "CK" THEN
SELECT sum(a.valor) INTO t_valor3 FROM cptb00001 a
WHERE a.status_t IS NULL AND a.aplica_a = x.num_doc AND
a.fecha_orig <= fecha_final AND a.cod_sp = x.cod_sp AND
a.cod_sp_sec = x.cod_sp_sec
IF t_valor3 IS NULL THEN
LET t_valor3 = 0
END IF
END IF
IF x.tipo_doc = "CK" THEN
SELECT UNIQUE a.num_doc FROM cptb00001 a
WHERE a.status_t IS NULL AND a.num_doc = x.aplica_a AND
a.cod_sp = x.cod_sp AND
a.cod_sp_sec = x.cod_sp_sec
IF STATUS = NOTFOUND THEN
SELECT sum(a.valor) INTO t_valor3 FROM cptb00001 a
WHERE a.status_t IS NULL AND a.aplica_a = x.aplica_a AND
a.cod_sp = x.cod_sp AND
a.cod_sp_sec = x.cod_sp_sec
IF t_valor3 IS NULL THEN
LET t_valor3 = 0
END IF
LET STATUS = 0
END IF
END IF
END IF
LET t_valor3 = t_valor3 * prima
IF t_valor3 IS NOT NULL AND t_valor3 != 0 THEN
LET b_balance = b_balance + t_valor3
PRINT COLUMN 3, x.num_doc CLIPPED,
COLUMN 12, x.tipo_doc,
COLUMN 16, x.fecha_doc using "dd/mm/yy",
COLUMN 59, t_valor3 using "(((,(((,(((.##)",
COLUMN 97, b_balance using "(((,(((,(((.##)"
LET debito = debito + t_valor3
LET p_valor = t_valor3
LET dias = fecha_final - x.fecha_doc
IF dias > 60 THEN
LET vm_60 = vm_60 + p_valor
END IF
IF dias > 45 and dias < 61 THEN
LET v46_60 = p_valor + v46_60
END IF
IF dias > 30 and dias < 46 THEN
LET v31_45 = p_valor + v31_45
END IF
IF dias < 31 THEN
LET v1_30 = p_valor + v1_30
END IF
END IF
AFTER GROUP OF x.cliente
SKIP 1 LINE
PRINT COLUMN 1, "ANALISIS POR ANTIGUEDAD",negrillas_on clipped,
COLUMN 37, "1 a 30",
COLUMN 51, "31 a 45",
COLUMN 66, "46 a 60",
COLUMN 79, "Mas de 60",negrillas_off clipped
PRINT COLUMN 1, "DE SU APRECIADA CUENTA: ",
COLUMN 26, v1_30 using "(((,(((.((&.&&)",
COLUMN 41, v31_45 using "(((,(((,((&.&&)",
COLUMN 51, v46_60 using "(((,(((,((&.&&)",
COLUMN 61, vm_60 using "(((,(((,((&.&&)"
SKIP 1 LINE
PRINT COLUMN 1, "NOTA: FAVOR REVISAR ESTE ESTADO Y NOTIFICAR A NUESTRO ",
"DEPARTAMENTO DE CONTABILIDAD SOBRE CUALQUIER "
PRINT COLUMN 1, "DISCREPANCIA O REPARO, A LA MAYOR BREVEDAD POSIBLE."
# PRINT COLUMN 1, "APRECIAMOS SU RESPUESTA, POR TANTO, QUEDAREMOS AGRADECIDOS"
# ," POR SU ATENCION, SERVANSE USAR LA COPIA DE ESTE ESTADO"
# PRINT COLUMN 1, "PARA SU CONFIRMACION."
SKIP to TOP OF PAGE
PAGE TRAILER
SKIP 1 LINE
PRINT COLUMN 1,negrillas_on clipped,
COLUMN 10,
"NOMENCLATURA: OC = ORDEN COMPRA CK = CHEQUE FT = FACTURAS ",
"ND = NOTA DE DEBITO NC = NOTA CREDITO CP = PREPAGOS",
negrillas_off clipped
END REPORT