ORRCXQ ;SLC/MKB - Alert utilities for CM ; 25 Jul 2003 9:31 AM
;;1.0;CARE MANAGEMENT;;Jul 15, 2003
;
USER(ORY,ORDUZ) ; -- Return user's current alerts in @ORY@(PKGID,AID)=DATA
;
N ORXQ,X,I,PKGID,AID,TM,DATA
S ORDUZ=$G(ORDUZ,DUZ),ORY=$NA(^TMP($J,"ORY")) K @ORY
S ORXQ="^TMP($J,""ORXQ"")" D USER^XQALERT(ORXQ,ORDUZ)
S I=0 F S I=$O(@ORXQ@(I)) Q:I<1 D
. S X=$P(@ORXQ@(I),U,2),PKGID=$P(X,";"),AID=$P(X,";",2,3),TM=$P(X,";",3)
. S DATA=$G(^XTV(8992,ORDUZ,"XQA",TM,1)) ;IA#2689
. S @ORY@(PKGID,AID)=DATA
K @ORXQ
Q
;
PAT(ORY,ORPAT,ORUSR) ; -- Return non-ADT alerts for ORPAT to ORUSR
; in @ORY@(#) = Item=ID^Text^Date in HL7 format
; where ID is "NOT:<XQAID>"
; RPC = ORRC ALERTS BY PATIENT
N ORXQ,ORN,I,TEXT,XQAID,DATE,NOT,ACTDT
S ORUSR=+$G(ORUSR),ACTDT=$$PARAM^ORRCACK(ORUSR)
S ORXQ="^TMP($J,""ORXQ"")" D USER^XQALERT(ORXQ,ORUSR)
S ORY=$NA(^TMP($J,"ORRCNOT")),ORN=0 K @ORY
S I=0 F S I=$O(@ORXQ@(I)) Q:I<1 D
. S TEXT=$P(@ORXQ@(I),U),XQAID=$P(@ORXQ@(I),U,2),DATE=$P(XQAID,";",3)
. Q:XQAID'?1"OR,".E I $G(ORPAT) Q:+$P(XQAID,",",2)'=ORPAT
. S NOT=+$P(XQAID,",",3) Q:"^18^19^20^35^36^"[(U_NOT_U) ;skip ADT ones
. I ACTDT,ACTDT'>DT,$$INCLD(NOT) Q ;skip results ones already included
. S ORN=ORN+1,@ORY@(ORN)="Item=NOT:"_XQAID_U_$E(TEXT,23,99)_U_$$FMTHL7^XLFDT(DATE)
K @ORXQ
Q
;
INCLD(NIEN) ; -- Order already in Results column?
; [from PAT - uses ORUSR]
N X,Y,DATA,NMSP,PKG S X=U_NIEN_U,Y=0
S NMSP=$S("^3^14^24^57^58^"[X:"LR","^21^22^25^53^"[X:"RA","^23^"[X:"GMRC","^32^33^44^60^"[X:"X",1:"") I NMSP="" Q 0
S DATA=$G(^XTV(8992,ORUSR,"XQA",DATE,1)),PKG=$P($P(DATA,"|",2),"@",2)
S ORIFN=0 F S ORIFN=$O(^ORA(102.4,"ACK",ORUSR,ORIFN)) Q:ORIFN<1 D Q:Y
. S OR0=$G(^OR(100,+ORIFN,0)),PKGIFN=+$G(^(4))
. S ORVP=$P(OR0,U,2) Q:+ORVP'=ORPAT
. S ORPKG=$$NMSP^ORCD($P(OR0,U,14)) I ORPKG'=NMSP,'(NMSP="X"&(PKG[ORPKG)) Q
. S:$$MATCH Y=1
Q Y
;
RSLT(ORDER,ORUSR) ; -- clear alerts for ORDERs results
N ORY,ORN,ORIFN,OR0,ORVP,ORPKG,PKGIFN,NIEN,PKGID,AID,DATA
D USER(.ORY,ORUSR),ORN ;notifs by pkg
S ORIFN=0 F S ORIFN=$O(ORDER(ORIFN)) Q:ORIFN<1 D
. S OR0=$G(^OR(100,+ORIFN,0)),PKGIFN=+$G(^(4))
. S ORPKG=$$NMSP^ORCD($P(OR0,U,14)) Q:"^LR^RA^GMRC^"'[(U_ORPKG_U)
. S ORVP=$P(OR0,U,2),PKGID="OR,"_+ORVP
. F S PKGID=$O(@ORY@(PKGID)) Q:$P(PKGID,",",1,2)'=("OR,"_+ORVP) D
.. S NIEN=$P(PKGID,",",3) Q:'$D(ORN(ORPKG,NIEN)) ;alert not for ORPKG
.. S AID="" F S AID=$O(@ORY@(PKGID,AID)) Q:AID="" D
... S DATA=@ORY@(PKGID,AID) Q:'$$MATCH
... D DELETE(PKGID_";"_AID)
K @ORY
Q
;
ORN ; -- List result notifications by pkg in ORN(NMSP,IEN)
N X,Y,I,N K ORN
F X="LR","RA","GMRC" D
. S Y=$S(X="LR":"3^14^24^57^58",X="RA":"21^22^25^53",X="GMRC":"23",1:"")
. F I=1:1:$L(Y,U) S N=$P(Y,U,I),ORN(X,N)=""
. F I=32,33,44,60 S ORN(X,I)="" ;flagged or stat results, for any pkg
Q
;
MATCH() ; -- Return 1 or 0, if alert matches current order
; Called from RSLT & $$INCLD, so expects those var's to be defined
N Y,APKG,ADATA S Y=0
S ADATA=$P(DATA,"|"),APKG=$P($P(DATA,"|",2),"@",2)
I ORPKG="LR",APKG["LR",+DATA=+ORIFN S Y=1 G MQ
I "^32^33^44^60^"[(U_NIEN_U) D G MQ
. I ORPKG="RA",APKG["RA",$D(^RADPT("AO",PKGIFN,+ORVP,+$P(ADATA,"~",2),+$P(ADATA,"~",3))) S Y=1 ;IA#2588
. I ORPKG="GMRC",APKG["GMRC",PKGIFN=+ADATA S Y=1
I ORPKG="RA",$D(^RADPT("AO",PKGIFN,+ORVP,+ADATA,+$P(ADATA,"~",2))) S Y=1 ;IA#2588
I ORPKG="GMRC",PKGIFN=+ADATA S Y=1
MQ Q Y
;
SIGN(ID) ; -- clear alerts for signatures
N ORY,ORNKILL,ORVP,PKGID,AID
D USER(.ORY,DUZ) I ID["OR" D G SIGQ
. S ORVP=$P($G(^OR(100,+ID,0)),U,2) Q:$O(^OR(100,"AS",ORVP,0))
. S PKGID="OR,"_+ORVP_",12",AID=""
. F S AID=$O(@ORY@(PKGID,AID)) Q:AID="" S ORNKILL(PKGID_";"_AID)=""
I ID["TIU" D G SIGQ
. S PKGID="TIU"_+ID,AID=""
. F S AID=$O(@ORY@(PKGID,AID)) Q:AID="" S ORNKILL(PKGID_";"_AID)=""
. ;ck w/Joel: possible alerts + formats, kill conditions
SIGQ I $D(ORNKILL) D DELETE
K @ORY
Q
;
DELETE(XQAID) ; -- Delete alert XQAID
Q:'$L($G(XQAID)) N XQAKILL,ORN
S ORN=+$P($P(XQAID,";"),",",3),XQAKILL=$S(ORN:$$XQAKILL^ORB3F1(ORN),1:0)
D DELETE^XQALERT ;for DUZ
Q
;
MSGTXT(ID) ; -- Return message text of alert ID
N IDX,D0,D1,Y
S IDX="^XTV(8992,""AXQA"","""_ID_""")",IDX=$Q(@IDX)
S D0=+$P(IDX,",",6),D1=+$P(IDX,",",7)
S Y=$P($G(^XTV(8992,D0,"XQA",D1,0)),U,3),Y=$E(Y,20,999)
Q Y
;
MSGDT(ADT,ATXT) ; -- Return event date from alert date and text
N I,X,Y,%DT
I ATXT?1"Transfer".E S Y=ADT G MDQ ;no date in text
S I=$F(ATXT," on "),X="" S:I X=$E(ATXT,I,999)
I ATXT?1"Admit".E S I=$F(X," "),X=$E(X,1,I-3) ;strip off ward,rm-bed
S:X?2N1"/"2N1" "2N1":"2N X=$TR(X," ","@")
S %DT="TS" D ^%DT I Y<0 S Y=ADT
MDQ Q Y
ORRCXQ ;SLC/MKB - Alert utilities for CM ; 25 Jul 2003 9:31 AM
+1 ;;1.0;CARE MANAGEMENT;;Jul 15, 2003
+2 ;
USER(ORY,ORDUZ) ; -- Return user's current alerts in @ORY@(PKGID,AID)=DATA
+1 ;
+2 NEW ORXQ,X,I,PKGID,AID,TM,DATA
+3 SET ORDUZ=$GET(ORDUZ,DUZ)
SET ORY=$NAME(^TMP($JOB,"ORY"))
KILL @ORY
+4 SET ORXQ="^TMP($J,""ORXQ"")"
DO USER^XQALERT(ORXQ,ORDUZ)
+5 SET I=0
FOR
SET I=$ORDER(@ORXQ@(I))
IF I<1
QUIT
Begin DoDot:1
+6 SET X=$PIECE(@ORXQ@(I),U,2)
SET PKGID=$PIECE(X,";")
SET AID=$PIECE(X,";",2,3)
SET TM=$PIECE(X,";",3)
+7 ;IA#2689
SET DATA=$GET(^XTV(8992,ORDUZ,"XQA",TM,1))
+8 SET @ORY@(PKGID,AID)=DATA
End DoDot:1
+9 KILL @ORXQ
+10 QUIT
+11 ;
PAT(ORY,ORPAT,ORUSR) ; -- Return non-ADT alerts for ORPAT to ORUSR
+1 ; in @ORY@(#) = Item=ID^Text^Date in HL7 format
+2 ; where ID is "NOT:<XQAID>"
+3 ; RPC = ORRC ALERTS BY PATIENT
+4 NEW ORXQ,ORN,I,TEXT,XQAID,DATE,NOT,ACTDT
+5 SET ORUSR=+$GET(ORUSR)
SET ACTDT=$$PARAM^ORRCACK(ORUSR)
+6 SET ORXQ="^TMP($J,""ORXQ"")"
DO USER^XQALERT(ORXQ,ORUSR)
+7 SET ORY=$NAME(^TMP($JOB,"ORRCNOT"))
SET ORN=0
KILL @ORY
+8 SET I=0
FOR
SET I=$ORDER(@ORXQ@(I))
IF I<1
QUIT
Begin DoDot:1
+9 SET TEXT=$PIECE(@ORXQ@(I),U)
SET XQAID=$PIECE(@ORXQ@(I),U,2)
SET DATE=$PIECE(XQAID,";",3)
+10 IF XQAID'?1"OR,".E
QUIT
IF $GET(ORPAT)
IF +$PIECE(XQAID,",",2)'=ORPAT
QUIT
+11 ;skip ADT ones
SET NOT=+$PIECE(XQAID,",",3)
IF "^18^19^20^35^36^"[(U_NOT_U)
QUIT
+12 ;skip results ones already included
IF ACTDT
IF ACTDT'>DT
IF $$INCLD(NOT)
QUIT
+13 SET ORN=ORN+1
SET @ORY@(ORN)="Item=NOT:"_XQAID_U_$EXTRACT(TEXT,23,99)_U_$$FMTHL7^XLFDT(DATE)
End DoDot:1
+14 KILL @ORXQ
+15 QUIT
+16 ;
INCLD(NIEN) ; -- Order already in Results column?
+1 ; [from PAT - uses ORUSR]
+2 NEW X,Y,DATA,NMSP,PKG
SET X=U_NIEN_U
SET Y=0
+3 SET NMSP=$SELECT("^3^14^24^57^58^"[X:"LR","^21^22^25^53^"[X:"RA","^23^"[X:"GMRC","^32^33^44^60^"[X:"X",1:"")
IF NMSP=""
QUIT 0
+4 SET DATA=$GET(^XTV(8992,ORUSR,"XQA",DATE,1))
SET PKG=$PIECE($PIECE(DATA,"|",2),"@",2)
+5 SET ORIFN=0
FOR
SET ORIFN=$ORDER(^ORA(102.4,"ACK",ORUSR,ORIFN))
IF ORIFN<1
QUIT
Begin DoDot:1
+6 SET OR0=$GET(^OR(100,+ORIFN,0))
SET PKGIFN=+$GET(^(4))
+7 SET ORVP=$PIECE(OR0,U,2)
IF +ORVP'=ORPAT
QUIT
+8 SET ORPKG=$$NMSP^ORCD($PIECE(OR0,U,14))
IF ORPKG'=NMSP
IF '(NMSP="X"&(PKG[ORPKG))
QUIT
+9 IF $$MATCH
SET Y=1
End DoDot:1
IF Y
QUIT
+10 QUIT Y
+11 ;
RSLT(ORDER,ORUSR) ; -- clear alerts for ORDERs results
+1 NEW ORY,ORN,ORIFN,OR0,ORVP,ORPKG,PKGIFN,NIEN,PKGID,AID,DATA
+2 ;notifs by pkg
DO USER(.ORY,ORUSR)
DO ORN
+3 SET ORIFN=0
FOR
SET ORIFN=$ORDER(ORDER(ORIFN))
IF ORIFN<1
QUIT
Begin DoDot:1
+4 SET OR0=$GET(^OR(100,+ORIFN,0))
SET PKGIFN=+$GET(^(4))
+5 SET ORPKG=$$NMSP^ORCD($PIECE(OR0,U,14))
IF "^LR^RA^GMRC^"'[(U_ORPKG_U)
QUIT
+6 SET ORVP=$PIECE(OR0,U,2)
SET PKGID="OR,"_+ORVP
+7 FOR
SET PKGID=$ORDER(@ORY@(PKGID))
IF $PIECE(PKGID,",",1,2)'=("OR,"_+ORVP)
QUIT
Begin DoDot:2
+8 ;alert not for ORPKG
SET NIEN=$PIECE(PKGID,",",3)
IF '$DATA(ORN(ORPKG,NIEN))
QUIT
+9 SET AID=""
FOR
SET AID=$ORDER(@ORY@(PKGID,AID))
IF AID=""
QUIT
Begin DoDot:3
+10 SET DATA=@ORY@(PKGID,AID)
IF '$$MATCH
QUIT
+11 DO DELETE(PKGID_";"_AID)
End DoDot:3
End DoDot:2
End DoDot:1
+12 KILL @ORY
+13 QUIT
+14 ;
ORN ; -- List result notifications by pkg in ORN(NMSP,IEN)
+1 NEW X,Y,I,N
KILL ORN
+2 FOR X="LR","RA","GMRC"
Begin DoDot:1
+3 SET Y=$SELECT(X="LR":"3^14^24^57^58",X="RA":"21^22^25^53",X="GMRC":"23",1:"")
+4 FOR I=1:1:$LENGTH(Y,U)
SET N=$PIECE(Y,U,I)
SET ORN(X,N)=""
+5 ;flagged or stat results, for any pkg
FOR I=32,33,44,60
SET ORN(X,I)=""
End DoDot:1
+6 QUIT
+7 ;
MATCH() ; -- Return 1 or 0, if alert matches current order
+1 ; Called from RSLT & $$INCLD, so expects those var's to be defined
+2 NEW Y,APKG,ADATA
SET Y=0
+3 SET ADATA=$PIECE(DATA,"|")
SET APKG=$PIECE($PIECE(DATA,"|",2),"@",2)
+4 IF ORPKG="LR"
IF APKG["LR"
IF +DATA=+ORIFN
SET Y=1
GOTO MQ
+5 IF "^32^33^44^60^"[(U_NIEN_U)
Begin DoDot:1
+6 ;IA#2588
IF ORPKG="RA"
IF APKG["RA"
IF $DATA(^RADPT("AO",PKGIFN,+ORVP,+$PIECE(ADATA,"~",2),+$PIECE(ADATA,"~",3)))
SET Y=1
+7 IF ORPKG="GMRC"
IF APKG["GMRC"
IF PKGIFN=+ADATA
SET Y=1
End DoDot:1
GOTO MQ
+8 ;IA#2588
IF ORPKG="RA"
IF $DATA(^RADPT("AO",PKGIFN,+ORVP,+ADATA,+$PIECE(ADATA,"~",2)))
SET Y=1
+9 IF ORPKG="GMRC"
IF PKGIFN=+ADATA
SET Y=1
MQ QUIT Y
+1 ;
SIGN(ID) ; -- clear alerts for signatures
+1 NEW ORY,ORNKILL,ORVP,PKGID,AID
+2 DO USER(.ORY,DUZ)
IF ID["OR"
Begin DoDot:1
+3 SET ORVP=$PIECE($GET(^OR(100,+ID,0)),U,2)
IF $ORDER(^OR(100,"AS",ORVP,0))
QUIT
+4 SET PKGID="OR,"_+ORVP_",12"
SET AID=""
+5 FOR
SET AID=$ORDER(@ORY@(PKGID,AID))
IF AID=""
QUIT
SET ORNKILL(PKGID_";"_AID)=""
End DoDot:1
GOTO SIGQ
+6 IF ID["TIU"
Begin DoDot:1
+7 SET PKGID="TIU"_+ID
SET AID=""
+8 FOR
SET AID=$ORDER(@ORY@(PKGID,AID))
IF AID=""
QUIT
SET ORNKILL(PKGID_";"_AID)=""
+9 ;ck w/Joel: possible alerts + formats, kill conditions
End DoDot:1
GOTO SIGQ
SIGQ IF $DATA(ORNKILL)
DO DELETE
+1 KILL @ORY
+2 QUIT
+3 ;
DELETE(XQAID) ; -- Delete alert XQAID
+1 IF '$LENGTH($GET(XQAID))
QUIT
NEW XQAKILL,ORN
+2 SET ORN=+$PIECE($PIECE(XQAID,";"),",",3)
SET XQAKILL=$SELECT(ORN:$$XQAKILL^ORB3F1(ORN),1:0)
+3 ;for DUZ
DO DELETE^XQALERT
+4 QUIT
+5 ;
MSGTXT(ID) ; -- Return message text of alert ID
+1 NEW IDX,D0,D1,Y
+2 SET IDX="^XTV(8992,""AXQA"","""_ID_""")"
SET IDX=$QUERY(@IDX)
+3 SET D0=+$PIECE(IDX,",",6)
SET D1=+$PIECE(IDX,",",7)
+4 SET Y=$PIECE($GET(^XTV(8992,D0,"XQA",D1,0)),U,3)
SET Y=$EXTRACT(Y,20,999)
+5 QUIT Y
+6 ;
MSGDT(ADT,ATXT) ; -- Return event date from alert date and text
+1 NEW I,X,Y,%DT
+2 ;no date in text
IF ATXT?1"Transfer".E
SET Y=ADT
GOTO MDQ
+3 SET I=$FIND(ATXT," on ")
SET X=""
IF I
SET X=$EXTRACT(ATXT,I,999)
+4 ;strip off ward,rm-bed
IF ATXT?1"Admit".E
SET I=$FIND(X," ")
SET X=$EXTRACT(X,1,I-3)
+5 IF X?2N1"/"2N1" "2N1"
SET X=$TRANSLATE(X," ","@")
+6 SET %DT="TS"
DO ^%DT
IF Y<0
SET Y=ADT
MDQ QUIT Y
