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