XUSERP.m

XUSERP ;ISF/RWF,SFVAMC/JC - file 200 Protocol ;06/24/2003  11:43 [ 07/29/2004   9:01 AM ]

 ;;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

XUSERP    ;ISF/RWF,SFVAMC/JC - file 200 Protocol ;06/24/2003  11:43 [ 07/29/2004   9:01 AM ]

 +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