added LSL2 stored procedures

LSL2/STPROC/NEXTKEY.txt

@@ -0,0 +1,143 @@
+COMPILE FUNCTION NextKey(TableName)
+/***********************************************************************************************************************
+
+    Name        :   NextKey
+
+    Description :   Routine to find next sequential key for a table.
+                    January 5, 1997 - John C. Henry, J.C. Henry, Inc.
+
+    Parameters  :
+        TableName   [in]  -- Name of the database table for which the next sequential key is being requested
+        NextNo      [out] -- Next sequential key for the given Tablename.
+
+
+    History     :   (Date, Initials, Notes)
+        01/05/97    jch     Original programmer.
+        11/13/18    djs     Supplemented Set_Status(error) with Error_Services for more robust error reporting due to
+                            the fact that this function is periodically returning 0 as a key when two users attempt to
+                            access the same resource (%SK% column) simultaneously. Updated the Lock statement to delay
+                            before reattempting when failing based upon a set time delay (10 seconds currently)
+                            rather than a number of loop cycles as originally designed. 
+
+***********************************************************************************************************************/
+#pragma precomp SRP_PreCompiler
+
+$Insert LOGICAL
+
+Declare Function Msg, Set_FSError, GetTickCount, Error_Services, Environment_Services, Logging_Services
+Declare Subroutine ErrMsg, Msg, Yield, Winyield, Sleepery, Error_Services, Logging_Services
+
+LogPath     = Environment_Services('GetApplicationRootPath') : '\LogFiles\NextKey'
+LogDate     = Oconv(Date(), 'D4/')
+LogTime     = Oconv(Time(), 'MTS')
+LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' NextKeyLog.csv'
+Headers     = 'Logging DTM' : @FM : 'User': @FM : 'Tablename' : @FM : 'Notes'
+objLog      = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$)
+LoggingDTM  = LogDate : ' ' : LogTime
+LogData     = ''
+LogData<1>  = LoggingDTM
+LogData<2>  = @User4
+LogData<3>  = Tablename
+LogData<4>  = 'Beginning NextKey routine.'
+Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+
+ErrorTitle = "Error in Function 'NEXTKEY' "
+
+OPEN 'DICT.':TableName TO DictVar ELSE
+    Mesg = 'Unable to open DICT.':TableName:' Table.'
+    stat = Set_Status(1,'STPROC',ErrorTitle:@SVM:Mesg)
+    Error_Services('Add', Mesg)
+    RETURN 0
+END
+
+OPEN TableName TO TableVar ELSE
+    Mesg = 'Unable to open ':TableName:'Table.'
+    stat = Set_Status(1,'STPROC',ErrorTitle:@SVM:Mesg)
+    Error_Services('Add', Mesg) 	
+    LogData<4> = Mesg
+    Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+    RETURN 0
+END
+
+TimeExpired = False$
+Start       = GetTickCount()
+Locked      = 0
+Tries       = 0
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// RDS Zero Bug Fix - DJS - Released for UAT on 11/14/2018
+Loop
+    TimeElapsed = GetTickCount() - Start
+    If TimeElapsed > 120000 then TimeExpired = True$ ; // 120000ms = 2 minutes
+    Lock DictVar,"%SK%" then
+        Locked     = True$
+        LogData<4> = '%SK% record locked.'
+        Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+    end else
+        LogData<4> = 'Failed to lock %SK% record. Reattempting...'
+        Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+        // Pause for a moment to allow the column to be unlocked by the lock holder.
+        // Yield() allows for pending Windows messages to be handled.
+        Sleepery(10)
+        WinYield()
+        Yield();Yield();Yield();Yield();Yield();Yield();Yield();Yield()
+    end
+Until Locked or TimeExpired
+repeat
+
+If TimeExpired then
+    Mesg = 'Unable to lock "%SK%" record in DICT.':TableName:' table.'
+    stat = Set_Status(-1,'STPROC',ErrorTitle:@SVM:Mesg)
+    Error_Services('Add', Mesg)
+    LogData<4> = Mesg
+    Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+    return 0
+end
+
+If RowExists('DICT.':TableName, '%SK%') then
+    LogData<4> = '%SK% record exists. Attempting to read next key in sequence...'
+    Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+    // This is the common case. Sequential counter record already exists (i.e. the table already exists and a
+    // sequential counter record is already in the database).
+    Read NextNo from DictVar, '%SK%' then
+        // Log new key
+        LogData<4> = NextNo:' key read from %SK% record.'
+        Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+    end else
+        // Failed to read the '%SK%' record. Record error on error stack (Error_Services) and return 0 (failure).
+        ErrorCode = Status()
+        ErrorMessage = "Failed to read '%SK%' record from DICT.":TableName:". Error code: ":ErrorCode:". File error: ":@FILE_ERROR:"."
+        Error_Services('Add', ErrorMessage)
+        LogData<4> = Mesg
+        Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+        RETURN 0        
+    end
+end else
+    LogData<4> = '%SK% record does not exist. Creating record and returning key value 1.'
+    Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+    // This is a new table and therefore we need to create a %SK% record to store a sequential counter
+    NextNo     = 1 
+end
+
+WRITE NextNo+1 ON DictVar,'%SK%' ELSE 
+    Mesg = "Unable to update next Sequential Number in DICT.":TableName:"."
+    stat = Set_Status(-1,'STPROC',ErrorTitle:@SVM:Mesg)
+    Error_Services('Add', Mesg)
+    LogData<4> = Mesg
+    Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+    RETURN 0
+END
+
+UNLOCK DictVar,'%SK%' ELSE
+    Mesg = 'Unable to unlock "%SK%" record in DICT.':TableName:' Table.'
+    stat = Set_Status(-1,'STPROC',ErrorTitle:@SVM:Mesg)
+    Error_Services('Add', Mesg)
+    LogData<4> = Mesg
+    Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+    RETURN 0
+END
+
+LogData<4>  = 'Ending NextKey routine.'
+Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
+
+RETURN NextNo
+