BEHOXQ ;MSC/IND/DKM - Notification Support ;19-Nov-2013 16:57;PLS
;;1.1;BEH COMPONENTS;**002003,002004,002006,002007**;Mar 20, 2007;Build 1
;=================================================================
; RPC: Get alerts for user
; DFN = If specified, limit alerts to only that patient
; ST = If specified, starting date/time for alert retrieval
; Return format is:
; Priority^Info Only^Patient Name^Pt Location^Display Text^Date Delivered^Sender Name^DFN^Alert Type^Alert ID^Can Delete^Extra Info
ALRLIST(DATA,DFN,ST) ;EP
N ALX,TOT,ALL,TMP,FN,NOW,QUALS,X,X3
D SETVAR^CIANBUTL("DFN",$G(DFN),"BEHOXQ")
S ALL='$L($G(DFN)),DFN=+$G(DFN),(ALX,TOT)=0,TMP=$$TMPGBL^CIAVMRPC,FN=90460.021,NOW=$$NOW^XLFDT,ST=+$G(ST)
D:'ST CLRVAR^CIANBUTL("BEHOXQ.AID")
D FIXXQA(DUZ)
F S ALX=$O(^BEHOXQ(FN,ALX)) Q:'ALX X $G(^(ALX,4))
S ALX=0
F S ST=$O(^XTV(8992,DUZ,"XQA",ST)) Q:'ST S X=$G(^(ST,0)),X3=$G(^(3)) D:$L(X)
.S ALX=ALX+1,@TMP@(ALX)=$S(X3'="":"G ",$P(X,U,7,8)="^ ":"I ",1:" ")_$P(X,U,3)_U_$P(X,U,2)_U_$P(X,U)_U_$P(X,U,10)
S ALX=0
F S ALX=$O(@TMP@(ALX)) Q:'ALX D
.N ALR,ALY,ALD,ALW,ALS,AID,ALT,DFN2,INF,DEL,LOC
.S ALD=$G(@TMP@(ALX)),AID=$P(ALD,U,2),ALY=$$ALRIEN(AID),ALW=$P(ALD,U,3),DEL=''$P(ALD,U,4)
.Q:'ALY
.X $G(^BEHOXQ(FN,ALY,2))
.S ALT=$P(^BEHOXQ(FN,ALY,0),U),DFN2=+$G(ALR("DFN")),INF=''$G(ALR("INF"))
.S:INF DEL=1
.;I DFN2,'$$ISACTIVE^BEHOPTCX(DFN2,.QUALS) Q ;P7
.I 'ALL,DFN2,DFN'=DFN2 Q
.S TOT=TOT+1,ALD=$E($P(ALD,U),4,999)
.S:ALD["): " ALD=$P(ALD,"): ",2,99)
.S ALR("TYP")=ALT_$S($L($G(ALR("TYP"))):"."_ALR("TYP"),1:"")
.S X=+$O(^XTV(8992.1,"B",AID,0)),X3=$G(^XTV(8992.1,X,20,+$O(^XTV(8992.1,X,20,"B",DUZ,$C(1)),-1),0)),ALS=+$P(X3,U,7)
.I ALS S ALW=$P(X3,U,8) ; Alert was forwarded
.E S ALS=$P($G(^XTV(8992.1,X,0)),U,5)
.S ALS=$$GET1^DIQ(200,+ALS,.01)
.S X=$P($G(^DPT(DFN2,0)),U),X3=$$HRN^BEHOPTCX(DFN2)
.;Added Patient Location (Room/Bed)
.S LOC=$G(^DPT(DFN2,.1))_" "_$G(^DPT(DFN2,.101))
.S:$L(X3) X=X_" ("_X3_")"
.S @DATA@(DFN2,TOT)=$G(ALR("PRI"),2)_U_INF_U_X_U_LOC_U_ALD_U_ALW_U_ALS_U_DFN2_U_ALR("TYP")_U_AID_U_DEL_U_$G(ALR("XTR"))
.D SETVAR^CIANBUTL(AID,1,"BEHOXQ.AID")
D SETVAR^CIANBUTL("START",NOW,"BEHOXQ")
K @TMP
Q
; RPC: Retrieve comment and message text associated with an alert.
ALRMSG(DATA,AID) ;EP
N CMT
I $$TEST^CIAUOS("XQALGUI") D
.N FNC
.S FNC("XQAID")=AID,FNC("LOC")="GETLONG"
.D ENTRY^XQALGUI(.DATA,.FNC)
S CMT=$P($G(^XTV(8992,DUZ,"XQA",$$XTVIEN(AID),2)),U,3)
S:$L(CMT) @DATA@(-2)=CMT,@DATA@(-1)=""
Q
; RPC: Forward an alert
FORWARD(DATA,AID,USR,CMT) ;EP
D FORWARD^XQALFWD(.AID,.USR,"A",$G(CMT))
S DATA=0
Q
; Check for new and deleted alerts
ALRCHECK N ST,TMP,X,Y
S ST=$$GETVAR^CIANBUTL("START",0,"BEHOXQ"),TMP=$$TMPGBL^CIAVMRPC(1),X=""
D ALRLIST(TMP,$$GETVAR^CIANBUTL("DFN",,"BEHOXQ"),ST)
F S X=$O(@TMP@(X)),Y=0 Q:'$L(X) D
.F S Y=$O(@TMP@(X,Y)) Q:'Y D
..D QUEUE^CIANBEVT("ALERT.ADD",@TMP@(X,Y))
K @TMP
F S X=$O(^XTMP("CIA",CIA("UID"),"V","BEHOXQ.AID",X)) Q:'$L(X) D
.Q:$D(^XTV(8992,"AXQA",X))
.D QUEUE^CIANBEVT("ALERT.DELETE",X),SETVAR^CIANBUTL(X,,"BEHOXQ.AID")
Q
; RPC: Alert post processing
ALRPP(DATA,AID) ;EP
S DATA=$$ALRIEN(AID)
X:DATA $G(^BEHOXQ(90460.021,DATA,3))
Q
; Return IEN of alert handler
ALRIEN(AID) ;
N ALY,FN,IEN
S (ALY,IEN)=0,FN=90460.021
F S ALY=$O(^BEHOXQ(FN,ALY)) Q:'ALY D Q:IEN
.I 0
.X $G(^BEHOXQ(FN,ALY,1))
.I S IEN=ALY
Q IEN
; Return IEN of alert in ALERT file
XTVIEN(AID) ;
Q +$O(^XTV(8992,"AXQA",AID,DUZ,$C(1)),-1)
; Parse an order alert
ORPARSE(AID,ALR) ;
N ORN,PRI
S ORN=$P($P(AID,";"),",",3)
D URGENCY^ORQORB(.PRI,ORN)
S ALR("INF")=$P($G(^ORD(100.9,ORN,0)),U,6,7)="INFODEL^ORB3FUP2"
S ALR("DFN")=+$P(AID,",",2),ALR("TYP")=+$P($P(AID,";"),",",3),ALR("PRI")=$S(PRI>0:PRI,1:2)
Q
; Parse a TIU alert
TIUPARSE(AID,ALR) ;
N X
D GETALRT^TIUSRVR(.X,AID)
S ALR("XTR")=$P(X,U,3),ALR("TYP")=+ALR("XTR"),ALR("DFN")=+$P(X,U,2),ALR("PRI")=2
S ALR("XTR")=ALR("XTR")_U_"VSIT="_$P($G(^TIU(8925,+X,0)),U,3)
Q
; Parse a BEH alert
BEHPARSE(AID,ALR) ;EP
N XQAID,XQADATA,XQAROU,XQAOPT,X,Y,Z
D GETACT^XQALERT(AID)
S ALR("INF")=XQAROU="^ ",ALR("XTR")=XQADATA
F Z=1:1:$L(XQADATA,U) D
.S X=$P(XQADATA,U,Z),Y=$P(X,"=",2,999),X=$P(X,"=")
.S:$L(X) ALR(X)=Y
Q
; Delete a BEH alert
BEHDEL(XQAID,XQAKILL) ;EP
N XQAFOUND
D DELETE^XQALERT
Q:$Q +$G(XQAFOUND)
Q
; RPC: Schedule an alert
SCHALR(DATA,DAT,ID,SBJ,XTR,MSG,RCP) ;EP
N FDA,ERR,SUB,X,Y
S FDA=$NA(FDA(90460.022,"+1,"))
S @FDA@(.01)=DAT
S @FDA@(1)=ID
S @FDA@(2)="`"_DUZ
S @FDA@(5)=$G(SBJ)
S @FDA@(6)=$G(XTR)
S:$D(MSG)>1 @FDA@(20)="MSG"
S:'$D(RCP) RCP=DUZ
S:$G(RCP) RCP(-1)=RCP
S X="",Y=2
F S X=$O(RCP(X)) Q:'$L(X) D
.S RCP=RCP(X),RCP=$S('RCP:"",RCP<0:"G.`"_-RCP,1:"U.`"_RCP)
.S:$L(RCP) FDA(90460.0221,"+"_Y_",+1,",.01)=RCP,Y=Y+1
D UPDATE^DIE("UE","FDA",,"ERR")
S DATA='$D(ERR),SUB("DUZ",DUZ)=""
D:DATA BRDCAST^CIANBEVT("ALERT.SCHEDULE.ADD","",.SUB)
Q
; Check for scheduled alerts
SCHCHECK N DAT,NOW,IEN,FN
S DAT=0,NOW=$$NOW^XLFDT,FN=90460.022
F S DAT=$O(^BEHOXQ(FN,"B",DAT)),IEN=0 Q:'DAT!(DAT>NOW) D
.F S IEN=$O(^BEHOXQ(FN,"B",DAT,IEN)) Q:'IEN D
..L +^BEHOXQ(FN,IEN):0
..E Q
..N X,XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLG,XQAARCH,XQASURO,XQASUPV,XQATEXT,DUZ,RCP
..S X=$G(^BEHOXQ(FN,IEN,0)),XQAMSG=$G(^(5)),XQADATA=$G(^(6)),XQAID=$P(X,U,2),DUZ=$P(X,U,3),XQATEXT=$NA(^(20)),RCP="",DUZ(2)=+$$GETDIV(DUZ) ;IHSDIV^XUS1(DUZ)
..I $$PATCH^XPDUTL("XU*8.0*285") D
...N TMP S TMP=XQATEXT
...K XQATEXT
...M XQATEXT=@TMP
..F S RCP=$O(^BEHOXQ(FN,IEN,10,"B",RCP)) Q:'$L(RCP) D
...I RCP[";VA(200," S XQA(+RCP)=""
...E S XQA("G."_$$GET1^DIQ(3.8,+RCP,.01))=""
..D SETUP^XQALERT,SCHDEL(,IEN)
..L -^BEHOXQ(FN,IEN)
Q
; RPC: Delete a scheduled alert
; DATA = True if entry deleted
SCHDEL(DATA,IEN) ;EP
N FN,SUB
S FN=90460.022,DATA=0,SUB("DUZ",+$P($G(^BEHOXQ(FN,IEN,0)),U,3))=""
L +^BEHOXQ(FN,IEN):0
E Q
D DIK(90460.022,IEN)
L -^BEHOXQ(FN,IEN)
S DATA='$D(^BEHOXQ(FN,IEN))
D:DATA BRDCAST^CIANBEVT("ALERT.SCHEDULE.DELETE",IEN,.SUB)
Q
; RPC: List alerts scheduled by user.
; ID = Alert ID
; USR = IEN of user (defaults to current)
; Return format is: IEN^Date^Patient Name^Subject^Data
SCHLIST(DATA,ID,USR) ;EP
N X,IEN,CNT,DAT,DFN,SBJ,XTR
S:'$G(USR) USR=DUZ
S (IEN,CNT)=0
F S IEN=$O(^BEHOXQ(90460.022,"C",USR,IEN)) Q:'IEN D
.S X=$G(^BEHOXQ(90460.022,IEN,0)),SBJ=$G(^(5)),XTR=$G(^(6))
.Q:$P(X,U,2)'=ID
.S DAT=+X,DFN=+$P(U_XTR,"^DFN=",2),CNT=CNT+1
.S @DATA@(CNT)=IEN_U_DAT_U_$P($G(^DPT(DFN,0)),U)_U_SBJ_U_XTR
Q
; RPC: Return list of recipients
SCHRECIP(DATA,IEN) ;EP
N RCP,CNT,X
S RCP="",CNT=0
F S RCP=$O(^BEHOXQ(90460.022,IEN,10,"B",RCP)) Q:'$L(RCP) D
.I RCP[";VA(200," S X=+RCP_U_$$GET1^DIQ(200,+RCP,.01)
.E S X=-RCP_U_"G."_$$GET1^DIQ(3.8,+RCP,.01)
.S CNT=CNT+1,@DATA@(CNT)=X
Q
; RPC: Return message text associated with a scheduled alert.
SCHMSG(DATA,IEN) ;EP
M @DATA=^BEHOXQ(90460.022,IEN,20)
K @DATA@(0)
Q
; Delete a file entry
DIK(DIK,DA) ;EP
S:DIK=+DIK DIK=$$ROOT^DILFD(DIK)
D ^DIK
Q
; Return true if notification type is enabled
; ORN = IEN in OE/RR NOTIFICATION file
; USR = Potential recipient of notification
ENABLED(ORN,USR) ;EP
Q:'ORN 1
Q:'$D(^ORD(100.9,ORN,0)) 1
;IHS/MSC/PLS - 11/19/2013
;I $$PATCH^XPDUTL("OR*3.0*220") Q:$$GET^XPAR($$ENTITY^ORB31(ORN),"ORB SYSTEM ENABLE/DISABLE",1,"I")="D" 0
;E Q:$$GET^XPAR($$ENTITY^ORB31(ORN,USR),"ORB SYSTEM ENABLE/DISABLE",1,"I")="D" 0
Q:$$GET^XPAR("DIV^SYS^PKG","ORB SYSTEM ENABLE/DISABLE",1,"I")="D" 0
Q $$GET^XPAR($$ENT^CIAVMRPC("ORB PROCESSING FLAG",,USR),"ORB PROCESSING FLAG",ORN)'="D"
; Fix XQA node in Alert File for user
FIXXQA(USER) ;
I $D(^XTV(8992,USER,"XQA",0))#2,'$P(^(0),U,2) S $P(^(0),U,2)="8992.01DA"
Q
; Return mail group IEN if user is a member of the specified mail group
; or indirectly through a member mail group.
ISMBR(MGRP,USER,EXCL) ;PEP - See comment above
S USER=$G(USER,DUZ)
S:MGRP'=+MGRP MGRP=$O(^XMB(3.8,"B",MGRP,0))
Q:'MGRP 0
Q:$D(EXCL(MGRP)) 0
Q:$D(^XMB(3.8,MGRP,1,"B",USER)) MGRP
N GRP
S EXCL(MGRP)="",GRP=0
F S GRP=$O(^XMB(3.8,MGRP,5,"B",GRP)) Q:'GRP Q:$$ISMBR(GRP,USER,.EXCL)
Q +GRP
GETDIV(USR) ;EP
Q:$G(DUZ("AG"))="I" $$IHSDIV^XUS1(USR)
N X
; Default Division in file 200, "AX1" x-ref
S X=+$O(^VA(200,USR,2,"AX1",1,0))
; If only one division get that one
I 'X D
.S X=+$O(^VA(200,USR,2,0))
.S:$O(^VA(200,USR,2,X)) X=0
Q X
CANCHGPT(DATA,DFN) ; EP-
S DATA=$$ISACTIVE^BEHOPTCX(DFN)
Q
BEHOXQ ;MSC/IND/DKM - Notification Support ;19-Nov-2013 16:57;PLS
+1 ;;1.1;BEH COMPONENTS;**002003,002004,002006,002007**;Mar 20, 2007;Build 1
+2 ;=================================================================
+3 ; RPC: Get alerts for user
+4 ; DFN = If specified, limit alerts to only that patient
+5 ; ST = If specified, starting date/time for alert retrieval
+6 ; Return format is:
+7 ; Priority^Info Only^Patient Name^Pt Location^Display Text^Date Delivered^Sender Name^DFN^Alert Type^Alert ID^Can Delete^Extra Info
ALRLIST(DATA,DFN,ST) ;EP
+1 NEW ALX,TOT,ALL,TMP,FN,NOW,QUALS,X,X3
+2 DO SETVAR^CIANBUTL("DFN",$GET(DFN),"BEHOXQ")
+3 SET ALL='$LENGTH($GET(DFN))
SET DFN=+$GET(DFN)
SET (ALX,TOT)=0
SET TMP=$$TMPGBL^CIAVMRPC
SET FN=90460.021
SET NOW=$$NOW^XLFDT
SET ST=+$GET(ST)
+4 IF 'ST
DO CLRVAR^CIANBUTL("BEHOXQ.AID")
+5 DO FIXXQA(DUZ)
+6 FOR
SET ALX=$ORDER(^BEHOXQ(FN,ALX))
IF 'ALX
QUIT
XECUTE $GET(^(ALX,4))
+7 SET ALX=0
+8 FOR
SET ST=$ORDER(^XTV(8992,DUZ,"XQA",ST))
IF 'ST
QUIT
SET X=$GET(^(ST,0))
SET X3=$GET(^(3))
IF $LENGTH(X)
Begin DoDot:1
+9 SET ALX=ALX+1
SET @TMP@(ALX)=$SELECT(X3'="":"G ",$PIECE(X,U,7,8)="^ ":"I ",1:" ")_$PIECE(X,U,3)_U_$PIECE(X,U,2)_U_$PIECE(X,U)_U_$PIECE(X,U,10)
End DoDot:1
+10 SET ALX=0
+11 FOR
SET ALX=$ORDER(@TMP@(ALX))
IF 'ALX
QUIT
Begin DoDot:1
+12 NEW ALR,ALY,ALD,ALW,ALS,AID,ALT,DFN2,INF,DEL,LOC
+13 SET ALD=$GET(@TMP@(ALX))
SET AID=$PIECE(ALD,U,2)
SET ALY=$$ALRIEN(AID)
SET ALW=$PIECE(ALD,U,3)
SET DEL=''$PIECE(ALD,U,4)
+14 IF 'ALY
QUIT
+15 XECUTE $GET(^BEHOXQ(FN,ALY,2))
+16 SET ALT=$PIECE(^BEHOXQ(FN,ALY,0),U)
SET DFN2=+$GET(ALR("DFN"))
SET INF=''$GET(ALR("INF"))
+17 IF INF
SET DEL=1
+18 ;I DFN2,'$$ISACTIVE^BEHOPTCX(DFN2,.QUALS) Q ;P7
+19 IF 'ALL
IF DFN2
IF DFN'=DFN2
QUIT
+20 SET TOT=TOT+1
SET ALD=$EXTRACT($PIECE(ALD,U),4,999)
+21 IF ALD[")
SET ALD=$PIECE(ALD,"): ",2,99)
+22 SET ALR("TYP")=ALT_$SELECT($LENGTH($GET(ALR("TYP"))):"."_ALR("TYP"),1:"")
+23 SET X=+$ORDER(^XTV(8992.1,"B",AID,0))
SET X3=$GET(^XTV(8992.1,X,20,+$ORDER(^XTV(8992.1,X,20,"B",DUZ,$CHAR(1)),-1),0))
SET ALS=+$PIECE(X3,U,7)
+24 ; Alert was forwarded
IF ALS
SET ALW=$PIECE(X3,U,8)
+25 IF '$TEST
SET ALS=$PIECE($GET(^XTV(8992.1,X,0)),U,5)
+26 SET ALS=$$GET1^DIQ(200,+ALS,.01)
+27 SET X=$PIECE($GET(^DPT(DFN2,0)),U)
SET X3=$$HRN^BEHOPTCX(DFN2)
+28 ;Added Patient Location (Room/Bed)
+29 SET LOC=$GET(^DPT(DFN2,.1))_" "_$GET(^DPT(DFN2,.101))
+30 IF $LENGTH(X3)
SET X=X_" ("_X3_")"
+31 SET @DATA@(DFN2,TOT)=$GET(ALR("PRI"),2)_U_INF_U_X_U_LOC_U_ALD_U_ALW_U_ALS_U_DFN2_U_ALR("TYP")_U_AID_U_DEL_U_$GET(ALR("XTR"))
+32 DO SETVAR^CIANBUTL(AID,1,"BEHOXQ.AID")
End DoDot:1
+33 DO SETVAR^CIANBUTL("START",NOW,"BEHOXQ")
+34 KILL @TMP
+35 QUIT
+36 ; RPC: Retrieve comment and message text associated with an alert.
ALRMSG(DATA,AID) ;EP
+1 NEW CMT
+2 IF $$TEST^CIAUOS("XQALGUI")
Begin DoDot:1
+3 NEW FNC
+4 SET FNC("XQAID")=AID
SET FNC("LOC")="GETLONG"
+5 DO ENTRY^XQALGUI(.DATA,.FNC)
End DoDot:1
+6 SET CMT=$PIECE($GET(^XTV(8992,DUZ,"XQA",$$XTVIEN(AID),2)),U,3)
+7 IF $LENGTH(CMT)
SET @DATA@(-2)=CMT
SET @DATA@(-1)=""
+8 QUIT
+9 ; RPC: Forward an alert
FORWARD(DATA,AID,USR,CMT) ;EP
+1 DO FORWARD^XQALFWD(.AID,.USR,"A",$GET(CMT))
+2 SET DATA=0
+3 QUIT
+4 ; Check for new and deleted alerts
ALRCHECK NEW ST,TMP,X,Y
+1 SET ST=$$GETVAR^CIANBUTL("START",0,"BEHOXQ")
SET TMP=$$TMPGBL^CIAVMRPC(1)
SET X=""
+2 DO ALRLIST(TMP,$$GETVAR^CIANBUTL("DFN",,"BEHOXQ"),ST)
+3 FOR
SET X=$ORDER(@TMP@(X))
SET Y=0
IF '$LENGTH(X)
QUIT
Begin DoDot:1
+4 FOR
SET Y=$ORDER(@TMP@(X,Y))
IF 'Y
QUIT
Begin DoDot:2
+5 DO QUEUE^CIANBEVT("ALERT.ADD",@TMP@(X,Y))
End DoDot:2
End DoDot:1
+6 KILL @TMP
+7 FOR
SET X=$ORDER(^XTMP("CIA",CIA("UID"),"V","BEHOXQ.AID",X))
IF '$LENGTH(X)
QUIT
Begin DoDot:1
+8 IF $DATA(^XTV(8992,"AXQA",X))
QUIT
+9 DO QUEUE^CIANBEVT("ALERT.DELETE",X)
DO SETVAR^CIANBUTL(X,,"BEHOXQ.AID")
End DoDot:1
+10 QUIT
+11 ; RPC: Alert post processing
ALRPP(DATA,AID) ;EP
+1 SET DATA=$$ALRIEN(AID)
+2 IF DATA
XECUTE $GET(^BEHOXQ(90460.021,DATA,3))
+3 QUIT
+4 ; Return IEN of alert handler
ALRIEN(AID) ;
+1 NEW ALY,FN,IEN
+2 SET (ALY,IEN)=0
SET FN=90460.021
+3 FOR
SET ALY=$ORDER(^BEHOXQ(FN,ALY))
IF 'ALY
QUIT
Begin DoDot:1
+4 IF 0
+5 XECUTE $GET(^BEHOXQ(FN,ALY,1))
+6 IF $TEST
SET IEN=ALY
End DoDot:1
IF IEN
QUIT
+7 QUIT IEN
+8 ; Return IEN of alert in ALERT file
XTVIEN(AID) ;
+1 QUIT +$ORDER(^XTV(8992,"AXQA",AID,DUZ,$CHAR(1)),-1)
+2 ; Parse an order alert
ORPARSE(AID,ALR) ;
+1 NEW ORN,PRI
+2 SET ORN=$PIECE($PIECE(AID,";"),",",3)
+3 DO URGENCY^ORQORB(.PRI,ORN)
+4 SET ALR("INF")=$PIECE($GET(^ORD(100.9,ORN,0)),U,6,7)="INFODEL^ORB3FUP2"
+5 SET ALR("DFN")=+$PIECE(AID,",",2)
SET ALR("TYP")=+$PIECE($PIECE(AID,";"),",",3)
SET ALR("PRI")=$SELECT(PRI>0:PRI,1:2)
+6 QUIT
+7 ; Parse a TIU alert
TIUPARSE(AID,ALR) ;
+1 NEW X
+2 DO GETALRT^TIUSRVR(.X,AID)
+3 SET ALR("XTR")=$PIECE(X,U,3)
SET ALR("TYP")=+ALR("XTR")
SET ALR("DFN")=+$PIECE(X,U,2)
SET ALR("PRI")=2
+4 SET ALR("XTR")=ALR("XTR")_U_"VSIT="_$PIECE($GET(^TIU(8925,+X,0)),U,3)
+5 QUIT
+6 ; Parse a BEH alert
BEHPARSE(AID,ALR) ;EP
+1 NEW XQAID,XQADATA,XQAROU,XQAOPT,X,Y,Z
+2 DO GETACT^XQALERT(AID)
+3 SET ALR("INF")=XQAROU="^ "
SET ALR("XTR")=XQADATA
+4 FOR Z=1:1:$LENGTH(XQADATA,U)
Begin DoDot:1
+5 SET X=$PIECE(XQADATA,U,Z)
SET Y=$PIECE(X,"=",2,999)
SET X=$PIECE(X,"=")
+6 IF $LENGTH(X)
SET ALR(X)=Y
End DoDot:1
+7 QUIT
+8 ; Delete a BEH alert
BEHDEL(XQAID,XQAKILL) ;EP
+1 NEW XQAFOUND
+2 DO DELETE^XQALERT
+3 IF $QUIT
QUIT +$GET(XQAFOUND)
+4 QUIT
+5 ; RPC: Schedule an alert
SCHALR(DATA,DAT,ID,SBJ,XTR,MSG,RCP) ;EP
+1 NEW FDA,ERR,SUB,X,Y
+2 SET FDA=$NAME(FDA(90460.022,"+1,"))
+3 SET @FDA@(.01)=DAT
+4 SET @FDA@(1)=ID
+5 SET @FDA@(2)="`"_DUZ
+6 SET @FDA@(5)=$GET(SBJ)
+7 SET @FDA@(6)=$GET(XTR)
+8 IF $DATA(MSG)>1
SET @FDA@(20)="MSG"
+9 IF '$DATA(RCP)
SET RCP=DUZ
+10 IF $GET(RCP)
SET RCP(-1)=RCP
+11 SET X=""
SET Y=2
+12 FOR
SET X=$ORDER(RCP(X))
IF '$LENGTH(X)
QUIT
Begin DoDot:1
+13 SET RCP=RCP(X)
SET RCP=$SELECT('RCP:"",RCP<0:"G.`"_-RCP,1:"U.`"_RCP)
+14 IF $LENGTH(RCP)
SET FDA(90460.0221,"+"_Y_",+1,",.01)=RCP
SET Y=Y+1
End DoDot:1
+15 DO UPDATE^DIE("UE","FDA",,"ERR")
+16 SET DATA='$DATA(ERR)
SET SUB("DUZ",DUZ)=""
+17 IF DATA
DO BRDCAST^CIANBEVT("ALERT.SCHEDULE.ADD","",.SUB)
+18 QUIT
+19 ; Check for scheduled alerts
SCHCHECK NEW DAT,NOW,IEN,FN
+1 SET DAT=0
SET NOW=$$NOW^XLFDT
SET FN=90460.022
+2 FOR
SET DAT=$ORDER(^BEHOXQ(FN,"B",DAT))
SET IEN=0
IF 'DAT!(DAT>NOW)
QUIT
Begin DoDot:1
+3 FOR
SET IEN=$ORDER(^BEHOXQ(FN,"B",DAT,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+4 LOCK +^BEHOXQ(FN,IEN):0
+5 IF '$TEST
QUIT
+6 NEW X,XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLG,XQAARCH,XQASURO,XQASUPV,XQATEXT,DUZ,RCP
+7 ;IHSDIV^XUS1(DUZ)
SET X=$GET(^BEHOXQ(FN,IEN,0))
SET XQAMSG=$GET(^(5))
SET XQADATA=$GET(^(6))
SET XQAID=$PIECE(X,U,2)
SET DUZ=$PIECE(X,U,3)
SET XQATEXT=$NAME(^(20))
SET RCP=""
SET DUZ(2)=+$$GETDIV(DUZ)
+8 IF $$PATCH^XPDUTL("XU*8.0*285")
Begin DoDot:3
+9 NEW TMP
SET TMP=XQATEXT
+10 KILL XQATEXT
+11 MERGE XQATEXT=@TMP
End DoDot:3
+12 FOR
SET RCP=$ORDER(^BEHOXQ(FN,IEN,10,"B",RCP))
IF '$LENGTH(RCP)
QUIT
Begin DoDot:3
+13 IF RCP[";VA(200,"
SET XQA(+RCP)=""
+14 IF '$TEST
SET XQA("G."_$$GET1^DIQ(3.8,+RCP,.01))=""
End DoDot:3
+15 DO SETUP^XQALERT
DO SCHDEL(,IEN)
+16 LOCK -^BEHOXQ(FN,IEN)
End DoDot:2
End DoDot:1
+17 QUIT
+18 ; RPC: Delete a scheduled alert
+19 ; DATA = True if entry deleted
SCHDEL(DATA,IEN) ;EP
+1 NEW FN,SUB
+2 SET FN=90460.022
SET DATA=0
SET SUB("DUZ",+$PIECE($GET(^BEHOXQ(FN,IEN,0)),U,3))=""
+3 LOCK +^BEHOXQ(FN,IEN):0
+4 IF '$TEST
QUIT
+5 DO DIK(90460.022,IEN)
+6 LOCK -^BEHOXQ(FN,IEN)
+7 SET DATA='$DATA(^BEHOXQ(FN,IEN))
+8 IF DATA
DO BRDCAST^CIANBEVT("ALERT.SCHEDULE.DELETE",IEN,.SUB)
+9 QUIT
+10 ; RPC: List alerts scheduled by user.
+11 ; ID = Alert ID
+12 ; USR = IEN of user (defaults to current)
+13 ; Return format is: IEN^Date^Patient Name^Subject^Data
SCHLIST(DATA,ID,USR) ;EP
+1 NEW X,IEN,CNT,DAT,DFN,SBJ,XTR
+2 IF '$GET(USR)
SET USR=DUZ
+3 SET (IEN,CNT)=0
+4 FOR
SET IEN=$ORDER(^BEHOXQ(90460.022,"C",USR,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+5 SET X=$GET(^BEHOXQ(90460.022,IEN,0))
SET SBJ=$GET(^(5))
SET XTR=$GET(^(6))
+6 IF $PIECE(X,U,2)'=ID
QUIT
+7 SET DAT=+X
SET DFN=+$PIECE(U_XTR,"^DFN=",2)
SET CNT=CNT+1
+8 SET @DATA@(CNT)=IEN_U_DAT_U_$PIECE($GET(^DPT(DFN,0)),U)_U_SBJ_U_XTR
End DoDot:1
+9 QUIT
+10 ; RPC: Return list of recipients
SCHRECIP(DATA,IEN) ;EP
+1 NEW RCP,CNT,X
+2 SET RCP=""
SET CNT=0
+3 FOR
SET RCP=$ORDER(^BEHOXQ(90460.022,IEN,10,"B",RCP))
IF '$LENGTH(RCP)
QUIT
Begin DoDot:1
+4 IF RCP[";VA(200,"
SET X=+RCP_U_$$GET1^DIQ(200,+RCP,.01)
+5 IF '$TEST
SET X=-RCP_U_"G."_$$GET1^DIQ(3.8,+RCP,.01)
+6 SET CNT=CNT+1
SET @DATA@(CNT)=X
End DoDot:1
+7 QUIT
+8 ; RPC: Return message text associated with a scheduled alert.
SCHMSG(DATA,IEN) ;EP
+1 MERGE @DATA=^BEHOXQ(90460.022,IEN,20)
+2 KILL @DATA@(0)
+3 QUIT
+4 ; Delete a file entry
DIK(DIK,DA) ;EP
+1 IF DIK=+DIK
SET DIK=$$ROOT^DILFD(DIK)
+2 DO ^DIK
+3 QUIT
+4 ; Return true if notification type is enabled
+5 ; ORN = IEN in OE/RR NOTIFICATION file
+6 ; USR = Potential recipient of notification
ENABLED(ORN,USR) ;EP
+1 IF 'ORN
QUIT 1
+2 IF '$DATA(^ORD(100.9,ORN,0))
QUIT 1
+3 ;IHS/MSC/PLS - 11/19/2013
+4 ;I $$PATCH^XPDUTL("OR*3.0*220") Q:$$GET^XPAR($$ENTITY^ORB31(ORN),"ORB SYSTEM ENABLE/DISABLE",1,"I")="D" 0
+5 ;E Q:$$GET^XPAR($$ENTITY^ORB31(ORN,USR),"ORB SYSTEM ENABLE/DISABLE",1,"I")="D" 0
+6 IF $$GET^XPAR("DIV^SYS^PKG","ORB SYSTEM ENABLE/DISABLE",1,"I")="D"
QUIT 0
+7 QUIT $$GET^XPAR($$ENT^CIAVMRPC("ORB PROCESSING FLAG",,USR),"ORB PROCESSING FLAG",ORN)'="D"
+8 ; Fix XQA node in Alert File for user
FIXXQA(USER) ;
+1 IF $DATA(^XTV(8992,USER,"XQA",0))#2
IF '$PIECE(^(0),U,2)
SET $PIECE(^(0),U,2)="8992.01DA"
+2 QUIT
+3 ; Return mail group IEN if user is a member of the specified mail group
+4 ; or indirectly through a member mail group.
ISMBR(MGRP,USER,EXCL) ;PEP - See comment above
+1 SET USER=$GET(USER,DUZ)
+2 IF MGRP'=+MGRP
SET MGRP=$ORDER(^XMB(3.8,"B",MGRP,0))
+3 IF 'MGRP
QUIT 0
+4 IF $DATA(EXCL(MGRP))
QUIT 0
+5 IF $DATA(^XMB(3.8,MGRP,1,"B",USER))
QUIT MGRP
+6 NEW GRP
+7 SET EXCL(MGRP)=""
SET GRP=0
+8 FOR
SET GRP=$ORDER(^XMB(3.8,MGRP,5,"B",GRP))
IF 'GRP
QUIT
IF $$ISMBR(GRP,USER,.EXCL)
QUIT
+9 QUIT +GRP
GETDIV(USR) ;EP
+1 IF $GET(DUZ("AG"))="I"
QUIT $$IHSDIV^XUS1(USR)
+2 NEW X
+3 ; Default Division in file 200, "AX1" x-ref
+4 SET X=+$ORDER(^VA(200,USR,2,"AX1",1,0))
+5 ; If only one division get that one
+6 IF 'X
Begin DoDot:1
+7 SET X=+$ORDER(^VA(200,USR,2,0))
+8 IF $ORDER(^VA(200,USR,2,X))
SET X=0
End DoDot:1
+9 QUIT X
CANCHGPT(DATA,DFN) ; EP-
+1 SET DATA=$$ISACTIVE^BEHOPTCX(DFN)
+2 QUIT
