{ ------------------------------------------------------------------ PROGRAMA : TEPRMT005 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla de Presupuestos de Partidas del Cash Flow PROGRAMADOR : Tadeo A. Ferreras FECHA REALIZACION : Diciembre 06, 1995. ------------------------------------------------------------------ } GLOBALS "teprgb000.4gl" DEFINE codigo1 INT , ano1 INT MAIN DEFER INTERRUPT CALL ARG_VAL(1) RETURNING usuarios CALL ARG_VAL(2) RETURNING clave CALL STARTLOG("teprmt004.txt") CONNECT to "smarmotech" USER usuarios USING clave DISPLAY usuarios CALL teprmt005() END MAIN FUNCTION teprmt005() CLEAR SCREEN OPTIONS FORM LINE 8, ERROR LINE 23, MESSAGE LINE 24, COMMENT LINE 21 OPEN FORM tefmmt005 FROM "tefmmt005" DISPLAY FORM tefmmt005 # CALL ayuda() DISPLAY "teprmt005" AT 4,3 ATTRIBUTE(RED) DISPLAY "Estimados de Partidas Del Cash-Flow" at 6,23 ATTRIBUTE(BLACK) MENU "OPCIONES" ON ACTION Adicionar LET INT_FLAG = FALSE CLEAR FORM CALL tepcad005() ON ACTION Consultar_modificar LET int_flag = FALSE CALL tepcmf005() ON ACTION Salir EXIT MENU END MENU END FUNCTION FUNCTION tepcad005() # WHENEVER ERROR CONTINUE ## Captura los datos que va a contener el registro INPUT BY NAME p_tetb04.codigo,p_tetb04.ano AFTER FIELD codigo IF p_tetb04.codigo is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD codigo END IF SELECT UNIQUE a.descripcion INTO p_tetb03.descripcion FROM tetb00003 a WHERE a.codigo = p_tetb04.codigo AND a.status_t IS NULL IF STATUS = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) NEXT FIELD codigo END IF DISPLAY BY NAME p_tetb03.descripcion AFTER FIELD ano IF p_tetb04.ano IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD ano END IF SELECT UNIQUE a.ano FROM tetb00004 a WHERE a.codigo = p_tetb04.codigo AND a.ano = p_tetb04.ano IF STATUS != NOTFOUND THEN LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD codigo END IF END INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET numero_msg = FALSE RETURN END IF FOR idx = 1 TO 12 LET arr_tetb04[idx].mes = idx SELECT UNIQUE a.descrip INTO arr_tetb04[idx].descrip FROM mestable a WHERE a.mes = arr_tetb04[idx].mes LET arr_tetb04[idx].valor = 0 END FOR CALL SET_COUNT(idx) INPUT ARRAY arr_tetb04 WITHOUT DEFAULTS FROM scr_tetb04.* BEFORE ROW LET curr = ARR_CURR() LET fila = SCR_LINE() AFTER FIELD mes IF arr_tetb04[curr].mes IS NOT NULL THEN SELECT UNIQUE a.descrip INTO arr_tetb04[curr].descrip FROM mestable a WHERE a.mes = arr_tetb04[curr].mes IF STATUS = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) NEXT FIELD mes END IF DISPLAY arr_tetb04[curr].descrip TO scr_tetb04[fila].descrip END IF AFTER FIELD valor IF arr_tetb04[curr].valor IS NOT NULL THEN IF arr_tetb04[curr].valor IS NULL THEN LET numero_msg = 16 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 RETURN END IF FOR idx = 1 TO 12 IF arr_tetb04[idx].valor IS NULL THEN LET arr_tetb04[idx].valor = 0 END IF INSERT INTO tetb00004 VALUES (p_tetb04.codigo,p_tetb04.ano, idx,arr_tetb04[idx].valor, NULL,usuarios,getdate(),NULL,NULL) END FOR LET numero_msg = 1 CALL msg(numero_msg) END FUNCTION FUNCTION tepcmf005() DIALOG ATTRIBUTES(UNBUFFERED,FIELD ORDER FORM) CONSTRUCT criterio ON a.codigo,b.ano FROM codigo1,ano1 BEFORE CONSTRUCT END CONSTRUCT ON ACTION buscar LET SELEC ="select unique a.codigo,a.descripcion,b.ano ", " from tetb00003 a,tetb00004 b ", "where a.codigo=b.codigo and b.status_t is null and ",criterio CLIPPED ," order by a.codigo" PREPARE busca FROM selec DECLARE datos CURSOR FOR busca DISPLAY selec LET idx=1 FOREACH datos INTO p_tetb003[idx].codigo2,p_tetb003[idx].descripcion1,p_tetb003[idx].ano2 LET idx=idx+1 END FOREACH IF idx=1 THEN CALL FGL_winmessage("error","NO HAY REGISTROS CON ESA CONDICION","STOP") CALL p_tetb003.clear() EXIT DIALOG END IF DISPLAY array p_tetb003 TO cons.* ON ACTION actualizar DIALOG ATTRIBUTES(UNBUFFERED,FIELD ORDER FORM) INPUT ARRAY arr_tetb04 FROM scr_tetb04.* BEFORE INPUT LET curr = ARR_CURR() LET p_tetb04.codigo=p_tetb003[curr].codigo2 LET p_tetb04.ano=p_tetb003[curr].ano2 LET p_tetb03.descripcion=p_tetb003[curr].descripcion1 DISPLAY BY NAME p_tetb04.codigo,p_tetb04.ano,p_tetb03.descripcion LET fila = SCR_LINE() DECLARE buscar1 CURSOR FOR SELECT a.mes,b.descrip,a.valor FROM tetb00004 a, mestable b WHERE (a.mes = b.mes) AND (a.codigo = p_tetb04.codigo) AND (a.ano = p_tetb04.ano) AND (a.status_t IS NULL) ORDER BY 1 DISPLAY "ano", p_tetb04.ano LET idx = 1 FOREACH buscar1 INTO arr_tetb04[idx].* LET idx = idx + 1 END FOREACH AFTER FIELD mes IF arr_tetb04[curr].mes IS NOT NULL THEN SELECT UNIQUE a.descrip INTO arr_tetb04[curr].descrip FROM mestable a WHERE a.mes = arr_tetb04[curr].mes IF STATUS = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) NEXT FIELD mes END IF DISPLAY arr_tetb04[curr].descrip TO scr_tetb04[fila].descrip END IF AFTER FIELD valor IF arr_tetb04[curr].valor IS NOT NULL THEN IF arr_tetb04[curr].valor IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD valor END IF END IF END INPUT ON ACTION guardar BEGIN WORK DELETE FROM tetb00004 WHERE @codigo = p_tetb04.codigo AND @ano = p_tetb04.ano FOR idx = 1 TO 12 IF arr_tetb04[idx].valor IS NULL THEN LET arr_tetb04[idx].valor = 0 END IF INSERT INTO tetb00004 VALUES (p_tetb04.codigo,p_tetb04.ano, idx,arr_tetb04[idx].valor, NULL,usuarios,getdate(),NULL,NULL) END FOR IF status<0 THEN ROLLBACK WORK CALL fgl_winmessage("error","NO SE PUDO ACTUALIZAR","STOP") ELSE COMMIT WORK LET numero_msg = 13 CALL msg(numero_msg) RETURN END IF ON ACTION CANCEL CLEAR FORM EXIT DIALOG END DIALOG ON ACTION eLiminar BEGIN WORK UPDATE tetb00004 SET status_t="E",us_mod=usuarios,fech_mod=getdate() WHERE codigo = p_tetb003[arr_curr()].codigo2 AND ano=p_tetb003[arr_curr()].ano2 IF status<0 THEN ROLLBACK WORK CALL fgl_winmessage("error","NO SE PUDO ELIMINAR","STOP") ELSE COMMIT WORK LET numero_msg = 39 CALL msg(numero_msg) RETURN END IF END DISPLAY ON ACTION CANCEL CLEAR FORM EXIT DIALOG END DIALOG END FUNCTION