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/XUSERP.m@ 813

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1XUSERP ;ISF/RWF,SFVAMC/JC - file 200 Protocol ;06/24/2003 11:43
2 ;;8.0;KERNEL;**313**;Jul 10, 1995
3 ;
4CALL(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 ;
16DEQUE(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 ;
33GET(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
Note: See TracBrowser for help on using the repository browser.