1 | XUSERP ;ISF/RWF,SFVAMC/JC - file 200 Protocol ;06/24/2003 11:43
|
---|
2 | ;;8.0;KERNEL;**313**;Jul 10, 1995
|
---|
3 | ;
|
---|
4 | CALL(XUNP,XUFLG) ;Queue Protocol
|
---|
5 | ;Call for Kernel Create, Update, Disuser or Terminate events
|
---|
6 | ;Queue Protocol for user trigger events
|
---|
7 | ;XUFLG=Action: 1=Add/Create New Entry, 2=Update Existing Entry, 3=Terminate
|
---|
8 | ;XUNP=input IEN of New Person File entry
|
---|
9 | Q:'+$G(XUNP)
|
---|
10 | N ZTSAVE,ZTRTN,ZTDTH,ZTDESC,ZTIO
|
---|
11 | S ZTRTN="DEQUE^XUSERP("_XUNP_","_XUFLG_")",ZTDTH=$H,ZTIO=""
|
---|
12 | S ZTDESC="User "_$P("add^change^terminate","^",XUFLG)_" event protocol"
|
---|
13 | D ^ZTLOAD
|
---|
14 | Q
|
---|
15 | ;
|
---|
16 | DEQUE(XUNP,XUFLG) ;Run Protocol
|
---|
17 | ;Call for Kernel Create, Update, Disuser or Terminate events
|
---|
18 | ;Call Protocol for user trigger events
|
---|
19 | ;XUFLG=Action: 1=Add/Create New Entry, 2=Update Existing Entry, 3=Terminate
|
---|
20 | ;XUNP=input IEN of New Person File entry
|
---|
21 | Q:'+$G(XUNP)
|
---|
22 | N XUDA,DIC,DIE,N,X,XUSR,XUIEN,XUIFN,$ES,$ET
|
---|
23 | S XUFLG=$G(XUFLG) I XUFLG<1!(XUFLG>3) S XUFLG=2
|
---|
24 | S $ETRAP="D ^%ZTER,UNWIND^%ZTER"
|
---|
25 | S N=$P("XU USER ADD^XU USER CHANGE^XU USER TERMINATE","^",XUFLG)
|
---|
26 | S X=+$O(^DIC(19,"B",N,0))_";DIC(19,"
|
---|
27 | ;XUIFN is used in the Terminate protocol.
|
---|
28 | I XUFLG=3 S XUIFN=XUNP
|
---|
29 | ;XUIEN and XUSR are user in the protocol.
|
---|
30 | S XUIEN=XUNP D EN^XQOR
|
---|
31 | Q
|
---|
32 | ;
|
---|
33 | GET(IEN,USR) ;Return file 200 data
|
---|
34 | ;Protocol XU USER ADD, XU USER CHANGE, XU USER TERMINATE
|
---|
35 | I '$L($G(IEN)) S USR="0-ERROR"
|
---|
36 | N XUSR0,XUSR1
|
---|
37 | I $D(^VA(200,IEN)) D
|
---|
38 | . S XUSR0=$G(^VA(200,IEN,0))
|
---|
39 | . S XUSR1=$G(^VA(200,IEN,.1))
|
---|
40 | . S USR("NAME")=$P(XUSR0,U)
|
---|
41 | . S USR("INITIAL")=$P(XUSR0,U,2)
|
---|
42 | . S USR("ACCESS CODE")=$P(XUSR0,U,3)
|
---|
43 | . S USR("FILE MANAGER ACCESS CODE")=$P(XUSR0,U,4)
|
---|
44 | . S USR("DISUSER")=$P(XUSR0,U,7)
|
---|
45 | . S USR("TERMINATION DATE")=$P(XUSR0,U,11)
|
---|
46 | . S USR("DATE VERIFY CODE LAST CHANGED")=$P(XUSR1,U)
|
---|
47 | . S USR("VERIFY CODE")=$P(XUSR1,U,2)
|
---|
48 | . S USR("NICKNAME")=$P(XUSR1,U,4)
|
---|
49 | . S USR("SSN")=$P(^VA(200,IEN,1),U,9)
|
---|
50 | . S USR("EML")=$P($G(^VA(200,IEN,.15)),U)
|
---|
51 | . S USR("HL7NAME")=$$HL7^XUSER(IEN)
|
---|
52 | . I $D(^VA(200,IEN,2)) S I=0 F S I=$O(^VA(200,IEN,2,I)) Q:I<1 D
|
---|
53 | . . S USR("DIV",I)=$P($G(^VA(200,IEN,2,I,0)),U) ;Pointer to file 4
|
---|
54 | Q
|
---|