source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORKLR2.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 7.4 KB
Line 
1ORKLR2 ; slc/CLA - Order checking support proc for lab orders, part 2;2/13/97 10:01
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3 Q
4ORFREQ(ORKLR,OI,ORDFN,NEWORDT,SPECIMEN) ;lab order freq restrictions order check
5 N LRID,LFREQS,MAX,DAILY,MAXDT,EARLYDT,ORM,ORD,X1,X2
6 S EARLYDT=NEWORDT
7 ;get lab id from orderable item (OI):
8 S LRID=$P(^ORD(101.43,OI,0),U,2) I $L($G(LRID)) D
9 .S LFREQS=$$FREQS(+LRID,SPECIMEN),MAX=$P(LFREQS,U),DAILY=$P(LFREQS,U,2)
10 .;if max order freq exists, don't process for daily order max:
11 .I '$L($G(MAX)) S:$L($G(DAILY)) ORD(LRID_";"_SPECIMEN)=DAILY_"^0"
12 .I $L($G(MAX)) D
13 ..S X1=NEWORDT,X2="-"_MAX D C^%DTC Q:X<1 S MAXDT=X
14 ..I MAXDT<EARLYDT S EARLYDT=MAXDT ;find and keep earliest MAXDT
15 ..;
16 ..;The earliest max d/t is used because if the lab order has children,
17 ..;they may have different (or no) maximum order freq values. By taking
18 ..;the earliest, we cover all values yet narrow the search range for the
19 ..;call into ORQ1. In MAXFREQ2 the specific max d/ts stored in ORL are
20 ..;checked against the d/ts of orders returned by ORQ1. ORQ1 orders' d/t
21 ..;are checked to see if they fall between the max d/t of an equivalent
22 ..;parent or child lab test order stored in ORL and the d/t of the order
23 ..;being checked.
24 ..;
25 ..S ORM(LRID_";"_SPECIMEN)=MAXDT
26 ;
27 ;expand into child-level lab identifiers if children exist for this OI:
28 S LRID="" F S LRID=$O(^ORD(101.43,OI,10,"AID",LRID)) Q:LRID="" D
29 .S MAX="",DAILY="",LFREQS=""
30 .S LFREQS=$$FREQS(+LRID,SPECIMEN),MAX=$P(LFREQS,U),DAILY=$P(LFREQS,U,2)
31 .;if max order freq exists, don't process for daily order max:
32 .I '$L($G(MAX)),($L($G(DAILY))) S ORD(LRID_";"_SPECIMEN)=DAILY
33 .I $L($G(MAX)) D
34 ..S X1=NEWORDT,X2="-"_MAX D C^%DTC Q:X<1 S MAXDT=X
35 ..I MAXDT<EARLYDT S EARLYDT=MAXDT ;find and keep earliest MAXDT
36 ..S ORM(LRID_";"_SPECIMEN)=MAXDT
37 I $D(ORM) D MAXFREQ(.ORM,EARLYDT)
38 I $D(ORD) D DAILY(.ORD)
39 Q
40MAXFREQ(ORM,EARLYDT) ;check for maximum order frequency violation
41 N DGIEN,HOR,SEQ,X,ORIFN,ODT,ORIFNC
42 S HOR=0,SEQ=0
43 ;get all lab orders since earliest max order freq d/t:
44 S DGIEN=0,DGIEN=$O(^ORD(100.98,"B","LAB",DGIEN))
45 K ^TMP("ORR",$J)
46 D EN^ORQ1(ORDFN,DGIEN,1,"",EARLYDT,NEWORDT,1,0)
47 S HOR=$O(^TMP("ORR",$J,HOR)) Q:+HOR<1
48 F S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1 D
49 .S X=^TMP("ORR",$J,HOR,SEQ),ORIFN=+$P(X,U),ODT=$P(X,U,4)
50 .;break into child orders if they exist:
51 .I $D(^OR(100,ORIFN,2,0)) D ;child orders exist
52 ..S ORIFNC=0 F S ORIFNC=$O(^OR(100,ORIFN,2,ORIFNC)) Q:ORIFNC="" D
53 ...D MAXFREQ2(ORIFNC,ODT,.ORM)
54 .I '$D(^OR(100,ORIFN,2,0)) D MAXFREQ2(ORIFN,ODT,.ORM)
55 K ^TMP("ORR",$J)
56 Q
57MAXFREQ2(ORIFN,ODT,ORL) ;second part of max order freq order check
58 N ORS,ORSI,ORSP,OROI,LRID,LRIDX,LRIDXC,EXDT,INVDT,MAXDT,ORKMSG
59 S ORS=$$STATUS^ORQOR2(ORIFN),ORSI=$P(ORS,U)
60 ;quit if order status is canceled/discontinued/expired/lapsed/changed/delayed:
61 I (ORSI=13)!(ORSI=1)!(ORSI=7)!(ORSI=14)!(ORSI=12)!(ORSI=10) Q
62 ;
63 ;get specimen for this order:
64 S ORSP=$$VALUE^ORCSAVE2(ORIFN,"SPECIMEN")
65 Q:'$L($G(ORSP)) ;quit if no specimen found
66 ;get orderable item for this order:
67 S OROI=$$OI^ORQOR2(ORIFN)
68 Q:'$L($G(OROI)) ;quit if no orderable item found
69 ;get lab id and check against ordered array ORD
70 S:$L($G(^ORD(101.43,OROI,0))) LRIDX=$P(^ORD(101.43,OROI,0),U,2)_";"_ORSP I $L($G(LRIDX)) D
71 .S LRID="" F S LRID=$O(ORL(LRID)) Q:LRID="" I LRID=LRIDX D
72 ..S MAXDT=ORL(LRID)
73 ..;if order's dt > max dt and (order's dt < new order's dt or
74 ..; order's date = new order's date), max order freq violated:
75 ..I ODT>MAXDT,((ODT<NEWORDT)!($P(ODT,".")=$P(NEWORDT,"."))) D
76 ...S ORKMSG="Max lab test order freq exceeded for: "_$E($P(^LAB(60,+LRID,0),U),1,30)
77 ...S ORKLR(ORKMSG)=ORIFN_U_ORKMSG
78 ;get children lab ids and check against ordered array ORD
79 S LRIDX="" F S LRIDX=$O(^ORL(101.43,OROI,10,"AID",LRIDX)) Q:LRIDX="" D
80 .S LRIDXC=LRIDX_";"_ORSP
81 .S LRID="" F S LRID=$O(ORL(LRID)) Q:LRID="" I LRID=LRIDXC D
82 ..S MAXDT=ORL(LRID)
83 ..;if order's dt > max dt and (order's dt < new order's dt or
84 ..; order's date = new order's date), max order freq violated:
85 ..I ODT>MAXDT,((ODT<NEWORDT)!($P(ODT,".")=$P(NEWORDT,"."))) D
86 ...S ORKMSG="Max lab test order freq exceeded for: "_$E($P(^LAB(60,+LRID,0),U),1,30)
87 ...S ORKLR(ORKMSG)=ORIFN_U_ORKMSG
88 Q
89DAILY(ORD) ;check for daily order maximum violation
90 N DGIEN,HOR,SEQ,X,ORIFN,ODT,ORIFNC,NEWORDAY,CNT
91 S HOR=0,SEQ=0,CNT=0
92 ;get all lab orders occurring on new order's date:
93 S NEWORDAY=$P(NEWORDT,".")
94 S DGIEN=0,DGIEN=$O(^ORD(100.98,"B","LAB",DGIEN))
95 K ^TMP("ORR",$J)
96 D EN^ORQ1(ORDFN,DGIEN,1,"",NEWORDAY+.0001,NEWORDAY+.24,1,0)
97 S HOR=$O(^TMP("ORR",$J,HOR)) Q:+HOR<1
98 S SEQ=0 F S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1 D
99 .S X=^TMP("ORR",$J,HOR,SEQ),ORIFN=+$P(X,U),ODT=$P(X,U,4)
100 .;break into child orders if they exist:
101 .I $D(^OR(100,ORIFN,2,0)) D ;child orders exist
102 ..S ORIFNC=0 F S ORIFNC=$O(^OR(100,ORIFN,2,ORIFNC)) Q:ORIFNC="" D
103 ...D DAILY2(ORIFNC,ODT,CNT,.ORD)
104 .I '$D(^OR(100,ORIFN,2,0)) D DAILY2(ORIFN,ODT,CNT,.ORD)
105 K ^TMP("ORR",$J)
106 Q
107DAILY2(ORIFN,ODT,CNT,ORL) ;second part of daily order max order check
108 N ORS,ORSI,ORSP,OROI,LRID,LRIDX,LRIDXC,EXDT,INVDT,DAILY
109 S ORS=$$STATUS^ORQOR2(ORIFN),ORSI=$P(ORS,U)
110 ;quit if order status is canceled/discontinued/expired/lapsed/changed/delayed:
111 I (ORSI=13)!(ORSI=1)!(ORSI=7)!(ORSI=14)!(ORSI=12)!(ORSI=10) Q
112 ;
113 ;get specimen for this order:
114 S ORSP=$$VALUE^ORCSAVE2(ORIFN,"SPECIMEN")
115 Q:'$L($G(ORSP)) ;quit if no specimen found
116 ;get orderable item for this order:
117 S OROI=$$OI^ORQOR2(ORIFN)
118 Q:'$L($G(OROI)) ;quit if no orderable item found
119 ;get lab id and check against ordered array ORD
120 S:$L($G(^ORD(101.43,OROI,0))) LRIDX=$P(^ORD(101.43,OROI,0),U,2)_";"_ORSP I $L($G(LRIDX)) D
121 .;use 2nd piece of the lab id array as a counter to keep counter specific to the lab test_specimen:
122 .S LRID="" F S LRID=$O(ORL(LRID)) Q:LRID="" I LRID=LRIDX D
123 ..S $P(ORL(LRID),U,2)=$P(ORL(LRID),U,2)+1,DAILY=$P(ORL(LRID),U)
124 ..;if count for this lab test_specimen exceeds daily order max, send oc message:
125 ..I $P(ORL(LRID),U,2)=DAILY D
126 ...S ORKMSG="Lab test daily order max exceeded for: "_$E($P(^LAB(60,+LRID,0),U),1,30)
127 ...S ORKLR(ORKMSG)=ORIFN_U_ORKMSG
128 ;get children lab ids and check against ordered array ORD
129 S LRIDX="" F S LRIDX=$O(^ORL(101.43,OROI,10,"AID",LRIDX)) Q:LRIDX="" D
130 .S LRIDXC=LRIDX_";"_ORSP
131 .;use 2nd piece of the lab id array as a counter to keep counter specific to the lab test_specimen:
132 .S LRID="" F S LRID=$O(ORL(LRID)) Q:LRID="" I LRID=LRIDXC D
133 ..S $P(ORL(LRID),U,2)=$P(ORL(LRID),U,2)+1,DAILY=$P(ORL(LRID),U)
134 ..;if count for this lab test_specimen exceeds daily order max, send oc message:
135 ..I $P(ORL(LRID),U,2)=DAILY D
136 ...S ORKMSG="Lab test daily order max exceeded for: "_$E($P(^LAB(60,+LRID,0),U),1,30)
137 ...S ORKLR(ORKMSG)=ORIFN_U_ORKMSG
138 Q
139FREQS(LRIEN,ORSPEC) ;extrinsic funct returns max order freq and daily order max for a lab test
140 N LRY,LRI,SPEC,MAXFREQ,X,DAILYMAX,Y,LRCNODE
141 S MAXFREQ="",DAILYMAX=""
142 D TEST^LR7OR3(LRIEN,.LRY)
143 I $D(LRY) D
144 .S LRI="" F S LRI=$O(LRY("CollSamp",LRI)) Q:LRI="" D
145 ..S LRCNODE=LRY("CollSamp",LRI),SPEC=$P(LRCNODE,U,3),X=+$P(LRCNODE,U,5),Y=+$P(LRCNODE,U,6)
146 ..;if specimens match:
147 ..I SPEC=ORSPEC D
148 ...;get maxfreq, if more than one max freq exists for this
149 ...; collection sample/specimen use the largest max freq:
150 ...I X>MAXFREQ S MAXFREQ=X
151 ...;if dailymax > 0:
152 ...I $G(Y)>0 D
153 ....I $L($G(DAILYMAX)),(Y<DAILYMAX) S DAILYMAX=Y ;use smallest daily mx
154 ....I '$L($G(DAILYMAX)) S DAILYMAX=Y ;get first occurrence of dailymax
155 Q MAXFREQ_U_DAILYMAX
Note: See TracBrowser for help on using the repository browser.