source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSER.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1XUSER ;SFISC/RWF - A common set of user functions ;6:26 AM 25 Jan 2005
2 ;;8.0;KERNEL;**75,97,99,150,226,267,288,330,370,373**;Jul 10, 1995
3 ;Covered under DBIA #2343
4 Q
5LOOKUP(XUF) ;Do a user lookup
6 ;Parameter, "Q" to NOT ask OK.
7 ;Parameter, "A" Don't select current users who have a termination
8 ; date prior to today's date
9 N DIC,XUDA,DIR,Y
10LK1 S DIC="^VA(200,",DIC(0)="AEMQZ" D ^DIC S XUDA=Y G:Y'>0 LKX
11 S Y=$P(Y(0),"^",11) I Y>0,Y<DT W !?15,"This user was terminated on ",$$FMTE^XLFDT(Y) I $G(XUF)["A" S XUDA=-1 G LK1
12 G:$G(XUF)["Q" LKX
13 S DIR(0)="Y",DIR("A")=" Is "_$P(XUDA,U,2)_" the one you want",DIR("B")="YES" D ^DIR
14 I Y'=1 S XUDA=-1 G:'$D(DIRUT) LK1
15LKX Q XUDA
16 ;
17ACTIVE(XUDA) ;Get if a user is active.
18 N %,X1,X2
19 S X1=$G(^VA(200,+$G(XUDA),0)),X2=$S(X1="":"",1:0)
20 I $L($P(X1,U,3)) S X2="1^"_$S($L($P($G(^VA(200,XUDA,.1)),U,2)):"ACTIVE",1:"NEW")
21 S:$P(X1,U,7)=1 X2="0^DISUSER"
22 S:X2["ACTIVE" $P(X2,U,3)=$P($G(^VA(200,XUDA,1.1)),U) ;Return last sign-on
23 S %=$P(X1,U,11) I %>0,%'>DT S X2="0^TERMINATED^"_%
24 Q X2
25 ;
26PROVIDER(XUDA,XUF) ;See if user qualifies as a CPRS provider
27 ;XUDA = IEN of Record in New Person File
28 ;XUF = Flag to control processing
29 ; 0 or not passed, do not include Visitors
30 ; 1 include Visitors
31 N %,X1,X2,XUORES
32 ;Test to see if XUDA Passed:
33 I '$D(XUDA) Q ""
34 ;
35 ;Test for valid IEN:
36 S X1=$G(^VA(200,+$G(XUDA),0)),X2=$S(X1="":"",1:1) Q:X2="" ""
37 ;
38 ;See if user has XUORES Security Key:
39 S XUORES=$D(^XUSEC("XUORES",XUDA))
40 ;
41 ;Test for Access Code:
42 I $P(X1,U,3)]"" Q 1
43 ;
44 ;Test for a Termination Date not in the Future
45 ;AND Not owner of XUORES Security Key:
46 S %=$P(X1,U,11) I %>0,%'>DT,'XUORES Q "0^TERMINATED^"_%
47 ;
48 ;Test if user has XUORES Security key:
49 I XUORES Q 1
50 ;
51 ;Tests for Visitors:
52 I +$G(XUF),$D(^VA(200,"BB","VISITOR",XUDA)) Q 1
53 I $D(^VA(200,"BB","VISITOR",XUDA)) Q "0^VISITOR"
54 ;
55 ;Default:
56 Q "0^NOT A PROVIDER"
57 ;
58DEA(FG,IEN) ;sr. ef. Return users DEA # or Facility DEA_"-"_user VA# or null
59 ;If FG is 1: DEA# or VA#
60 N DEA,VA,IN,N,N1,INN
61 S IEN=$G(IEN,DUZ),INN=+DUZ(2)
62 S N=$G(^VA(200,IEN,"PS")),N1=$G(^VA(200,IEN,"QAR"))
63 S DEA=$P(N,U,2),VA=$P(N,U,3)
64 I $L(DEA),$S('$L($P(N1,U,9)):1,1:$P(N1,U,9)>DT) Q DEA
65 I $G(FG) Q VA
66 S IN=$P($G(^DIC(4,INN,"DEA")),U) ;Check signed-in Inst.
67 I '$L(IN) D
68 . N XU1 D PARENT^XUAF4("XU1","`"_INN,"PARENT FACILITY")
69 . S INN=$O(XU1("P","")) I INN S IN=$P($G(^DIC(4,INN,"DEA")),U)
70 . Q
71 I $L(VA),$L(IN) Q IN_"-"_VA
72 Q ""
73 ;
74DIV4(XUROOT,XUDUZ) ;Return the Divisions that this user is assigned to.
75 ;Returns 0 - no institution for user, 1 - institution for user
76 ;XUROOT is passed by reference.
77 N %,%1 S:$G(XUDUZ)="" XUDUZ=DUZ S (%,%1)=0
78 F S %=$O(^VA(200,XUDUZ,2,%)) Q:%'>0 S XUROOT(%)=$P($G(^(%,0)),U,2),%1=1
79 Q %1
80 ;
81NAME(IEN,FL) ;Return the full name from Name Components file
82 N NA S NA("FILE")=200,NA("FIELD")=.01,NA("IENS")=IEN
83 S FL=$G(FL,"G") ;Valid are Famly or Given
84 S:"FG"'[FL FL="G"
85 Q $$NAMEFMT^XLFNAME(.NA,FL,"CMDP")
86 ;
87HL7(IEN) ;Return a HL7 name from the components file
88 N NA S NA("FILE")=200,NA("FIELD")=.01,NA("IENS")=IEN
89 Q $$HLNAME^XLFNAME(.NA,"","~")
90 ;
91SCR200() ;Whole File Screen logic for file 200
92 ;
93 ; Test for Security Key & Length=9 & All numeric
94 I $G(DUZ),$D(^XUSEC("XUSHOWSSN",DUZ)),$L(X)=9,X?9N Q 1
95 ;
96 ; Test to see if FileMan can "talk" to the user, IA# 4577
97 I $G(DIC(0))'["E" Q 1
98 ;
99 ; Test to see if index being searched is SSN, IA# 4578
100 I $G(DINDEX)'="SSN" Q 1
101 ;
102 ; Default - None of the above is TRUE
103 Q 0
Note: See TracBrowser for help on using the repository browser.