{ =============================================================================== PROGRAMA : NOPRMT005 SISTEMA : Sistema de Nomina OBJETIVO : Mantenimiento para maestra de la tabla de rentencion mensual para los asalariados (ano 1993) PROGRAMADOR : Tadeo A. Ferreras F. FECHA : Agosto 23, 1993 =============================================================================== } GLOBALS "noprgb000.4gl" DEFINE retencion RECORD salario DECIMAL(12,2), valor DECIMAL(12,2) END RECORD DEFINE p_ret RECORD salario DECIMAL(12,2), valor DECIMAL(12,2) END RECORD DEFINE num_reg INTEGER DEFINE estado RECORD status_t CHAR(1), us_crea CHAR(9), fech_crea LIKE notb00005.fech_crea, us_mod CHAR(9), fech_mod LIKE notb00005.fech_mod END RECORD FUNCTION noprmt005() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, COMMENT LINE 21 LET formulario = formulario CLIPPED,"nofmmt005" OPEN FORM nofmmt005 FROM "nofmmt005" DISPLAY FORM nofmmt005 CALL pantalla() DISPLAY "noprmt005" AT 4,3 DISPLAY "Impuesto Sobre La Renta" AT 6,28 MENU "OPCIONES" COMMAND "Adicionar" " Adiciona Registro Cancela Operacion" let int_flag = false CLEAR FORM CALL nopcad005() COMMAND "Consultar-modificar" " Realiza Busqueda Cancela Operacion" let int_flag = false CALL nopcmf005() COMMAND "Salir" "Retorna Menu Anterior" EXIT MENU END MENU END FUNCTION FUNCTION nopcad005() CLEAR FORM # WHENEVER ERROR CONTINUE ## Captura los datos que va a contener el registro LABEL vuelve: INPUT BY NAME retencion.* ## Verifica que el codigo no exista en el catalogo de movimientos. Si existe, ## entonces despliega los datos del registro existente. AFTER FIELD salario IF retencion.salario IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD salario END IF AFTER FIELD valor IF retencion.valor IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD valor ELSE SELECT UNIQUE a.salario,a.valor,a.status_t INTO retencion.salario,retencion.valor,p_status FROM notb00005 a WHERE a.salario = retencion.salario and a.valor = retencion.valor IF status >= 0 THEN IF status != NOTFOUND THEN IF p_status = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD salario END IF DISPLAY BY NAME retencion.* LET numero_msg = 12 CALL msg(numero_msg) CLEAR FORM LET retencion.salario = NULL LET retencion.valor = NULL NEXT FIELD salario END IF ELSE CALL integridad() IF bandera = 1 THEN CLEAR SCREEN RETURN END IF END IF END IF END INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE CLEAR FORM RETURN END IF INSERT INTO notb00005 VALUES(retencion.*,0,NULL,USER,CURRENT,NULL,NULL) LET numero_msg = 1 CALL msg(numero_msg) GOTO vuelve END FUNCTION FUNCTION nopcmf005() CLEAR FORM ## Aqui se prepara para la captura del criterio de seleccion # WHENEVER ERROR CONTINUE CONSTRUCT criterio ON a.salario,a.valor FROM salario,valor IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE CLEAR FORM RETURN END IF LET SELEC = "SELECT UNIQUE a.rowid,a.salario,a.valor,a.status_t, ", " a.us_crea,a.fech_crea,a.us_mod,a.fech_mod ", "FROM notb00005 a WHERE ", " a.status_t IS NULL AND ", criterio CLIPPED, " ORDER BY 1" PREPARE busca FROM selec CALL integridad() IF bandera = 1 THEN CLEAR FORM RETURN END IF DECLARE datos SCROLL CURSOR FOR busca OPEN datos FETCH FIRST datos INTO num_reg,retencion.*,estado.* 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 FORM RETURN END IF END IF DISPLAY BY NAME retencion.*,estado.* MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT datos INTO num_reg,retencion.*,estado.* IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF DISPLAY BY NAME retencion.*,estado.* COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS datos INTO num_reg,retencion.*,estado.* IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF DISPLAY BY NAME retencion.*,estado.* COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST datos INTO num_reg,retencion.*,estado.* DISPLAY BY NAME retencion.*,estado.* LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST datos INTO num_reg,retencion.*,estado.* DISPLAY BY NAME retencion.*,estado.* LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" LET p_ret.* = retencion.* INPUT BY NAME retencion.* WITHOUT DEFAULTS AFTER FIELD salario IF retencion.salario IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD salario END IF IF retencion.salario != p_ret.salario THEN SELECT a.salario FROM notb00005 a WHERE a.salario = retencion.salario IF status != NOTFOUND THEN LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD salario END IF END IF AFTER FIELD valor IF retencion.valor IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD valor END IF IF retencion.valor <> p_ret.valor THEN SELECT a.valor FROM notb00005 a WHERE a.valor = retencion.valor IF status != NOTFOUND THEN LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD valor END IF END IF END INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE CLEAR FORM RETURN END IF CALL integridad() IF bandera = 1 THEN CLEAR FORM RETURN END IF UPDATE notb00005 SET (salario,valor,status_t,us_crea,fech_crea, us_mod,fech_mod) = (retencion.salario,retencion.valor,NULL, USER,CURRENT,USER,CURRENT) WHERE rowid = num_reg LET numero_msg = 13 CALL msg(numero_msg) COMMAND KEY ("L") "eLiminar" UPDATE notb00005 SET (status_t,us_mod,fech_mod) = ("E",USER,CURRENT) WHERE rowid = num_reg LET numero_msg = 39 CALL msg(numero_msg) COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM EXIT MENU END MENU END FUNCTION