Files
MBS/PROYECTO/nodir/noprmt011.4gl
T

503 lines
17 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : NOPRMT011
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Control de Prestamos y Facturas
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Septiembre 09, 1993
------------------------------------------------------------------
}
GLOBALS "noprgb000.4gl"
DEFINE monto1,monto2 DECIMAL(12,2)
DEFINE p_nomina CHAR(1),
opcion VARCHAR(3)
DEFINE num_ctrl,num_ctrl1 CHAR(8)
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT to "smarmotech" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
CALL noprmt011()
END MAIN
FUNCTION noprmt011()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
LET formulario = formulario CLIPPED,"nofmmt011"
OPEN FORM nofmmt011 FROM "nofmmt011"
DISPLAY FORM nofmmt011
# CALL pantalla()
# DISPLAY "noprmt011" AT 4,3
# DISPLAY "Control de Prestamos y Facturas" AT 6,25
MENU
ON ACTION nuevo
let int_flag = false
CLEAR FORM
CALL nopcad011()
ON ACTION buscar
let int_flag = false
CALL nopcmf011()
ON ACTION salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION nopcad011()
# WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
LABEL entrada:
INPUT BY NAME presta.*
## Verifica que el registro no exista. Si existe, entonces despliega los
## datos del registro existente.
AFTER FIELD num_emp
IF presta.num_emp IS NOT NULL THEN
SELECT departamento,nivel_emp,cod_puesto,nom1_emp,apell1_emp,
nomina
INTO presta.departamento,presta.nivel_emp,
presta.cod_puesto,nombre1,apellido1,p_nomina
FROM adtb00003
WHERE num_emp = presta.num_emp and
(status_t is null or status_t = "I")
IF status = NOTFOUND THEN
LET numero_msg = 159
CALL msg(numero_msg)
NEXT FIELD num_emp
END IF
ELSE
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_puesto
END IF
LET descrip1 = nombre1 clipped," ",apellido1 clipped
DISPLAY BY NAME presta.departamento,presta.nivel_emp,
presta.cod_puesto,descrip1
AFTER FIELD num_doc
IF presta.num_doc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
LET num_ctrl = presta.num_doc USING "<<<<<<<<"
LET num_ctrl1= YEAR(TODAY) USING "&&&&"
IF num_ctrl[1,2] = num_ctrl1[3,4] THEN
LET numero_msg = 216
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
AFTER FIELD cod_mov
{IF presta.cod_mov = 25 THEN
LET numero_msg = 203
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF}
SELECT unique @num_doc FROM notb00011
WHERE @num_emp = presta.num_emp and
@num_doc = presta.num_doc and
@cod_mov = presta.cod_mov
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF presta.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD num_emp
END IF
SELECT * INTO presta.* FROM notb00011
WHERE num_emp = presta.num_emp and
num_doc = presta.num_doc and
cod_mov = presta.cod_mov
DISPLAY BY NAME presta.*
LET numero_msg = 12
CALL msg(numero_msg)
DISPLAY BY NAME mov_nomi.descrip_mov
INITIALIZE presta.* TO NULL
SLEEP 2
NEXT FIELD num_emp
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
END IF
IF presta.cod_mov is not null THEN
SELECT descrip_mov INTO mov_nomi.descrip_mov FROM notb00002
WHERE cod_mov = presta.cod_mov and
status_t is null
IF status = NOTFOUND THEN
LET numero_msg = 34
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
ELSE
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
DISPLAY BY NAME mov_nomi.descrip_mov
AFTER FIELD fecha
IF presta.fecha IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
{ SELECT max(fecha) INTO fecha_control FROM notb00008
IF presta.fecha < fecha_control THEN
LET numero_msg = 57
CALL msg(numero_msg)
NEXT FIELD fecha
END IF}
AFTER FIELD monto
IF presta.monto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD monto
END IF
BEFORE FIELD porciento
LET presta.porciento = 0
LET monto2 = 0
DISPLAY BY NAME presta.porciento,monto2
AFTER FIELD porciento
IF presta.porciento IS NOT NULL THEN
LET monto1 = (presta.monto * presta.porciento)/100
LET monto2 = presta.monto - monto1
END IF
DISPLAY BY NAME monto2
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
# IF cuota IS NULL OR cuota = 0 THEN
# CALL fgl_winmessage("INFO","DEBES DE DIGITAR LA CUOTA QUE PAGARA ESTE EMPLEADO","INFO")
# NEXT FIELD cuota
# END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
BEGIN WORK
# Inserta en nomina los prestamos de los empleados
DELETE FROM notb00008 WHERE num_emp = presta.num_emp and
cod_mov = presta.cod_mov and
num_nomi = presta.num_doc
INSERT INTO notb00008 (num_emp,departamento,nivel_emp,cod_puesto,
cod_mov,valor,fecha,num_nomi,tipo_emp,
clase_mov,us_crea,fech_crea)
VALUES (presta.num_emp,presta.departamento,presta.nivel_emp,
presta.cod_puesto,presta.cod_mov,monto2,presta.fecha,
presta.num_doc,p_nomina,"F", SUSER_SNAME(),GETDATE())
INSERT INTO notb00011
VALUES (presta.num_emp,presta.departamento,presta.nivel_emp,
presta.cod_puesto,presta.num_doc,presta.cod_mov,presta.fecha,
presta.monto,presta.porciento,null,SUSER_SNAME(),GETDATE(),null,NULL,presta.valor_cuota)
IF presta.valor_cuota IS NOT NULL AND presta.valor_cuota <> 0 THEN
CALL actualizacuota()
END IF
COMMIT WORK
LET numero_msg = 1
CALL msg(numero_msg)
# CLEAR FORM
GOTO entrada
END FUNCTION
FUNCTION nopcmf011()
## Aqui se prepara para la captura del criterio de seleccion
LET monto2 = 0
DISPLAY BY NAME monto2
# WHENEVER ERROR CONTINUE
CONSTRUCT criterio ON a.num_emp,a.num_doc,a.cod_mov
FROM num_emp,num_doc,cod_mov
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC =
"SELECT a.num_emp,a.departamento,a.nivel_emp,a.cod_puesto,",
"num_doc,a.cod_mov,CONVERT(CHAR(10),a.fecha,103),a.monto,a.porciento,a.status_t,a.us_crea,",
" a.fech_crea,a.us_mod,a.fech_mod FROM notb00011 a WHERE a.status_t is null and ",
criterio clipped," ORDER BY a.cod_mov,a.num_emp,a.fecha"
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO presta.num_Emp,presta.departamento,presta.nivel_emp,
presta.nivel_emp,presta.num_doc,presta.cod_mov,
presta.fecha,presta.monto,presta.porciento,presta.status_t,
presta.us_Crea,presta.fech_crea,presta.us_mod,presta.fech_mod
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
END IF
CALL buscadata()
MENU "OPCIONES "
COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO presta.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL buscadata()
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO presta.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL buscadata()
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO presta.*
CALL buscadata()
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO presta.*
CALL buscadata()
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <CTRL-C> Cancela Operacion"
IF presta.status_t = "E" THEN
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
INPUT BY NAME presta.num_doc,presta.monto,presta.porciento,
presta.valor_cuota,
presta.us_crea,presta.fech_crea,presta.us_mod,
presta.fech_mod WITHOUT DEFAULTS
AFTER FIELD num_doc
IF presta.num_doc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
LET num_ctrl = presta.num_doc USING "<<<<<<<<"
LET num_ctrl1= YEAR(TODAY) USING "&&&&"
IF num_ctrl[1,2] = num_ctrl1[3,4] THEN
LET numero_msg = 216
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
AFTER FIELD monto
IF presta.monto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD monto
END IF
BEFORE FIELD porciento
LET monto2 = 0
DISPLAY BY NAME monto2
AFTER FIELD porciento
IF presta.porciento IS NOT NULL THEN
LET monto1 = (presta.monto * presta.porciento)/100
LET monto2 = presta.monto - monto1
END IF
DISPLAY BY NAME monto2
#### Verifica si el usuario presiono la tecla <CTRL-C>
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
# IF cuota IS NULL OR cuota = 0 THEN
# CALL fgl_winmessage("INFO","DEBES DE DIGITAR LA CUOTA QUE PAGARA ESTE EMPLEADO","INFO")
# NEXT FIELD cuota
# END IF
# Inserta en nomina los prestamos de los empleados
SELECT nomina INTO p_nomina FROM adtb00003
WHERE num_emp = presta.num_emp AND (status_t IS NULL or status_t = "I")
BEGIN WORK
DELETE FROM notb00008
WHERE num_emp = presta.num_emp and cod_mov = presta.cod_mov AND
num_nomi = presta.num_doc
INSERT INTO notb00008 (num_emp,departamento,nivel_emp,cod_puesto,
cod_mov,valor,fecha,num_nomi,tipo_emp,
clase_mov,us_crea,fech_crea)
VALUES (presta.num_emp,presta.departamento,presta.nivel_emp,
presta.cod_puesto,presta.cod_mov,monto2,presta.fecha,
presta.num_doc,p_nomina,"F",SUSER_SNAME(),GETDATE())
CALL integridad()
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
UPDATE notb00011 SET cod_mov = presta.cod_mov,
fecha = presta.fecha,
monto = presta.monto,
porciento = presta.porciento,
valor_cuota = presta.valor_cuota,
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE num_emp = presta.num_emp and num_doc = presta.num_doc AND
cod_mov = presta.cod_mov
CALL integridad()
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
IF presta.valor_cuota IS NOT NULL AND presta.valor_cuota <> 0 THEN
CALL actualizacuota()
END IF
COMMIT WORK
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
LET opcion = fgl_winquestion("ELIMINAR","ESTA SEGURO DE ELIMINAR ESTE REGISTRO?","NO","NO|YES","QUESTION",0)
IF opcion = "YES" THEN
BEGIN WORK
UPDATE notb00011 SET status_t = "E",
us_mod = suser_sname(),
fech_mod = getdate()
WHERE notb00011.num_emp = presta.num_emp AND
notb00011.num_doc = presta.num_doc AND
notb00011.cod_mov = presta.cod_mov
UPDATE notb00008 SET status_t = "E",
us_mod = suser_sname(),
fech_mod = getdate()
WHERE notb00008.num_emp = presta.num_emp AND
notb00008.num_nomi = presta.num_doc AND
notb00008.cod_mov = presta.cod_mov AND
notb00008.clase_mov = 'F'
DELETE FROM notb00003 WHERE cod_mov = presta.cod_mov AND num_emp = presta.num_emp
COMMIT WORK
LET numero_msg = 39
CALL msg(numero_msg)
END IF
COMMAND "Retornar" "Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
FUNCTION actualizacuota()
SELECT a.cod_mov FROM notb00003 a
WHERE a.num_emp = presta.num_emp AND
a.cod_mov = presta.cod_mov
IF STATUS = NOTFOUND THEN
INSERT INTO notb00003(num_emp,departamento,nivel_emp,cod_puesto,cod_mov,valor,us_crea,fech_Crea)
VALUES (presta.num_emp,presta.departamento,presta.nivel_emp,presta.cod_puesto,presta.cod_mov, presta.valor_cuota,usuarios,getdate())
ELSE
LET opcion = fgl_winquestion("ACTUALIZAR",
"EL EMPLEADO TIENE UNA CUOTA DE UN PRESTAMO, DESAS ACTUALIZAR LA CUOTA CON ESTA NUEVA?"
,"NO","NO|YES","QUESTION",0)
IF opcion = "YES" THEN
UPDATE notb00003 SET valor = presta.valor_cuota,
us_mod = usuarios,
fech_mod = getdate()
WHERE num_Emp = presta.num_emp AND
cod_mov = presta.cod_mov
END IF
END IF
END FUNCTION
FUNCTION buscadata()
SELECT descrip_mov INTO mov_nomi.descrip_mov FROM notb00002
WHERE cod_mov = presta.cod_mov
SELECT nom1_emp,apell1_emp INTO nombre1,apellido1 FROM adtb00003
WHERE num_emp = presta.num_emp
SELECT a.valor INTO presta.valor_cuota FROM notb00003 a WHERE a.num_emp = presta.num_emp AND
a.cod_mov = presta.cod_mov
LET descrip1 = nombre1 clipped," ",apellido1 clipped
IF presta.porciento IS NOT NULL THEN
LET monto1 = (presta.monto * presta.porciento)/100
LET monto2 = presta.monto - monto1
END IF
DISPLAY BY NAME monto2,presta.valor_cuota
DISPLAY BY NAME presta.*,descrip1,mov_nomi.descrip_mov
END FUNCTION