{ ------------------------------------------------------------------ PROGRAMA : IPPRMT007 OBJETIVO : Precios Minimos y de Listas PROGRAMADOR : JUAN SOTO FECHA REALIZACION : Agosto 25, 1997. DIRECTOR PROYECTO : JOSE ALFREDO PAULINO ALEJO ------------------------------------------------------------------ } GLOBALS "ipprgb000.4gl" FUNCTION ipprmt007() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, HELP KEY CONTROL-W, MESSAGE LINE 24, COMMENT LINE 21 OPEN FORM ipfmmt007 FROM "ipfmmt007" DISPLAY FORM ipfmmt007 CALL pantalla() DISPLAY "ipprmt007" AT 4,3 DISPLAY "Mantenimiento Precios Minimos Y De Lista " at 6,22 MENU "OPCIONES" COMMAND "Adicionar" " Adiciona Registro Cancela Operacion" HELP 5 LET INT_FLAG = FALSE CLEAR FORM LET INT_FLAG = FALSE CALL ippcad007() COMMAND "Consultar-modificar" " Realiza Busqueda Cancela Operacion" HELP 6 CALL ippcmf007() COMMAND "Salir" "Retorna Menu Anterior" EXIT MENU END MENU END FUNCTION FUNCTION ippcad007() MESSAGE "" ## Captura los datos que va a contener el registro INPUT BY NAME p_iptb14.* { ON KEY (CONTROL-W) CASE 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 p_iptb14.cod_n = p_conteo.cod_n LET p_iptb14.cod_grupo = p_conteo.cod_grupo LET p_iptb14.cod_tipo = p_conteo.cod_tipo LET p_iptb14.cod_sec = p_conteo.cod_sec DISPLAY p_iptb14.cod_n TO cod_n DISPLAY p_iptb14.cod_grupo TO cod_grupo DISPLAY p_iptb14.cod_tipo TO cod_tipo DISPLAY p_iptb14.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp SELECT * INTO p_iptb14.* FROM iptb00014 WHERE cod_n = p_iptb14.cod_n AND cod_grupo = p_iptb14.cod_grupo AND cod_tipo = p_iptb14.cod_tipo AND cod_sec = p_iptb14.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF p_iptb14.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY BY NAME p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n ELSE INITIALIZE p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod TO NULL DISPLAY BY NAME p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF NEXT FIELD peso_bruto 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 p_iptb14.cod_n = p_conteo.cod_n LET p_iptb14.cod_grupo = p_conteo.cod_grupo LET p_iptb14.cod_tipo = p_conteo.cod_tipo LET p_iptb14.cod_sec = p_conteo.cod_sec DISPLAY p_iptb14.cod_n TO cod_n DISPLAY p_iptb14.cod_grupo TO cod_grupo DISPLAY p_iptb14.cod_tipo TO cod_tipo DISPLAY p_iptb14.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp SELECT * INTO p_iptb14.* FROM iptb00014 WHERE cod_n = p_iptb14.cod_n AND cod_grupo = p_iptb14.cod_grupo AND cod_tipo = p_iptb14.cod_tipo AND cod_sec = p_iptb14.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF p_iptb14.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY BY NAME p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n ELSE INITIALIZE p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod TO NULL DISPLAY BY NAME p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF NEXT FIELD peso_bruto 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 p_iptb14.cod_n = p_conteo.cod_n LET p_iptb14.cod_grupo = p_conteo.cod_grupo LET p_iptb14.cod_tipo = p_conteo.cod_tipo LET p_iptb14.cod_sec = p_conteo.cod_sec DISPLAY p_iptb14.cod_n TO cod_n DISPLAY p_iptb14.cod_grupo TO cod_grupo DISPLAY p_iptb14.cod_tipo TO cod_tipo DISPLAY p_iptb14.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp SELECT * INTO p_iptb14.* FROM iptb00014 WHERE cod_n = p_iptb14.cod_n AND cod_grupo = p_iptb14.cod_grupo AND cod_tipo = p_iptb14.cod_tipo AND cod_sec = p_iptb14.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF p_iptb14.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY BY NAME p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n ELSE INITIALIZE p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod TO NULL DISPLAY BY NAME p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF NEXT FIELD peso_bruto 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 p_iptb14.cod_n = p_conteo.cod_n LET p_iptb14.cod_grupo = p_conteo.cod_grupo LET p_iptb14.cod_tipo = p_conteo.cod_tipo LET p_iptb14.cod_sec = p_conteo.cod_sec DISPLAY p_iptb14.cod_n TO cod_n DISPLAY p_iptb14.cod_grupo TO cod_grupo DISPLAY p_iptb14.cod_tipo TO cod_tipo DISPLAY p_iptb14.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp SELECT * INTO p_iptb14.* FROM iptb00014 WHERE cod_n = p_iptb14.cod_n AND cod_grupo = p_iptb14.cod_grupo AND cod_tipo = p_iptb14.cod_tipo AND cod_sec = p_iptb14.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF p_iptb14.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY BY NAME p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n ELSE INITIALIZE p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod TO NULL DISPLAY BY NAME p_iptb14.peso_bruto, p_iptb14.peso_neto, p_iptb14.dim_caja, p_iptb14.us_crea, p_iptb14.fech_crea, p_iptb14.us_mod, p_iptb14.fech_mod END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF NEXT FIELD peso_bruto END IF LET int_flag = FALSE END CASE } ## Verifica que el codigo no exista en el catalogo de p_iptb14. Si existe, ## entonces despliega los datos del registro existente. AFTER FIELD cod_sec SELECT i.descrip_esp,i.descrip_ing INTO descrip1, descrip2 FROM iptb00002 i WHERE i.cod_n = p_iptb14.cod_n AND i.cod_grupo = p_iptb14.cod_grupo AND i.cod_tipo = p_iptb14.cod_tipo AND i.cod_sec = p_iptb14.cod_sec and i.status_t is null IF status = NOTFOUND THEN LET numero_msg = 35 CALL msg(numero_msg) NEXT FIELD cod_n END IF SELECT i.*FROM iptb00014 i WHERE i.cod_n = p_iptb14.cod_n AND i.cod_grupo = p_iptb14.cod_grupo AND i.cod_tipo = p_iptb14.cod_tipo AND i.cod_sec = p_iptb14.cod_sec and i.status_t is null IF status != NOTFOUND THEN LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n END IF LET descripcion= descrip1 CLIPPED DISPLAY BY NAME descripcion ATTRIBUTE(CYAN) AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF SELECT i.descrip_esp,i.descrip_ing INTO descrip1, descrip2 FROM iptb00002 i WHERE i.cod_n = p_iptb14.cod_n AND i.cod_grupo = p_iptb14.cod_grupo AND i.cod_tipo = p_iptb14.cod_tipo AND i.cod_sec = p_iptb14.cod_sec and i.status_t is null IF status = NOTFOUND THEN LET numero_msg = 35 CALL msg(numero_msg) NEXT FIELD cod_n END IF LET descripcion= descrip1 CLIPPED DISPLAY BY NAME descripcion ATTRIBUTE(CYAN) INSERT INTO iptb00014 VALUES (p_iptb14.*) UPDATE iptb00014 SET us_crea = user, fech_crea = current WHERE cod_n = p_iptb14.cod_n AND cod_grupo = p_iptb14.cod_grupo AND cod_tipo = p_iptb14.cod_tipo AND cod_sec = p_iptb14.cod_sec LET numero_msg = 1 CALL msg(numero_msg) NEXT FIELD cod_n AFTER FIELD fech_mod EXIT INPUT END INPUT END FUNCTION FUNCTION ippcmf007() ## Aqui se prepara para la captura del criterio de seleccion MESSAGE "" CLEAR FORM CONSTRUCT criterio ON iptb00014.* FROM iptb00014.* IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET SELEC = " SELECT UNIQUE * FROM iptb00014 WHERE ", " status_t is null AND ", criterio clipped, " ORDER BY 1,2,3,4" 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 p_iptb14.* 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 p_iptb14.* CALL busca_articulo() MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT datos INTO p_iptb14.* IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF DISPLAY BY NAME p_iptb14.* CALL busca_articulo() COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS datos INTO p_iptb14.* IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF DISPLAY BY NAME p_iptb14.* CALL busca_articulo() COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST datos INTO p_iptb14.* DISPLAY BY NAME p_iptb14.* CALL busca_articulo() LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST datos INTO p_iptb14.* DISPLAY BY NAME p_iptb14.* CALL busca_articulo() LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" INPUT BY NAME p_iptb14.precio_min, p_iptb14.precio_lista WITHOUT DEFAULTS AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF UPDATE iptb00014 SET precio_min = p_iptb14.precio_min, precio_lista = p_iptb14.precio_lista, us_mod = USER, fech_mod = CURRENT WHERE cod_n = p_iptb14.cod_n AND cod_grupo = p_iptb14.cod_grupo AND cod_tipo = p_iptb14.cod_tipo AND cod_sec = p_iptb14.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" DELETE FROM iptb00014 WHERE cod_n = p_iptb14.cod_n AND cod_grupo = p_iptb14.cod_grupo AND cod_tipo = p_iptb14.cod_tipo AND cod_sec = p_iptb14.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_articulo() # 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.descrip_ing INTO descrip1 ,descrip2 FROM iptb00002 i WHERE i.cod_n = p_iptb14.cod_n AND i.cod_grupo = p_iptb14.cod_grupo AND i.cod_tipo = p_iptb14.cod_tipo AND i.cod_sec = p_iptb14.cod_sec IF status >= 0 THEN IF status = NOTFOUND THEN LET numero_msg = 26 CALL msg(numero_msg) ELSE IF p_iptb14.status_t = "E" THEN LET numero_msg = 44 CALL msg(numero_msg) END IF END IF LET descripcion= descrip1 CLIPPED DISPLAY BY NAME descripcion ATTRIBUTE(CYAN) ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF END FUNCTION { FUNCTION busca_pt() OPEN WINDOW busqueda AT 7,12 WITH FORM "vefmwd003" ATTRIBUTE (BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST,MESSAGE LINE LAST) LET int_flag = false CONSTRUCT criterio ON a.descrip_esp FROM descrip_esp LET selec2 = "SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp, ", " a.descrip_ing,a.cod_grupo ", "FROM iptb00002 a ", "WHERE a.cod_n = b.cod_n and a.cod_grupo = b.cod_grupo and ", " a.cod_tipo = b.cod_tipo and a.cod_sec = b.cod_sec and ", " a.status_t is null AND ", criterio clipped," ORDER BY 5 " IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) GO TO sale9 END IF PREPARE busca_pila FROM selec2 IF status >= 0 THEN IF status = notfound THEN LET numero_msg = 12 CALL msg(numero_msg) END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 END IF END IF DECLARE buscar_pila CURSOR FOR busca_pila LET idx = 1 FOREACH buscar_pila INTO pilas[idx].* IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) EXIT FOREACH END IF LET idx = idx + 1 END FOREACH CALL set_count(idx-1) MESSAGE " Selecciona Producto Terminado donde esta el cursor" DISPLAY ARRAY pilas TO s_pilas.* LET curr1 = arr_curr() LET pterminado.cod_n = pilas[curr1].cod_n LET pterminado.cod_grupo = pilas[curr1].cod_grupo LET pterminado.cod_tipo = pilas[curr1].cod_tipo LET pterminado.cod_sec = pilas[curr1].cod_sec LET descuento.cod_n = pilas[curr1].cod_n LET descuento.cod_grupo = pilas[curr1].cod_grupo LET descuento.cod_tipo = pilas[curr1].cod_tipo LET descuento.cod_sec = pilas[curr1].cod_sec LET descrip1 = pilas[curr1].descrip_esp LABEL sale9: CLOSE WINDOW busqueda END FUNCTION }