Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUSERP

XUSERP.m

Go to the documentation of this file.
  1. XUSERP ;ISF/RWF,SFVAMC/JC - file 200 Protocol ;06/24/2003 11:43
  1. ;;8.0;KERNEL;**313**;Jul 10, 1995
  1. ;
  1. CALL(XUNP,XUFLG) ;Queue Protocol
  1. ;Call for Kernel Create, Update, Disuser or Terminate events
  1. ;Queue Protocol for user trigger events
  1. ;XUFLG=Action: 1=Add/Create New Entry, 2=Update Existing Entry, 3=Terminate
  1. ;XUNP=input IEN of New Person File entry
  1. Q:'+$G(XUNP)
  1. N ZTSAVE,ZTRTN,ZTDTH,ZTDESC,ZTIO
  1. S ZTRTN="DEQUE^XUSERP("_XUNP_","_XUFLG_")",ZTDTH=$H,ZTIO=""
  1. S ZTDESC="User "_$P("add^change^terminate","^",XUFLG)_" event protocol"
  1. D ^ZTLOAD
  1. Q
  1. ;
  1. DEQUE(XUNP,XUFLG) ;Run Protocol
  1. ;Call for Kernel Create, Update, Disuser or Terminate events
  1. ;Call Protocol for user trigger events
  1. ;XUFLG=Action: 1=Add/Create New Entry, 2=Update Existing Entry, 3=Terminate
  1. ;XUNP=input IEN of New Person File entry
  1. Q:'+$G(XUNP)
  1. N XUDA,DIC,DIE,N,X,XUSR,XUIEN,XUIFN,$ES,$ET
  1. S XUFLG=$G(XUFLG) I XUFLG<1!(XUFLG>3) S XUFLG=2
  1. S $ETRAP="D ^%ZTER,UNWIND^%ZTER"
  1. S N=$P("XU USER ADD^XU USER CHANGE^XU USER TERMINATE","^",XUFLG)
  1. S X=+$O(^DIC(19,"B",N,0))_";DIC(19,"
  1. ;XUIFN is used in the Terminate protocol.
  1. I XUFLG=3 S XUIFN=XUNP
  1. ;XUIEN and XUSR are user in the protocol.
  1. S XUIEN=XUNP D EN^XQOR
  1. Q
  1. ;
  1. GET(IEN,USR) ;Return file 200 data
  1. ;Protocol XU USER ADD, XU USER CHANGE, XU USER TERMINATE
  1. I '$L($G(IEN)) S USR="0-ERROR"
  1. N XUSR0,XUSR1
  1. I $D(^VA(200,IEN)) D
  1. . S XUSR0=$G(^VA(200,IEN,0))
  1. . S XUSR1=$G(^VA(200,IEN,.1))
  1. . S USR("NAME")=$P(XUSR0,U)
  1. . S USR("INITIAL")=$P(XUSR0,U,2)
  1. . S USR("ACCESS CODE")=$P(XUSR0,U,3)
  1. . S USR("FILE MANAGER ACCESS CODE")=$P(XUSR0,U,4)
  1. . S USR("DISUSER")=$P(XUSR0,U,7)
  1. . S USR("TERMINATION DATE")=$P(XUSR0,U,11)
  1. . S USR("DATE VERIFY CODE LAST CHANGED")=$P(XUSR1,U)
  1. . S USR("VERIFY CODE")=$P(XUSR1,U,2)
  1. . S USR("NICKNAME")=$P(XUSR1,U,4)
  1. . S USR("SSN")=$P(^VA(200,IEN,1),U,9)
  1. . S USR("EML")=$P($G(^VA(200,IEN,.15)),U)
  1. . S USR("HL7NAME")=$$HL7^XUSER(IEN)
  1. . I $D(^VA(200,IEN,2)) S I=0 F S I=$O(^VA(200,IEN,2,I)) Q:I<1 D
  1. . . S USR("DIV",I)=$P($G(^VA(200,IEN,2,I,0)),U) ;Pointer to file 4
  1. Q