BEHOUSCX ;MSC/IND/DKM - User Context Support ;02-Nov-2009 10:27;PLS
;;1.1;BEH COMPONENTS;**006002**;Sep 18, 2007
;=================================================================
; Retrieve user information for specified USER
; 1 2 3 4 5 6 7 8 9 10
; DUZ^NAME^USRCLS^CANSIGN^ISPROVIDER^ORDERROLE^NOORDER^PTMOUT;STMOUT;CNTDN^SRVIEN^SRVNAME
USERINFO(DATA,USER) ;
N X
I +$G(USER) N DUZ D DUZ^XUP(USER)
S DATA=$P($G(^VA(200,DUZ,0)),U)
Q:'$L(DATA)
S DATA=DUZ_U_DATA
S $P(DATA,U,3)=$S($$HASKEY("ORES"):3,$$HASKEY("ORELSE"):2,$$HASKEY("OREMAS"):1,1:0)
S $P(DATA,U,4)=$$HASKEY("ORES")&$$ISPROV
S $P(DATA,U,5)=$$ISPROV
S $P(DATA,U,6)=$$ORDROLE
S $P(DATA,U,7)=$$GET^XPAR("ALL","ORWOR DISABLE ORDERING")
S $P(DATA,U,8)=$$GET^XPAR("ALL","CIAVM PRIMARY TIMEOUT")
S X=$$GET^XPAR("ALL","CIAVM SECONDARY TIMEOUT")
S:'X X=$G(DTIME,300)
S DATA=DATA_";"_X_";"_$$GET^XPAR("ALL","CIAVM COUNTDOWN INTERVAL")
S $P(DATA,U,9)=+$G(^VA(200,DUZ,5))
S $P(DATA,U,10)=$$GET1^DIQ(49,+$P(DATA,U,10),.01)
Q
; Returns the role a person takes in ordering
; 0=nokey, 1=clerk, 2=nurse, 3=physician, 4=student, 5=bad keys
ORDROLE() ;EP
Q:$$HASKEY("OREMAS")+$$HASKEY("ORELSE")+$$HASKEY("ORES")>1 5
Q:$$HASKEY("OREMAS") 1
Q:$$HASKEY("ORELSE") 2
Q:$$HASKEY("ORES")&$$ISPROV 3
Q:$$ISPROV 4
Q 0
; Returns true if user is a provider
ISPROV() ;EP
Q $$HASKEY("PROVIDER")
; Returns true if user has key
; KEY = Security key (or parameter if begins with "@")
; USR = IEN of user to check (defaults to current user)
HASKEY(KEY,USR) ;PEP - Does user have key?
Q:'$L(KEY) 1
S USR=$G(USR,DUZ)
I $E(KEY)="@" D GETPAR^CIAVMRPC(.KEY,$E(KEY,2,999),,,,USR) Q ''KEY
Q ''$D(^XUSEC(KEY,+USR))
; Check for multiple keys
HASKEYS(DATA,KEYS,USR) ;
N PC
S DATA=""
F PC=1:1:$L(KEYS,U) S $P(DATA,U,PC)=$$HASKEY($P(KEYS,U,PC),.USR)
Q
; Return a set of names from the NEW PERSON file
NEWPERS(DATA,FROM,DIR,KEY,DATE,FLT,CNT) ;
; .DATA=returned list
; FROM=text to $O from
; DIR=$O direction,
; KEY=screen users by security key (optional)
; DATE=checks for an active person class on this date (optional)
; FLT=any of: A=Active only, D=Current division only
; CNT=maximum # to return (defaults to 44)
N I,IEN
S I=0,CNT=$S($G(CNT)>0:+CNT,1:44),KEY=$G(KEY),DATE=$G(DATE),FLT=$G(FLT,"AD")
S:FLT FLT="A" ; Backward compatibility
I DATE,DATE'=+DATE S DATE=$$DT^CIAU(DATE) Q:DATE<0
F S FROM=$O(^VA(200,"B",FROM),DIR),IEN=0 Q:FROM="" D Q:I'<CNT
.F S IEN=$O(^VA(200,"B",FROM,IEN)) Q:'IEN D
..Q:IEN<1
..Q:'$$HASKEY(KEY,IEN)
..I FLT["A",'$$ACTIVE(IEN,DATE) Q ; terminated user
..I FLT["D",'$$INDIV(IEN) Q
..S I=I+1,DATA(I)=IEN_U_FROM
Q
; Return true if user was active on/before given date
; IEN = User IEN
; DAT = Date constraint
ACTIVE(IEN,DAT) ;PEP - User active?
N X
I $G(DAT) N DT S DT=DAT\1
S X=$$ACTIVE^XUSER(IEN)
Q $S(X:+X,1:X=0)
; Returns true if user in specified division
; For users not assigned to any divisions, always returns true
; IEN = User IEN (defaults to DUZ)
; DIV = Division constraint (defaults to current division)
INDIV(IEN,DIV) ;
N RTN
S:'$G(IEN) IEN=DUZ
S:'$D(DIV) DIV=DUZ(2)
Q $S('$$DIV4^XUSER(.RTN,IEN):1,1:$D(RTN(DIV)))
; Returns true if valid electronic signature
VALIDSIG(DATA,ESIG) ;
N X
S X=$$DECRYP^XUSRB1(ESIG)
D HASH^XUSHSHP
S DATA=X=$P($G(^VA(200,+DUZ,20)),U,4)
Q
; Returns true if electronic signature code passes input transform
VALINSIG(DATA,ESIG) ;
N X
S DATA=1
S X=$$DECRYP^XUSRB1(ESIG)
I $L(X)>20!($L(X)<6) S DATA="-1^Length must be between 6 and 20 characters." Q
I X'?.UNP S DATA="-2^Signature code can only contain uppercase letters, punctuation or numbers." Q
Q
STORESIG(DATA,ESIG) ;
N X,LP,DA
S DA=DUZ
S DATA=0
S X=$$DECRYP^XUSRB1(ESIG)
D HASH^XUSHSHP ;returns hashed value in X
L +^VA(200,DUZ):5
E S DATA="-1^Unable to obtain lock on New Person File." Q
S $P(^VA(200,DUZ,20),U,4)=X
S LP=0 F S LP=$O(^DD(200,20.4,1,LP)) Q:'LP X ^(LP,1) ; Fire DD Triggers
L -^VA(200,DUZ)
Q
; Returns true if user has electronic signature code
HASESIG(DATA) ;EP
S DATA=$L($P($G(^VA(200,DUZ,20)),U,4))>0
Q
; Returns true if password is valid
VALIDPSW(DATA,PSW) ;
S DATA=$$EN^XUSHSH($$UP^XLFSTR($$DECRYP^XUSRB1(PSW)))=$P($G(^VA(200,+DUZ,.1)),U,2)
Q
; Returns true if File Manager Access Code field contains code
; If user has the '@' code, returns true regardless
HASFMCD(DATA,CODE) ;
S DATA=$G(DUZ(0))["@"!($G(DUZ(0))[CODE)
Q
BEHOUSCX ;MSC/IND/DKM - User Context Support ;02-Nov-2009 10:27;PLS
+1 ;;1.1;BEH COMPONENTS;**006002**;Sep 18, 2007
+2 ;=================================================================
+3 ; Retrieve user information for specified USER
+4 ; 1 2 3 4 5 6 7 8 9 10
+5 ; DUZ^NAME^USRCLS^CANSIGN^ISPROVIDER^ORDERROLE^NOORDER^PTMOUT;STMOUT;CNTDN^SRVIEN^SRVNAME
USERINFO(DATA,USER) ;
+1 NEW X
+2 IF +$GET(USER)
NEW DUZ
DO DUZ^XUP(USER)
+3 SET DATA=$PIECE($GET(^VA(200,DUZ,0)),U)
+4 IF '$LENGTH(DATA)
QUIT
+5 SET DATA=DUZ_U_DATA
+6 SET $PIECE(DATA,U,3)=$SELECT($$HASKEY("ORES"):3,$$HASKEY("ORELSE"):2,$$HASKEY("OREMAS"):1,1:0)
+7 SET $PIECE(DATA,U,4)=$$HASKEY("ORES")&$$ISPROV
+8 SET $PIECE(DATA,U,5)=$$ISPROV
+9 SET $PIECE(DATA,U,6)=$$ORDROLE
+10 SET $PIECE(DATA,U,7)=$$GET^XPAR("ALL","ORWOR DISABLE ORDERING")
+11 SET $PIECE(DATA,U,8)=$$GET^XPAR("ALL","CIAVM PRIMARY TIMEOUT")
+12 SET X=$$GET^XPAR("ALL","CIAVM SECONDARY TIMEOUT")
+13 IF 'X
SET X=$GET(DTIME,300)
+14 SET DATA=DATA_";"_X_";"_$$GET^XPAR("ALL","CIAVM COUNTDOWN INTERVAL")
+15 SET $PIECE(DATA,U,9)=+$GET(^VA(200,DUZ,5))
+16 SET $PIECE(DATA,U,10)=$$GET1^DIQ(49,+$PIECE(DATA,U,10),.01)
+17 QUIT
+18 ; Returns the role a person takes in ordering
+19 ; 0=nokey, 1=clerk, 2=nurse, 3=physician, 4=student, 5=bad keys
ORDROLE() ;EP
+1 IF $$HASKEY("OREMAS")+$$HASKEY("ORELSE")+$$HASKEY("ORES")>1
QUIT 5
+2 IF $$HASKEY("OREMAS")
QUIT 1
+3 IF $$HASKEY("ORELSE")
QUIT 2
+4 IF $$HASKEY("ORES")&$$ISPROV
QUIT 3
+5 IF $$ISPROV
QUIT 4
+6 QUIT 0
+7 ; Returns true if user is a provider
ISPROV() ;EP
+1 QUIT $$HASKEY("PROVIDER")
+2 ; Returns true if user has key
+3 ; KEY = Security key (or parameter if begins with "@")
+4 ; USR = IEN of user to check (defaults to current user)
HASKEY(KEY,USR) ;PEP - Does user have key?
+1 IF '$LENGTH(KEY)
QUIT 1
+2 SET USR=$GET(USR,DUZ)
+3 IF $EXTRACT(KEY)="@"
DO GETPAR^CIAVMRPC(.KEY,$EXTRACT(KEY,2,999),,,,USR)
QUIT ''KEY
+4 QUIT ''$DATA(^XUSEC(KEY,+USR))
+5 ; Check for multiple keys
HASKEYS(DATA,KEYS,USR) ;
+1 NEW PC
+2 SET DATA=""
+3 FOR PC=1:1:$LENGTH(KEYS,U)
SET $PIECE(DATA,U,PC)=$$HASKEY($PIECE(KEYS,U,PC),.USR)
+4 QUIT
+5 ; Return a set of names from the NEW PERSON file
NEWPERS(DATA,FROM,DIR,KEY,DATE,FLT,CNT) ;
+1 ; .DATA=returned list
+2 ; FROM=text to $O from
+3 ; DIR=$O direction,
+4 ; KEY=screen users by security key (optional)
+5 ; DATE=checks for an active person class on this date (optional)
+6 ; FLT=any of: A=Active only, D=Current division only
+7 ; CNT=maximum # to return (defaults to 44)
+8 NEW I,IEN
+9 SET I=0
SET CNT=$SELECT($GET(CNT)>0:+CNT,1:44)
SET KEY=$GET(KEY)
SET DATE=$GET(DATE)
SET FLT=$GET(FLT,"AD")
+10 ; Backward compatibility
IF FLT
SET FLT="A"
+11 IF DATE
IF DATE'=+DATE
SET DATE=$$DT^CIAU(DATE)
IF DATE<0
QUIT
+12 FOR
SET FROM=$ORDER(^VA(200,"B",FROM),DIR)
SET IEN=0
IF FROM=""
QUIT
Begin DoDot:1
+13 FOR
SET IEN=$ORDER(^VA(200,"B",FROM,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+14 IF IEN<1
QUIT
+15 IF '$$HASKEY(KEY,IEN)
QUIT
+16 ; terminated user
IF FLT["A"
IF '$$ACTIVE(IEN,DATE)
QUIT
+17 IF FLT["D"
IF '$$INDIV(IEN)
QUIT
+18 SET I=I+1
SET DATA(I)=IEN_U_FROM
End DoDot:2
End DoDot:1
IF I'<CNT
QUIT
+19 QUIT
+20 ; Return true if user was active on/before given date
+21 ; IEN = User IEN
+22 ; DAT = Date constraint
ACTIVE(IEN,DAT) ;PEP - User active?
+1 NEW X
+2 IF $GET(DAT)
NEW DT
SET DT=DAT\1
+3 SET X=$$ACTIVE^XUSER(IEN)
+4 QUIT $SELECT(X:+X,1:X=0)
+5 ; Returns true if user in specified division
+6 ; For users not assigned to any divisions, always returns true
+7 ; IEN = User IEN (defaults to DUZ)
+8 ; DIV = Division constraint (defaults to current division)
INDIV(IEN,DIV) ;
+1 NEW RTN
+2 IF '$GET(IEN)
SET IEN=DUZ
+3 IF '$DATA(DIV)
SET DIV=DUZ(2)
+4 QUIT $SELECT('$$DIV4^XUSER(.RTN,IEN):1,1:$DATA(RTN(DIV)))
+5 ; Returns true if valid electronic signature
VALIDSIG(DATA,ESIG) ;
+1 NEW X
+2 SET X=$$DECRYP^XUSRB1(ESIG)
+3 DO HASH^XUSHSHP
+4 SET DATA=X=$PIECE($GET(^VA(200,+DUZ,20)),U,4)
+5 QUIT
+6 ; Returns true if electronic signature code passes input transform
VALINSIG(DATA,ESIG) ;
+1 NEW X
+2 SET DATA=1
+3 SET X=$$DECRYP^XUSRB1(ESIG)
+4 IF $LENGTH(X)>20!($LENGTH(X)<6)
SET DATA="-1^Length must be between 6 and 20 characters."
QUIT
+5 IF X'?.UNP
SET DATA="-2^Signature code can only contain uppercase letters, punctuation or numbers."
QUIT
+6 QUIT
STORESIG(DATA,ESIG) ;
+1 NEW X,LP,DA
+2 SET DA=DUZ
+3 SET DATA=0
+4 SET X=$$DECRYP^XUSRB1(ESIG)
+5 ;returns hashed value in X
DO HASH^XUSHSHP
+6 LOCK +^VA(200,DUZ):5
+7 IF '$TEST
SET DATA="-1^Unable to obtain lock on New Person File."
QUIT
+8 SET $PIECE(^VA(200,DUZ,20),U,4)=X
+9 ; Fire DD Triggers
SET LP=0
FOR
SET LP=$ORDER(^DD(200,20.4,1,LP))
IF 'LP
QUIT
XECUTE ^(LP,1)
+10 LOCK -^VA(200,DUZ)
+11 QUIT
+12 ; Returns true if user has electronic signature code
HASESIG(DATA) ;EP
+1 SET DATA=$LENGTH($PIECE($GET(^VA(200,DUZ,20)),U,4))>0
+2 QUIT
+3 ; Returns true if password is valid
VALIDPSW(DATA,PSW) ;
+1 SET DATA=$$EN^XUSHSH($$UP^XLFSTR($$DECRYP^XUSRB1(PSW)))=$PIECE($GET(^VA(200,+DUZ,.1)),U,2)
+2 QUIT
+3 ; Returns true if File Manager Access Code field contains code
+4 ; If user has the '@' code, returns true regardless
HASFMCD(DATA,CODE) ;
+1 SET DATA=$GET(DUZ(0))["@"!($GET(DUZ(0))[CODE)
+2 QUIT
