Files
MBS/PROYECTO/addir/adprmt008.4gl
T

234 lines
6.6 KiB
Plaintext

{
---------------------------------------------------------------------------
PROGRAMA : ADPRMT008
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Movimientos en la Accion de Nomina
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Mayo 21, 1993
---------------------------------------------------------------------------
}
GLOBALS "adprgb000.4gl"
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CONNECT to "smarmotech" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
CALL adprmt008()
END MAIN
FUNCTION adprmt008()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM adfmmt008 FROM "adfmmt008"
DISPLAY FORM adfmmt008
DISPLAY "adprmt008" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Movimientos de Empleados" AT 6,31 ATTRIBUTE(BLACK)
MENU
ON ACTION nuevo
let int_flag = false
INITIALIZE emplea.* TO NULL
CALL adpcad008()
ON ACTION buscar
let int_flag = false
CALL adpcmf008()
ON ACTION Salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION adpcad008()
# WHENEVER ERROR CONTINUE
## CAPTURA LOS DATOS QUE VA A CONTENER EL REGISTRO
INPUT BY NAME mov_emp.*
BEFORE INPUT
SELECT MAX(a.cod_mto) INTO mov_emp.cod_mto FROM adtb00009 a
IF mov_emp.cod_mto IS NULL THEN
LET mov_emp.cod_mto = 0
END IF
## VERIFICA QUE EL CODIGO NO EXISTA EN EL CATALOGO DE MOVIMIENTOS DE EMPLEADO.
## SI EXISTE ENTONCES DESPLIEGA LOS DATOS DEL REGISTRO EXISTENTE.
CALL codigos_nomina()
NEXT FIELD desc_mto
AFTER FIELD desc_mto
IF mov_emp.desc_mto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD desc_mto
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
SELECT a.cod_mov FROM adtb00009 a
WHERE a.cod_mov = mov_emp.cod_mov AND a.status_t IS NULL
IF STATUS <> NOTFOUND THEN
CALL fgl_winmessage("INFO","YA EXISTE UN TIPO DE TRANSACCION CON ESTE CODIGO DE NOMINAS","INFO")
NEXT FIELD desc_mto
END IF
LET mov_emp.cod_mto = mov_emp.cod_mto +1
INSERT INTO adtb00009 (cod_mto,desc_mto,cod_mov,tipo_mov,us_crea,fech_crea) VALUES (mov_emp.cod_mto,
mov_emp.desc_mto, mov_emp.cod_mov, mov_emp.tipo_mov, usuarios, GETDATE())
DISPLAY BY NAME mov_emp.cod_mto
LET numero_msg = 1
CALL msg(numero_msg)
CONTINUE INPUT
END INPUT
END FUNCTION
FUNCTION adpcmf008()
## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA
## MODIFICACION DE REGISTROS.
# WHENEVER ERROR CONTINUE
CALL codigos_nomina()
CONSTRUCT criterio ON a.cod_mto,a.desc_mto FROM cod_mto,desc_mto
LET SELEC = " SELECT a.* FROM adtb00009 a where ",
" a.status_t is null and ",
criterio clipped,
" ORDER BY a.cod_mto"
PREPARE busca FROM selec
DECLARE dato SCROLL CURSOR FOR busca
OPEN dato
FETCH FIRST dato INTO mov_emp.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
END IF
DISPLAY BY NAME mov_emp.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT dato INTO mov_emp.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME mov_emp.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS dato INTO mov_emp.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME mov_emp.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST dato INTO mov_emp.*
DISPLAY BY NAME mov_emp.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST dato INTO mov_emp.*
DISPLAY BY NAME mov_emp.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
IF mov_emp.status_t = "E" THEN
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
## SE SELECCIONAN LOS CAMPOS MODIFICABLES
INPUT BY NAME mov_emp.desc_mto,
mov_emp.tipo_mov,
mov_emp.cod_mov
WITHOUT DEFAULTS
BEFORE INPUT
CALL codigos_nomina()
AFTER FIELD desc_mto
IF mov_emp.desc_mto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD desc_mto
END IF
#### 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 bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
## AQUI SE ACTUALIZAN LOS REGISTROS
UPDATE adtb00009 SET desc_mto = mov_emp.desc_mto,
cod_mov = mov_emp.cod_mov,
tipo_mov = mov_emp.tipo_mov,
us_mod = usuarios,
fech_mod = GETDATE()
WHERE cod_mto = mov_emp.cod_mto
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
## AQUI SE ELIMINAN LOS REGISTROS
COMMAND KEY ("L") "eLiminar"
UPDATE adtb00009 SET status_t = "E",
us_mod = usuarios,
fech_mod = getdate()
WHERE cod_mto = mov_emp.cod_mto
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION