open-insight/SYSPROG/STPROC/RTI_GET_NEXT_ID.txt
2024-03-25 15:17:34 -07:00

111 lines
2.2 KiB
Plaintext

function rti_get_next_id(byVal_table)
/*
** Copyright (C) 2022 Revelation Software Inc. All Rights Reserved **
This program is proprietary and is not to be used by or disclosed
to others, nor is it to be copied without written permission from
Revelation Technologies, Inc.
Author : RJC
Date : 07 March 2022
Purpose : Sequential Key processing
Comments
========
Get the next id, make sure it is not used, and update the counter
*/
$insert logical
Declare Function get_Status
Declare Subroutine Set_status
EQU SK$ to "%SK%"
If Assigned(byval_table) Then table = byval_table Else table = ""
if assigned(force_increment) else force_increment = ''
if table = '' then
err = 'Table name is missing'
GoTo Error
end
convert @lower.case to @upper.case in table
next_id = ''
err = ''
dict = 'DICT.':table
open table to f_table else
err = 'Unable to open ': table
GoTo Error
end
open dict to f_Dict else
err = 'Unable to open dict for ': table
GoTo Error
end
set_status(0)
locked = false$
started = time()
timeout = 60
loop
Lock f_dict,SK$ then
locked = true$
end else
end
until locked or ( time()-started > timeout )
repeat
if locked else
err = 'Unable to lock Primary Key counter for ' : quote(table)
GoTo Error
end
Read next_id from f_Dict, SK$ else
* should message here
next_id = 1
Write next_id on f_dict, SK$ else
Unlock f_dict, SK$ Else Null
err = 'Unable to write ': dict : ' ': SK$
GoTo Error
end
end
test_Id = next_id
loop
exists = 0
lock f_table, test_id then
read test_rec from f_Table, test_id then
exists = 1
end
unlock f_table, test_id else null
end else
exists = 1
end
if exists then
test_id +=1
end
while exists
Repeat
write test_id+1 on f_dict, SK$ else
Unlock f_dict, SK$ Else Null
err = 'Unable to write ': dict : ' ': SK$
GoTo Error
end
Unlock f_dict, SK$ else
err = 'Unable to Unlock ': dict : ' ': SK$
GoTo Error
end
return test_id
Error:
Set_Status(1,err)
Return ''