Files
MBS/PROYECTO/codir/coprmt023.4gl
T

222 lines
7.0 KiB
Plaintext

{
--------------------------------------------------------------------------
PROGRAMA : COPRMT023
OBJETIVO : MANTENER LA TABLA DE ITBI PARA LAS COMPRAS
PROGRAMADOR : JUAN F. SOTO
FECHA : AGOSTO 1997
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO ALEJO
--------------------------------------------------------------------------
}
GLOBALS
"coprgb000.4gl"
DEFINE datos_g RECORD LIKE cotb00014.*,
pg CHAR(1),
fech_oc LIKE cotb00014.fech_oc
DEFINE c_entra RECORD
fecha_rep LIKE cotb00009.fecha_rep,
tipo LIKE cotb00014.tipo,
num_oc LIKE cotb00014.num_oc,
planilla LIKE cotb00009.planilla,
exenta LIKE cotb00009.exenta,
nota_credito LIKE cotb00009.nota_credito,
itbi_nc LIKE cotb00009.itbi_nc,
valor_credito LIKE cotb00009.valor_credito,
status_t CHAR(1),
us_crea LIKE cotb00009.us_crea,
fech_crea LIKE cotb00009.fech_crea,
us_mod LIKE cotb00009.us_mod,
fech_mod LIKE cotb00009.fech_mod
END RECORD
FUNCTION coprmt023()
OPTIONS
FORM LINE 9,
ERROR LINE 24,
COMMENT LINE 23
OPEN FORM cofmmt023 FROM "cofmmt023"
DISPLAY FORM cofmmt023
DISPLAY "coprmt023" AT 4,3
DISPLAY "Mantenimiento ITBI Para Las Compras" AT 6,20
MENU "OPCION"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Delete> Cancela Operacion"
LET int_flag = FALSE
CALL coprmtad()
COMMAND "Modificar-consultar"
"<Esc> Actualiza Registro <Delete> Cancela Operacion"
LET int_flag = FALSE
CALL coprmtmf()
COMMAND "Salir"
EXIT MENU
END MENU
END FUNCTION
FUNCTION coprmtad()
LABEL vuelve:
INITIALIZE c_entra.* TO NULL
INPUT BY NAME c_entra.*
AFTER FIELD num_oc
IF c_entra.num_oc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_oc
END IF
# BUSCA LA ORDEN DE COMPRA INTRODUCIDA POR EL USUARIO
SELECT a.* INTO datos_g.*
FROM cotb00014 a
WHERE a.num_oc = c_entra.num_oc AND
a.tipo = c_entra.tipo AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
#-----------------------------------------------------------------------------
CALL busca_nombre()
#-----------------------------------------------------------------------------
LET fech_oc = datos_g.fech_oc
DISPLAY BY NAME c_entra.*,suplidor.nom_sp,datos_g.cod_sp,datos_g.cod_sp_sec
AFTER FIELD valor_credito
IF c_entra.nota_credito IS NULL THEN
IF c_entra.valor_credito IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_credito
END IF
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
EXIT INPUT
END INPUT
# ACTUALIZANDO LA TABLA DE ITBI PARA LAS COMPRAS
INSERT INTO cotb00009 VALUES(c_entra.*)
UPDATE cotb00009 set us_crea = user,
fech_crea = current
WHERE num_oc = c_entra.num_oc and
tipo = c_entra.tipo
CLEAR FORM
GOTO vuelve
END FUNCTION
FUNCTION coprmtmf()
CONSTRUCT BY NAME criterio ON cotb00009.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
RETURN
END IF
LET selec = "SELECT a.* FROM cotb00009 a WHERE ",criterio CLIPPED,
" ORDER BY 1,2"
PREPARE comando FROM selec
DECLARE busca SCROLL CURSOR FOR comando
OPEN busca
FETCH FIRST busca INTO c_entra.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
CALL busca_nombre()
MENU "OPCION"
COMMAND "Siguiente" "Busca El Siguiente Registro Cumpla La Condicion"
FETCH NEXT busca INTO c_entra.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL busca_nombre()
COMMAND "Primero" "Busca El Primer Registro Cumpla La Condicion"
FETCH FIRST busca INTO c_entra.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL busca_nombre()
COMMAND "Anterior" "Busca El Registro Anterior Cumpla La Condicion"
FETCH PREVIOUS busca INTO c_entra.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL busca_nombre()
COMMAND "Ultimo" "Busca El Ultimo Registro Cumpla La Condicion"
FETCH LAST busca INTO c_entra.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL busca_nombre()
COMMAND "Escoger" "<Esc> Actualiza Registro <Delete> Cancela Operacion"
INPUT BY NAME c_entra.planilla THRU c_entra.valor_credito
WITHOUT DEFAULTS
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE cotb00009 SET planilla = c_entra.planilla,
exenta = c_entra.exenta,
itbi_nc = c_entra.itbi_nc,
nota_credito = c_entra.nota_credito,
valor_credito = c_entra.valor_credito
WHERE @tipo = c_entra.tipo AND
@num_oc = c_entra.num_oc AND
fecha_rep = c_entra.fecha_rep
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY("L") "eLiminar" "Eliminar Logicamente Este Registro"
PROMPT "Esta Seguro de Eliminar Este Registro (S/N)? " FOR pg
LET pg = UPSHIFT(pg)
IF pg = "S" THEN
UPDATE cotb00009 SET status_t = "E"
WHERE tipo = c_entra.tipo AND
num_oc = c_entra.num_oc
LET numero_msg = 39
CALL msg(numero_msg)
END IF
COMMAND "Retornar" "Retorna Al Menu Anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_nombre()
# BUSCA EL NOMBRE DEL SUPLIDOR
SELECT a.cod_sp,a.cod_sp_sec,a.fech_oc
INTO datos_g.cod_sp,datos_g.cod_sp_sec,datos_g.fech_oc
FROM cotb00014 a
WHERE a.tipo = c_entra.tipo AND
a.num_oc = c_entra.num_oc
SELECT a.nom_sp INTO suplidor.nom_sp
FROM cotb00001 a
WHERE a.cod_sp = datos_g.cod_sp AND
a.cod_sp_sec = datos_g.cod_sp_sec
LET c_entra.tipo = c_entra.tipo
LET c_entra.num_oc = c_entra.num_oc
DISPLAY BY NAME suplidor.nom_sp
DISPLAY BY NAME datos_g.cod_sp,datos_g.cod_sp_sec,
c_entra.*,datos_g.fech_oc
END FUNCTION