added LSL2 stored procedures
This commit is contained in:
76
LSL2/STPROC/OBJ_ICAR.txt
Normal file
76
LSL2/STPROC/OBJ_ICAR.txt
Normal file
@ -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
|
||||
|
||||
|
Reference in New Issue
Block a user