source: FOIAVistA/trunk/r/CARE_MANAGEMENT-ORRC/ORRCEVT.m@ 1742

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

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1ORRCEVT ; SLC/MKB,JFR - Event utilities ; 7/5/05 11:15
2 ;;1.0;CARE MANAGEMENT;**2**;Jul 15, 2003
3 ;
4 ; ID = "VST:"_alertID (="OR,<dfn>,<nien>;<user>;<date.time>")
5 ; or _apptID (="A;<date.time>;<hospital location>;<dfn>")
6 ; or _visitID (="V;<date.time>;<hospital location>;<dfn>")
7 ; or _procID (=order#)
8 ;
9PATS(ORY,ORUSR) ; -- Return list of patients for whom ORUSR has ADT alerts
10 ; in @ORY@(PAT) = #event alerts
11 ; @ORY@(PAT,ID) = "" per alert
12 ; [from ORRCDPT]
13 N ORXQ,ORI,XQAID,PAT,NOT,X,ACTDT
14 S ORY=$NA(^TMP($J,"ORRCEVT")) K @ORY
15 S ORXQ=$NA(^TMP($J,"ORXQ")) K @ORXQ
16 S ORUSR=+$G(ORUSR),ACTDT=$$PARAM^ORRCACK(ORUSR)
17 D USER^XQALERT(ORXQ,ORUSR) Q:+$G(@ORXQ)<1
18 S ORI=0 F S ORI=$O(@ORXQ@(ORI)) Q:ORI<1 S XQAID=$P(@ORXQ@(ORI),U,2) D
19 . Q:XQAID'?1"OR,".E S PAT=+$P(XQAID,",",2),NOT=+$P(XQAID,",",3)
20 . I $D(^TMP($J,"ORRCLST")),'$D(^TMP($J,"ORRCY",PAT)) Q
21 . I $D(^TMP($J,"ORRCLST")) D
22 .. I "^18^19^20^35^36^"'[(U_NOT_U) D:'$$INCLD Q ;non-ADT alerts
23 ... S ^TMP($J,"ORRCNOTF",PAT)=1
24 .. S X=+$G(@ORY@(PAT)),@ORY@(PAT)=X+1,@ORY@(PAT,"VST:"_XQAID)=""
25 . I '$D(^TMP($J,"ORRCLST")) D ; add pts to dynamic if other notifs
26 .. I "^18^19^20^35^36^"'[(U_NOT_U) D:'$$INCLD Q ;non-ADT alerts
27 ... S ^TMP($J,"ORRCNOTF",PAT)=1
28 ... I '$D(^TMP($J,"ORRCY",PAT)) S ^TMP($J,"ORRCY",PAT)="" ; add patient
29 .. S X=+$G(@ORY@(PAT)),@ORY@(PAT)=X+1,@ORY@(PAT,"VST:"_XQAID)=""
30 K @ORXQ,^TMP($J,"ORSLT")
31 Q
32 ;
33INCLD() ; -- Order already in Results column?
34 I "^3^14^21^22^23^24^25^53^57^58^"'[(U_NOT_U) Q 0
35 I (ACTDT<1)!(ACTDT>DT) Q 0
36 N X,DATE,DATA
37 S DATE=$P(XQAID,";",3),DATA=$G(^XTV(8992,ORUSR,"XQA",DATE,1))
38 S X=$P(DATA,"|") S:$L(X,"~")>2 X=$P(X,"~",2,3) I X="" Q 0
39 I '$G(^TMP($J,"ORSLT",PAT,X)) Q 0
40 Q 1
41 ;
42IDS(ORY,ORPAT,ORBEG,OREND) ; -- Return appointments for ORPAT
43 ; in @ORY@(ORPAT) = #appts
44 ; @ORY@(ORPAT,ID) = "" per appt
45 ; [from ORRCDPT1]
46 N ORRCVST,ORVST,ORI,CNT,ID,ORDG,ORLIST,ORIFN,STS,STRT,ORDT
47 S ORY=$NA(^TMP($J,"ORRCEVT")) K @ORY
48 S ORPAT=+$G(ORPAT),ORBEG=$G(ORBEG),OREND=$G(OREND)
49 D VST^ORWCV(.ORRCVST,ORPAT,ORBEG,OREND,1) ;=ID^FMdate^ClinicName^StatusName
50 M ORVST=ORRCVST
51 S (CNT,ORI)=0 F S ORI=$O(ORVST(ORI)) Q:ORI<1 D
52 . S ID="VST:"_$P(ORVST(ORI),U)_";"_ORPAT
53 . S CNT=CNT+1,@ORY@(ORPAT,ID)=""
54 ;+scheduled Radiology procedures
55 S ORDG=+$O(^ORD(100.98,"B","XRAY",0)),ORPAT=+ORPAT_";DPT("
56 D EN^ORQ1(ORPAT,ORDG,2) S ORDT=$S($G(DT):DT,1:$P($$NOW^XLFDT,"."))
57 S ORI=0 F S ORI=$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1 S ORIFN=^(ORI) D
58 . S STS=$P($G(^OR(100,+ORIFN,3)),U,3),STRT=$P($G(^(0)),U,8)
59 . Q:"^1^2^7^12^13^14^"[(U_STS_U) I STRT,STRT<ORDT Q ;done
60 . S CNT=CNT+1,@ORY@(ORPAT,"VST:"_+ORIFN)=""
61 S:CNT @ORY@(ORPAT)=CNT K ^TMP("ORR",$J,ORLIST)
62 Q
63 ;
64LIST(ORY,ORPAT,ORUSR,ORDET) ; -- Return alerted events to ORUSR for ORPAT
65 ; in @ORY@(#) = Item=ID^Text^Date in HL7 format, and also if ORDET
66 ; = Text=line of associated document text
67 ; RPC = ORRC EVENTS BY PATIENT
68 N ORXQ,ORN,I,XQAID,NOT,TEXT,DATE
69 S ORXQ=$NA(^TMP($J,"ORXQ")) K @ORXQ D USER^XQALERT(ORXQ,+$G(ORUSR))
70 S ORY=$NA(^TMP($J,"ORRCEVT")),ORN=0 K @ORY
71 S I=0 F S I=$O(@ORXQ@(I)) Q:I<1 D
72 . S TEXT=$P(@ORXQ@(I),U),XQAID=$P(@ORXQ@(I),U,2),DATE=$P(XQAID,";",3)
73 . Q:XQAID'?1"OR,".E Q:+$P(XQAID,",",2)'=ORPAT
74 . S NOT=+$P(XQAID,",",3) Q:"^18^19^20^35^36^"'[(U_NOT_U)
75 . S ORN=ORN+1,@ORY@(ORN)="Item=VST:"_XQAID_U_$E(TEXT,23,99)_U_$$FMTHL7^XLFDT(DATE)
76 . I $G(ORDET) D NOTE
77 K @ORXQ
78 Q
79 ;
80APPT(ORY,ORPAT,ORBEG,OREND,ORDET) ; -- Return past/future appointments
81 ; in @ORY@(#) = Item=ID^Text^Date in HL7 format^Status, and also if ORDET
82 ; = Text=line of associated document text
83 ; RPC = ORRC APPTS BY PATIENT
84 N ORN,ORVST,ORI,X,ID,LOC,DATE,VISIT,ORNOTE,ORJ,ORDG,ORLIST,ORIFN,ORNOW
85 N STS,STRT,NOW,ORRCVST,ORRCNOTE
86 S ORPAT=+$G(ORPAT),ORBEG=$$HL7TFM^XLFDT($G(ORBEG)),OREND=$$HL7TFM^XLFDT($G(OREND)),NOW=$$NOW^XLFDT
87 D VST^ORWCV(.ORRCVST,ORPAT,ORBEG,OREND,1) ;=ID^FMdate^ClinicName^StatusName
88 M ORVST=ORRCVST
89 S ORY=$NA(^TMP($J,"ORRCAPPT")),ORN=0 K @ORY
90 S ORI=0 F S ORI=$O(ORVST(ORI)) Q:ORI<1 D
91 . S X=ORVST(ORI),DATE=$P(X,U,2)
92 . S ID="VST:"_$P(X,U)_";"_ORPAT,LOC=+$P(ID,";",3)
93 . S ORN=ORN+1,@ORY@(ORN)="Item="_ID_U_$P(X,U,3)_U_$$FMTHL7^XLFDT(DATE)_U_$P(X,U,4)
94 . I $G(ORDET) D
95 .. I DATE>NOW S ORN=ORN+1,@ORY@(ORN)="Text=Scheduled Appointment" Q
96 .. I $G(^SC(LOC,"OOS")) S ORN=ORN+1,@ORY@(ORN)="Text=No note available" Q
97 .. S VISIT=+$$GETENC^PXAPI(ORPAT,DATE,LOC) K ORNOTE
98 .. D DETNOTE^ORQQVS(.ORRCNOTE,ORPAT,VISIT)
99 .. M ORNOTE=ORRCNOTE
100 .. S ORJ=0 F S ORJ=$O(ORNOTE(ORJ)) Q:ORJ<1 S ORN=ORN+1,@ORY@(ORN)="Text="_ORNOTE(ORJ)
101 ;+future Radiology procedures in #100
102 S ORDG=+$O(^ORD(100.98,"B","XRAY",0)),ORPAT=+ORPAT_";DPT("
103 D EN^ORQ1(ORPAT,ORDG,2) S ORNOW=$$NOW^XLFDT
104 S ORI=0 F S ORI=$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1 S ORIFN=^(ORI) D
105 . S STS=$P($G(^OR(100,+ORIFN,3)),U,3),STRT=$P($G(^(0)),U,8)
106 . Q:"^1^2^7^12^13^14^"[(U_STS_U) I STRT,STRT<ORNOW Q ;done
107 . S ORN=ORN+1,@ORY@(ORN)="Item=VST:"_+ORIFN_U_$$TXT^ORRCOR(+ORIFN)_U_$$FMTHL7^XLFDT(STRT)_U_$$STS^ORRCOR(+ORIFN)
108 . I $G(ORDET) D ORD^ORRCOR
109 K ^TMP("ORR",$J,ORLIST)
110 Q
111 ;
112TEXT(ORY,VISIT) ; -- Return associated document text of VISITs
113 ; where VISIT(#) = ID
114 ; in @ORY@(#) = Item=ID^Text^Date in HL7 format
115 ; = Text=line of document text
116 ; RPC = ORRC EVENTS BY ID
117 N ORN,ORI,ID,XQAID,LOC,TEXT,DATE,VST,ORIFN,DFN,ORNOTE,ORRCNOTE,NOW
118 S NOW=$$NOW^XLFDT,ORN=0,ORY=$NA(^TMP($J,"ORRCEVT")) K @ORY
119 S ORI="" F S ORI=$O(VISIT(ORI)) Q:ORI="" S ID=$P(VISIT(ORI),":",2) D
120 . I ID D Q ;order
121 .. S DATE=$P($G(^OR(100,+ID,0)),U,8)
122 .. S ORN=ORN+1,@ORY@(ORN)="Item=VST:"_ID_U_$$TXT^ORRCOR(+ID)_U_$$FMTHL7^XLFDT(DATE)
123 .. S ORIFN=ID D ORD^ORRCOR
124 . I ID?1"OR,".E D Q ;alert
125 .. S TEXT=$$MSGTXT^ORRCXQ(ID),DATE=+$P(ID,";",3)
126 .. S ORN=ORN+1,@ORY@(ORN)="Item=VST:"_ID_U_TEXT_U_$$FMTHL7^XLFDT(DATE)
127 .. S XQAID=ID D NOTE
128 . S DATE=$P(ID,";",2),LOC=+$P(ID,";",3),DFN=+$P(ID,";",4)
129 . S ORN=ORN+1,@ORY@(ORN)="Item=VST:"_ID_U_$P($G(^SC(LOC,0)),U)_U_DATE
130 . I DATE>NOW S ORN=ORN+1,@ORY@(ORN)="Text=Scheduled Appointment" Q
131 . S VST=+$$GETENC^PXAPI(DFN,DATE,LOC) K ORNOTE,ORRCNOTE
132 . D DETNOTE^ORQQVS(.ORRCNOTE,DFN,VST)
133 . M ORNOTE=ORRCNOTE
134 . S ORJ=0 F S ORJ=$O(ORNOTE(ORJ)) Q:ORJ<1 S ORN=ORN+1,@ORY@(ORN)="Text="_ORNOTE(ORJ)
135 Q
136 ;
137NOTE ; -- Add note text associated with event in alert XQAID to @ORY@(ORN)
138 ; Expects TEXT,DATE from alert
139 N DFN,NOT,VDT,VAIP,VAERR,LOC,VISIT,ORZ,ORI,ENC,X0,ORRCZ
140 S DFN=+$P(XQAID,",",2),NOT=+$P(XQAID,",",3),VDT=$$MSGDT^ORRCXQ(DATE,TEXT)
141 I NOT=20,TEXT?1"Died on ".E S ORN=ORN+1,@ORY@(ORN)="Text=No details available." Q
142 I NOT=19 D ;Unsched visit
143 . S LOC=0,VISIT=0 ;IA #2065
144 . S ENC=0 F S ENC=$O(^SCE("ADFN",DFN,VDT,ENC)) Q:ENC<1 D Q:LOC
145 .. S X0=$G(^SCE(ENC,0)) Q:$P(X0,U,6) Q:$P(X0,U,8)=1 ;not parent, appt
146 .. Q:$G(^SC(+$P(X0,U,4),"OOS")) ;not OOS loc
147 .. S LOC=+$P(X0,U,4),VISIT=+$P(X0,U,5)
148 . S:VISIT<1 VISIT=+$$GETENC^PXAPI(DFN,VDT,LOC)
149 . K ORZ D DETNOTE^ORQQVS(.ORRCZ,DFN,VISIT)
150 . M ORZ=ORRCZ
151 I NOT'=19 D ;inpt mvt
152 . S VAIP("D")=$S(NOT=18!(NOT=36):DATE,1:VDT) D IN5^VADPT
153 . S VDT=+VAIP(13,1),LOC=+$G(^DIC(42,+VAIP(13,4),44))
154 . S VISIT=+$$GETENC^PXAPI(DFN,VDT,LOC)
155 . K ORZ D DETSUM^ORQQVS(.ORRCZ,DFN,VISIT)
156 . M ORZ=ORRCZ
157 . K ^TMP("PXKENC",$J)
158 S ORI=0 F S ORI=$O(ORZ(ORI)) Q:ORI<1 S ORN=ORN+1,@ORY@(ORN)="Text="_ORZ(ORI)
159 Q
160 ;
161CLEAR(ORY,ORUSR,VISIT) ; -- Clear VISIT alerts for ORUSR
162 ; where VISIT(#) = ID
163 ; returns ORY(#) = ID ^ 1 or 0, if successful
164 ; RPC = ORRC EVENTS ACKNOWLEDGE
165 Q:'$G(ORUSR) N ORN,ORI,XQAID S ORN=0 K ORY
166 S ORI="" F S ORI=$O(VISIT(ORI)) Q:ORI="" D
167 . S XQAID=$P(VISIT(ORI),":",2)
168 . D DELETE^ORRCXQ(XQAID)
169 . S ORN=ORN+1,ORY(ORN)="VST:"_XQAID_"^1"
170 Q
171 ;
172TEST19(USR) ; -- Trigger Unsched Visit alert to test
173 N XQA,XQAID,XQAMSG
174 S XQA(USR)="",XQAID="OR,54,19",XQAMSG="CPRS,JOH (C1239): Unscheduled visit on OCT 14,1999@17:16:21"
175 D SETUP^XQALERT
176 Q
177 ;
178TEST35(USR) ; -- Trigger Discharge alert to test
179 N XQA,XQAID,XQAMSG
180 S XQA(USR)="",XQAID="OR,?,35",XQAMSG="Discharged on ?"
181 D SETUP^XQALERT
182 Q
183 ;
184TEST20(USR) ; -- Trigger Deceased alert to test
185 N XQA,XQAID,XQAMSG
186 S XQA(USR)="",XQAID="OR,91265,20",XQAMSG="CPRS,K (C8838): Died on AUG 31,1999"
187 D SETUP^XQALERT
188 Q
Note: See TracBrowser for help on using the repository browser.