source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3FUP2.m@ 613

Last change on this file since 613 was 613, checked in by George Lilly, 14 years ago

initial load of WorldVistAEHR
File size: 8.8 KB
Line 
1ORB3FUP2 ; slc/CLA - Routine to support notification follow-up actions ;6/28/00 12:00
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,64,88,112,243**;Dec 17, 1997;Build 242
3RESULT ;STAT, orderer-flagged and site-flagged result follow-up
4 ;determine what pkg to get report/results from then do RPTLAB or RPTRAD
5 N ORBFILL S ORBFILL=$P($P(XQADATA,"|",2),"@",2)
6 I ORBFILL["LR" D RPTLAB
7 I ORBFILL["RA" D RPTRAD
8 I ORBFILL["GMRC" D RPTCON
9 Q
10CSPN ;co-sign progress note(s) follow-up
11 K XQAKILL
12 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
13 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
14 I $G(ORENVIR)="GUI" ;entry pt to get notes req co-sign then quit
15 ;joel rtn to display notes req co-signature and allow co-sign on vt
16 ;if lm fup action completed D DEL^ORB3FUP1(.ORY,ORBXQAID)
17 Q
18USPN ;unsigned progress note(s) follow-up
19 K XQAKILL
20 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
21 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
22 I $G(ORENVIR)="GUI" ;entry pt to get unsigned notes then quit
23 ;joel rtn to display notes req signature and allow signature on vt
24 ;if lm fup action completed D DEL^ORB3FUP1(.ORY,ORBXQAID)
25 Q
26EXMED ;expiring med(s) follow-up
27 K XQAKILL
28 N ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL
29 S ORBXQAID=XQAID
30 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
31 ;the FLG code for EXPIRING orders in ORQ1 is '5'
32 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"RX",5,"","")
33 I $G(ORENVIR)'="GUI" D
34 .D MSG^ORB3FUP1
35 .S ORDG=$$DG^ORQOR1("RX") ;get Display Group ien
36 .D EN^ORCB(ORPT,5,ORDG,.ORBLMDEL)
37 .K ^TMP("ORR",$J)
38 .Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
39 .D EN^ORQ1(ORPT_";DPT(",ORDG,5,"","","",0,0)
40 .S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
41 ..D DEL^ORB3FUP1(.ORY,ORBXQAID) ;if no more EXPIRING orders found, delete the alert
42 .K X,^TMP("ORR",$J)
43 Q
44UVMED ;unverified med(s) follow-up
45 K XQAKILL
46 N ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL,ORADT
47 S ORBXQAID=XQAID
48 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
49 ;the FLG code for UNVERIFIED (NURSE) orders in ORQ1 is '9'
50 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"RX",9,"","")
51 I $G(ORENVIR)'="GUI" D
52 .D MSG^ORB3FUP1
53 .S ORDG=$$DG^ORQOR1("RX") ;get Display Group ien
54 .D EN^ORCB(ORPT,9,ORDG,.ORBLMDEL)
55 .K ^TMP("ORR",$J)
56 .Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
57 .;
58 .;if user doesn't have ORELSE or ORMAS keys (can't verify),
59 .; delete user's alert after display:
60 .I '$D(^XUSEC("ORELSE",DUZ)),('$D(^XUSEC("OREMAS",DUZ))) S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) Q
61 .;
62 .;get current admission date/time:
63 .N DFN S DFN=ORPT,VA200="" D INP^VADPT
64 .S ORADT=$P($G(VAIN(7)),U)
65 .S ORADT=$S('$L($G(ORADT)):$$FMADD^XLFDT($$NOW^XLFDT,"-30"),1:ORADT)
66 .;
67 .;if no more UNVERIFIED MED orders found (within current admission or
68 .; past 30 days), delete the alert:
69 .D EN^ORQ1(ORPT_";DPT(",ORDG,9,"",ORADT,$$NOW^XLFDT,0,0)
70 .S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
71 ..D DEL^ORB3FUP1(.ORY,ORBXQAID)
72 .K X,^TMP("ORR",$J),VA200,VAIN
73 Q
74UNVER ;unverified order(s) follow-up
75 K XQAKILL
76 N ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL,ORADT
77 S ORBXQAID=XQAID
78 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
79 ;the FLG code for UNVERIFIED (NURSE) orders in ORQ1 is '9'
80 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",9,"","")
81 I $G(ORENVIR)'="GUI" D
82 .D MSG^ORB3FUP1
83 .S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
84 .D EN^ORCB(ORPT,9,ORDG,.ORBLMDEL)
85 .K ^TMP("ORR",$J)
86 .Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
87 .;
88 .;if user doesn't have ORELSE or ORMAS keys (can't verify),
89 .; delete user's alert after display:
90 .I '$D(^XUSEC("ORELSE",DUZ)),('$D(^XUSEC("OREMAS",DUZ))) S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) Q
91 .;
92 .;get current admission date/time:
93 .N DFN S DFN=ORPT,VA200="" D INP^VADPT
94 .S ORADT=$P($G(VAIN(7)),U)
95 .S ORADT=$S('$L($G(ORADT)):$$FMADD^XLFDT($$NOW^XLFDT,"-30"),1:ORADT)
96 .;
97 .;if no more UNVERIFIED orders found (within current admission or past
98 .; 30 days), delete the alert:
99 .D EN^ORQ1(ORPT_";DPT(",ORDG,9,"",ORADT,$$NOW^XLFDT,0,0)
100 .S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
101 ..D DEL^ORB3FUP1(.ORY,ORBXQAID)
102 .K X,^TMP("ORR",$J),VA200,VAIN
103 Q
104NEWCON ;new consult/request follow-up
105 K XQAKILL
106 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
107 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
108 ;I $G(ORENVIR)="GUI" D ;comment out until GUI follow-up
109 ;.entry pt to get new consults then quit
110 I $G(ORENVIR)'="GUI" D
111 .D MSG^ORB3FUP1
112 .D EN^GMRCALRT(XQADATA,XQAID) ;display new c/r and allow action
113 .;D DEL^ORB3FUP1(.ORY,ORBXQAID) ;Dwight does the delete in GMRC
114 Q
115UPCON ;updated consult/request follow-up
116 K XQAKILL
117 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
118 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
119 I $G(ORENVIR)'="GUI" D
120 .D MSG^ORB3FUP1
121 .D EN^GMRCALRT(XQADATA,XQAID) ;display updated c/r and allow action
122 Q
123DCCON ;cancelled, held or DCed consult/request follow-up
124 K XQAKILL
125 N ORPT,NXQADATA
126 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
127 ;I $G(ORENVIR)="GUI" D ;comment out until GUI follow-up
128 ;.entry pt to get new consults then quit
129 I $G(ORENVIR)'="GUI" D
130 .D MSG^ORB3FUP1
131 .I XQADATA["GMRC" S NXQADATA=$P($P(XQADATA,"|",2),"@") D EN^GMRCEDIT(NXQADATA,XQAID)
132 .I +$G(NXQADATA)<1 D EN^GMRCEDIT(XQADATA,XQAID)
133 Q
134RPTCON ;consult result follow-up
135 K XQAKILL
136 N NXQADATA
137 ;N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
138 ;S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
139 I $G(ORENVIR)="GUI" D DETAIL^ORQQCN(.ORBY,XQADATA)
140 I $G(ORENVIR)'="GUI" D
141 .D MSG^ORB3FUP1
142 .D EN^GMRCALRT(XQADATA,XQAID)
143 .;I XQADATA["GMRC" S NXQADATA=$P($P(XQADATA,"|",2),"@") D EN^GMRCALRT(NXQADATA,XQAID)
144 .;I +$G(NXQADATA)<1 D EN^GMRCALRT(XQADATA,XQAID)
145 .;D DEL^ORB3FUP1(.ORY,ORBXQAID) ;Dwight does the delete in GMRC
146 Q
147RPTAP ; AP lab result follow-up
148 K XQAKILL
149 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
150 S ORPT=$P($P(ORBXQAID,";"),",",2) ;get pt dfn from xqaid
151 N ORACCNUM,ORDTSTKN S ORACCNUM=$P(XQADATA,U,2),ORDTSTKN=$P(XQADATA,U,3)
152 I $G(ORENVIR)'="GUI" D
153 .D MSG^ORB3FUP1
154 .D EN1^ORCXPND(ORPT,ORACCNUM_"-"_ORDTSTKN,"LABS")
155 .D DEL^ORB3FUP1(.ORY,ORBXQAID)
156 Q
157RPTLAB ;lab result follow-up
158 K XQAKILL
159 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
160 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
161 N ORDER,ORLAB S ORDER=$P(XQADATA,"@")
162 I $G(ORENVIR)="GUI" D DETAIL^ORQQLR(.ORBY,ORPT,ORDER)
163 I $G(ORENVIR)'="GUI" D
164 .D MSG^ORB3FUP1
165 .;S ORLAB=$$OETOLAB^ORQQLR1(ORDER)
166 .;Q:'$L($G(ORLAB))
167 .;D EN1^ORCXPND(ORPT,ORLAB,"LABS") ;api used lab # pre-6/97
168 .D EN1^ORCXPND(ORPT,ORDER,"LABS")
169 .D DEL^ORB3FUP1(.ORY,ORBXQAID)
170 Q
171RPTRAD ;radiology result follow-up for HL7-triggered notifications
172 K XQAKILL
173 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
174 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
175 N INVDT,CASE S INVDT="",CASE=""
176 ;XQADATA is different for HL7-triggered vs. radiology pkg triggered
177 S INVDT=$P(XQADATA,"~",2),CASE=$P($P(XQADATA,"~",3),"@")
178 I $G(ORENVIR)="GUI" D DETAIL^ORQQRA(.ORBY,ORPT,INVDT,CASE)
179 I $G(ORENVIR)'="GUI" D
180 .D MSG^ORB3FUP1
181 .D EN1^ORCXPND(ORPT,INVDT_"-"_CASE,"XRAYS")
182 .D DEL^ORB3FUP1(.ORY,ORBXQAID)
183 Q
184RPTRAD2 ;radiology result follow-up for radiology pkg-triggered notifications
185 K XQAKILL
186 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
187 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
188 N INVDT,CASE S INVDT="",CASE=""
189 ;XQADATA is different for HL7-triggered vs. radiology pkg triggered
190 S INVDT=$P(XQADATA,"~",1),CASE=$P(XQADATA,"~",2)
191 I $G(ORENVIR)="GUI" D DETAIL^ORQQRA(.ORBY,ORPT,INVDT,CASE)
192 I $G(ORENVIR)'="GUI" D
193 .D MSG^ORB3FUP1
194 .D EN1^ORCXPND(ORPT,INVDT_"-"_CASE,"XRAYS")
195 .D DEL^ORB3FUP1(.ORY,ORBXQAID)
196 Q
197EXOI ;expiring flagged orderable items follow-up
198 K XQAKILL
199 N ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL
200 S ORBXQAID=XQAID
201 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
202 ;the FLG code for EXPIRING orders in ORQ1 is '5'
203 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",5,"","")
204 I $G(ORENVIR)'="GUI" D
205 .D MSG^ORB3FUP1
206 .S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
207 .D EN^ORCB(ORPT,5,ORDG,.ORBLMDEL)
208 .K ^TMP("ORR",$J)
209 .Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
210 .D EN^ORQ1(ORPT_";DPT(",ORDG,5,"","","",0,0)
211 .S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
212 ..D DEL^ORB3FUP1(.ORY,ORBXQAID) ;if no more EXPIRING orders found, delete the alert
213 .K X,^TMP("ORR",$J)
214 Q
215INTCON ;consult interpretation follow-up
216 K XQAKILL
217 N NXQADATA
218 I $G(ORENVIR)'="GUI" D
219 .D MSG^ORB3FUP1
220 .R !!?5,"This alert must be processed in the CPRS GUI.",X:10
221 .K X
222 Q
223CHGRAD ;radiology follow-up for #67 Imaging Request Changed
224 K XQAKILL
225 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
226 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
227 I $G(ORENVIR)'="GUI" D
228 .D MSG^ORB3FUP1
229 .I $L($T(EN1^RAO7PC4))>0 D
230 ..D EN1^RAO7PC4 ;display before and after change(s)
231 ..D DEL^ORB3FUP1(.ORY,ORBXQAID)
232 Q
233INFODEL ;follow-up action to delete "informational" alerts
234 K XQAKILL
235 N ORY,ORBXQAID
236 S ORBXQAID=XQAID
237 D MSG^ORB3FUP1
238 D DEL^ORB3FUP1(.ORY,ORBXQAID)
239 Q
Note: See TracBrowser for help on using the repository browser.