{ ------------------------------------------------------------------ PROGRAMA : TEPRMT002 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla de Procedencias. PROGRAMADOR : Tadeo A. Ferreras FECHA REALIZACION : Diciembre 2, 1992. ------------------------------------------------------------------ } GLOBALS "teprgb000.4gl" DEFINE responde CHAR(200) MAIN DEFER INTERRUPT CALL ARG_VAL(1) RETURNING usuarios CALL ARG_VAL(2) RETURNING clave CALL STARTLOG("teprmt002.txt") CONNECT to "smarmotech" USER usuarios USING clave CALL teprmt002() END MAIN FUNCTION teprmt002() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, MESSAGE LINE 24, COMMENT LINE 21 OPEN FORM tefmmt002 FROM "tefmmt002" DISPLAY FORM tefmmt002 # CALL ayuda() DISPLAY "teprmt002" AT 4,3 ATTRIBUTE(RED) DISPLAY "Mantenimiento de Procedencia" at 6,26 ATTRIBUTE(BLACK) MENU "OPCIONES" ON ACTION Adicionar LET INT_FLAG = FALSE CLEAR FORM LET INT_FLAG = FALSE CALL tepcad002() ON ACTION Consultar_modificar LET int_flag = FALSE CALL tepcmf002() ON ACTION Salir EXIT MENU END MENU END FUNCTION FUNCTION tepcad002() # WHENEVER ERROR CONTINUE ## Captura los datos que va a contener el registro INITIALIZE procedencias.* TO NULL LET descrip1 = NULL LET descrip2 = NULL DIALOG ATTRIBUTES(UNBUFFERED,FIELD ORDER FORM ) INPUT BY NAME procedencias.* BEFORE INPUT SELECT MAX(a.procedencia) INTO procedencias.procedencia FROM tetb00002 a IF procedencias.procedencia IS NULL THEN LET procedencias.procedencia=0 END IF LET procedencias.procedencia=procedencias.procedencia+1 DISPLAY BY NAME procedencias.procedencia # AFTER FIELD procedencia AFTER FIELD descripcion SELECT UNIQUE descripcion INTO procedencias.descripcion FROM tetb00002 WHERE @procedencia = procedencias.procedencia IF STATUS != NOTFOUND THEN DISPLAY BY NAME procedencias.descripcion LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD procedencia END IF IF procedencias.descripcion[1] = " " OR procedencias.descripcion is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD descripcion END IF ON ACTION guardar BEGIN WORK INSERT INTO tetb00002 VALUES (procedencias.procedencia,procedencias.descripcion,procedencias.status_t,usuarios,getdate(),NULL,null) 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 LET int_flag= FALSE CLEAR FORM EXIT DIALOG END INPUT END DIALOG END FUNCTION FUNCTION tepcmf002() INITIALIZE b_procedencias to null DIALOG ATTRIBUTES(UNBUFFERED,FIELD ORDER FORM ) ## Aqui se prepara para la captura del criterio de seleccion CONSTRUCT criterio ON a.procedencia,a.descripcion FROM procedencia1,descripcion1 BEFORE CONSTRUCT END CONSTRUCT ON ACTION buscar LET SELEC = " SELECT UNIQUE a.procedencia,a.descripcion FROM tetb00002 a ", " WHERE a.status_t IS NULL AND ", criterio clipped," ORDER BY a.procedencia " PREPARE busca FROM selec DECLARE datos SCROLL CURSOR WITH HOLD FOR busca LET idx=1 FOREACH datos INTO b_procedencias[idx].procedencia3,b_procedencias[idx].descripcion3 LET idx=idx+1 END FOREACH IF idx=1 THEN CALL FGL_winmessage("error","NO HAY REGISTROS CON ESA CONDICION","STOP") CALL b_procedencias.clear() EXIT DIALOG END IF DISPLAY ARRAY b_procedencias TO tb_pro.* ON ACTION actualizar DIALOG ATTRIBUTES(UNBUFFERED,FIELD ORDER FORM ) INPUT BY NAME procedencias.descripcion BEFORE INPUT LET procedencias.procedencia=b_procedencias[arr_curr()].procedencia3 SELECT a.procedencia,a.descripcion,a.us_crea,a.fech_crea,a.us_mod ,a.fech_mod INTO procedencias.procedencia,procedencias.descripcion,procedencias.us_crea, procedencias.fech_crea,procedencias.us_mod,procedencias.fech_mod FROM tetb00002 a WHERE a.procedencia=b_procedencias[arr_curr()].procedencia3 DISPLAY BY NAME procedencias.* ON ACTION guardar BEGIN WORK DISPLAY procedencias.descripcion UPDATE tetb00002 SET descripcion=procedencias.descripcion,us_mod=usuarios,fech_mod=getdate() WHERE @procedencia = procedencias.procedencia 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 END INPUT ON ACTION CANCEL LET int_flag= FALSE CLEAR FORM EXIT DIALOG END DIALOG ON ACTION eliminar LET responde = fgl_winquestion("INFO","ESTA SEGURO DE ELIMINAR EL REGISTRO","NO","YES|NO","QUESTION",0) LET responde = UPSHIFT(responde) IF responde = "YES" THEN BEGIN WORK UPDATE tetb00002 SET status_t="E",us_mod=usuarios,fech_mod=getdate() WHERE @procedencia=b_procedencias[arr_curr()].procedencia3 DISPLAY "aqui",procedencias.procedencia IF STATUS < 0 THEN ROLLBACK WORK CALL fgl_winmessage("ELIMINA", "ERROR ELIMINANDO", "stop") ROLLBACK WORK RETURN ELSE COMMIT WORK CALL fgl_winmessage("ELIMINA", "ELIMINACION EXITOSA", "stop") RETURN END IF END IF END DISPLAY ON ACTION CANCEL LET int_flag= FALSE CALL b_procedencias.CLEAR() CLEAR FORM EXIT DIALOG END DIALOG END FUNCTION FUNCTION msg(numero_msg) DEFINE numero_msg SMALLINT DEFINE descripcion CHAR (60) SELECT desc_msg INTO descripcion FROM msgtable WHERE cod_msg = numero_msg IF status = NOTFOUND THEN SELECT desc_msg INTO descripcion FROM msgtable WHERE cod_msg = 22 LET descripcion = descripcion CLIPPED,numero_msg using "<<<<" ERROR descripcion ATTRIBUTE(BOLD) ELSE ERROR descripcion ATTRIBUTE(BOLD) LET numero_msg = 0 END IF END FUNCTION