Files
MBS/PROYECTO/cpdir/cpprrp014.4gl
T

275 lines
8.7 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : CPPRRP014
SISTEMA : Cuenta por Pagar
OBJETIVO : Analisis de Gastos por Cuentas Dptos. Administracion
PROGRAMADOR : Tadeo A. Ferreras
FECHA REALIZACION : Marzo 1, 1993
-------------------------------------------------------------------------------
}
GLOBALS "cpprgb000.4gl"
DEFINE mov CHAR(1)
DEFINE idx_1, idx_2, idx_3 SMALLINT
DEFINE fecha_inicial, fecha_final DATE
DEFINE salir, salir2,salir1, salir3, tipo_venta CHAR(1)
DEFINE selec5, selec6 CHAR(1500)
DEFINE cuenta_no CHAR(8)
DEFINE descripcion CHAR(30)
DEFINE cod_sp SMALLINT
DEFINE datos_13 RECORD
departamento SMALLINT,
fecha_orig DATE,
num_doc CHAR(10),
cod_sp SMALLINT,
cod_sp_sec SMALLINT,
nom_sup CHAR(45),
valor DECIMAL(12,2)
END RECORD
DEFINE datos_131 RECORD
cuenta_no CHAR(8),
descripcion CHAR(30)
END RECORD
DEFINE datos_132 RECORD
cod_sp SMALLINT,
cod_sp_sec SMALLINT,
total_np DECIMAL(12,2)
END RECORD
FUNCTION cpprrp014()
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM cpfmrp014 FROM "cpfmrp014"
DISPLAY FORM cpfmrp014
CALL pantalla()
DISPLAY "cpprrp014" AT 4,3
DISPLAY "Analisis de Gastos por Cuentas y Dptos. de Administracion" AT 6,11
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
INPUT BY NAME fecha_inicial,fecha_final,cuenta_no
AFTER FIELD fecha_inicial
IF fecha_inicial is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_inicial
END IF
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 cuenta_no
IF cuenta_no is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
SELECT UNIQUE a.descripcion INTO descripcion FROM cgtb00001 a
WHERE a.cuenta_no = cuenta_no AND a.status_t IS NULL
IF descripcion IS NULL THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
DISPLAY BY NAME descripcion
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET selec5 =
"SELECT UNIQUE a.departamento,a.fecha,a.factura,a.cod_sp,a.cod_sp_sec, ",
" b.nom_sp,SUM(a.debito-a.credito) ",
"FROM cptb00003 a,cotb00001 b ",
"WHERE (a.departamento BETWEEN 1000 AND 5900 OR ",
" a.departamento >= 7000) AND a.fecha BETWEEN ? AND ? AND ",
" a.cod_sp = b.cod_sp AND a.cod_sp_sec = b.cod_sp_sec AND ",
" a.status_t is null AND a.cuenta_no = ? GROUP BY 1,2,3,4,5,6 "
DISPLAY "<< Buscando Informacion ... Espere Por Favor. >>" AT 19,14
ATTRIBUTE (REVERSE,BOLD)
PREPARE b_balance FROM selec5
DECLARE c_balance CURSOR FOR b_balance
OPEN c_balance USING fecha_inicial,fecha_final,cuenta_no
START REPORT reporte_14 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 c_balance INTO datos_13.*
IF status = notfound THEN
LET salir = "S"
EXIT WHILE
END IF
IF int_flag THEN
LET int_flag = FALSE
LET numero_msg = 2
CALL msg(numero_msg)
RETURN
END IF
OUTPUT TO REPORT reporte_14(datos_13.*)
END WHILE
FINISH REPORT reporte_14
RUN "TYPE C:\\ARCHIVO > %USPRINT%"
CLEAR SCREEN
END FUNCTION
REPORT reporte_14(x)
DEFINE x RECORD
departamento SMALLINT,
fecha_orig DATE,
num_doc CHAR(10),
cod_sp SMALLINT,
cod_sp_sec SMALLINT,
nom_sup CHAR(45),
valor DECIMAL(12,2)
END RECORD
DEFINE nom_dpto CHAR(30)
DEFINE registro INTEGER
DEFINE p_numero,p_zona 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 normall CHAR(3)
DEFINE comprimido CHAR(3)
DEFINE hora CHAR(5)
DEFINE tipo CHAR(2)
DEFINE imp_cli CHAR(1)
DEFINE balance1,balancea,balanceb DECIMAL(12,2)
DEFINE credito, debito, tcredito, tdebito, tbalance,
limite, b_balance,total1,total2 DECIMAL(12,2)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 3
ORDER BY x.departamento,x.fecha_orig,x.num_doc
FORMAT
PAGE HEADER
LET doble_on = ASCII 116
LET doble_off = ASCII 117
LET negrillas_on = ASCII 27, ASCII 098
LET negrillas_off = ASCII 27, ASCII 099
LET comp_on = ASCII 31
LET comp_off = ASCII 30
LET comprimido = ASCII 31
LET doce = ASCII 27, ASCII 77
LET normal = ASCII 27, ASCII 80
LET normall = ASCII 030
LET hora = time
LET lj = (83 - LENGTH(p_companias.nombre CLIPPED))/2
PRINT COLUMN 1, "cpprrp014",
COLUMN lj, p_companias.nombre CLIPPED,
COLUMN 76, "Pag. ",pageno using "###"
PRINT COLUMN 17, " Sistema de Cuentas por Pagar",
COLUMN 76, today using "dd/mm/yy"
PRINT COLUMN 17, " Analisis de Gastos por Cuentas y Dptos.",
COLUMN 79, hora
PRINT COLUMN 24, "Del ",fecha_inicial USING "dd/mm/yy",
" Al ", fecha_final using "dd/mm/yy"
PRINT COLUMN 17, " Administracion General "
SKIP 1 LINES
PRINT COLUMN 1, "Cuenta No. ",cuenta_no CLIPPED," ",
descripcion CLIPPED
PRINT COLUMN 1,"--------------------------------------------------",
"-----------------------------"
PRINT COLUMN 1, "Fecha",
COLUMN 12, "Factura",
COLUMN 24, "Suplidor",
COLUMN 65, "Valor Factura"
PRINT COLUMN 1,"--------------------------------------------------",
"-----------------------------"
BEFORE GROUP OF x.departamento
LET total1 = 0
LET nom_dpto = NULL
IF x.departamento IS NOT NULL THEN
SELECT UNIQUE a.nom_dpto INTO nom_dpto FROM adtb00001 a
WHERE a.departamento = x.departamento
ELSE
LET nom_dpto = "SIN DEPARTAMENTO"
END IF
PRINT COLUMN 1, x.departamento," ",nom_dpto CLIPPED
SKIP 1 LINE
ON EVERY ROW
IF total2 IS NULL THEN
LET total2 = 0
END IF
LET total1 = total1 + x.valor
LET total2 = total2 + x.valor
PRINT COLUMN 1, x.fecha_orig USING "dd/mm/yy",
COLUMN 12, x.num_doc,
COLUMN 24, x.cod_sp USING "&&","-",
x.cod_sp_sec using "&&&&"," ",
x.nom_sup clipped,
COLUMN 66, x.valor using "(((,(((,(((.##)"
AFTER GROUP OF x.departamento
SKIP 1 LINE
PRINT COLUMN 1, "Total Dpto.--->",
COLUMN 66, GROUP SUM(x.valor) USING "(((,(((,((&.&&)"
SKIP 1 LINE
ON LAST ROW
SKIP 1 LINE
PRINT COLUMN 1, "Total Gral.--->",
COLUMN 66, SUM(x.valor) USING "(((,(((,((&.&&)"
LET total1 = 0
LET total2 = 0
PRINT normall
END REPORT