primer commit subida
This commit is contained in:
@@ -0,0 +1,391 @@
|
||||
#######################################################################
|
||||
# SISTEMA : DOCUMENTACION DE SISTEMA
|
||||
# PROGRAMA : DSPRMT003.4GL
|
||||
# OBJETIVO : Relacion de Sistema y Menu.
|
||||
# AUTOR : Tadeo A. Ferreras F.
|
||||
# FECHA : JUNIO 9, 1995
|
||||
########################################################################
|
||||
DATABASE rayovac
|
||||
GLOBALS
|
||||
"dsprgb000.4gl"
|
||||
|
||||
FUNCTION dsprmt003()
|
||||
|
||||
OPTIONS
|
||||
FORM LINE 8,
|
||||
ERROR LINE 23,
|
||||
PROMPT LINE 23
|
||||
|
||||
OPEN FORM dsfmmt003 FROM "dsfmmt003"
|
||||
DISPLAY FORM dsfmmt003
|
||||
CALL pantalla()
|
||||
DISPLAY "dsprmt003" at 4,3
|
||||
MENU "Mant"
|
||||
COMMAND "Adicionar"
|
||||
"Presione <ESC> para Grabar <Ctrl-C> Para Cancelar"
|
||||
LET int_flag = FALSE
|
||||
CLEAR FORM
|
||||
CALL dsprad003()
|
||||
COMMAND "Consulta-Modificar"
|
||||
"Presione <ESC> para Actualizar <Ctrl-C> Para Cancelar"
|
||||
LET int_flag = FALSE
|
||||
CLEAR FORM
|
||||
CALL dsprmd003()
|
||||
COMMAND "Salir"
|
||||
EXIT MENU
|
||||
END MENU
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION dsprad003()
|
||||
|
||||
INPUT BY NAME dstb04.cod_sistema,dstb04.menu1
|
||||
|
||||
AFTER FIELD cod_sistema
|
||||
IF dstb04.cod_sistema IS NULL THEN
|
||||
LET numero_msg = 16
|
||||
CALL msg(numero_msg)
|
||||
NEXT FIELD cod_sistema
|
||||
END IF
|
||||
|
||||
SELECT a.* INTO dstb03.* FROM dstb00003 a
|
||||
WHERE a.cod_sistema = dstb04.cod_sistema
|
||||
|
||||
IF STATUS = NOTFOUND THEN
|
||||
LET numero_msg = 3
|
||||
CALL msg(numero_msg)
|
||||
# NEXT FIELD cod_sistema
|
||||
END IF
|
||||
|
||||
DISPLAY BY NAME dstb03.desc_sistema
|
||||
|
||||
AFTER FIELD menu1
|
||||
IF dstb04.menu1 IS NULL THEN
|
||||
LET numero_msg = 16
|
||||
CALL msg(numero_msg)
|
||||
NEXT FIELD menu1
|
||||
END IF
|
||||
|
||||
SELECT UNIQUE a.menu1 INTO dstb04.menu1 FROM dstb00004 a
|
||||
WHERE a.cod_sistema = dstb04.cod_sistema AND
|
||||
a.menu1 = dstb04.menu1
|
||||
|
||||
IF STATUS != NOTFOUND THEN
|
||||
LET numero_msg = 12
|
||||
CALL msg(numero_msg)
|
||||
NEXT FIELD cod_sistema
|
||||
END IF
|
||||
|
||||
SELECT UNIQUE a.descripcion INTO desc_menu FROM dstb00001 a
|
||||
WHERE a.programa = dstb04.menu1 AND a.numero_act = 1 and
|
||||
a.status_t is null
|
||||
|
||||
IF STATUS = NOTFOUND THEN
|
||||
LET numero_msg = 243
|
||||
CALL msg(numero_msg)
|
||||
# NEXT FIELD menu1
|
||||
END IF
|
||||
|
||||
IF dstb04.menu1[1,2] != dstb04.cod_sistema THEN
|
||||
LET numero_msg = 242
|
||||
CALL msg(numero_msg)
|
||||
# NEXT FIELD menu1
|
||||
END IF
|
||||
|
||||
IF dstb04.menu1[3,4] != "MN" THEN
|
||||
LET numero_msg = 244
|
||||
CALL msg(numero_msg)
|
||||
# NEXT FIELD menu1
|
||||
END IF
|
||||
DISPLAY BY NAME desc_menu
|
||||
|
||||
END INPUT
|
||||
IF int_flag THEN
|
||||
LET numero_msg = 2
|
||||
CALL msg(numero_msg)
|
||||
LET int_flag = FALSE
|
||||
RETURN
|
||||
END IF
|
||||
|
||||
INPUT ARRAY arreglo FROM programa1.*
|
||||
BEFORE ROW
|
||||
LET curr = ARR_CURR()
|
||||
LET fila = SCR_LINE()
|
||||
|
||||
AFTER FIELD programa
|
||||
|
||||
IF arreglo[curr].programa IS NOT NULL THEN
|
||||
SELECT UNIQUE a.descripcion INTO arreglo[curr].desc_pr FROM dstb00001 a
|
||||
WHERE a.programa = arreglo[curr].programa AND a.numero_act = 1 and
|
||||
a.status_t is null
|
||||
|
||||
IF STATUS = NOTFOUND THEN
|
||||
LET numero_msg = 243
|
||||
CALL msg(numero_msg)
|
||||
# NEXT FIELD programa
|
||||
END IF
|
||||
|
||||
IF arreglo[curr].programa = dstb04.menu1 THEN
|
||||
LET numero_msg = 245
|
||||
CALL msg(numero_msg)
|
||||
NEXT FIELD programa
|
||||
END IF
|
||||
|
||||
FOR idx = 1 TO ARR_CURR()
|
||||
IF curr != idx THEN
|
||||
IF arreglo[idx].programa = arreglo[curr].programa THEN
|
||||
LET numero_msg = 21
|
||||
CALL msg(numero_msg)
|
||||
NEXT FIELD programa
|
||||
END IF
|
||||
END IF
|
||||
END FOR
|
||||
DISPLAY arreglo[curr].desc_pr TO programa1[fila].desc_pr
|
||||
END IF
|
||||
|
||||
AFTER FIELD opcion
|
||||
IF arreglo[curr].programa IS NOT NULL THEN
|
||||
IF arreglo[curr].opcion IS NULL THEN
|
||||
LET numero_msg = 16
|
||||
CALL msg(numero_msg)
|
||||
NEXT FIELD opcion
|
||||
END IF
|
||||
|
||||
FOR idx = 1 TO ARR_COUNT()
|
||||
IF idx != CURR THEN
|
||||
IF arreglo[idx].opcion = arreglo[curr].opcion THEN
|
||||
ERROR "NUMERO DE OPCION EXISTE EN LA LINEA NO. ",idx USING "<<<<"
|
||||
NEXT FIELD opcion
|
||||
END IF
|
||||
END IF
|
||||
END FOR
|
||||
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 ARR_COUNT()
|
||||
IF arreglo[idx].programa IS NOT NULL THEN
|
||||
INSERT INTO dstb00004
|
||||
VALUES(dstb04.cod_sistema,dstb04.menu1,arreglo[idx].programa,
|
||||
arreglo[idx].opcion,NULL,USER,CURRENT,NULL,NULL)
|
||||
END IF
|
||||
END FOR
|
||||
|
||||
LET numero_msg = 1
|
||||
CALL msg(numero_msg)
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION dsprmd003()
|
||||
|
||||
CONSTRUCT criterio ON a.cod_sistema,a.menu1 FROM cod_sistema,menu1
|
||||
|
||||
IF int_flag THEN
|
||||
ERROR "(2) OPERACION CANCELADA"
|
||||
LET int_flag = FALSE
|
||||
RETURN
|
||||
END IF
|
||||
|
||||
LET selec = "SELECT UNIQUE a.cod_sistema,a.menu1,b.desc_sistema ",
|
||||
"FROM dstb00004 a,dstb00003 b ",
|
||||
"WHERE a.cod_sistema=b.cod_sistema AND a.status_t IS NULL AND ",
|
||||
criterio CLIPPED," ORDER BY 1,2"
|
||||
|
||||
PREPARE comando FROM selec
|
||||
DECLARE busca SCROLL CURSOR FOR comando
|
||||
OPEN busca
|
||||
|
||||
FETCH FIRST busca INTO dstb04.cod_sistema,dstb04.menu1,dstb03.desc_sistema
|
||||
|
||||
IF STATUS = NOTFOUND THEN
|
||||
LET numero_msg = 3
|
||||
CALL msg(numero_msg)
|
||||
RETURN
|
||||
END IF
|
||||
|
||||
SELECT UNIQUE a.descripcion INTO desc_menu FROM dstb00001 a
|
||||
WHERE a.programa = dstb04.menu1 AND a.numero_act = 1 and
|
||||
a.status_t is null
|
||||
|
||||
DISPLAY BY NAME dstb04.cod_sistema,dstb04.menu1,
|
||||
dstb03.desc_sistema,desc_menu
|
||||
|
||||
MENU "OPCION"
|
||||
COMMAND "Siguiente"
|
||||
FETCH NEXT busca INTO dstb04.cod_sistema,dstb04.menu1,dstb03.desc_sistema
|
||||
|
||||
IF STATUS = NOTFOUND THEN
|
||||
LET numero_msg = 3
|
||||
CALL msg(numero_msg)
|
||||
END IF
|
||||
|
||||
SELECT UNIQUE a.descripcion INTO desc_menu FROM dstb00001 a
|
||||
WHERE a.programa = dstb04.menu1 AND a.numero_act = 1 and
|
||||
a.status_t is null
|
||||
|
||||
DISPLAY BY NAME dstb04.cod_sistema,dstb04.menu1,
|
||||
dstb03.desc_sistema,desc_menu
|
||||
|
||||
COMMAND "Anterior"
|
||||
FETCH PREVIOUS busca INTO dstb04.cod_sistema,dstb04.menu1,
|
||||
dstb03.desc_sistema
|
||||
|
||||
IF STATUS = NOTFOUND THEN
|
||||
LET numero_msg = 3
|
||||
CALL msg(numero_msg)
|
||||
END IF
|
||||
|
||||
SELECT UNIQUE a.descripcion INTO desc_menu FROM dstb00001 a
|
||||
WHERE a.programa = dstb04.menu1 AND a.numero_act = 1 and
|
||||
a.status_t is null
|
||||
|
||||
DISPLAY BY NAME dstb04.cod_sistema,dstb04.menu1,
|
||||
dstb03.desc_sistema,desc_menu
|
||||
|
||||
COMMAND "Primero"
|
||||
FETCH FIRST busca INTO dstb04.cod_sistema,dstb04.menu1,dstb03.desc_sistema
|
||||
|
||||
IF STATUS = NOTFOUND THEN
|
||||
LET numero_msg = 3
|
||||
CALL msg(numero_msg)
|
||||
END IF
|
||||
|
||||
SELECT UNIQUE a.descripcion INTO desc_menu FROM dstb00001 a
|
||||
WHERE a.programa = dstb04.menu1 AND a.numero_act = 1 and
|
||||
a.status_t is null
|
||||
|
||||
DISPLAY BY NAME dstb04.cod_sistema,dstb04.menu1,
|
||||
dstb03.desc_sistema,desc_menu
|
||||
|
||||
COMMAND "Ultimo"
|
||||
FETCH LAST busca INTO dstb04.cod_sistema,dstb04.menu1,dstb03.desc_sistema
|
||||
|
||||
IF STATUS = NOTFOUND THEN
|
||||
LET numero_msg = 3
|
||||
CALL msg(numero_msg)
|
||||
END IF
|
||||
|
||||
SELECT UNIQUE a.descripcion INTO desc_menu FROM dstb00001 a
|
||||
WHERE a.programa = dstb04.menu1 AND a.numero_act = 1 and
|
||||
a.status_t is null
|
||||
|
||||
DISPLAY BY NAME dstb04.cod_sistema,dstb04.menu1,
|
||||
dstb03.desc_sistema,desc_menu
|
||||
|
||||
COMMAND "Escoger" "Presione <ESC> Para Actualizar <Ctrl-C> Para Cancelar"
|
||||
|
||||
DECLARE busca_1 CURSOR FOR
|
||||
SELECT UNIQUE a.programa,a.opcion FROM dstb00004 a
|
||||
WHERE a.status_t IS NULL AND a.cod_sistema = dstb04.cod_sistema AND
|
||||
a.menu1 = dstb04.menu1 ORDER BY 2
|
||||
|
||||
LET idx = 1
|
||||
FOREACH busca_1 INTO arreglo[idx].programa,arreglo[idx].opcion
|
||||
|
||||
SELECT UNIQUE a.descripcion INTO arreglo[idx].desc_pr FROM dstb00001 a
|
||||
WHERE a.programa = arreglo[idx].programa AND a.numero_act = 1 AND
|
||||
a.status_t is null
|
||||
|
||||
LET idx = idx + 1
|
||||
END FOREACH
|
||||
CALL SET_COUNT(idx -1)
|
||||
|
||||
INPUT ARRAY arreglo WITHOUT DEFAULTS FROM programa1.*
|
||||
BEFORE ROW
|
||||
LET curr = ARR_CURR()
|
||||
LET fila = SCR_LINE()
|
||||
|
||||
AFTER FIELD programa
|
||||
IF arreglo[curr].programa IS NOT NULL THEN
|
||||
IF arreglo[curr].programa IS NULL THEN
|
||||
LET numero_msg = 16
|
||||
CALL msg(numero_msg)
|
||||
NEXT FIELD programa
|
||||
END IF
|
||||
|
||||
SELECT UNIQUE a.descripcion INTO arreglo[curr].desc_pr FROM dstb00001 a
|
||||
WHERE a.programa = arreglo[curr].programa AND a.numero_act = 1 AND
|
||||
a.status_t is null
|
||||
|
||||
IF STATUS = NOTFOUND THEN
|
||||
LET numero_msg = 243
|
||||
CALL msg(numero_msg)
|
||||
# NEXT FIELD programa
|
||||
END IF
|
||||
|
||||
DISPLAY arreglo[curr].desc_pr TO programa1[fila].desc_pr
|
||||
|
||||
IF arreglo[curr].programa = dstb04.menu1 THEN
|
||||
LET numero_msg = 245
|
||||
CALL msg(numero_msg)
|
||||
NEXT FIELD programa
|
||||
END IF
|
||||
|
||||
FOR idx = 1 TO ARR_CURR()
|
||||
IF curr != idx THEN
|
||||
IF arreglo[idx].programa = arreglo[curr].programa THEN
|
||||
LET numero_msg = 21
|
||||
CALL msg(numero_msg)
|
||||
NEXT FIELD programa
|
||||
END IF
|
||||
END IF
|
||||
END FOR
|
||||
|
||||
END IF
|
||||
|
||||
AFTER FIELD opcion
|
||||
IF arreglo[curr].programa IS NOT NULL THEN
|
||||
IF arreglo[curr].opcion IS NULL THEN
|
||||
LET numero_msg = 16
|
||||
CALL msg(numero_msg)
|
||||
NEXT FIELD opcion
|
||||
END IF
|
||||
FOR idx = 1 TO ARR_COUNT()
|
||||
IF idx != CURR THEN
|
||||
IF arreglo[idx].opcion = arreglo[curr].opcion THEN
|
||||
ERROR "NUMERO DE OPCION EXISTE EN LA LINEA NO. ",idx USING "<<<<"
|
||||
NEXT FIELD opcion
|
||||
END IF
|
||||
END IF
|
||||
END FOR
|
||||
END IF
|
||||
|
||||
END INPUT
|
||||
IF int_flag THEN
|
||||
LET numero_msg = 2
|
||||
CALL msg(numero_msg)
|
||||
LET int_flag = FALSE
|
||||
RETURN
|
||||
END IF
|
||||
|
||||
DELETE FROM dstb00004 WHERE @cod_sistema = dstb04.cod_sistema AND
|
||||
@menu1 = dstb04.menu1
|
||||
|
||||
FOR idx = 1 TO ARR_COUNT()
|
||||
IF arreglo[idx].programa IS NOT NULL THEN
|
||||
INSERT INTO dstb00004
|
||||
VALUES(dstb04.cod_sistema,dstb04.menu1,arreglo[idx].programa,
|
||||
arreglo[idx].opcion,NULL,USER,CURRENT,NULL,NULL)
|
||||
END IF
|
||||
END FOR
|
||||
|
||||
LET numero_msg = 13
|
||||
CALL msg(numero_msg)
|
||||
|
||||
COMMAND KEY ("L") "eLiminar"
|
||||
UPDATE dstb00004 SET (status_t,us_mod,fech_mod) = ("E",USER,CURRENT)
|
||||
WHERE @cod_sistema = dstb04.cod_sistema AND @menu1 = dstb04.menu1
|
||||
|
||||
LET numero_msg = 39
|
||||
CALL msg(numero_msg)
|
||||
|
||||
COMMAND "Retornar"
|
||||
EXIT MENU
|
||||
END MENU
|
||||
END FUNCTION
|
||||
|
||||
|
||||
Reference in New Issue
Block a user