- 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 Feb 18, 2025@23:38:51 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