392 lines
10 KiB
Plaintext
392 lines
10 KiB
Plaintext
#######################################################################
|
|
# 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
|
|
|
|
|