XUSERP ;ISF/RWF,SFVAMC/JC - file 200 Protocol ;06/24/2003 11:43
;;8.0;KERNEL;**313**;Jul 10, 1995
;
CALL(XUNP,XUFLG) ;Queue Protocol
;Call for Kernel Create, Update, Disuser or Terminate events
;Queue Protocol for user trigger events
;XUFLG=Action: 1=Add/Create New Entry, 2=Update Existing Entry, 3=Terminate
;XUNP=input IEN of New Person File entry
Q:'+$G(XUNP)
N ZTSAVE,ZTRTN,ZTDTH,ZTDESC,ZTIO
S ZTRTN="DEQUE^XUSERP("_XUNP_","_XUFLG_")",ZTDTH=$H,ZTIO=""
S ZTDESC="User "_$P("add^change^terminate","^",XUFLG)_" event protocol"
D ^ZTLOAD
Q
;
DEQUE(XUNP,XUFLG) ;Run Protocol
;Call for Kernel Create, Update, Disuser or Terminate events
;Call Protocol for user trigger events
;XUFLG=Action: 1=Add/Create New Entry, 2=Update Existing Entry, 3=Terminate
;XUNP=input IEN of New Person File entry
Q:'+$G(XUNP)
N XUDA,DIC,DIE,N,X,XUSR,XUIEN,XUIFN,$ES,$ET
S XUFLG=$G(XUFLG) I XUFLG<1!(XUFLG>3) S XUFLG=2
S $ETRAP="D ^%ZTER,UNWIND^%ZTER"
S N=$P("XU USER ADD^XU USER CHANGE^XU USER TERMINATE","^",XUFLG)
S X=+$O(^DIC(19,"B",N,0))_";DIC(19,"
;XUIFN is used in the Terminate protocol.
I XUFLG=3 S XUIFN=XUNP
;XUIEN and XUSR are user in the protocol.
S XUIEN=XUNP D EN^XQOR
Q
;
GET(IEN,USR) ;Return file 200 data
;Protocol XU USER ADD, XU USER CHANGE, XU USER TERMINATE
I '$L($G(IEN)) S USR="0-ERROR"
N XUSR0,XUSR1
I $D(^VA(200,IEN)) D
. S XUSR0=$G(^VA(200,IEN,0))
. S XUSR1=$G(^VA(200,IEN,.1))
. S USR("NAME")=$P(XUSR0,U)
. S USR("INITIAL")=$P(XUSR0,U,2)
. S USR("ACCESS CODE")=$P(XUSR0,U,3)
. S USR("FILE MANAGER ACCESS CODE")=$P(XUSR0,U,4)
. S USR("DISUSER")=$P(XUSR0,U,7)
. S USR("TERMINATION DATE")=$P(XUSR0,U,11)
. S USR("DATE VERIFY CODE LAST CHANGED")=$P(XUSR1,U)
. S USR("VERIFY CODE")=$P(XUSR1,U,2)
. S USR("NICKNAME")=$P(XUSR1,U,4)
. S USR("SSN")=$P(^VA(200,IEN,1),U,9)
. S USR("EML")=$P($G(^VA(200,IEN,.15)),U)
. S USR("HL7NAME")=$$HL7^XUSER(IEN)
. I $D(^VA(200,IEN,2)) S I=0 F S I=$O(^VA(200,IEN,2,I)) Q:I<1 D
. . S USR("DIV",I)=$P($G(^VA(200,IEN,2,I,0)),U) ;Pointer to file 4
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSERP 2088 printed Oct 16, 2024@18:13:13 Page 2
XUSERP ;ISF/RWF,SFVAMC/JC - file 200 Protocol ;06/24/2003 11:43
+1 ;;8.0;KERNEL;**313**;Jul 10, 1995
+2 ;
CALL(XUNP,XUFLG) ;Queue Protocol
+1 ;Call for Kernel Create, Update, Disuser or Terminate events
+2 ;Queue Protocol for user trigger events
+3 ;XUFLG=Action: 1=Add/Create New Entry, 2=Update Existing Entry, 3=Terminate
+4 ;XUNP=input IEN of New Person File entry
+5 if '+$GET(XUNP)
QUIT
+6 NEW ZTSAVE,ZTRTN,ZTDTH,ZTDESC,ZTIO
+7 SET ZTRTN="DEQUE^XUSERP("_XUNP_","_XUFLG_")"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+8 SET ZTDESC="User "_$PIECE("add^change^terminate","^",XUFLG)_" event protocol"
+9 DO ^ZTLOAD
+10 QUIT
+11 ;
DEQUE(XUNP,XUFLG) ;Run Protocol
+1 ;Call for Kernel Create, Update, Disuser or Terminate events
+2 ;Call Protocol for user trigger events
+3 ;XUFLG=Action: 1=Add/Create New Entry, 2=Update Existing Entry, 3=Terminate
+4 ;XUNP=input IEN of New Person File entry
+5 if '+$GET(XUNP)
QUIT
+6 NEW XUDA,DIC,DIE,N,X,XUSR,XUIEN,XUIFN,$ESTACK,$ETRAP
+7 SET XUFLG=$GET(XUFLG)
IF XUFLG<1!(XUFLG>3)
SET XUFLG=2
+8 SET $ETRAP="D ^%ZTER,UNWIND^%ZTER"
+9 SET N=$PIECE("XU USER ADD^XU USER CHANGE^XU USER TERMINATE","^",XUFLG)
+10 SET X=+$ORDER(^DIC(19,"B",N,0))_";DIC(19,"
+11 ;XUIFN is used in the Terminate protocol.
+12 IF XUFLG=3
SET XUIFN=XUNP
+13 ;XUIEN and XUSR are user in the protocol.
+14 SET XUIEN=XUNP
DO EN^XQOR
+15 QUIT
+16 ;
GET(IEN,USR) ;Return file 200 data
+1 ;Protocol XU USER ADD, XU USER CHANGE, XU USER TERMINATE
+2 IF '$LENGTH($GET(IEN))
SET USR="0-ERROR"
+3 NEW XUSR0,XUSR1
+4 IF $DATA(^VA(200,IEN))
Begin DoDot:1
+5 SET XUSR0=$GET(^VA(200,IEN,0))
+6 SET XUSR1=$GET(^VA(200,IEN,.1))
+7 SET USR("NAME")=$PIECE(XUSR0,U)
+8 SET USR("INITIAL")=$PIECE(XUSR0,U,2)
+9 SET USR("ACCESS CODE")=$PIECE(XUSR0,U,3)
+10 SET USR("FILE MANAGER ACCESS CODE")=$PIECE(XUSR0,U,4)
+11 SET USR("DISUSER")=$PIECE(XUSR0,U,7)
+12 SET USR("TERMINATION DATE")=$PIECE(XUSR0,U,11)
+13 SET USR("DATE VERIFY CODE LAST CHANGED")=$PIECE(XUSR1,U)
+14 SET USR("VERIFY CODE")=$PIECE(XUSR1,U,2)
+15 SET USR("NICKNAME")=$PIECE(XUSR1,U,4)
+16 SET USR("SSN")=$PIECE(^VA(200,IEN,1),U,9)
+17 SET USR("EML")=$PIECE($GET(^VA(200,IEN,.15)),U)
+18 SET USR("HL7NAME")=$$HL7^XUSER(IEN)
+19 IF $DATA(^VA(200,IEN,2))
SET I=0
FOR
SET I=$ORDER(^VA(200,IEN,2,I))
if I<1
QUIT
Begin DoDot:2
+20 ;Pointer to file 4
SET USR("DIV",I)=$PIECE($GET(^VA(200,IEN,2,I,0)),U)
End DoDot:2
End DoDot:1
+21 QUIT
