source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQRY.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1ORQRY ; SLC/MKB/JDL - Order Query utilities ;3/17/03 14:45
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153,174**;Dec 17, 1997
3 ;
4 ;
5PP(DFN,PROV) ; -- Returns 1 or 0, if PROV is prim prov for DFN
6 N X,Y I '$G(DFN)!'$G(PROV) Q ""
7 S X=$$OUTPTPR^SDUTL3(+DFN),Y=$S(+X=+PROV:1,1:0)
8 Q Y
9 ;
10ACT(DFN,BEG,END,LOC) ; -- Returns 1 or 0, if recent activity for DFN
11 ; BEG = beginning date [default = DT-1yr]
12 ; END = ending date [default = DT]
13 ; LOC(IEN) = list of clinic IENs from #44 [default = all]
14 N X,YY,VASD,VAERR,IDT,DA
15 N VSTH,IX,JX
16 S DFN=+$G(DFN),YY=0 I '$G(DFN) Q ""
17 S BEG=$G(BEG,DT-10000),END=$G(END,DT) ;default=last year
18 I END<BEG S X=END,END=BEG,BEG=X
19 I '$D(LOC) D G:YY ACTQ ;check inpatient, Rx data
20 . ;curr inpt
21 . I $G(^DPT(DFN,.105)) S YY=1 Q
22 . S X=+$O(^DGPM("APRD",DFN,BEG))
23 . ; admission
24 . I X,X'>END S YY=1 Q
25 . ;Rx
26 . D OCL^PSOORRL(DFN,BEG,END) I $O(^TMP("PS",$J,0)) S YY=1 Q
27 S VSTH="",(IX,JX)=0
28 D VST^ORWCV(.VSTH,DFN,BEG,END)
29 F S IX=$O(VSTH(IX)) Q:'IX D
30 . F S JX=$O(LOC(JX)) Q:'JX D
31 . . I +$P($G(VSTH(IX)),";",3)=JX S YY=1 Q
32 I YY=1 G ACTQ
33 S IDT=BEG-.0001 F S IDT=$O(^SCE("ADFN",DFN,IDT)) Q:IDT<1!(IDT>END) D Q:YY ;IA #2065
34 . I '$D(LOC) S YY=1 Q
35 . S DA=0 F S DA=+$O(^SCE("ADFN",DFN,IDT,DA)) Q:DA<1 I $D(LOC(+$P($G(^SCE(DA,0)),U,4))) S YY=1 Q
36ACTQ K ^UTILITY("VASD",$J),^TMP("PS",$J)
37 Q YY
38 ;
39BYPT(ORY,DFN,QRY) ; -- Returns report data in @ORY based on QRY parameters
40 Q:'$G(DFN) N PAT,ORYPAT,VA,VADM,VAIN,VAERR ;M ^XTMP("ORQRY",$G(DUZ)_";"_$H)=QRY
41 S ORY=$G(ORY,"^TMP($J)"),DFN=+DFN D OERR^VADPT
42 S ORYPAT("Patient.DFN")=DFN,PAT=DFN_";DPT("
43 S ORYPAT("Patient.Age")=VADM(4),ORYPAT("Patient.Name")=VADM(1)
44 S ORYPAT("Patient.Last4")=$E(VADM(1))_VA("BID")
45 S ORYPAT("Patient.Ward")=$S(VAIN(4):$P(VAIN(4),U,2)_" "_VAIN(5),1:"")
46 I $D(QRY("Document")) D DOCMTS
47 I $D(QRY("Order")) D ORDERS
48 I $D(QRY("Consult")) D CSLTS
49 I $D(QRY("Visit")) D VISITS
50 Q
51 ;
52DOCMTS ; -- Find documents
53 N DOCMT
54 M DOCMT=QRY("Document")
55 D DOCDT^ORQRY01(.DOCMT)
56 D QUERY^TIUQRY(ORY,.DOCMT,.ORYPAT)
57 I $D(DOCMT("NegativeSearch")) D NEGATE("Documents")
58 Q
59 ;
60CSLTS ; -- Find consults (treats consults as special case of orders)
61 N ORDER,ORGRP,SDATE,EDATE,ORCNT,X,CSLTMODE
62 M ORDER=QRY("Consult") S ORCNT=0,CSLTMODE=1
63 I '$D(ORDER("DisplayGroup")) D
64 . S ORDER("DisplayGroup",$O(^ORD(100.98,"B","CSLT",0)))=""
65 G ORDERS1
66 ;
67ORDERS ; -- Find orders
68 N ORDER,ORGRP,SDATE,EDATE,ORCNT,I
69 M ORDER=QRY("Order") S ORCNT=0
70ORDERS1 N ORCBO I $D(ORDER("ItemCombo1"))>1 S (ORCBO(1),ORCBO(2))=-1
71 I $D(ORDER("DisplayGroup"))>1 S I=0 F S I=$O(ORDER("DisplayGroup",I)) Q:'I D GRP(I)
72 D DATES,@$S($D(ORDER("Abnormal")):"ARSX",1:"ACTX") ;$G(ORDER("View")):"AVWX"
73 ; if looking for a combination and both not there, remove the orders
74 I $D(ORCBO),((ORCBO(1)=-1)!(ORCBO(2)=-1)) D
75 . D RMOV($S($G(CSLTMODE):"CST",1:"ORD"))
76 . S ORCNT=0
77 S:'$D(CSLTMODE) @ORY@(0,"Orders")=ORCNT
78 S:$D(CSLTMODE) @ORY@(0,"Consults")=ORCNT
79 I $D(ORDER("NegativeSearch")) D NEGATE($S($G(CSLTMODE):"Consults",1:"Orders"))
80 Q
81 ;
82GRP(DG) ; -- Setup display group DG in ORGRP()
83 N STK,MEM
84 S ORGRP(DG)="",STK=1,STK(STK)=DG_"^0",STK(0)=0,MEM=0
85 F S MEM=$O(^ORD(100.98,+STK(STK),1,MEM)) D @$S(+MEM'>0:"POP",1:"PROC") Q:STK<1
86 Q
87POP S STK=STK-1,MEM=$P(STK(STK),"^",2)
88 Q
89PROC S $P(STK(STK),"^",2)=MEM,DG=$P(^ORD(100.98,+STK(STK),1,MEM,0),"^",1)
90 S ORGRP(DG)="",STK=STK+1,STK(STK)=DG_"^0",MEM=0
91 Q
92 ;
93DATES ; -- Return SDATE and EDATE from TimeFrame
94 ; [Inverted for rev-chron search]
95 N X S X=$O(ORDER("TimeFrame","")),SDATE=$P(X,":"),EDATE=$P(X,":",2)
96 I EDATE S EDATE=$S($L(EDATE,".")=2:EDATE+.0001,1:EDATE+1)
97 I SDATE S SDATE=$S($L(SDATE,".")=2:SDATE-.0001,1:SDATE)
98 S SDATE=9999999-$S(SDATE:SDATE,1:0),EDATE=9999999-$S(EDATE:EDATE,1:9999998)
99 S X=EDATE,EDATE=SDATE,SDATE=X
100 Q
101 ;
102AVWX ; -- use ORQ1 for order view
103 N X,DG,MULT,ORLIST,ORI,IFN,ACT
104 S X=$O(ORDER("TimeFrame","")),SDATE=$P(X,":"),EDATE=$P(X,":",2)
105 S DG=+$O(^ORD(100.98,"B","ALL",0)),X=$G(ORDER("View"))
106 S MULT=$S("^1^6^8^9^10^11^13^14^20^22^"[(U_X_U):1,1:0)
107 D EN^ORQ1(PAT,,X,,SDATE,EDATE,,MULT)
108 S ORI=0 F S ORI=$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI'>0 S IFN=$G(^(ORI)),ACT=$P(IFN,";",2) D CONT
109 K ^TMP("ORR",$J,ORLIST)
110 Q
111 ;
112ARSX ; -- loop on ARS xref
113 N IDX,IFN
114 S IDX="^OR(100,""ARS"",PAT,SDATE)"
115 F S IDX=$Q(@IDX) Q:$P(IDX,"""",4)'=PAT Q:$P(IDX,",",4)>EDATE D
116 . S IFN=+$P(IDX,",",5) D CONT
117 Q
118ACTX ; -- loop on "ACT" xref
119 N IDX,IFN,ACT
120 S IDX="^OR(100,""ACT"",PAT,SDATE)"
121 F S IDX=$Q(@IDX) Q:$P(IDX,"""",4)'=PAT Q:$P(IDX,",",4)>EDATE D
122 . S IFN=+$P(IDX,",",6),ACT=+$P(IDX,",",7)
123 . I $P($G(^OR(100,IFN,8,ACT,0)),U,2)="NW"!$D(ORDER("SignStatus")) D CONT
124 Q
125CONT ; -- Proceed with checking order ORDER() & IFN [from ARS,ACT]
126 N X,X0,X3,X7,X8,ACTN
127 S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)),X7=$G(^(7))
128 Q:$P(X3,U,8) I $P(X3,U,9),'$P($G(^OR(100,+$P(X3,U,9),3)),U,8) Q
129 ;I $L($P(X0,U,17)),"^10^11^"[(U_STS_U) S X=$$LAPSED^OREVNTX($P(X0,U,17))
130 I $D(ORGRP) Q:'$D(ORGRP(+$P(X0,U,11)))
131 I $D(ORDER("Requestor")) Q:'$D(ORDER("Requestor",+$P(X0,U,4))) ;X8?
132 I $D(ORDER("Status")) Q:'$D(ORDER("Status",+$P(X3,U,3)))
133 I $D(ORDER("Abnormal")) Q:'$P(X7,U,2)
134 I $D(ORDER("Orderable")) Q:'$$OI(IFN)
135 S ACTN=$S($G(ACT):ACT,1:$$LAST(IFN)),X8=$G(^OR(100,IFN,8,ACTN,0))
136 S TXT=+$P(X8,U,14) I $D(ORDER("Text")) Q:'$$TEXT(IFN,TXT)
137 I $D(ORDER("SignStatus")) Q:'$L($P(X8,U,4)) Q:'$D(ORDER("SignStatus",+$P(X8,U,4)))
138 ;I $D(ORDER("Requestor")) Q:'$D(ORDER("Requestor",+$P(X8,U,3)))
139 D SAVEORD
140 Q
141 ;
142LAST(IFN) ; -- Returns DA of current/latest action for order IFN
143 ; (Only NW or XX actions?)
144 N Y S Y=+$P($G(^OR(100,IFN,3)),U,7)
145 I Y<1 S Y=+$O(^OR(100,IFN,8,"?"),-1)
146 Q Y
147 ;
148OI(IFN) ; -- Return 1 or 0, if IFN contains any requested OI's
149 N ITM,Y S Y=0
150 S ITM=0 F S ITM=$O(ORDER("Orderable",ITM)) Q:ITM<1 I $D(^OR(100,IFN,.1,"B",ITM)) S Y=1 Q
151 Q Y
152 ;
153TEXT(IFN,TXT) ; -- Return 1 or 0, if IFN;TXT text contains requested string
154 N X,Y,I S Y=0
155 S X="" F S X=$O(ORDER("Text",X)) Q:X="" S I=0 D
156 . F S I=+$O(^OR(100,IFN,8,TXT,.1,I)) Q:I<1 I $$UP^XLFSTR($G(^(I,0)))[$$UP^XLFSTR(X) S Y=1 Q
157 Q Y
158 ;
159SAVEORD ; -- Save order number in @ORY@("ORD:IFN;ACTN")
160 ; Called from CONT: also uses X0,X3,X8,TXT,ORYPAT
161 N ID,X
162 S ID=$S($D(CSLTMODE):"CST:",1:"ORD:")_IFN_";"_ACTN,ORCNT=ORCNT+1
163 S @ORY@(ID,"Order.Datetime")=$S($P(X0,U,8):$P(X0,U,8),1:$P(X8,U,16))
164 S @ORY@(ID,"Order.DisplayGroup")=$P($G(^ORD(100.98,+$P(X0,U,11),0)),U)
165 S @ORY@(ID,"Order.Provider")=$P($G(^VA(200,+$P(X0,U,4),0)),U)
166 S X=$P(X8,U,4),@ORY@(ID,"Order.Signature")=$S(X=0!(X=4):"on chart",X=1:"electronically signed",X=2:"unsigned",X=3:"not required",X=5:"cancelled",X=6:"service correction",X=7:"digitally signed",1:"")
167 S @ORY@(ID,"Order.Status")=$$LOW^XLFSTR($P($G(^ORD(100.01,+$P(X3,U,3),0)),U))
168 S @ORY@(ID,"Order.Abnormal")=$S($P(X7,U,2):"YES",X7:"NO",1:"")
169 S @ORY@(ID,"Order.Finding")=$P(X7,U,3)
170 S @ORY@(ID,"Order.Text")=$$BLDTXT(IFN,TXT)
171 M @ORY@(ID)=ORYPAT
172 I $D(ORCBO) D SETCBO(IFN)
173 Q
174BLDTXT(IFN,TXT) ; -- Return concatenated order text up to 245 chars
175 N I,ALL,PART,MAX S ALL="",MAX=0
176 S I=0 F S I=$O(^OR(100,IFN,8,TXT,.1,I)) Q:'I D Q:MAX
177 . S PART=$G(^OR(100,IFN,8,TXT,.1,I,0))
178 . I ($L(ALL)+$L(PART))<245 S ALL=ALL_$S($L(ALL):" ",1:"")_PART
179 . E S MAX=1
180 I MAX S ALL=ALL_"..."
181 Q ALL
182 ;
183SETCBO(IFN) ; -- Set flags when looking for combinations of orderable items
184 N I,OI
185 S I=0 F S I=$O(^OR(100,IFN,.1,I)) Q:'I D
186 . S OI=+^OR(100,IFN,.1,I,0)
187 . I $D(ORDER("ItemCombo1",OI)) S ORCBO(1)=1
188 . I $D(ORDER("ItemCombo2",OI)) S ORCBO(2)=1
189 Q
190 ;
191VISITS ; -- Find clinic visits
192 ; Save in @ORY@("VST:TYPE;DT;LOC")
193 N VISIT,X,SDATE,EDATE,ORV,ORCNT,I,ID,VTYPE
194 M VISIT=QRY("Visit")
195 S X=$O(VISIT("TimeFrame","")),SDATE=$P(X,":"),EDATE=$P(X,":",2)
196 S SDATE=SDATE-.0001 S:$L(EDATE,".")<2 EDATE=EDATE+.9999
197 D VST^ORWCV(.ORV,DFN,SDATE,EDATE,1) S ORCNT=0
198 S I=0 F S I=+$O(ORV(I)) Q:I<1 D
199 . S X=ORV(I) Q:'$$ISVALID(X)
200 . Q:$P(X,";",2)>(EDATE+1)
201 . S VTYPE=$P(ORV(I),";")
202 . S ID="VST:"_$P(X,U),ORCNT=ORCNT+1
203 . S @ORY@(ID,"Visit.Datetime")=$P(ID,";",2)
204 . S @ORY@(ID,"Visit.Location")=$P(X,U,3)
205 . S @ORY@(ID,"Visit.NoShow")=$S($E(X)'="A":"",$$UP^XLFSTR($P(X,U,4))["NO-SHOW":"YES",1:"NO")
206 . S:VTYPE'="I" @ORY@(ID,"Visit.Status")=$P(X,U,4)
207 . M @ORY@(ID)=ORYPAT
208 S @ORY@(0,"Visits")=ORCNT
209 I $D(VISIT("NegativeSearch")) D NEGATE("Visits")
210 Q
211 ;
212ISVALID(VST) ; -- True: valid visit data
213 N IX,VSTID,ISVAL
214 S VSTID=+$P(VST,";",3)
215 S (IX,ISVAL)=0
216 F S IX=$O(VISIT("Location",IX)) Q:'IX D
217 . I IX=VSTID S ISVAL=1 Q
218 S:'$D(VISIT("Location")) ISVAL=1
219 Q ISVAL
220 ;
221NEGATE(SRCHITM) ; -- set report to return nodes only when nothing found
222 N ID,RTNCNT,PRE
223 I SRCHITM="Consults" S ID="PTC:"_DFN,PRE="CST"
224 I SRCHITM="Orders" S ID="PTO:"_DFN,PRE="ORD"
225 I SRCHITM="Documents" S ID="PTD:"_DFN,PRE="DOC"
226 I SRCHITM="Visits" S ID="PTV:"_DFN,PRE="VST"
227 S RTNCNT=@ORY@(0,SRCHITM)
228 I RTNCNT=0 D
229 . M @ORY@(ID)=ORYPAT
230 . S @ORY@(ID,"Patient.NoneFound")=SRCHITM
231 . S @ORY@(0,SRCHITM)=1
232 E D
233 . D RMOV(PRE)
234 . S @ORY@(0,SRCHITM)=0
235 Q
236 ;
237RMOV(PRE) ; -- Remove nodes based on ID prefix
238 N ID
239 S ID="" F S ID=$O(@ORY@(ID)) Q:ID="" I $P(ID,":")=PRE K @ORY@(ID)
240 Q
Note: See TracBrowser for help on using the repository browser.