UPC no CD0204 - EMS204
Marcos Giufrida
Temos uma UPC no programa CD0204 que passou a não funcionar, "sozinho"
!
Não sei o que aconteceu, mas sempre que tentamos criar um novo
registro no CD0204, ao ser clicado no chekin verde para confirmar a
inclusão do registro, ele para de responder e não grava o registro.
O estranho é que em nosso banco teste, com a mesma upc, o problema
não acontece.
Fui comentando parte por parte para tentar identificar onde está o
problema e cheguei até a criação do FILL-IN "wh-port-ms". Quando
comento o trecho (destacado em vermelho) do programa onde é criado
esse campo na tela, ele não apresenta o erro.
Alguém sabe o que pode estar acontecendo?
Segue abaixo a UPC.
/* Definicao de Parametros */
DEF INPUT PARAMETER p-ind-event AS CHAR NO-UNDO.
DEF INPUT PARAMETER p-ind-object AS CHAR NO-UNDO.
DEF INPUT PARAMETER p-wgh-object AS HANDLE NO-UNDO.
DEF INPUT PARAMETER p-wgh-frame AS WIDGET-HANDLE NO-UNDO.
DEF INPUT PARAMETER p-cod-table AS CHAR NO-UNDO.
DEF INPUT PARAMETER p-row-table AS ROWID NO-UNDO.
DEF VAR c-objeto AS CHAR NO-UNDO.
ASSIGN c-objeto = ENTRY(NUM-ENTRIES(p-wgh-object:PRIVATE-DATA,"~/"),
p-wgh-object:PRIVATE-DATA,"~/").
/* definicao de variaveis */
DEF NEW GLOBAL SHARED VAR wh-port-ms AS WIDGET-HANDLE
NO-UNDO.
DEF NEW GLOBAL SHARED VAR wh-dcb AS WIDGET-HANDLE
NO-UNDO.
DEF NEW GLOBAL SHARED VAR wh-it-codigo AS WIDGET-HANDLE
NO-UNDO.
DEF NEW GLOBAL SHARED VAR wh-cod-imagem AS WIDGET-HANDLE
NO-UNDO.
DEF NEW GLOBAL SHARED VAR tx-port-ms AS WIDGET-HANDLE
NO-UNDO.
DEF NEW GLOBAL SHARED VAR tx-dcb AS WIDGET-HANDLE
NO-UNDO.
DEF VAR wh-frame AS WIDGET-HANDLE
NO-UNDO.
/***************************** LOGICA PRINCIPAL
************************************/
IF p-ind-object = "VIEWER" THEN DO:
IF (p-ind-event = "INITIALIZE" OR
p-ind-event = "BEFORE-DISPLAY" OR
p-ind-event = "ADD") AND c-objeto = "v36in172.w" THEN DO:
CREATE TEXT tx-port-ms
ASSIGN FRAME = p-wgh-frame
FORMAT = "x(26)"
WIDTH = 26
SCREEN-VALUE = "Portaria Minist,rio Sa£de:"
ROW = 4.6
COL = 58.3
/*FGCOLOR = 1*/
VISIBLE = YES.
CREATE FILL-IN wh-port-ms
ASSIGN FRAME = p-wgh-frame
SIDE-LABEL-HANDLE = tx-port-ms:HANDLE
FORMAT = "x(5)"
WIDTH = 7
HEIGHT = 0.88
ROW = 4.4
COL = 75.9
/*BGCOLOR = 1
FGCOLOR = 15*/
LABEL = "Portaria Minist,rio Sa£de:"
VISIBLE = YES
SENSITIVE = NO
NAME = "c-port-ms".
CREATE TEXT tx-dcb
ASSIGN FRAME = p-wgh-frame
FORMAT = "x(4)"
WIDTH = 4
SCREEN-VALUE = "DCB:"
ROW = 5.6
COL = 71.8
/*FGCOLOR = 1*/
VISIBLE = YES.
CREATE FILL-IN wh-dcb
ASSIGN FRAME = p-wgh-frame
SIDE-LABEL-HANDLE = tx-dcb:HANDLE
FORMAT = "x(12)"
WIDTH = 9
HEIGHT = 0.88
ROW = 5.4
COL = 75.9
/*BGCOLOR = 1
FGCOLOR = 15*/
LABEL = "DCB:"
VISIBLE = YES
SENSITIVE = NO
NAME = "c-dcb".
ASSIGN wh-frame = p-wgh-frame:FIRST-CHILD /*
Pegando o Field-Group */
wh-frame = wh-frame:FIRST-CHILD. /*
Pegando o 1o. Campo */
DO WHILE VALID-HANDLE(wh-frame):
IF wh-frame:TYPE <> "FIELD-GROUP" THEN DO:
IF wh-frame:NAME = "cod-imagem" THEN
ASSIGN wh-cod-imagem = wh-frame.
IF wh-frame:NAME = "c-port-ms" THEN
ASSIGN wh-port-ms = wh-frame.
IF wh-frame:NAME = "c-dcb" THEN
ASSIGN wh-dcb = wh-frame.
IF VALID-HANDLE(wh-cod-imagem) AND
VALID-HANDLE(wh-port-ms) AND
VALID-HANDLE(wh-dcb) THEN
LEAVE.
ASSIGN wh-frame = wh-frame:NEXT-SIBLING.
END.
ELSE ASSIGN wh-frame = wh-frame:FIRST-CHILD.
END.
/* Ordem do Tab */
wh-port-ms:MOVE-AFTER-TAB-ITEM(wh-cod-imagem:HANDLE).
wh-dcb:MOVE-AFTER-TAB-ITEM(wh-port-ms:HANDLE).
RUN ip-disp-campos.
END.
IF p-ind-event = "DISPLAY" AND c-objeto = "v36in172.w" THEN DO:
ASSIGN wh-frame = p-wgh-frame:FIRST-CHILD /* Pegando
o Field-Group */
wh-frame = wh-frame:FIRST-CHILD. /* Pegando
o 1o. Campo */
DO WHILE VALID-HANDLE(wh-frame):
IF wh-frame:TYPE <> "FIELD-GROUP" THEN DO:
IF wh-frame:NAME = "c-port-ms" THEN DO:
ASSIGN wh-port-ms = wh-frame.
END.
IF wh-frame:NAME = "c-dcb" THEN DO:
ASSIGN wh-dcb = wh-frame.
END.
IF VALID-HANDLE(wh-port-ms) AND
VALID-HANDLE(wh-dcb) THEN
LEAVE.
ASSIGN wh-frame = wh-frame:NEXT-SIBLING.
END.
ELSE ASSIGN wh-frame = wh-frame:FIRST-CHILD.
END.
/* Localizando o registro na tabela mgesp.cliente_aut_ms para
display na tela*/
RUN ip-disp-campos.
END.
IF p-ind-event = "DISPLAY" AND c-objeto = "v34in172.w" THEN DO:
ASSIGN wh-frame = p-wgh-frame:FIRST-CHILD /* Pegando
o Field-Group */
wh-frame = wh-frame:FIRST-CHILD. /* Pegando
o 1o. Campo */
DO WHILE VALID-HANDLE(wh-frame):
IF wh-frame:TYPE <> "FIELD-GROUP" THEN DO:
IF wh-frame:NAME = "it-codigo" THEN DO:
ASSIGN wh-it-codigo = wh-frame.
ON LEAVE OF wh-it-codigo PERSISTENT RUN
upc\upcd0204-a.p.
END.
IF VALID-HANDLE(wh-it-codigo)THEN
LEAVE.
ASSIGN wh-frame = wh-frame:NEXT-SIBLING.
END.
ELSE ASSIGN wh-frame = wh-frame:FIRST-CHILD.
END.
END.
IF (p-ind-event = "ENABLE" OR p-ind-event = "ADD") AND
LENGTH(wh-it-codigo:SCREEN-VALUE) = 4 AND
c-objeto = "v36in172.w" THEN DO:
ASSIGN wh-port-ms:SENSITIVE = YES
wh-dcb:SENSITIVE = YES.
END.
IF p-ind-event = "DISABLE" AND c-objeto = "v36in172.w" THEN DO:
ASSIGN wh-port-ms:SENSITIVE = NO
wh-dcb:SENSITIVE = NO.
END.
IF p-ind-event = "VALIDATE" AND c-objeto = "v36in172.w" THEN DO:
/*MESSAGE 'vai pesquisar' VIEW-AS ALERT-BOX.*/
FIND mgesp.item_ext WHERE
mgesp.item_ext.it_codigo = wh-it-codigo:SCREEN-VALUE
NO-ERROR.
/* MESSAGE 'pesquisou' VIEW-AS ALERT-BOX.*/
IF NOT AVAIL mgesp.item_ext THEN DO:
/*MESSAGE 'vai criar' VIEW-AS ALERT-BOX.*/
CREATE mgesp.item_ext.
ASSIGN mgesp.item_ext.it_codigo = wh-it-codigo:SCREEN-VALUE.
/*MESSAGE 'criou' VIEW-AS ALERT-BOX. */
END.
ASSIGN mgesp.item_ext.port_ms = wh-port-ms:SCREEN-VALUE.
/*
ASSIGN mgesp.item_ext.dcb = wh-dcb:SCREEN-VALUE.
*/
/* MESSAGE 'Atualizou' VIEW-AS ALERT-BOX.*/
END.
END.
/************************* INTERNAL PROCEDURES
************************************/
PROCEDURE ip-disp-campos:
FIND mgesp.item_ext WHERE
mgesp.item_ext.it_codigo =
SUBSTRING(wh-it-codigo:SCREEN-VALUE,1,4)
NO-LOCK NO-ERROR.
IF AVAIL mgesp.item_ext THEN DO:
ASSIGN wh-port-ms:SCREEN-VALUE = STRING(mgesp.item_ext.port_ms)
wh-dcb:SCREEN-VALUE = STRING(mgesp.item_ext.dcb).
END.
END.
Jônatas Gardin
Duas possíveis causas: return-value bichado ou error-status sendo setado.
Não encontrei lugar onde o return-value esteja sendo setado mas alguma
trigger pode estar fazendo isso.
Já o error-status é setado em todos os lugares e às vezes isso é validado no
retorno da UPC. Dê uma atenção especial às triggers de write das tabelas
envolvidas. Pode ser que a trigger de write da tabela item esteja retornando
o erro.
Dica: coloque sempre o código abaixo no final de uma UPC para evitar erros
bobos:
define var OcorreuErro as logical no-undo.
assign OcorreuErro = no no-error.
return "NOK":U.
Abraços
Jônatas Gardin
Marcos Giufrida
Então.. eu coloquei o código que vc sugeriu e deve ter encontrado
algum erro realmente, pois não completa efetivação do item e não
trava tb.
Como posso descobrir que erro é esse? As triggers são as padrões da
Datasul.
Jônatas Gardin
Como eu já sofri bastante com essa trigger de write da tabela item, eu
primeiro desabilitaria ela para ver se é alguma validação realizada pela
Datasul que não está passando.
Para desabilitar, faça o "on write of item override do: end." e veja se
passa.
Abraços
Jônatas Gardin
-----Original Message-----
From: Progre...@googlegroups.com [mailto:Progre...@googlegroups.com]
On Behalf Of Marcos Giufrida
Sent: terça-feira, 20 de junho de 2006 07:25
To: Progress - 4GL
Progress
Fabricio
Marcos, é dificil acontecer, mas é possível que após alguma
atualização do EMS uma variável com o nome "wh-port-ms" tenha sido
criada pela Datasul (já ví isso acontecer com um amigo) e como essa
variável é global, isso pode estar te causando o problema.
Sei que isso pode parecer simples, mas não custa tentar mudar o nome
do fill-in pra fazer um teste! Não acha?
Um grande abraço,
Fabricio