77 lines
1.4 KiB
Plaintext
77 lines
1.4 KiB
Plaintext
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
|
|
|
|
|