added LSL2 stored procedures

LSL2/STPROC/OBJ_ICAR.txt

@@ -0,0 +1,76 @@
+COMPILE FUNCTION obj_ICAR(Method,Parms)
+/*
+	Methods for Notes table
+    
+	07/16/2007 JCH - Initial Coding
+     
+    Properties:
+     
+    Methods:
+    
+    RespSup()						;* Returns 1 if @USER4 is an ICAR Resp Supervisor
+	
+*/
+
+
+DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, NextKey
+DECLARE SUBROUTINE  Set_Status, Msg, obj_Tables, RList, ErrMsg, Btree.Extract
+
+$INSERT MSG_EQUATES
+$INSERT ICAR_EQU
+
+EQU TARGET_ACTIVELIST$ TO 5
+ 
+
+ErrTitle = 'Error in Stored Procedure "obj_ICAR"'
+ErrorMsg = ''
+
+IF NOT(ASSIGNED(Method))	THEN ErrorMsg = 'Unassigned parameter "Method" passed to subroutine'
+IF NOT(ASSIGNED(Parms))		THEN Parms = ''
+
+IF ErrorMsg NE '' THEN
+	Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
+	RETURN ''
+END
+
+Result = ''
+
+BEGIN CASE
+	CASE Method = 'RespSup'		; GOSUB RespSup
+	CASE 1
+		ErrorMsg = 'Unknown Method ':QUOTE(Method):' passed to object.'
+
+END CASE
+
+IF ErrorMsg NE '' THEN
+	Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
+	RETURN ''
+END
+
+RETURN Result
+
+
+* * * * * * *
+RespSup:
+* * * * * * *
+
+OPEN 'DICT.LSL_USERS' TO DictVar ELSE
+	Errmsg('Unable to open DICT.LSL_USERS for lookup.')
+	RETURN
+END
+
+SearchString = 'GROUPS':@VM:'ICAR_RESP_SUP':@FM
+
+Supervisors = ''
+Option = ''
+Flag = ''
+
+Btree.Extract(SearchString, 'LSL_USERS', DictVar, Supervisors, Option, Flag)
+
+LOCATE @USER4 IN Supervisors USING @VM SETTING Pos THEN
+	Result = 1
+END
+
+RETURN
+
+