source: FOIAVistA/trunk/r/CARE_MANAGEMENT-ORRC/ORRCXQ.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1ORRCXQ ;SLC/MKB - Alert utilities for CM ; 25 Jul 2003 9:31 AM
2 ;;1.0;CARE MANAGEMENT;;Jul 15, 2003
3 ;
4USER(ORY,ORDUZ) ; -- Return user's current alerts in @ORY@(PKGID,AID)=DATA
5 ;
6 N ORXQ,X,I,PKGID,AID,TM,DATA
7 S ORDUZ=$G(ORDUZ,DUZ),ORY=$NA(^TMP($J,"ORY")) K @ORY
8 S ORXQ="^TMP($J,""ORXQ"")" D USER^XQALERT(ORXQ,ORDUZ)
9 S I=0 F S I=$O(@ORXQ@(I)) Q:I<1 D
10 . S X=$P(@ORXQ@(I),U,2),PKGID=$P(X,";"),AID=$P(X,";",2,3),TM=$P(X,";",3)
11 . S DATA=$G(^XTV(8992,ORDUZ,"XQA",TM,1)) ;IA#2689
12 . S @ORY@(PKGID,AID)=DATA
13 K @ORXQ
14 Q
15 ;
16PAT(ORY,ORPAT,ORUSR) ; -- Return non-ADT alerts for ORPAT to ORUSR
17 ; in @ORY@(#) = Item=ID^Text^Date in HL7 format
18 ; where ID is "NOT:<XQAID>"
19 ; RPC = ORRC ALERTS BY PATIENT
20 N ORXQ,ORN,I,TEXT,XQAID,DATE,NOT,ACTDT
21 S ORUSR=+$G(ORUSR),ACTDT=$$PARAM^ORRCACK(ORUSR)
22 S ORXQ="^TMP($J,""ORXQ"")" D USER^XQALERT(ORXQ,ORUSR)
23 S ORY=$NA(^TMP($J,"ORRCNOT")),ORN=0 K @ORY
24 S I=0 F S I=$O(@ORXQ@(I)) Q:I<1 D
25 . S TEXT=$P(@ORXQ@(I),U),XQAID=$P(@ORXQ@(I),U,2),DATE=$P(XQAID,";",3)
26 . Q:XQAID'?1"OR,".E I $G(ORPAT) Q:+$P(XQAID,",",2)'=ORPAT
27 . S NOT=+$P(XQAID,",",3) Q:"^18^19^20^35^36^"[(U_NOT_U) ;skip ADT ones
28 . I ACTDT,ACTDT'>DT,$$INCLD(NOT) Q ;skip results ones already included
29 . S ORN=ORN+1,@ORY@(ORN)="Item=NOT:"_XQAID_U_$E(TEXT,23,99)_U_$$FMTHL7^XLFDT(DATE)
30 K @ORXQ
31 Q
32 ;
33INCLD(NIEN) ; -- Order already in Results column?
34 ; [from PAT - uses ORUSR]
35 N X,Y,DATA,NMSP,PKG S X=U_NIEN_U,Y=0
36 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
37 S DATA=$G(^XTV(8992,ORUSR,"XQA",DATE,1)),PKG=$P($P(DATA,"|",2),"@",2)
38 S ORIFN=0 F S ORIFN=$O(^ORA(102.4,"ACK",ORUSR,ORIFN)) Q:ORIFN<1 D Q:Y
39 . S OR0=$G(^OR(100,+ORIFN,0)),PKGIFN=+$G(^(4))
40 . S ORVP=$P(OR0,U,2) Q:+ORVP'=ORPAT
41 . S ORPKG=$$NMSP^ORCD($P(OR0,U,14)) I ORPKG'=NMSP,'(NMSP="X"&(PKG[ORPKG)) Q
42 . S:$$MATCH Y=1
43 Q Y
44 ;
45RSLT(ORDER,ORUSR) ; -- clear alerts for ORDERs results
46 N ORY,ORN,ORIFN,OR0,ORVP,ORPKG,PKGIFN,NIEN,PKGID,AID,DATA
47 D USER(.ORY,ORUSR),ORN ;notifs by pkg
48 S ORIFN=0 F S ORIFN=$O(ORDER(ORIFN)) Q:ORIFN<1 D
49 . S OR0=$G(^OR(100,+ORIFN,0)),PKGIFN=+$G(^(4))
50 . S ORPKG=$$NMSP^ORCD($P(OR0,U,14)) Q:"^LR^RA^GMRC^"'[(U_ORPKG_U)
51 . S ORVP=$P(OR0,U,2),PKGID="OR,"_+ORVP
52 . F S PKGID=$O(@ORY@(PKGID)) Q:$P(PKGID,",",1,2)'=("OR,"_+ORVP) D
53 .. S NIEN=$P(PKGID,",",3) Q:'$D(ORN(ORPKG,NIEN)) ;alert not for ORPKG
54 .. S AID="" F S AID=$O(@ORY@(PKGID,AID)) Q:AID="" D
55 ... S DATA=@ORY@(PKGID,AID) Q:'$$MATCH
56 ... D DELETE(PKGID_";"_AID)
57 K @ORY
58 Q
59 ;
60ORN ; -- List result notifications by pkg in ORN(NMSP,IEN)
61 N X,Y,I,N K ORN
62 F X="LR","RA","GMRC" D
63 . S Y=$S(X="LR":"3^14^24^57^58",X="RA":"21^22^25^53",X="GMRC":"23",1:"")
64 . F I=1:1:$L(Y,U) S N=$P(Y,U,I),ORN(X,N)=""
65 . F I=32,33,44,60 S ORN(X,I)="" ;flagged or stat results, for any pkg
66 Q
67 ;
68MATCH() ; -- Return 1 or 0, if alert matches current order
69 ; Called from RSLT & $$INCLD, so expects those var's to be defined
70 N Y,APKG,ADATA S Y=0
71 S ADATA=$P(DATA,"|"),APKG=$P($P(DATA,"|",2),"@",2)
72 I ORPKG="LR",APKG["LR",+DATA=+ORIFN S Y=1 G MQ
73 I "^32^33^44^60^"[(U_NIEN_U) D G MQ
74 . I ORPKG="RA",APKG["RA",$D(^RADPT("AO",PKGIFN,+ORVP,+$P(ADATA,"~",2),+$P(ADATA,"~",3))) S Y=1 ;IA#2588
75 . I ORPKG="GMRC",APKG["GMRC",PKGIFN=+ADATA S Y=1
76 I ORPKG="RA",$D(^RADPT("AO",PKGIFN,+ORVP,+ADATA,+$P(ADATA,"~",2))) S Y=1 ;IA#2588
77 I ORPKG="GMRC",PKGIFN=+ADATA S Y=1
78MQ Q Y
79 ;
80SIGN(ID) ; -- clear alerts for signatures
81 N ORY,ORNKILL,ORVP,PKGID,AID
82 D USER(.ORY,DUZ) I ID["OR" D G SIGQ
83 . S ORVP=$P($G(^OR(100,+ID,0)),U,2) Q:$O(^OR(100,"AS",ORVP,0))
84 . S PKGID="OR,"_+ORVP_",12",AID=""
85 . F S AID=$O(@ORY@(PKGID,AID)) Q:AID="" S ORNKILL(PKGID_";"_AID)=""
86 I ID["TIU" D G SIGQ
87 . S PKGID="TIU"_+ID,AID=""
88 . F S AID=$O(@ORY@(PKGID,AID)) Q:AID="" S ORNKILL(PKGID_";"_AID)=""
89 . ;ck w/Joel: possible alerts + formats, kill conditions
90SIGQ I $D(ORNKILL) D DELETE
91 K @ORY
92 Q
93 ;
94DELETE(XQAID) ; -- Delete alert XQAID
95 Q:'$L($G(XQAID)) N XQAKILL,ORN
96 S ORN=+$P($P(XQAID,";"),",",3),XQAKILL=$S(ORN:$$XQAKILL^ORB3F1(ORN),1:0)
97 D DELETE^XQALERT ;for DUZ
98 Q
99 ;
100MSGTXT(ID) ; -- Return message text of alert ID
101 N IDX,D0,D1,Y
102 S IDX="^XTV(8992,""AXQA"","""_ID_""")",IDX=$Q(@IDX)
103 S D0=+$P(IDX,",",6),D1=+$P(IDX,",",7)
104 S Y=$P($G(^XTV(8992,D0,"XQA",D1,0)),U,3),Y=$E(Y,20,999)
105 Q Y
106 ;
107MSGDT(ADT,ATXT) ; -- Return event date from alert date and text
108 N I,X,Y,%DT
109 I ATXT?1"Transfer".E S Y=ADT G MDQ ;no date in text
110 S I=$F(ATXT," on "),X="" S:I X=$E(ATXT,I,999)
111 I ATXT?1"Admit".E S I=$F(X," "),X=$E(X,1,I-3) ;strip off ward,rm-bed
112 S:X?2N1"/"2N1" "2N1":"2N X=$TR(X," ","@")
113 S %DT="TS" D ^%DT I Y<0 S Y=ADT
114MDQ Q Y
Note: See TracBrowser for help on using the repository browser.