COMPILE FUNCTION obj_Tables(Method,Parms)

/* 
	Data Table Read, Write, Delete Lock, Unlock Methods
	
	11/22/00 by JCH - J.C. Henry, Inc
	
	Properties:
	
	TableKey	Record Key
	TableRec	Record
	TableName	Table Name
	TableVar	Table Variable from OPEN statement (Optional)
	
	Methods:
	
	OpenTable(TableName)										Open TableName and Return TableVar
	ReadOnlyRec(TableName,TableKey,TableVar)					Read Record Returns TableRecord without Lock
	ReadRec(TableName,TableKey,TableVar)						Read Record for update (with lock set)
	WriteRec(TableName,TableKey,TableVar,TableRec,Locked)		Write Record
	DeleteRec(TableName,TableKey,TableVar)						Delete Record
	LockRec(TableName,TableKey,TableVar)						Lock Record
	UnlockRec(TableName,TableKey,TableVar)						Unlock Record
	LockSet(TableName,TableKey(s))								Locks all Keys in list
	UnlockSet(TableName,TableKey(s),TableVar)					Unlocks all Keys in list
		
		
	Records are checked for any contents prior to write.  If there is no data in the
	record then the record is DELETED from the table.
	
	History:
	
	08/27/20    DJS     Updated UnlockRec subroutine to utilize Database_Services and to only unlock a record
	                    if the record is locked in order to avoid setting an FS411 error uneccessarily. 
										  
	
*/

DECLARE SUBROUTINE Set_Status, Set_FSError, Database_Services, Logging_Services
DECLARE FUNCTION Set_Status, Database_Services, Logging_Services, Environment_Services

EQU Tab$        TO \09\
EQU CRLF$       TO \0D0A\
EQU LF$         TO \0A\
EQU Comma$      TO ','

EQU TRUE$	    TO 1
EQU FALSE$	    TO 0

EQU TABLE_NAME$	TO 1
EQU TABLE_KEY$	TO 2
EQU TABLE_VAR$	TO 3
EQU TABLE_REC$	TO 4

$INSERT CopyRight
$INSERT Msg_Equates

LogPath     = Environment_Services('GetApplicationRootPath') : '\LogFiles\obj_Tables'
LogDate     = Oconv(Date(), 'D4/')
LogTime     = Oconv(Time(), 'MTS')
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' obj_Tables Log.csv'
Headers     = 'Logging DTM' : @FM : 'User' : @FM : 'Method' : @FM : 'TableName' : @FM : 'TableKey' : @FM : 'Notes'
objLog      = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$)
LoggingDTM  = LogDate : ' ' : LogTime   ; // Logging DTM

ErrTitle = 'Error in obj_Tables'

ErrorMsg = ''

IF NOT(ASSIGNED(Method))	THEN ErrorMsg = 'Unassigned parameter "Method" passed to subroutine.'
IF NOT(ASSIGNED(Parms))		THEN ErrorMsg = 'Unassigned parameter "Parms" passed to subroutine.'

IF Method	= ''	THEN ErrorMsg = 'Null parameter "Method" passed to subroutine'
IF Parms	= ''	THEN ErrorMsg = 'Null parameter "Parms" passed to subroutine.'


IF ErrorMsg NE '' THEN
	stat = Set_Status(-1,ErrTitle:@SVM:ErrorMsg)		;* Initialization Errors
	RETURN ''
END

Result = ''

TableName	= Parms[1,@RM]
TableKey	= Parms[COL2()+1,@RM]
TableVar	= Parms[COL2()+1,@RM]
TableRec	= Parms[COL2()+1,@RM]


BEGIN CASE
	CASE Method = 'OpenTable'		; GOSUB OpenTable
	CASE Method = 'ReadOnlyRec'		; GOSUB ReadOnlyRec
	CASE Method = 'ReadRec'			; GOSUB ReadRec
	CASE Method = 'WriteRec'		; GOSUB WriteRec
	CASE Method = 'WriteOnlyRec'	; GOSUB WriteOnlyRec
	CASE Method = 'DeleteRec'		; GOSUB DeleteRec
	CASE Method = 'LockRec'			; GOSUB LockRec
	CASE Method = 'UnlockRec'		; GOSUB UnlockRec
	CASE Method = 'LockSet'			; GOSUB LockSet
	CASE Method = 'UnlockSet'		; GOSUB UnlockSet
	CASE 1
		ErrorMsg = 'Method ':QUOTE(Method):' not defined in object.'
		
END CASE


IF ErrorMsg = '' THEN
	Parms = FieldStore(Parms,@RM,TABLE_VAR$,0,TableVar)
END ELSE
	stat = Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
	RETURN ''
END

RETURN Result


* * * * * * *
OpenTable:
* * * * * * *

IF TableName = '' THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'

IF ErrorMsg = '' THEN
	OPEN TableName TO TableVar THEN
		Result = TableVar
		Parms = FieldStore(Parms,@RM,3,1,TableVar)									;* Added 1/22/2007 JCH
	END ELSE
		ErrorMsg = 'Unable to open Table ':QUOTE(TableName)
	END
END


RETURN

* * * * * * *
ReadRec:
* * * * * * *

GOSUB LockRec

IF ErrorMsg NE '' THEN RETURN

* * * * * * *
ReadOnlyRec:
* * * * * * *

IF TableName = ''	THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
IF TableKey = ''	THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
IF TableVar = ''	THEN
	GOSUB OpenTable
	IF ErrorMsg THEN RETURN
END

READ TableRec FROM TableVar,TableKey THEN
	Result = TableRec
END ELSE
    // Log failure to read
    LogData = ''
    LogData<1> = LoggingDTM
    LogData<2> = @User4
    LogData<3> = Method
    LogData<4> = TableName
    LogData<5> = TableKey
    LogData<6> = 'Error code: ':@FILE_ERROR<1>:' Error message: ':@FILE_ERROR<2>:' Error detail: ':@FILE_ERROR<3>
    Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
    
	IF @FILE_ERROR<1> = 100 THEN
*       Record doesn't exist
*       04/20/2021 - DJS - Moved unlock call outside of this specific error condition so that the record is always
*                          unlocked if the record fails to be read.
*		GOSUB UnlockRec
        Null
	END ELSE
		Set_FSError()
		ErrorMsg = 'Record ':QUOTE(TableKey):' not found in Table ':QUOTE(TableName)
	END
	Result = ''

	If ( (TableName NE '') and (TableKey NE '') ) then
        RecordLocked = Database_Services('IsKeyIDLocked', TableName, TableKey, False$)
        If RecordLocked EQ True$ then Database_Services('ReleaseKeyIDLock', TableName, TableKey)
    end
    
END

RETURN


* * * * * * *
WriteRec:
* * * * * * *

IF TableName = ''	THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
IF TableKey = ''	THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
IF TableVar = ''	THEN GOSUB OpenTable

IF ErrorMsg THEN RETURN

IF ErrorMsg = '' THEN

	TestRec = TableRec
	
	CONVERT @SVM:@VM:@FM TO '' IN TestRec
	
	IF TestRec = '' THEN
		DELETE TableVar,TableKey ELSE Null
*		ErrorMsg = 'Blank table rec with ':QUOTE(TableKey):' on ':QUOTE(TableName):' table.'; *added 4/9/21 for debugging
*		Set_FSError()
	END ELSE
	    Set_Status(0)
	    rv = Get_Status(errCode)
		WRITE TableRec ON TableVar,TableKey THEN
		    rv = Get_Status(errCode)
		END ELSE
			ErrorMsg = 'Unable to write ':QUOTE(TableKey):' on ':QUOTE(TableName):' table.'
		END
		
	END
	
	If ( (TableName NE '') and (TableKey NE '') ) then
        RecordLocked = Database_Services('IsKeyIDLocked', TableName, TableKey, False$)
        If RecordLocked EQ True$ then Database_Services('ReleaseKeyIDLock', TableName, TableKey)
	end

END

RETURN


* * * * * * *
WriteOnlyRec:
* * * * * * *

IF TableName = ''	THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
IF TableKey = ''	THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
IF TableVar = ''	THEN GOSUB OpenTable

IF ErrorMsg THEN RETURN

IF ErrorMsg = '' THEN

	TestRec = TableRec
	
	CONVERT @SVM:@VM:@FM TO '' IN TestRec
	
	IF TestRec = '' THEN
		DELETE TableVar,TableKey ELSE Null
	END ELSE
		WRITE TableRec ON TableVar,TableKey ELSE
			ErrorMsg = 'Unable to write ':QUOTE(TableKey):' on ':QUOTE(TableName):' table.'
		END
	END
END

RETURN


* * * * * * *
DeleteRec:
* * * * * * *

IF TableName = ''	THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
IF TableKey = ''	THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
IF TableVar = ''	THEN GOSUB OpenTable

IF ErrorMsg THEN RETURN

IF ErrorMsg = '' THEN
	DELETE TableVar,TableKey THEN
		GOSUB UnlockRec
	END
END

RETURN



* * * * * * *
LockRec:
* * * * * * *

IF TableName = ''	THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
IF TableKey = ''	THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
IF TableVar = ''	THEN GOSUB OpenTable

IF ErrorMsg THEN RETURN

LockData	= ''
Locked		= FALSE$
RetryCnt	= 0

LOOP

	LOCK TableVar,TableKey THEN
		Locked = TRUE$
	END ELSE
		    		
		BEGIN CASE
			CASE @FILE_ERROR NE ''
				Set_FSError()
				ErrorMsg = 'Unable to Lock ':QUOTE(TableKey):' in Table ':QUOTE(TableName)
				
			CASE Get_Status(errCode)
				ErrorMsg = QUOTE(TableKey):' in Table ':QUOTE(TableName):' Locked by another workstation.'
				
			CASE 1
				ErrorMsg = QUOTE(TableKey):' in Table ':QUOTE(TableName):' Locked by This workstation.'
			
		END CASE
		
		RetryCnt += 1
	END
  
UNTIL Locked OR RetryCnt = 10 REPEAT


RETURN


* * * * * * *
UnlockRec:
* * * * * * *

RecordLocked = Database_Services('IsKeyIDLocked', TableName, TableKey, False$)
If RecordLocked EQ True$ then Database_Services('ReleaseKeyIDLock', TableName, TableKey)

RETURN


* * * * * * * 
LockSet:
* * * * * * * 

IF TableName = ''	THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
IF TableKey = ''	THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
IF TableVar = ''	THEN GOSUB OpenTable

TableKeys = TableKey			;* Pass in @VM'd list of keys In TableKey

IF ErrorMsg THEN RETURN

IF TableKeys	= '' THEN RETURN

Set_Status(0)

LockedTableKeys = ''

FOR I = 1 TO COUNT(TableKeys,@VM) + (TableKeys NE '')
	TableKey = TableKeys<1,I>
	GOSUB LockRec
	
	If Locked THEN
		LockedTableKeys<1,-1> = TableKey
	End ELSE
		For N = 1 To Count(LockedTableKeys,@VM) + (LockedTableKeys NE '')
			TableKey = LockedTableKeys<1,N>
			Gosub UnlockRec
		Next N
	End
	
NEXT I

Result = TableVar

RETURN


* * * * * * * 
UnlockSet:
* * * * * * * 

IF TableName = ''	THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
IF TableKey = ''	THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
IF TableVar = ''	THEN ErrorMsg = 'Null parameter "TableVar" passed to subroutine'

LockedTableKeys = TableKey			;* Pass in @VM'd list of keys In TableKey

IF ErrorMsg THEN RETURN

IF LockedTableKeys = '' THEN RETURN

Set_Status(0)


FOR I = 1 TO COUNT(LockedTableKeys,@VM) + (LockedTableKeys NE '')
	TableKey = LockedTableKeys<1,I>
	GOSUB UnlockRec
NEXT I

RETURN




