Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BEHOUSCX

BEHOUSCX.m

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