I'm trying to search the database and then delete a record if a match is found. Then if no match is found, I would like to return an error in string format with the error message.
DEF INPUT PARAM i_cCarID LIKE Car.carID NO-UNDO.
DEFINE OUTPUT PARAMETER o_cErrorMsg AS CHARACTER NO-UNDO.
DEF BUFFER carBuffer_B1 FOR Car.
FIND FIRST carBuffer_B1 WHERE carBuffer.carID= i_cCarID EXCLUSIVE-LOCK NO-ERROR.
IF AVAIL(carBuffer_B1) THEN DO:
DELETE carBuffer_B1 NO-ERROR.
IF ERROR-STATUS:ERROR THEN DO:
o_cErrorMSG = "Error: ".
RETURN o_cErrorMsg + ERROR-STATUS:GET-MESSAGE(1).
END.
END.
This code doesn't seem to return any errors when called from java.
Edit 1. Does not finding a match even result in an error or do you have to somehow explicitly "throw" an error?
You have an output parameter but the procedure does a RETURN. That's the reason you don't see any error. Your procedure needs to be something like this: (Example has Customer table and don't have enough error handling)
DEF INPUT PARAM i_cCustNum LIKE Customer.Cust-Num NO-UNDO.
DEFINE OUTPUT PARAMETER o_cErrorMsg AS CHARACTER NO-UNDO.
DEF BUFFER carBuffer_B1 FOR Customer.
FIND FIRST carBuffer_B1 WHERE carBuffer_B1.Cust-Num = i_cCarID EXCLUSIVE-LOCK NO-ERROR.
IF AVAIL(carBuffer_B1) THEN
DO:
DELETE carBuffer_B1 NO-ERROR.
o_cErrorMsg = "Delete Succeeded for id " + string(i_cCarID).
END.
ELSE
DO:
o_cErrorMsg = "No record found with id " + string(i_cCarID).
END.
Related
Procedure should handle any table linked to browse means it should be generic.
please help.
/* below code is sample to Show the data in message box ,
but only first data it is showing right now.*/
DEFINE INPUT PARAMETER hRecord AS WIDGET-HANDLE.
DEFINE INPUT PARAMETER hQuery AS WIDGET-HANDLE .
DEF VAR hFld AS HANDLE NO-UNDO.
DEFINE VARIABLE iCOunt AS INTEGER INITIAL 0.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE j AS integer INITIAL 1.
MESSAGE hRecord:NUM-COL VIEW-AS ALERT-BOX.
DO WHILE TRUE:
hQuery:GET-NEXT().
iCount = iCount + 1.
DO i = 1 TO hRecord:NUM-COL:
hfld = hRecord:GET-BROWSE-COL(i).
MESSAGE hfld:SCREEN-VALUE.
END.
j = j + 1.
END.
MESSAGE iCount VIEW-AS ALERT-BOX.
END PROCEDURE.
You can get a buffer field like so:
hfld = hRecord:GET-BUFFER-FIELD(i).
and then get the field's value:
DISPLAY hfld:BUFFER-VALUE.
See the docs for an explanation of what these do.
Program:It is a just maintenance program, in this one it displays the Item Code in one frame and it prompt for the input. if you enter the item code it has to displays what are the blank fields for that record in pt_mstr and display in one frame(No need to display all blank fields, just first 4 or 5 fields enough). and also in that frame only if user want to update it update directly to main table pt_mstr.
What i tried is, i just write the code for getting blank fields using buffer handle and after that i create one temp table and displaying the fields, i strucked there itself, i am unable to update fields.
My code:
/*Sample Item master Maintenance Program*/
/* DISPLAY TITLE */
{us/mf/mfdtitle.i "3+ "}
DEFINE VARIABLE hBuffer AS HANDLE NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE j AS INTEGER NO-UNDO.
DEFINE VARIABLE hField AS HANDLE NO-UNDO.
define variable fldnm as character extent 10 no-undo.
define temp-table tt_temp no-undo
field tt_part like pt_part
field field1 as char extent 10.
form
pt_part colon 25
with frame a side-labels width 80.
setFrameLabels(frame a:handle).
/* DISPLAY */
view frame a.
repeat with frame a:
prompt-for pt_part
editing:
/* FIND NEXT/PREVIOUS RECORD */
{us/mf/mfnp.i pt_mstr pt_part "pt_mstr.pt_domain = global_domain and pt_part" pt_part pt_part pt_part }
if recno <> ? then
do:
display pt_part.
find pt_mstr where pt_part = input pt_part and pt_domain=global_domain no-lock no-error.
ASSIGN hBuffer = BUFFER pt_mstr:HANDLE.
empty temp-table tt_temp.
j = 1.
DO i = 1 TO 10:
ASSIGN hField = hBuffer:BUFFER-FIELD(i).
IF ((hField:BUFFER-VALUE = "" )) THEN
do:
/* message hField:NAME "test" view-as alert-box.*/
find first tt_temp where tt_part = pt_part no-lock no-error.
if not avail tt_temp then
do:
create tt_temp.
assign
tt_part = pt_part
field1[j] = hField:NAME.
j = j + 1.
end.
else do:
assign
field1[j] = hField:NAME.
j = j + 1.
end.
end.
end.
end.
for each tt_temp:
display field1[1] field1[2] field1[3] field1[4].
end.
end.
end.
Are you sure you need your temp-tables to do this? I've created an example using only the actual table (but created a fake temp-table instead). You would have to look into data error handling, data validation, transaction, locking etc before putting this into production of course.
/*First we need some fake data */
DEFINE TEMP-TABLE ttMockedData NO-UNDO
FIELD id AS INTEGER
FIELD dataName AS CHARACTER FORMAT "x(8)"
FIELD dataType AS CHARACTER FORMAT "x(8)"
FIELD dataDescrioption AS CHARACTER FORMAT "x(32)".
DEFINE VARIABLE iId AS INTEGER NO-UNDO.
DEFINE VARIABLE iSearch AS INTEGER NO-UNDO LABEL "Search".
PROCEDURE createData:
DEFINE INPUT PARAMETER pcName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDesc AS CHARACTER NO-UNDO.
iId = iId + 1.
CREATE ttMockedData.
ASSIGN
ttMockedData.id = iId
ttMockedData.dataName = pcName
ttMockedData.dataType = pcType
ttMockedData.dataDesc = pcDesc.
END PROCEDURE.
RUN createData("Test 1", "TESTTYPE", "A TEST").
RUN createData("Test 2", "", "ANOTHER TEST").
RUN createData("", "TESTTYPE 2", "").
RUN createData("4", "", "").
/* Program starts here */
updating:
REPEAT:
UPDATE iSearch WITH FRAME x0.
IF iSearch > 0 THEN DO:
FIND FIRST ttMockedData NO-LOCK WHERE ttMockedData.id = iSearch NO-ERROR.
IF NOT AVAILABLE ttMockedData THEN DO:
MESSAGE "Not found" VIEW-AS ALERT-BOX ERROR.
RETURN ERROR.
END.
ELSE DO:
DISP ttMockedData WITH FRAME x1 1 COLUMNS SIDE-LABELS.
/* Is there an empty field? - Then we update! */
IF ttMockedData.dataName = ""
OR ttMockedData.dataType = ""
OR ttMockedData.dataDescrioption = "" THEN DO:
DISPLAY
ttMockedData.dataName
ttMockedData.DataType
ttMockedData.dataDesc
WITH FRAME x2 1 COLUMN SIDE-LABELS TITLE "Complete the data...".
/* This isn't working with temp-tables of course! */
/* Just here to make sure you handle locking! */
FIND CURRENT ttMockedData EXCLUSIVE-LOCK.
UPDATE
ttMockedData.dataName WHEN ttMockedData.dataName = ""
ttMockedData.DataType WHEN ttMockedData.DataType = ""
ttMockedData.dataDesc WHEN ttMockedData.dataDesc = ""
WITH FRAME x2.
/* This isn't working with temp-tables of course! */
/* Just here to make sure you handle locking! */
FIND CURRENT ttMockedData NO-LOCK.
END.
END.
END.
ELSE LEAVE updating.
END.
I am fairly new to Progress and even newer to handles so apologies if I have missed anything obvious, I've looked online but am yet to find what I'm looking for.
I am running a dynamic query similar to the below, in this example after then query is run, the "age" field of the corrresponding record is displayed on screen, I understand how this is done from the buffer-field attribute-method, but my question is how do I display the entire record, is there an equivalent attribute method, or have I misunderstood something crucial?. Thank you for your time. :
def var tbl as character no-undo.
def var fld as character no-undo.
def var qh as handle no-undo.
def var bh as handle no-undo.
def var fh as handle no-undo.
assign tbl = "customer".
assign fld = "age".
create buffer bh for table tbl.
create query qh.
qh:set-buffers( bh ).
qh:query-prepare( "for each " + tbl + " where name = 'tom'" ).
qh:query-open.
do transaction:
qh:get-first( no-lock ).
fh = bh:buffer-field( fld ).
display fh:buffer-value.
end.
delete object bh.
delete object qh
There's no "easy" way to display the entire record in one statement the way you can with a static "DISPLAY table-name" statement. You can get the count of fields (buffer-handle:NUM-FIELDS) and then step through the individual fields and display their values using
DO i = 1 to bh:NUM-FIELDS:
DISPLAY bh:BUFFER-FIELD(i):BUFFER-VALUE WITH DOWN.
DOWN.
END.
create query qh.
qh:set-buffers( bh ).
qh:query-prepare( "for each " + tbl + " where name = 'tom'" ).
qh:query-open.
qh:GET-FIRST().
DO while qh:QUERY-OFF-END = False:
DO i = 1 TO bh:NUM-FIELDS:
display bh:BUFFER-FIELD (i):NAME STRING(bh:BUFFER-FIELD(i):BUFFER-VALUE) with down.
down.
END.
qh:GET-NEXT ().
END.
I'm trying to write a modular procedure, where I pass in a string representation of a table name, and query/update that table.
What I tried was something to this affect:
PROCEDURE foo:
DEFINE INPUT PARAMETER chTableName AS CHARACTER NO-UNDO.
FIND FIRST VALUE(chTableName) NO-LOCK
WHERE blahblahblah NO-ERROR.
IF AVAIL VALUE(chTableName) THEN
ASSIGN
VALUE(chTableName).value = foo.
END PROCEDURE.
This obviously does not work, but hopefully this will get the point across of what I'm trying to accomplish.
Any help or info in this matter would be appreciated. Thanks.
Hopefully you are running version 9 or better where dynamic queries are available.
procedure x:
define input parameter tbl as character no-undo.
define input parameter fld as character no-undo.
define input parameter xyz as character no-undo.
define variable qh as handle no-undo.
define variable bh as handle no-undo.
define variable fh as handle no-undo.
create buffer bh for table tbl.
create query qh.
qh:set-buffers( bh ).
qh:query-prepare( "for each " + tbl ).
qh:query-open.
do transaction:
qh:get-first( exclusive-lock ).
fh = bh:buffer-field( fld ).
display fh:buffer-value.
fh:buffer-value = xyz.
end.
delete object bh.
delete object qh.
return.
end.
run x ( "customer", "name", "fred" ).
find first customer no-lock.
display name.
This can get you started:
DEFINE TEMP-TABLE tt NO-UNDO
FIELD a AS INTEGER.
PROCEDURE foo:
DEFINE INPUT PARAMETER pcTable AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcWhere AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcField AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER piValue AS INTEGER NO-UNDO.
DEFINE VARIABLE hBuffer AS HANDLE NO-UNDO.
DEFINE VARIABLE hQuery AS HANDLE NO-UNDO.
CREATE BUFFER hBuffer FOR TABLE pcTable.
CREATE QUERY hQuery.
hQuery:SET-BUFFERS(hBuffer).
hQuery:QUERY-PREPARE("FOR EACH " + pcTable + " WHERE " + pcWhere).
hQuery:QUERY-OPEN().
hQuery:GET-FIRST().
IF hBuffer:AVAILABLE THEN DO:
ASSIGN
hBuffer:BUFFER-FIELD(pcField):BUFFER-VALUE = piValue NO-ERROR.
IF ERROR-STATUS:ERROR THEN DO:
MESSAGE "Failed" VIEW-AS ALERT-BOX ERROR.
END.
END.
DELETE OBJECT hBuffer.
DELETE OBJECT hQuery.
END PROCEDURE.
CREATE tt.
ASSIGN tt.a = 1.
RUN foo( INPUT "tt"
, INPUT "tt.a = 1"
, INPUT "a"
, INPUT 2).
DISPLAY tt.
When I read data into a dataset with the method hDataset:READ-XML() and the path to the file is incorrect, Progress first shows a warning message (warning nr 4065) and then an error message. I can catch (using a CATCH block) the error message, but not the warning. The user must remove the warning manually.
How can I suppress this warning?
DEFINE TEMP-TABLE tt NO-UNDO
FIELD a AS CHARACTER.
DEFINE DATASET ds FOR tt.
DO ON ERROR UNDO , LEAVE:
/* Reading non existing xml-file */
DATASET ds:READ-XML("FILE", "c:\dddw\s.xml","empty","", FALSE, "","" ).
CATCH err AS Progress.Lang.Error :
MESSAGE err:GETMESSAGE(1)
VIEW-AS ALERT-BOX INFO BUTTONS OK.
END CATCH.
END.
Generelly in Progress ABL you supress messages with adding NO-ERROR after the command/method.
hDataset:READ-XML() NO-ERROR.
After that you would normally check if ERROR-STATUS:STATUS = TRUE (an error occured), however that doesn's seem to work in this case.
This examples work:
DEFINE TEMP-TABLE tt NO-UNDO
FIELD a AS CHARACTER.
DEFINE DATASET ds FOR tt.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
/* Reading non existing xml-file */
DATASET ds:READ-XML("FILE", "c:\dddw\s.xml","empty","", FALSE, "","" ) NO-ERROR.
/* This is false */
DISP ERROR-STATUS:ERROR.
/* However, ERROR-STATUS:NUM-MESSAGES shows 2 errors */
IF ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
DO i = 1 TO ERROR-STATUS:NUM-MESSAGES:
DISPLAY ERROR-STATUS:GET-MESSAGE(i) FORMAT "x(66)".
PAUSE.
END.
END.
If the file you want to read is local you can (should?) do SEARCH(path+file) first - that will return ? if the file doesn't exist.
IF SEARCH("/mydir/myfile.xml") = ? THEN DO:
MESSAGE "The file seems to be lost" VIEW-AS ALERT-BOX ERROR.
RETURN.
END.
ELSE DO:
/* Read XML etc */
END.