The following procedure recordCheck.p checks whether a specific record exists or does not exist at all. If exists checks whether a record is locked by another customer or not. In all three cases the pop-up message is displayed. For screenshots please refer to attached zip file.
To demonstrate all three situations follow the steps:
-> connect to sports DB
TEST 1: Record exists and is not locked
-> run the procedure recordCheck.p
-> message "The specified record EXISTS & NOT locked" is displayed (see the screenshot)
TEST 2: Record exists and is locked
-> run the procedure recordLock.p
-> run the procedure recordCheck.p
-> message "The specified record is LOCKED" with other useful information is displayed (see the screenshot)
TEST 3: Record does not exist
-> set variable in PROCEDURE GetRecordRecid as follows: cWhereString = 'cust-num = 20000'
-> run the procedure recordCheck.p
-> message "The specified record does NOT exist" is displayed (see the screenshot)
Procedure recordLock.p
FIND customer WHERE cust-num = 15 EXCLUSIVE-LOCK.
DISPLAY customer WITH 1 COLUMN.
UPDATE customer.NAME.
Procedure recordCheck.p
DEFINE VARIABLE cDatabaseName AS CHARACTER NO-UNDO.
DEFINE VARIABLE cTableName AS CHARACTER NO-UNDO.
DEFINE VARIABLE cBufferTable AS CHARACTER NO-UNDO.
DEFINE VARIABLE cWhereString AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPrepareString AS CHARACTER NO-UNDO.
DEFINE VARIABLE cRecordStatus AS CHARACTER NO-UNDO.
DEFINE VARIABLE hBufferHandle AS HANDLE NO-UNDO.
DEFINE VARIABLE hFieldHandle AS HANDLE NO-UNDO.
DEFINE VARIABLE hQueryHandle AS HANDLE NO-UNDO.
DEFINE VARIABLE iTableNumber AS INTEGER NO-UNDO.
DEFINE VARIABLE iRecordRecid AS INTEGER NO-UNDO.
DEFINE VARIABLE i_Lock-Table AS INTEGER NO-UNDO.
/* Starting with 10.1B, the INT64 data type is used for some _lock table fields */
/* Modify the &IF statement conditions to use it under version 8.x and earlier. */
&IF (PROVERSION BEGINS "9") OR (PROVERSION BEGINS "10.0") OR (PROVERSION BEGINS "10.1A") &THEN
DEFINE VARIABLE i_Lock-Id AS INTEGER NO-UNDO.
DEFINE VARIABLE i_Lock-RecId AS INTEGER NO-UNDO.
&ELSE
DEFINE VARIABLE i_Lock-Id AS INT64 NO-UNDO.
DEFINE VARIABLE i_Lock-RecId AS INT64 NO-UNDO.
&ENDIF
/* Get user table number */
RUN getTableNumber.
/* Get the user table record RECID */
RUN GetRecordRecid.
/* If the record does not exist then stop */
IF iRecordRecid = ? OR iRecordRecid = 0 THEN
ASSIGN
cRecordStatus = "The specified record does NOT exist".
ELSE
/* The record DOES exist, check its locking status */
RUN CheckRecordLockStatus.
/* Finally, message the findings and destroy last dynamic query */
MESSAGE cRecordStatus
VIEW-AS ALERT-BOX INFO BUTTONS OK.
RUN DestroyQuery.
/*============= PROCEDURE GetTableNumber ===============*/
PROCEDURE GetTableNumber:
ASSIGN
cDatabaseName = "sports" /*change if required*/
cTableName = "Customer" /*change if required*/
cBufferTable = cDatabaseName + "." + "_File"
cWhereString = cBufferTable + '._File-Name = ' + QUOTER(cTableName)
cPrepareString = 'FOR EACH ' + cBufferTable + ' NO-LOCK WHERE ' + cWhereString.
RUN BuildQery.
hQueryHandle:GET-FIRST(NO-LOCK).
IF hBufferHandle:AVAILABLE THEN DO:
hFieldHandle = hBufferHandle:BUFFER-FIELD("_File-Number").
iTableNumber = hFieldHandle:BUFFER-VALUE.
END.
RUN DestroyQuery.
END PROCEDURE.
/*============= PROCEDURE GetRecordRecid ===============*/
PROCEDURE GetRecordRecid:
ASSIGN
cBufferTable = cDatabaseName + "." + cTableName
cWhereString = 'cust-num = 15' /*change if required*/
cPrepareString = 'FOR EACH ' + cBufferTable + ' NO-LOCK WHERE ' + cWhereString.
RUN BuildQery.
hQueryHandle:GET-FIRST(NO-LOCK).
IF hBufferHandle:AVAILABLE THEN
iRecordRecid = hBufferHandle:RECID.
RUN DestroyQuery.
END PROCEDURE.
/*============= PROCEDURE CheckRecordLockStatus ========*/
PROCEDURE CheckRecordLockStatus:
ASSIGN
cBufferTable = cDatabaseName + "." + "_Lock"
cWhereString = ""
cPrepareString = 'FOR EACH ' + cBufferTable + ' FIELDS (_lock-Id _Lock-Table _Lock-Recid) NO-LOCK WHERE ' + cWhereString
cRecordStatus =
"The specified record EXISTS & NOT locked" + "~n" +
"Record Recid:" + "~t~t" + STRING(iRecordRecid) + "~n" +
"Record Table:" + "~t~t" + STRING(iTableNumber).
RUN BuildQery.
REPEAT:
hQueryHandle:GET-NEXT(NO-LOCK).
IF ( hQueryHandle:QUERY-OFF-END ) OR ( NOT hBufferHandle:AVAILABLE ) THEN LEAVE.
ASSIGN
hFieldHandle = hBufferHandle:BUFFER-FIELD("_Lock-Table")
i_Lock-Table = hFieldHandle:BUFFER-VALUE
hFieldHandle = hBufferHandle:BUFFER-FIELD("_Lock-RecId")
i_Lock-RecId = hFieldHandle:BUFFER-VALUE
hFieldHandle = hBufferHandle:BUFFER-FIELD("_Lock-Id")
i_Lock-Id = hFieldHandle:BUFFER-VALUE.
IF ( i_Lock-Table = ? ) OR ( i_Lock-RecId = ? ) THEN LEAVE.
IF ( i_Lock-Table <> iTableNumber ) OR ( i_Lock-RecId <> iRecordRecid ) THEN NEXT.
/* If we reach here, the variable i_Lock-Id is our _Lock table _Lock-Id value */
RUN DestroyQuery.
RUN GetLockingDetails.
END.
END PROCEDURE.
/*============= PROCEDURE GetLockingDetails ============*/
PROCEDURE GetLockingDetails:
DEFINE VARIABLE iFieldCounter AS INTEGER NO-UNDO.
ASSIGN
cBufferTable = cDatabaseName + "." + "_Lock"
cWhereString = "_Lock-Id = " + STRING(i_Lock-Id)
cPrepareString = 'FOR EACH ' + cBufferTable + ' NO-LOCK WHERE ' + cWhereString.
RUN BuildQery.
hQueryHandle:GET-FIRST(NO-LOCK).
IF hBufferHandle:AVAILABLE THEN DO:
cRecordStatus = "The specified record is LOCKED. Details follow" + "~n".
DO iFieldCounter = 1 TO hBufferHandle:NUM-FIELDS:
hFieldHandle = hBufferHandle:BUFFER-FIELD(iFieldCounter).
IF hFieldHandle:BUFFER-VALUE <> ? THEN
cRecordStatus = cRecordStatus + hFieldHandle:NAME + ":~t" + hFieldHandle:BUFFER-VALUE + "~n".
END.
END.
END PROCEDURE.
/*============= PROCEDURE BuildQery ====================*/
PROCEDURE BuildQery:
CREATE BUFFER hBufferHandle FOR TABLE cBufferTable.
CREATE QUERY hQueryHandle.
hQueryHandle:SET-BUFFERS(hBufferHandle).
hQueryHandle:QUERY-PREPARE(cPrepareString).
hQueryHandle:QUERY-OPEN.
END PROCEDURE.
/*============= PROCEDURE DestroyQuery =================*/
PROCEDURE DestroyQuery:
hQueryHandle:QUERY-CLOSE.
DELETE OBJECT hBufferHandle.
DELETE OBJECT hQueryHandle.
ASSIGN
hBufferHandle = ?
hQueryHandle = ?.
hFieldHandle = ?.
END PROCEDURE.
