{ ------------------------------------------------------------------ PROGRAMA : TEPRMT021 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla de Comisiones. PROGRAMADOR : Lic. Abner Montalvo Zapata FECHA REALIZACION : Diciembre 2, 1992. ------------------------------------------------------------------ } GLOBALS "teprgb000.4gl" FUNCTION teprmt021() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, MESSAGE LINE 24, COMMENT LINE 21 OPEN FORM tefmmt021 FROM "tefmmt003" DISPLAY FORM tefmmt021 CALL pantalla() # CALL ayuda() DISPLAY "teprmt021" AT 4,3 ATTRIBUTE(RED) DISPLAY "Mantenimiento de Comisiones por Vendedor" at 6,20 ATTRIBUTE(BLACK) MENU "OPCIONES" COMMAND "Adicionar" " Adiciona Registro Cancela Operacion" HELP 5 LET INT_FLAG = FALSE CLEAR FORM LET INT_FLAG = FALSE CALL tepcad021() COMMAND "Consultar-modificar" " Realiza Busqueda Cancela Operacion" HELP 6 CALL tepcmf021() COMMAND "Salir" "Retorna Menu Anterior" EXIT MENU END MENU END FUNCTION FUNCTION tepcad021() DEFINE fech_ant CHAR(8) # WHENEVER ERROR CONTINUE MESSAGE "" ## Captura los datos que va a contener el registro INPUT BY NAME comisiones.* {ON KEY (CONTROL-W) CASE WHEN INFIELD (cod_vend) CALL consulta_empleados2() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) NEXT FIELD cod_vend END IF IF NOT int_flag THEN LET comisiones.cod_vend = transportista.cod_transp LET comisiones.sec_vend = transportista.sec_transp DISPLAY transportista.cod_transp TO cod_vend DISPLAY transportista.sec_transp TO sec_vend DISPLAY descrip6 TO descrip6 NEXT FIELD cod_n END IF LET int_flag = FALSE WHEN INFIELD (sec_vend) CALL consulta_empleados2() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) NEXT FIELD cod_vend END IF IF NOT int_flag THEN LET comisiones.cod_vend = transportista.cod_transp LET comisiones.sec_vend = transportista.sec_transp DISPLAY transportista.cod_transp TO cod_vend DISPLAY transportista.sec_transp TO sec_vend DISPLAY descrip6 TO descrip6 NEXT FIELD cod_n END IF LET int_flag = FALSE WHEN INFIELD (cod_n) CALL busca_pt() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) NEXT FIELD cod_n END IF IF NOT int_flag THEN LET comisiones.cod_n = pterminado.cod_n LET comisiones.cod_grupo = pterminado.cod_grupo LET comisiones.cod_tipo = pterminado.cod_tipo LET comisiones.cod_sec = pterminado.cod_sec DISPLAY pterminado.cod_n TO cod_n DISPLAY pterminado.cod_grupo TO cod_grupo DISPLAY pterminado.cod_tipo TO cod_tipo DISPLAY pterminado.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp NEXT FIELD porc_ventas END IF LET int_flag = FALSE WHEN INFIELD (cod_grupo) CALL busca_pt() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) NEXT FIELD cod_grupo END IF IF NOT int_flag THEN LET comisiones.cod_n = pterminado.cod_n LET comisiones.cod_grupo = pterminado.cod_grupo LET comisiones.cod_tipo = pterminado.cod_tipo LET comisiones.cod_sec = pterminado.cod_sec DISPLAY pterminado.cod_n TO cod_n DISPLAY pterminado.cod_grupo TO cod_grupo DISPLAY pterminado.cod_tipo TO cod_tipo DISPLAY pterminado.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp NEXT FIELD porc_ventas END IF LET int_flag = FALSE WHEN INFIELD (cod_tipo) CALL busca_pt() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) NEXT FIELD cod_tipo END IF IF NOT int_flag THEN LET comisiones.cod_n = pterminado.cod_n LET comisiones.cod_grupo = pterminado.cod_grupo LET comisiones.cod_tipo = pterminado.cod_tipo LET comisiones.cod_sec = pterminado.cod_sec DISPLAY pterminado.cod_n TO cod_n DISPLAY pterminado.cod_grupo TO cod_grupo DISPLAY pterminado.cod_tipo TO cod_tipo DISPLAY pterminado.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp NEXT FIELD porc_ventas END IF LET int_flag = FALSE WHEN INFIELD (cod_sec) CALL busca_pt() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) NEXT FIELD cod_sec END IF IF NOT int_flag THEN LET comisiones.cod_n = pterminado.cod_n LET comisiones.cod_grupo = pterminado.cod_grupo LET comisiones.cod_tipo = pterminado.cod_tipo LET comisiones.cod_sec = pterminado.cod_sec DISPLAY pterminado.cod_n TO cod_n DISPLAY pterminado.cod_grupo TO cod_grupo DISPLAY pterminado.cod_tipo TO cod_tipo DISPLAY pterminado.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp NEXT FIELD porc_ventas END IF LET int_flag = FALSE END CASE } AFTER FIELD cod_vend IF comisiones.cod_vend = 0 or | The symbol 'comisiones.cod_vend' does not represent a defined variable. | See error number -4369. comisiones.cod_vend is null THEN | The symbol 'comisiones.cod_vend' does not represent a defined variable. | See error number -4369. LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_vend END IF AFTER FIELD sec_vend IF comisiones.sec_vend = 0 or comisiones.sec_vend is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD sec_vend ELSE SELECT i.nom1_emp, i.apell1_emp INTO descrip1, descrip2 FROM adtb00003 i WHERE i.num_emp = comisiones.cod_vend AND i.status_t is null IF status >= 0 THEN IF status = NOTFOUND THEN LET numero_msg = 68 CALL msg(numero_msg) NEXT FIELD cod_vend END IF LET descrip6 = descrip1 clipped," ",descrip2 clipped DISPLAY descrip6 TO descrip6 ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF END IF ## Verifica que el codigo no exista en el catalogo de comisiones. Si existe, ## entonces despliega los datos del registro existente. AFTER FIELD cod_sec SELECT i.descrip_esp INTO descrip1 FROM intb00001 i WHERE i.cod_n = comisiones.cod_n AND i.cod_grupo = comisiones.cod_grupo AND i.cod_tipo = comisiones.cod_tipo AND i.cod_sec = comisiones.cod_sec and i.status_t is null IF status >= 0 THEN IF status = NOTFOUND THEN LET numero_msg = 26 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY descrip1 TO descrip_esp ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF SELECT * INTO comisiones.* FROM vetb00011 WHERE cod_vend = comisiones.cod_vend AND sec_vend = comisiones.sec_vend AND cod_n = comisiones.cod_n AND cod_grupo = comisiones.cod_grupo AND cod_tipo = comisiones.cod_tipo AND cod_sec = comisiones.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF comisiones.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_vend END IF DISPLAY BY NAME comisiones.porc_ventas, comisiones.porc_cobros, comisiones.us_crea, comisiones.fech_crea, comisiones.us_mod, comisiones.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_vend ELSE INITIALIZE comisiones.porc_ventas, comisiones.porc_cobros, comisiones.us_crea, comisiones.fech_crea, comisiones.us_mod, comisiones.fech_mod TO NULL DISPLAY BY NAME comisiones.porc_ventas, comisiones.porc_cobros, comisiones.us_crea, comisiones.fech_crea, comisiones.us_mod, comisiones.fech_mod END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF AFTER FIELD porc_ventas IF comisiones.porc_ventas IS NULL OR comisiones.porc_ventas = 0 THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD porc_ventas END IF AFTER FIELD porc_cobros IF comisiones.porc_cobros IS NULL THEN LET comisiones.porc_cobros = 0 END IF AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF IF comisiones.cod_vend = 0 or | The symbol 'comisiones.cod_vend' does not represent a defined variable. | See error number -4369. comisiones.cod_vend is null THEN | The symbol 'comisiones.cod_vend' does not represent a defined variable. | See error number -4369. LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_vend END IF IF comisiones.sec_vend = 0 or comisiones.sec_vend is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD sec_vend ELSE SELECT i.nom1_emp, i.apell1_emp INTO descrip1, descrip2 FROM adtb00003 i WHERE i.num_emp = comisiones.cod_vend AND i.status_t is null IF status >= 0 THEN IF status = NOTFOUND THEN LET numero_msg = 68 CALL msg(numero_msg) NEXT FIELD cod_vend END IF LET descrip6 = descrip1 clipped," ",descrip2 clipped DISPLAY descrip6 TO descrip6 ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF END IF IF comisiones.cod_n IS NULL OR comisiones.cod_n = 0 THEN LET numero_msg = 60 CALL msg(numero_msg) NEXT FIELD cod_n END IF ## Verifica que el codigo no exista en el catalogo de comisiones. Si existe, ## entonces despliega los datos del registro existente. IF ( comisiones.cod_n = 0 AND comisiones.cod_grupo = 0 AND comisiones.cod_tipo = 0 AND comisiones.cod_sec = 0 ) THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_n ELSE SELECT i.descrip_esp INTO descrip1 FROM intb00001 i WHERE i.cod_n = comisiones.cod_n AND i.cod_grupo = comisiones.cod_grupo AND i.cod_tipo = comisiones.cod_tipo AND i.cod_sec = comisiones.cod_sec and i.status_t is null IF status >= 0 THEN IF status = NOTFOUND THEN LET numero_msg = 26 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY descrip1 TO descrip_esp ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF END IF SELECT * INTO comisiones.* FROM vetb00011 WHERE cod_vend = comisiones.cod_vend AND sec_vend = comisiones.sec_vend AND cod_n = comisiones.cod_n AND cod_grupo = comisiones.cod_grupo AND cod_tipo = comisiones.cod_tipo AND cod_sec = comisiones.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF comisiones.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_vend END IF DISPLAY BY NAME comisiones.porc_ventas, comisiones.porc_cobros, comisiones.us_crea, comisiones.fech_crea, comisiones.us_mod, comisiones.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_vend END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF IF comisiones.porc_ventas IS NULL OR comisiones.porc_ventas = 0 THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD porc_ventas END IF IF comisiones.porc_cobros IS NULL THEN LET comisiones.porc_cobros = 0 END IF # Valida que el codigo del articulo no sea cero. Si no es cero, adiciona el # registro en la tabla, de lo contrario, presenta mensaje de error y acepta # el codigo de nuevo. { IF (comisiones.cod_n = 0 AND comisiones.cod_grupo = 0 AND comisiones.cod_tipo = 0 AND comisiones.cod_sec = 0 ) OR (comisiones.cod_vend = 0 AND comisiones.sec_vend = 0 ) OR comisiones.porc_ventas = 0 THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_vend ELSE } INSERT INTO vetb00011 VALUES (comisiones.cod_vend, comisiones.sec_vend, comisiones.cod_n, comisiones.cod_grupo, comisiones.cod_tipo, comisiones.cod_sec, comisiones.porc_ventas, comisiones.porc_cobros, null, USER, CURRENT, null, null) # Verifica el Status que retorna luego de insertar el registro en la tabla. # Si el Status es diferente de cero quiere decir que hubo problemas durante # la creacion del registro, entonces despliega un mensaje de alerta para que # el usuario sepa que hubo problemas en la creacion del registro. CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF LET numero_msg = 1 CALL msg(numero_msg) NEXT FIELD cod_vend { END IF } EXIT INPUT END INPUT END FUNCTION FUNCTION tepcmf021() ## Aqui se prepara para la captura del criterio de seleccion MESSAGE "" CLEAR FORM CONSTRUCT criterio ON vetb00011.* FROM vetb00011.* IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET SELEC = " SELECT UNIQUE * FROM vetb00011 WHERE ", " status_t is null AND ", criterio clipped, " ORDER BY 1,2,3,4,5,6" PREPARE busca FROM selec CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF DECLARE datos SCROLL CURSOR WITH HOLD FOR busca OPEN datos FETCH FIRST datos INTO comisiones.* 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 LET bandera = 0 RETURN END IF END IF DISPLAY BY NAME comisiones.* CALL busca_vendedor2() CALL busca_nombre_articulo2() MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT datos INTO comisiones.* IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF DISPLAY BY NAME comisiones.* CALL busca_vendedor2() CALL busca_nombre_articulo2() COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS datos INTO comisiones.* IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF DISPLAY BY NAME comisiones.* CALL busca_vendedor2() CALL busca_nombre_articulo2() COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST datos INTO comisiones.* DISPLAY BY NAME comisiones.* CALL busca_vendedor2() CALL busca_nombre_articulo2() LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST datos INTO comisiones.* DISPLAY BY NAME comisiones.* CALL busca_vendedor2() CALL busca_nombre_articulo2() LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" INPUT BY NAME comisiones.porc_ventas, comisiones.porc_cobros WITHOUT DEFAULTS AFTER FIELD porc_ventas IF comisiones.porc_ventas IS NULL OR comisiones.porc_ventas = 0 THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD porc_ventas END IF AFTER FIELD porc_cobros IF (comisiones.porc_ventas IS NULL OR comisiones.porc_ventas = 0) AND (comisiones.porc_cobros IS NULL OR comisiones.porc_cobros = 0) THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD porc_ventas END IF AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF IF comisiones.porc_ventas IS NULL OR comisiones.porc_ventas = 0 THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD porc_ventas END IF IF (comisiones.porc_ventas IS NULL OR comisiones.porc_ventas = 0) AND (comisiones.porc_cobros IS NULL OR comisiones.porc_cobros = 0) THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD porc_ventas END IF UPDATE vetb00011 SET porc_ventas = comisiones.porc_ventas, porc_cobros = comisiones.porc_cobros, us_mod = USER, fech_mod = CURRENT WHERE sec_vend = comisiones.sec_vend AND cod_n = comisiones.cod_n AND cod_grupo = comisiones.cod_grupo AND cod_tipo = comisiones.cod_tipo AND cod_sec = comisiones.cod_sec CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF LET numero_msg = 13 CALL msg(numero_msg) EXIT INPUT END INPUT COMMAND KEY ("L") "eLiminar" "Elimina registro que esta en la pantalla" UPDATE vetb00011 SET status_t = "E" WHERE cod_vend = comisiones.cod_vend AND sec_vend = comisiones.sec_vend AND cod_n = comisiones.cod_n AND cod_grupo = comisiones.cod_grupo AND cod_tipo = comisiones.cod_tipo AND cod_sec = comisiones.cod_sec LET numero_msg = 39 CALL msg(numero_msg) COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM # CALL ayuda() EXIT MENU END MENU END FUNCTION FUNCTION busca_vendedor2() # Esta funcion busca el nombre del vendedor y lo despliega en pantalla # Esta funcion es valida solamente para la consulta-modificacion. SELECT i.nom1_emp, i.apell1_emp, i.status_t INTO descrip1, descrip2, status_reg FROM adtb00003 i WHERE i.num_emp = comisiones.sec_vend and i.status_t is null IF status >= 0 THEN IF status = NOTFOUND THEN LET numero_msg = 68 CALL msg(numero_msg) ELSE IF status_reg = "E" THEN LET numero_msg = 67 CALL msg(numero_msg) END IF END IF LET descrip6 = descrip1 clipped," ",descrip2 clipped DISPLAY descrip6 TO descrip6 ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF END FUNCTION FUNCTION busca_nombre_articulo2() # Esta funcion busca el nombre del articulo y lo despliega en pantalla # Esta funcion es valida solamente para la consulta-modificacion. SELECT i.descrip_esp, i.status_t INTO descrip1, status_reg FROM intb00001 i WHERE i.cod_n = comisiones.cod_n AND i.cod_grupo = comisiones.cod_grupo AND i.cod_tipo = comisiones.cod_tipo AND i.cod_sec = comisiones.cod_sec IF status >= 0 THEN IF status = NOTFOUND THEN LET numero_msg = 26 CALL msg(numero_msg) ELSE IF status_reg = "E" THEN LET numero_msg = 44 CALL msg(numero_msg) END IF END IF DISPLAY descrip1 TO descrip_esp ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF END FUNCTION FUNCTION consulta_empleados2() OPEN WINDOW busqueda AT 7,12 WITH FORM "tefmwd001" ATTRIBUTE (BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST,MESSAGE LINE LAST) LET int_flag = false CONSTRUCT criterio ON a.nom1_emp FROM descrip6 LET selec2 = "SELECT a.num_emp, a.nom1_emp, a.apell1_emp ", "FROM adtb00003 a ", "WHERE a.status_t is null AND ",criterio clipped," ORDER BY 1,2 " IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) GO TO salir_consulta_e END IF PREPARE busca_empleados FROM selec2 IF status >= 0 THEN IF status = notfound THEN LET numero_msg = 3 CALL msg(numero_msg) END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 END IF END IF DECLARE buscar_empleados CURSOR FOR busca_empleados LET idx = 1 FOREACH buscar_empleados INTO arr_empleados[idx].* IF status = NOTFOUND THEN EXIT FOREACH END IF IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) EXIT FOREACH END IF LET empleados[idx].cod_emp = arr_empleados[idx].cod_emp LET empleados[idx].descrip6 = arr_empleados[idx].nom_emp clipped," ",arr_empleados[idx].apell_emp clipped LET idx = idx + 1 END FOREACH CALL set_count(idx-1) MESSAGE " Selecciona Empleado donde esta el cursor" DISPLAY ARRAY empleados TO s_empleados.* LET curr1 = arr_curr() LET transportista.cod_transp = empleados[curr1].cod_emp LET descrip6 = empleados[curr1].descrip6 LABEL salir_consulta_e: CLOSE WINDOW busqueda END FUNCTION