source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3FUP1.m@ 1362

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1ORB3FUP1 ; slc/CLA - Routine to support notification follow-up actions ;7/15/95 17:23
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,64,74,105,139**;Dec 17, 1997
3 Q
4TYPE(ORBY,ORXQAID) ; return notif follow-up action type
5 N NIEN
6 S NIEN=$P($P(ORXQAID,";"),",",3)
7 S ORBY=$G(^ORD(100.9,NIEN,3))
8 I ORBY="" S ORBY="INFO^"
9 E S ORBY=$P(ORBY,U,2)
10 Q
11GUI(ORBY,ORXQAID) ; Notification follow-up for GUI called via API: ORB FOLLOW-UP
12 ; called by ORB FOLLOW-UP api:
13 S ORENVIR="GUI"
14 D PROCESS
15 Q
16PROCESS ; main process for notification follow-up
17 ;ORXQAID = OR,dfn,nien;
18 ;XQADATA = placer num^placer id;filler num^filler id
19 ;XQAKILL = value of parameter ORB DELETE MECHANISM for notif in 101.9
20 N ORPDIEN,ORN,ORDFN,ORSITE,ORFID,ORFIEN,ORKILL
21 D GETACT^XQALERT(ORXQAID) ;return follow-up action info
22 ;Q:'($D(XQADATA)) Q:'($D(XQAID))
23 ;Q:($P(XQAID,",")'="OR")
24 ;call function rpc stored in xqarou with params from xqadata
25 D @XQAROU
26 K ORENVIR
27 Q
28MSG ; display msg re: alert being processed for non-GUI follow-up actions
29 I $G(ORENVIR)'="GUI" D
30 .I $L($G(XQX)) W !!,"Processing alert: ",$P(XQX,U,3) H 1.5
31 Q
32DEL(ORBY,XQAID,ORKILL) ; delete an alert
33 N ORN
34 S ORN=$P($P(XQAID,";"),",",3)
35 I $G(ORKILL)=1!($G(ORKILL)=0) S XQAKILL=ORKILL
36 I $G(XQAKILL)="" S XQAKILL=$$XQAKILL^ORB3F1(ORN)
37 I $G(XQAKILL)="" S XQAKILL=1
38 S ORBY="FALSE"
39 I $L($G(XQAID)) D DELETE^XQALERT S ORBY="TRUE"
40 K XQAKILL
41 Q
42CSORD ;co-sign order(s) follow-up
43 K XQAKILL
44 N ORPT,ORDG,ORBXQAID,ORY S ORBXQAID=XQAID
45 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
46 ;the FLG code for orders requiring CO-SIGNATURE in ORQ1 is 'to be determined when ASU is available'
47 D DEL(.ORY,XQAID) ;until ASU is implemented, delete the alert and quit
48 Q ;quit until ASU is implemented
49 ;I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",???,"","")
50 ;I $G(ORENVIR)'="GUI" D
51 ;.D MSG
52 ;.S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
53 ;.D EN^ORCB(ORPT,???,ORDG,???)
54 ;.K ^TMP("ORR",$J)
55 ;.D EN^ORQ1(ORPT_";DPT(",ORDG,???,"","","",0,0)
56 ;.S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
57 ;..D DEL(.ORY,ORBXQAID) ;if no more orders req. co-sign, delete the alert
58 ;.K ^TMP("ORR",$J)
59 Q
60EXDNR ;expiring dnr follow-up
61 K XQAKILL
62 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
63 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
64 N DNRORD,DNRY S DNRORD=$P(XQADATA,"@")
65 I $G(ORENVIR)="GUI" D
66 .S ORBY(1)=DNRY
67 I $G(ORENVIR)'="GUI" D
68 .D MSG
69 .D EN1^ORCB(DNRORD,"RENEW") ;display order, allow renewing, then delete
70 .D DEL(.ORY,ORBXQAID)
71 Q
72UNLINKED ;unlinked provider follow-up
73 K XQAKILL
74 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
75 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
76 N ORNUM,ORUNY S ORNUM=$P(XQADATA,"@")
77 I $G(ORENVIR)="GUI" D
78 .S ORBY(1)=ORUNY
79 I $G(ORENVIR)'="GUI" D
80 .D MSG
81 .D EN1^ORCB(ORNUM,"REPLACE") ;display order, allow replace, then delete
82 .D DEL(.ORY,ORBXQAID)
83 Q
84FLORD ;flagged order(s) follow-up
85 K XQAKILL
86 N ORPT,ORDG,X,ORBXQAID,ORY,ORBLMDEL
87 S ORBXQAID=XQAID
88 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
89 ;the FLG code for "FLAGGED" in ORQ1 is '12'
90 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",12,"","")
91 I $G(ORENVIR)'="GUI" D
92 .D MSG
93 .S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
94 .D EN^ORCB(ORPT,12,ORDG,.ORBLMDEL)
95 .K ^TMP("ORR",$J)
96 .Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
97 .D EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
98 .S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
99 ..D DEL(.ORY,ORBXQAID) ;if no more flagged orders found, delete alert
100 .K ^TMP("ORR",$J)
101 Q
102NEWORD ;new order(s) follow-up
103 K XQAKILL
104 N ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
105 S ORSDT="",OREDT="",ENT="USR",ORBXQAID=XQAID
106 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
107 ;the FLG code for NEW orders since last reviewed orders in ORQ1 is '6'
108 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
109 I $G(ORENVIR)'="GUI" D
110 .D MSG
111 .S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
112 .D EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
113 .Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
114 .D DEL(.ORY,ORBXQAID) ;delete the alert
115 Q
116DCORD ;DC order(s) follow-up
117 K XQAKILL
118 N ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
119 S ORSDT="",OREDT="",ENT="USR",ORBXQAID=XQAID
120 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
121 ;the FLG code for DC orders is '3'
122 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
123 I $G(ORENVIR)'="GUI" D
124 .D MSG
125 .S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
126 .D EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
127 .Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
128 .D DEL(.ORY,ORBXQAID) ;delete the alert
129 Q
130NUMORD ;detailed order display follow-up - return order number
131 K XQAKILL
132 N ORBXQAID,ORY S ORBXQAID=XQAID
133 S ORNUM=$P(XQADATA,"@")
134 I $G(ORENVIR)="GUI" D
135 .Q
136 I $G(ORENVIR)'="GUI" D
137 .D MSG
138 .D EN1^ORCB(+ORNUM,"NEW") ;display order, allow new order then delete
139 .D DEL(.ORY,ORBXQAID)
140 Q
141ESORD ;order(s) requiring electronic signature follow-up
142 K XQAKILL
143 N ORPT,ORDG,ORBXQAID,ORY,ORX,ORZ,ORDERS,ORDNUM,ORQUIT,ORBLMDEL
144 S ORBXQAID=XQAID,ORDERS=0,ORQUIT=0
145 S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
146 ;the FLG code for UNSIGNED orders in ORQ1 is '11'
147 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",11,"","")
148 I $G(ORENVIR)'="GUI" D
149 .D MSG
150 .S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
151 .D EN^ORCB(ORPT,11,ORDG,.ORBLMDEL)
152 .K ^TMP("ORR",$J) ;clean up array
153 .Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
154 .I $L($G(XQAID)) D ;EN^ORCB may kill XQAID in its follow-up
155 ..;
156 ..;get unsigned orders - if none exist, delete alert then quit:
157 ..D EN^ORQ1(ORPT_";DPT(",ORDG,11,"","","",0,0)
158 ..S ORX="",ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX="" I +$G(^TMP("ORR",$J,ORX,"TOT"))<1 D DEL(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
159 ..;
160 ..;user does not have ORES key, delete user's alert:
161 ..I '$D(^XUSEC("ORES",DUZ)) S XQAKILL=1 D DEL(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
162 ..;
163 ..;if prov is NOT linked to pt via attending, primary, teams or PCMM:
164 ..I $$PPLINK^ORQPTQ1(DUZ,ORPT)=0 D
165 ...S ORX="" F S ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX=""!(ORDERS=1) D
166 ....S ORZ="" F S ORZ=$O(^TMP("ORR",$J,ORX,ORZ)) Q:ORZ=""!(ORDERS=1) D
167 .....S ORDNUM=^TMP("ORR",$J,ORX,ORZ)
168 .....;quit if this unsigned order's last action was made by the user
169 .....I DUZ=+$$UNSIGNOR^ORQOR2(ORDNUM) S ORDERS=1
170 ...I ORDERS'=1 D ;provider has no outstanding unsiged orders for pt
171 ....S XQAKILL=1 D DEL(.ORY,ORBXQAID) ;delete alert for this user
172 ..K ^TMP("ORR",$J)
173 Q
174UNFLAG(ORPT) ;order unflagged - delete alert if no more flagged orders
175 N ORDG
176 S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
177 K ^TMP("ORR",$J)
178 D EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
179 S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
180 .;if no more flagged orders found, delete alert:
181 .S XQAKILL=$$XQAKILL^ORB3F1(6)
182 .I $G(XQAKILL)="" S XQAKILL=1
183 .S XQAID="OR,"_ORPT_",6" D DELETEA^XQALERT K XQAID,XQAKILL
184 K ^TMP("ORR",$J)
185 Q
Note: See TracBrowser for help on using the repository browser.