source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3FUP2.m@ 760

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

initial load of FOIAVistA 6/30/08 version
File size: 8.5 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**;Dec 17, 1997
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
147RPTLAB ;lab result follow-up
148 K XQAKILL
149 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
150 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
151 N ORDER,ORLAB S ORDER=$P(XQADATA,"@")
152 I $G(ORENVIR)="GUI" D DETAIL^ORQQLR(.ORBY,ORPT,ORDER)
153 I $G(ORENVIR)'="GUI" D
154 .D MSG^ORB3FUP1
155 .;S ORLAB=$$OETOLAB^ORQQLR1(ORDER)
156 .;Q:'$L($G(ORLAB))
157 .;D EN1^ORCXPND(ORPT,ORLAB,"LABS") ;api used lab # pre-6/97
158 .D EN1^ORCXPND(ORPT,ORDER,"LABS")
159 .D DEL^ORB3FUP1(.ORY,ORBXQAID)
160 Q
161RPTRAD ;radiology result follow-up for HL7-triggered notifications
162 K XQAKILL
163 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
164 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
165 N INVDT,CASE S INVDT="",CASE=""
166 ;XQADATA is different for HL7-triggered vs. radiology pkg triggered
167 S INVDT=$P(XQADATA,"~",2),CASE=$P($P(XQADATA,"~",3),"@")
168 I $G(ORENVIR)="GUI" D DETAIL^ORQQRA(.ORBY,ORPT,INVDT,CASE)
169 I $G(ORENVIR)'="GUI" D
170 .D MSG^ORB3FUP1
171 .D EN1^ORCXPND(ORPT,INVDT_"-"_CASE,"XRAYS")
172 .D DEL^ORB3FUP1(.ORY,ORBXQAID)
173 Q
174RPTRAD2 ;radiology result follow-up for radiology pkg-triggered notifications
175 K XQAKILL
176 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
177 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
178 N INVDT,CASE S INVDT="",CASE=""
179 ;XQADATA is different for HL7-triggered vs. radiology pkg triggered
180 S INVDT=$P(XQADATA,"~",1),CASE=$P(XQADATA,"~",2)
181 I $G(ORENVIR)="GUI" D DETAIL^ORQQRA(.ORBY,ORPT,INVDT,CASE)
182 I $G(ORENVIR)'="GUI" D
183 .D MSG^ORB3FUP1
184 .D EN1^ORCXPND(ORPT,INVDT_"-"_CASE,"XRAYS")
185 .D DEL^ORB3FUP1(.ORY,ORBXQAID)
186 Q
187EXOI ;expiring flagged orderable items follow-up
188 K XQAKILL
189 N ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL
190 S ORBXQAID=XQAID
191 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
192 ;the FLG code for EXPIRING orders in ORQ1 is '5'
193 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",5,"","")
194 I $G(ORENVIR)'="GUI" D
195 .D MSG^ORB3FUP1
196 .S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
197 .D EN^ORCB(ORPT,5,ORDG,.ORBLMDEL)
198 .K ^TMP("ORR",$J)
199 .Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
200 .D EN^ORQ1(ORPT_";DPT(",ORDG,5,"","","",0,0)
201 .S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
202 ..D DEL^ORB3FUP1(.ORY,ORBXQAID) ;if no more EXPIRING orders found, delete the alert
203 .K X,^TMP("ORR",$J)
204 Q
205INTCON ;consult interpretation follow-up
206 K XQAKILL
207 N NXQADATA
208 I $G(ORENVIR)'="GUI" D
209 .D MSG^ORB3FUP1
210 .R !!?5,"This alert must be processed in the CPRS GUI.",X:10
211 .K X
212 Q
213CHGRAD ;radiology follow-up for #67 Imaging Request Changed
214 K XQAKILL
215 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
216 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
217 I $G(ORENVIR)'="GUI" D
218 .D MSG^ORB3FUP1
219 .I $L($T(EN1^RAO7PC4))>0 D
220 ..D EN1^RAO7PC4 ;display before and after change(s)
221 ..D DEL^ORB3FUP1(.ORY,ORBXQAID)
222 Q
223INFODEL ;follow-up action to delete "informational" alerts
224 K XQAKILL
225 N ORY,ORBXQAID
226 S ORBXQAID=XQAID
227 D MSG^ORB3FUP1
228 D DEL^ORB3FUP1(.ORY,ORBXQAID)
229 Q
Note: See TracBrowser for help on using the repository browser.