source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRLA.m@ 1240

Last change on this file since 1240 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1USRLA ; SLC/JER,MA - Authorization Library functions ;6/29/01 11:19
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**15,20**;Jun 20, 1997
3CANDO(DOCTYPE,STATUS,EVENT,USER,USRROLE) ; Evaluate Authorization
4 ; 18 JUNE 2001 MA added a change to check for "OR" logic
5 ; when checking roles.
6 ; Receives: DOCTYPE = Pointer to TIU DOCMT DEF FILE (8925.1)
7 ; STATUS = Pointer to TIU STATUS FILE (8925.6)
8 ; EVENT = Pointer to USR EVENT FILE (8930.8)
9 ; USER = Pointer to NEW PERSON FILE (200)
10 ; [USRROLE] = Pointer to USER ROLE FILE (8930.2)
11 ; Role, if received, is a particular role
12 ; already known to belong to USER for docmt
13 ; being checked. See CANDO^TIULP.
14 ; DBIA 2321 ^TIU(8925.1)
15 N USRC,USRCY,USRRY,USRR,USRY,USRFALSE
16 ; First, loop thru Class xref "AC" to determine whether USER
17 ; is a member of any subclasses which are authorized to perform
18 ; EVENT on DOCTYPE with STATUS.
19 ;
20 ; Class Section
21 ;
22 S (USRC,USRY,USRFALSE)=0
23 F S USRC=$O(^USR(8930.1,"AC",DOCTYPE,STATUS,EVENT,USRC)) Q:+USRC'>0!(+$G(USRCY)>0&(USRY>0)) D
24 . N USRADA,USRAND S USRADA=0
25 . F S USRADA=+$O(^USR(8930.1,"AC",DOCTYPE,STATUS,EVENT,USRC,USRADA)) Q:+USRADA'>0!(+$G(USRY)>0) D
26 . . S USRCY=+$$ISA^USRLM(USER,USRC)
27 . . ; If user is NOT a member of the class for which a rule has been
28 . . ; defined, set USRFALSE to indicate evaluation of a rule that
29 . . ; was NOT satisfied.
30 . . I +USRCY'>0 S USRFALSE=1
31 . . ; If a match is obtained on user class, check to see whether
32 . . ; additional conditions on user role exist.
33 . . I +USRCY>0 D
34 . . . S USRFALSE=0
35 . . . I $P($G(^USR(8930.1,USRADA,0)),U,5)="&",($G(USRROLE)=$P($G(^(0)),U,6)) S USRY=1
36 . . . I $P($G(^USR(8930.1,USRADA,0)),U,5)'="&" S USRY=1
37 ; In the event that authorization is granted to users with a
38 ; particular role with respect to the document, without concern
39 ; for class membership, check the Role xref "AR".
40 ;
41 ; Role Section.
42 ;
43 I +USRY'>0,+$G(USRROLE) D
44 . S USRR=0
45 . F S USRR=$O(^USR(8930.1,"AR",DOCTYPE,STATUS,EVENT,USRROLE,USRR)) Q:+USRR'>0!(USRY>0) D
46 . . ; Check for "&" condition
47 . . I $P($G(^USR(8930.1,+USRR,0)),U,5)="&",+$P($G(^(0)),U,4) D
48 . . . I +$$ISA^USRLM(+$G(USER),+$P($G(^USR(8930.1,+USRR,0)),U,4)) S USRY=1 ; **15** Changed DUZ to USER.
49 . . ; Check for only a role needed
50 . . I '+USRY,'+$P($G(^USR(8930.1,+USRR,0)),U,4) S USRY=1
51 . . ; Check for an "OR" condition
52 . . I '+USRY,$P($G(^USR(8930.1,+USRR,0)),U,5)="!" D
53 . . . N USRCLS
54 . . . S USRCLS=+$P($G(^USR(8930.1,+USRR,0)),U,4)
55 . . . I +$$ISA^USRLM(+$G(USER),+USRCLS)!USRROLE=+$P($G(^USR(8930.1,+USRR,0)),U,6) S USRY=1
56 ; To allow heritability of authorization, if the user is not
57 ; authorized to perform the specified action on the specific
58 ; document in its current state, AND if no explicit rule for
59 ; the current document definition failed (i.e., USRFALSE'>0),
60 ; then traverse up the document class hierarchy and evaluate
61 ; whether authorization is granted at a higher level.
62 I +USRY'>0,(+$G(USRFALSE)'>0) D
63 . N USRTYP S USRTYP=0
64 . F S USRTYP=$O(^TIU(8925.1,"AD",DOCTYPE,USRTYP)) Q:+USRTYP'>0!(+USRY>0) D
65 . . S USRY=$$CANDO(USRTYP,STATUS,EVENT,USER,$G(USRROLE))
66 Q USRY
Note: See TracBrowser for help on using the repository browser.