{ ------------------------------------------------------------------------------- PROGRAMA : CTPRMT026 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla de Costos Reales Acumulados Pilas PROGRAMADOR : Ing. Juan F. Soto. FECHA REALIZACION : Junio 08, 1995. ------------------------------------------------------------------------------- } GLOBALS "ctprgb000.4gl" DEFINE selec1 CHAR(1000) DEFINE id_num INTEGER FUNCTION ctprmt026() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, COMMENT LINE 21 OPEN FORM ctfmmt026 FROM "ctfmmt030" DISPLAY FORM ctfmmt026 CALL pantalla() DISPLAY "ctprmt026" AT 4,3 DISPLAY "Costos Reales Mensual Pilas" AT 6,26 MENU "OPCIONES" COMMAND "Adicionar" " Adiciona Registro Cancela Operacion" CLEAR FORM LET int_flag = false CALL ctpcad026() COMMAND "Consultar-modificar" " Realiza Busqueda Cancela Operacion" LET int_flag = false CALL ctpcmf026() COMMAND "Salir" "Retorna Menu Anterior" EXIT MENU END MENU END FUNCTION FUNCTION ctpcad026() #WHENEVER ERROR CONTINUE ## Captura los datos que va a contener el registro INPUT BY NAME costos_p.* AFTER FIELD cod_sec IF ( costos_p.cod_n = 0 AND costos_p.cod_grupo = 0 AND costos_p.cod_tipo = 0 AND costos_p.cod_sec = 0 ) THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_n ELSE SELECT a.descrip_esp,a.unidad_med INTO articulos.descrip_esp,articulos.unidad_med FROM intb00001 a WHERE a.cod_n = costos_p.cod_n AND a.cod_grupo = costos_p.cod_grupo AND a.cod_tipo = costos_p.cod_tipo AND a.cod_sec = costos_p.cod_sec AND a.status_t is null IF status >= 0 THEN IF status = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) NEXT FIELD cod_n END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF DISPLAY BY NAME articulos.descrip_esp,articulos.unidad_med END IF AFTER FIELD costo_lq IF costos_p.costo_lq IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD costo_lq END IF AFTER FIELD cantidad IF costos_p.cantidad IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cantidad END IF AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF IF costos_p.costo_lq IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD costo_lq END IF IF costos_p.cantidad IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cantidad END IF INSERT INTO cttb00036 VALUES (costos_p.ventas,costos_p.fecha_lq, costos_p.num_oc,costos_p.cod_n,costos_p.cod_grupo, costos_p.cod_tipo,costos_p.cod_sec,costos_p.cantidad, costos_p.costo_lq,NULL,USER,CURRENT,null, null) CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF LET numero_msg = 1 CALL msg(numero_msg) CLEAR FORM EXIT INPUT END INPUT END FUNCTION FUNCTION ctpcmf026() #WHENEVER ERROR CONTINUE ## Aqui se prepara para la captura del criterio de seleccion CONSTRUCT BY NAME criterio ON ventas,fecha_lq, cod_n,cod_grupo,cod_tipo, cod_sec IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET selec1 = " SELECT *,rowid FROM cttb00036 ", " WHERE status_t IS NULL AND fecha_lq IS NOT NULL AND rowid != 0 AND ", criterio clipped, " ORDER BY 1,2,3,4,5,6 " PREPARE datos FROM selec1 DECLARE busca1 SCROLL CURSOR FOR datos OPEN busca1 FETCH FIRST busca1 INTO costos_p.*,id_num IF STATUS = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) RETURN END IF SELECT descrip_esp,unidad_med INTO articulos.descrip_esp,articulos.unidad_med FROM intb00001 a WHERE a.cod_n = costos_p.cod_n AND a.cod_grupo = costos_p.cod_grupo AND a.cod_tipo = costos_p.cod_tipo AND a.cod_sec = costos_p.cod_sec DISPLAY BY NAME costos_p.*,articulos.descrip_esp,articulos.unidad_med MENU "OPCIONES" COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT busca1 INTO costos_p.*,id_num IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF SELECT descrip_esp,unidad_med INTO articulos.descrip_esp,articulos.unidad_med FROM intb00001 a WHERE a.cod_n=costos_p.cod_n AND a.cod_grupo=costos_p.cod_grupo AND a.cod_tipo=costos_p.cod_tipo AND a.cod_sec=costos_p.cod_sec DISPLAY BY NAME costos_p.*,articulos.descrip_esp,articulos.unidad_med COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS busca1 INTO costos_p.*,id_num IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF SELECT descrip_esp,unidad_med INTO articulos.descrip_esp,articulos.unidad_med FROM intb00001 a WHERE a.cod_n = costos_p.cod_n AND a.cod_grupo = costos_p.cod_grupo AND a.cod_tipo = costos_p.cod_tipo AND a.cod_sec = costos_p.cod_sec DISPLAY BY NAME costos_p.*,articulos.descrip_esp,articulos.unidad_med COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST busca1 INTO costos_p.*,id_num SELECT descrip_esp,unidad_med INTO articulos.descrip_esp,articulos.unidad_med FROM intb00001 a WHERE a.cod_n = costos_p.cod_n AND a.cod_grupo = costos_p.cod_grupo AND a.cod_tipo = costos_p.cod_tipo AND a.cod_sec = costos_p.cod_sec DISPLAY BY NAME costos_p.*,articulos.descrip_esp,articulos.unidad_med LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST busca1 INTO costos_p.*,id_num SELECT descrip_esp,unidad_med INTO articulos.descrip_esp,articulos.unidad_med FROM intb00001 a WHERE a.cod_n = costos_p.cod_n AND a.cod_grupo = costos_p.cod_grupo AND a.cod_tipo = costos_p.cod_tipo AND a.cod_sec = costos_p.cod_sec DISPLAY BY NAME costos_p.*,articulos.descrip_esp,articulos.unidad_med LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" INPUT BY NAME costos_p.cantidad,costos_p.costo_lq WITHOUT DEFAULTS AFTER FIELD costo_lq IF costos_p.costo_lq IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD costo_lq END IF AFTER FIELD cantidad IF costos_p.cantidad IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cantidad END IF ## Verifica si el usuario presiono la tecla AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF UPDATE cttb00036 SET costo_lq = costos_p.costo_lq, cantidad = costos_p.cantidad, us_mod = USER, fech_mod = CURRENT WHERE rowid = id_num LET numero_msg = 13 CALL msg(numero_msg) EXIT INPUT END INPUT COMMAND KEY ("L") "eLiminar" DELETE FROM cttb00036 WHERE rowid = id_num LET numero_msg = 39 CALL msg(numero_msg) COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM EXIT MENU END MENU END FUNCTION