source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VIN5A.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: 9.3 KB
Line 
1LA7VIN5A ;DALOI/JMC - Process Incoming UI Msgs, continued ;May 29, 2008
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,67,72,66**;Sep 27, 1994;Build 30
3 ; This routine is a continuation of LA7VIN5.
4 ; It is performs processing of fields in OBX segments.
5 Q
6 ;
7XFORM ; Transform the result based on fields 12,13,14,16,17 in the Chem Test
8 ; multiple in the Auto Instrument file (62.4), or set on the fly
9 ; from PARAM 1
10 N LA7I
11 S LA7XFORM=LA76241(2)
12 ;
13 ; get PARAM 1 overrides
14 I $D(LA7XFORM(1)),LA7XFORM(1)?1.N S $P(LA7XFORM,"^")=LA7XFORM(1)
15 F LA7I=2,3,5,6 I $D(LA7XFORM(LA7I)) S $P(LA7XFORM,"^",LA7I)=LA7XFORM(LA7I)
16 ; set up defaults if field was not answered
17 ; accept results,yes
18 I $P(LA7XFORM,"^",3)="" S $P(LA7XFORM,"^",3)=1
19 ; strip spaces,no
20 I $P(LA7XFORM,"^",6)="" S $P(LA7XFORM,"^",6)=0
21 ; now transform
22 ;
23 ; Don't accept results
24 I '$P(LA7XFORM,"^",3) S LA7VAL="" Q
25 ;
26 ; Only accept "FINAL" type results
27 I $P(LA7XFORM,"^",3)=2,"CFUX"'[LA7ORS S LA7VAL="" Q
28 ;
29 ; Accept ordered tests only
30 ; If LEDI interface (10) and message indicates a reflex ("G") or add-on
31 ; test ("A") then process anyway in case it has not been added to
32 ; accession.
33 I $P(LA7XFORM,"^",5) D
34 . I LA7INTYP=10,LA7SAC?1(1"A",1"G") Q
35 . S LA7LIMIT=1
36 ;
37 ; Decimal places if number of places defined
38 I $P(LA7XFORM,"^")?1.N D JUSTDEC
39 ;
40 ; Strip spaces
41 I $P(LA7XFORM,"^",6) S LA7VAL=$TR(LA7VAL," ","")
42 ;
43 ; Make result a comment
44 ; Set value to null after making into remark, don't store twice.
45 I $P(LA7XFORM,"^",2) D
46 . N LA7Y
47 . ; Store comment in ^LAH global
48 . S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
49 . D RMKSET^LASET(LA7LWL,LA7ISQN,LA7VAL,LA7Y)
50 . S LA7VAL=""
51 Q
52 ;
53 ;
54CHKDIE ; Check if value to be stored passes input transform of field in DD
55 N LA7ERR,LA7Y
56 ;
57 ; If result is on a LEDI interface (type=10) then don't check result
58 ; against FileMan input transform.
59 ; VistA sends "canc" as test result when test is cancelled.
60 ; DoD sends "PL Canceled" --> change to "canc" for VistA storage.
61 I LA7INTYP=10 D Q
62 . I LA7VAL="PL Cancelled" S LA7VAL="canc"
63 . I LA7VAL="PL Canceled" S LA7VAL="canc"
64 . I LA7VAL="PLCanceled" S LA7VAL="canc"
65 ;
66 ; If value fails data checker then log error and suppress result.
67 D CHK^DIE(LA7SUBFL,LA76304,"H",LA7VAL,.LA7Y,"LA7ERR")
68 I LA7Y="^" D
69 . N LA7X
70 . S LA7X=$G(LA7ERR("DIERR",1,"TEXT",1))
71 . D CREATE^LA7LOG(37)
72 . S LA7VAL=""
73 Q
74 ;
75 ;
76JUSTDEC ; Justify to number of places specified
77 ;
78 N LA7DDTYP,LA7FMT,LA7I,LA7PRFIX,LA7X
79 ;
80 ; If LEDI interface (type=10) then skip decimal adjustment
81 I LA7INTYP=10 Q
82 ;
83 ; Get data name field type from DD
84 ; Only justify if Vista field is numeric or free text.
85 S LA7DDTYP=$$GET1^DID(LA7SUBFL,LA76304,"","TYPE")
86 I "NUMERIC^FREE TEXT"'[LA7DDTYP D Q
87 . N LA7FLDNM
88 . S LA7FLDNM=$$GET1^DID(63.04,LA76304,"","LABEL")
89 . D CREATE^LA7LOG(38)
90 ;
91 S LA7X=LA7VAL,(LA7FMT,LA7PRFIX)=""
92 ;
93 ; If comma formatted, strip comma and set flag to add back in.
94 S LA7X=$TR(LA7X,",","")
95 I LA7X'=LA7VAL S LA7FMT="P"
96 ;
97 ; If "<>=" formatted, strip and save to add back in.
98 F LA7I=1:1:$L(LA7X) Q:$E(LA7X,LA7I)'?1(1"<",1">",1"=")
99 I LA7I>1 D
100 . S LA7PRFIX=$E(LA7X,1,LA7I-1)
101 . S LA7X=$E(LA7X,LA7I,$L(LA7X))
102 ;
103 ; Format if starts with number or decimal point, skip other results.
104 I LA7X?1(1.N,.N1"."1.N) D
105 . S LA7X=$FN(LA7X,LA7FMT,+LA7XFORM)
106 . S LA7VAL=LA7PRFIX_LA7X
107 Q
108 ;
109 ;
110PRDID(LA7PRDID,LA7SFAC,LA7CS) ; Process/Store Producer's ID
111 ; Store where test was performed.
112 ; Call with LA7PRDID = Producer's ID field
113 ; LA7SFAC = sending facility
114 ; LA7CS = component encoding character
115 ;
116 ; Remove units/reference ranges when Lab UI interface
117 ; so file #60 settings always used
118 I $G(LA7INTYP)=1 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)="" Q
119 ;
120 N LA74,LA7I,LA7X,LA7Y
121 ;
122 S LA7X=$P(LA7PRDID,LA7CS,2),LA74=""
123 ;
124 F LA7I=1,4 D Q:LA74
125 . I $P(LA7PRDID,LA7CS,LA7I+2)="99VA4" S LA74=$$LKUP^XUAF4($P(LA7PRDID,LA7CS,LA7I))
126 . I 'LA74,$P(LA7PRDID,LA7CS,LA7I+2)?1(1"L-CL",1"CLIA",1"99VACLIA") S LA74=$$IDX^XUAF4("CLIA",$P(LA7PRDID,LA7CS,LA7I))
127 . I 'LA74 S LA74=$$LKUP^XUAF4($P(LA7PRDID,LA7CS,LA7I+1))
128 . I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7PRDID,LA7CS),1,1)
129 . I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7SFAC,LA7CS),1,1)
130 ;
131 ; Store producer's id in LAH global with results.
132 I LA74 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",9)=LA74 Q
133 ;
134 ; Don't store producer's id as comment.
135 I '$P(LA76241(2),"^",9) Q
136 ; If unable to identify producer in file #4
137 ; then store as comment if field STORE PRODUCER'S ID (#20) enabled.
138 I LA7X="" Q
139 S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
140 S LA7X=$S(LA7Y="":"P",1:"p")_"erformed by "_LA7X
141 D RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
142 ;
143 Q
144 ;
145 ;
146REFRNG(LA7X) ; Process/Store References Range.
147 ; Call with LA7X = reference range to store.
148 ;
149 Q:$G(LA7INTYP)=1
150 N LA7Y,X,Y
151 ;
152 ; Check if site does not want to store reference ranges on POC test.
153 I LA7INTYP>19,LA7INTYP<30,+$P(LA76241(2),"^",10)=0 Q
154 ;
155 ; Remove leading and trailing quotes from reference range.
156 S LA7X=$$TRIM^XLFSTR($G(LA7X),"RL","""")
157 I LA7X="" Q
158 ;
159 S X=$P($G(^LAH(LA7LWL,1,LA7ISQN,LA76304)),"^",5)
160 ;
161 ; >lower limit (no upper limit e.g. >10) - store as low value
162 I LA7X?1">".N.1".".N S $P(X,"!",2)=$TR(LA7X,">",""),LA7X=""
163 ;
164 ; <upper limit (no lower limit e.g. <15) - store as high value
165 I LA7X?1"<".N.1".".N S $P(X,"!",3)=$TR(LA7X,"<",""),LA7X=""
166 ;
167 ; Alphabetic reference with hyphen
168 I LA7X?1.A1"-"1.A S $P(X,"!",2)=$C(34)_LA7X_$C(34),LA7X=""
169 ;
170 ; Lower limit value
171 S Y=$P(LA7X,"-")
172 I Y'="" D
173 . I Y?.N.1".".N S $P(X,"!",2)=Y
174 . E S $P(X,"!",2)=$C(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$C(34)
175 ;
176 ; Upper limit value
177 S Y=$P(LA7X,"-",2)
178 I Y'="" D
179 . I Y?.N.1".".N S $P(X,"!",3)=Y
180 . E S $P(X,"!",3)=$C(34)_$$UNESC^LA7VHLU3(Y,LA7FS_LA7ECH)_$C(34)
181 ;
182 ; Store reference range in LAH global with results.
183 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=X
184 ;
185 Q
186 ;
187 ;
188ABFLAG(LA7X) ; Process/Store Abnormal Flags.
189 ; Call with LA7X = abnormal flags to store.
190 ; Converts flag to interpretation based on HL7 Table 0078.
191 ; If no match store code instead of interpretation
192 ;
193 Q:LA7INTYP=1
194 N I,LA7I,LA7Y,X
195 ;
196 ; Store abnormal flags in LAH global with results.
197 ; Currently only storing high/low and critical flags
198 S LA7Y=$S(LA7X="L":"L",LA7X="H":"H",LA7X="LL":"L*",LA7X="HH":"H*",1:"")
199 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",2)=LA7Y
200 ;
201 ; Critical or designated abnormal tests generate bulletin/alert
202 ; on LEDI (type=10) interfaces.
203 I LA7INTYP=10,LA7Y'="" D
204 . I $E(LA7Y,2)'="*",'$P(LA76241(2),"^",11) Q
205 . S LA7I=$O(^TMP("LA7 ABNORMAL RESULTS",$J,""),-1),LA7I=LA7I+1
206 . S X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$S(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)
207 . S ^TMP("LA7 ABNORMAL RESULTS",$J,LA7I)=X
208 ;
209 ; If POC interface and abnormal flag is not handled by VistA above
210 ; then store as comment.
211 I LA7INTYP>19,LA7INTYP<30,LA7Y="",LA7X'="" D
212 . S X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
213 . S I=$F(X,LA7X)\3
214 . S LA7Y="normalcy status - "_$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
215 . D RMKSET^LASET(LA7LWL,LA7ISQN,LA7Y,$P(LA7RMK(0,+LA76241(0)),"^",2))
216 ;
217 Q
218 ;
219 ;
220EII ; Store equipment instance identifier in LAH global with results.
221 ;
222 N I,LA7X,X
223 ;
224 S LA7X=""
225 F I=1:1:4 D
226 . S X=$P(LA7EII,LA7CS,I)
227 . I X="" Q
228 . S $P(LA7X,"!",I)=$TR(X,"!","~")
229 I LA7X'="" S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",11)=LA7X
230 Q
231 ;
232 ;
233ORESULTS ; Process results that accompany order (ORM) messages
234 ;
235 N I,LA764,LA7DIE,LA7ERR,LA7I,LA7WP,LA7X,LA7Y,X
236 S LA7WP(1,0)=" ",LA7I=2,X=""
237 I LA7RLNC S X="[LOINC "_$$GET1^DIQ(95.3,LA7RLNC_",",.01)_"] "_$$GET1^DIQ(95.3,LA7RLNC_",",80)
238 I 'LA7RLNC,LA7RNLT D
239 . S LA764=$$FIND1^DIC(64,"","X",LA7RNLT,"E","","LA7ERR")
240 . I 'LA764 S LA7RNLT="" Q
241 . S X="[NLT "_$$GET1^DIQ(64,LA764_",",1)_"] "_$$GET1^DIQ(64,LA764_",",.01,"I")
242 I 'LA7RLNC,'LA7RNLT D
243 . I LA7TEST(0)]""!(LA7TEST]"") S X="["_LA7TEST(0,1)_" "_LA7TEST_"] "_LA7TEST(0) Q
244 . S X="["_LA7TEST(2,1)_" "_LA7TEST(2)_"] "_LA7TEST(2,0)
245 S LA7WP(LA7I,0)="Test result: "_X
246 ; Date value
247 I LA7VTYP="DT" D
248 . S LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
249 . S LA7X=$$HL7TFM^XLFDT(LA7X,"L")
250 . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X
251 ; Coded entry
252 I "CECM"[LA7VTYP D
253 . S LA7X=$P($$P^LA7VHLU(.LA7SEG,6,LA7FS),LA7CS,2)
254 . S LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
255 . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X_$S(LA7UNITS]"":" "_LA7UNITS,1:"")
256 ; Numeric/ Structured Numeric value
257 I "NMSN"[LA7VTYP D
258 . S LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
259 . S LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
260 . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X_$S(LA7UNITS]"":" "_LA7UNITS,1:"")
261 ; String Data/ Formatted Text/ Text Data
262 I "FTSTX"[LA7VTYP D
263 . D PA^LA7VHLU(.LA7SEG,6,LA7FS,.LA7X)
264 . D UNESCFT^LA7VHLU3(.LA7X,LA7FS_LA7ECH,.LA7Y)
265 . I LA7Y=1,(($L(LA7Y(1,0))+$L(LA7UNITS))<225) S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7Y(1,0)_$S(LA7UNITS]"":" "_LA7UNITS,1:"") Q
266 . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value:"
267 . F I=1:1:LA7Y S LA7I=LA7I+1,LA7WP(LA7I,0)=LA7Y(I,0)
268 . I LA7UNITS'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test units: "_LA7UNITS
269 ; Normals/ Reference range
270 S LA7X=$$P^LA7VHLU(.LA7SEG,8,LA7FS)
271 I LA7X'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test normals: "_LA7X
272 ; Normalcy status
273 S LA7X=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
274 I LA7X'="" D
275 . S X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
276 . S I=$F(X,LA7X)\3,LA7X=$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
277 . I LA7X'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test normalcy status: "_LA7X
278 I $D(LA7WP) D WP^DIE(69.6,LA7696_",",99,"A","LA7WP","LA7DIE(99)")
279 Q
Note: See TracBrowser for help on using the repository browser.