source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VIN5.m@ 1352

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1LA7VIN5 ;DALOI/JMC - Process Incoming UI Msgs, continued ; 01/14/99
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
3 ; This routine is a continuation of LA7VIN1 and is only called from there.
4 ; It is called to process OBX segments for "CH" subscript tests.
5 Q
6 ;
7OBX ;
8 ;
9 N LA76241,LA76304,LA7EII,LA7I,LA7LIMIT,LA7OBM,LA7SUBFL,LA7TEST,LA7TREEN,LA7UNITS,LA7VAL,LA7VTYP,LA7X,LA7XFORM,LA7Y
10 ;
11 K LA7RMK,^TMP("LA7TREE",$J)
12 ;
13 S LA7SUBFL=63.04
14 ;
15 ; OBX Set ID
16 S LA7SOBX=$$P^LA7VHLU(.LA7SEG,2,LA7FS)
17 ;
18 ; Value type - type of data from Table 0125
19 S LA7VTYP=$P($$P^LA7VHLU(.LA7SEG,3,LA7FS),LA7CS)
20 ;
21 ; Determine test result codes - check for primary and alternate codes
22 ; For DoD/CHCS interface - do NOT process test codes using 99LRT as coding system per DoD/July 2002.
23 S LA7X=$$P^LA7VHLU(.LA7SEG,4,LA7FS),(LA7RNLT,LA7RLNC)=""
24 S LA7TEST=$P(LA7X,LA7CS)
25 S LA7TEST(0)=$$UNESC^LA7VHLU3($P(LA7X,LA7CS,2),LA7FS_LA7ECH)
26 I LA7TEST(0)["^" S LA7TEST(0)=$TR(LA7TEST(0),"^","~")
27 S LA7TEST(0,1)=$P(LA7X,LA7CS,3)
28 S LA7TEST(2)=$P(LA7X,LA7CS,4)
29 S LA7TEST(2,0)=$$UNESC^LA7VHLU3($P(LA7X,LA7CS,5),LA7FS_LA7ECH)
30 I LA7TEST(2,0)["^" S LA7TEST(2,0)=$TR(LA7TEST(2,0),"^","~")
31 S LA7TEST(2,1)=$P(LA7X,LA7CS,6)
32 F I=3,6 D
33 . S LA7Y=$P(LA7X,LA7CS,I-2)
34 . I $P(LA7X,LA7CS,I)="LN" D Q
35 . . I $$GET1^DIQ(95.3,+LA7Y_",",.01)=LA7Y S LA7RLNC=+LA7Y
36 . I $P(LA7X,LA7CS,I)="99VA64" D Q
37 . . I $$FIND1^DIC(64,"","OMX",LA7Y) S LA7RNLT=LA7Y
38 . I $P(LA7X,LA7CS,I)="99LRT" D Q
39 . . I LA7TEST(0)="",LA7TEST(2,0)'="" S LA7TEST(0)=LA7TEST(2,0)
40 . . I LA7TEST(2,0)="",LA7TEST(0)'="" S LA7TEST(2,0)=LA7TEST(0)
41 . . I I=3 S (LA7TEST,LA7TEST(0),LA7TEST(0,1))="" Q
42 . . I I=6 S (LA7TEST(2),LA7TEST(2,0),LA7TEST(2,1))="" Q
43 I LA7TEST="",LA7TEST(2)'="" D
44 . S LA7TEST=LA7TEST(2),LA7TEST(0)=LA7TEST(2,0),LA7TEST(0,1)=LA7TEST(2,1)
45 . S (LA7TEST(2),LA7TEST(2,0),LA7TEST(2,1))=""
46 ;
47 ; No test code in message
48 I LA7TEST="",LA7TEST(2)="" D Q
49 . N LA7OBX
50 . S LA7OBX=LA7SEG(0)
51 . D CREATE^LA7LOG(15)
52 ;
53 ; Test code not found in auto inst file, also check alternate codes,
54 ; and log error if none found.
55 I LA7MTYP="ORU" D Q:LA7TEST=""
56 . I LA7TEST'="",$D(^LAB(62.4,LA7624,3,"AC",LA7TEST)) Q
57 . I LA7TEST(2)'="",$D(^LAB(62.4,LA7624,3,"AC",LA7TEST(2))) D Q
58 . . S LA7TEST=LA7TEST(2),LA7TEST(0)=LA7TEST(2,0),LA7TEST(0,1)=LA7TEST(2,1)
59 . D CREATE^LA7LOG(16) S LA7TEST=""
60 ;
61 ; Units - trim leading/trailing spaces
62 S LA7UNITS=$$P^LA7VHLU(.LA7SEG,7,LA7FS)
63 I LA7UNITS]"" S LA7UNITS=$$TRIM^XLFSTR(LA7UNITS,"LR"," ")
64 ;
65 ; Observation result status - Table 0085
66 S LA7ORS=$$P^LA7VHLU(.LA7SEG,12,LA7FS)
67 ;
68 ; Responsible observer
69 S LA7RO=$$XCNTFM^LA7VHLU4($$P^LA7VHLU(.LA7SEG,17,LA7FS),LA7ECH)
70 ;
71 ; Observation method
72 S LA7X=$$P^LA7VHLU(.LA7SEG,18,LA7FS),LA7OBM=""
73 I $P(LA7X,LA7CS,3)="99VA64_2" S LA7OBM=$P($P(LA7X,LA7CS,1),".",2)
74 ;
75 ; Equipment instance identifier
76 S LA7EII=$$P^LA7VHLU(.LA7SEG,19,LA7FS)
77 I LA7EII'="" D
78 . S LA7EII=$$UNESC^LA7VHLU3(LA7EII,LA7FS_LA7ECH)
79 . S LA7EII=$TR(LA7EII,"^",";")
80 ;
81 ; Process ORU message results for all tests which use this test code.
82 I LA7MTYP="ORU" D Q
83 . S LA76241=0
84 . F S LA76241=$O(^LAB(62.4,LA7624,3,"AC",LA7TEST,LA76241)) Q:'LA76241 D PROCESS
85 ;
86 I LA7MTYP="ORM",$G(LA7696)>0 D ORESULTS^LA7VIN5A
87 ;
88 Q
89 ;
90 ;
91PROCESS ; Process results for a given test code
92 S LA7VAL=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
93 I LA7VTYP="CE",$P(LA7VAL,LA7CS,2)'="" S LA7VAL=$P(LA7VAL,LA7CS,2)
94 E S LA7VAL=$P(LA7VAL,LA7CS)
95 ;
96 F LA7I=0,1,2 S LA76241(LA7I)=$G(^LAB(62.4,LA7624,3,LA76241,LA7I))
97 ;
98 ; Chem test fields incorrect
99 I (LA76241(0)="")!(LA76241(1)="") D Q
100 . D CREATE^LA7LOG(18)
101 ;
102 ; Setup LA7RMK(0) variable in case comments (NTE) sent with test results.
103 S LA7RMK(0,+LA76241(0))=+$P(LA76241(2),"^",7)_"^"_$P(LA76241(2),"^",8)
104 ;
105 S LA76304=+$P(LA76241(1),"(",2) ;lab data field
106 ; No dataname for this result
107 I LA76304'>1 D Q
108 . D CREATE^LA7LOG(18)
109 ;
110 ; Set flag for new results alert
111 I "CDW"'[LA7ORS S ^TMP("LA7-ORU",$J,LA76248,LA76249)=""
112 ;
113 ; Set flag to send amended results bulletin
114 I "CDW"[LA7ORS D
115 . S LA7I=$O(^TMP("LA7 AMENDED RESULTS",$J,""),-1),LA7I=LA7I+1
116 . S X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$S(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)
117 . S ^TMP("LA7 AMENDED RESULTS",$J,LA7I)=X
118 . I LA7UID'="" S ^LAH("LA7 AMENDED RESULTS",LA7UID,LA76304,LA7LWL,LA7ISQN)=X
119 ;
120 ; NOTE - this array can be set from inside PARAM 1
121 K LA7XFORM
122 ; execute PARAM 1 if not a LEDI interface
123 I LA7INTYP'=10 X $P(LA76241(0),"^",2)
124 I $P(LA76241(2),"^",3)=0 Q
125 I $P(LA76241(2),"^",3)=2,"CFUX"'[LA7ORS Q
126 ;
127 ; No value found
128 I LA7VAL="" D Q
129 . D CREATE^LA7LOG(17)
130 ;
131 ; Transform result based on fields in file 62.4
132 D XFORM^LA7VIN5A
133 Q:LA7VAL=""
134 ;
135 ; Check if result passes input transform on data name
136 D CHKDIE^LA7VIN5A
137 Q:LA7VAL=""
138 ;
139 ; Set flag to not store comments if it wasn't explicitly ordered.
140 I $G(LA7LIMIT)=1 D
141 . N LA76804
142 . K LA7LIMIT,LA7TREEN,^TMP("LA7TREE",$J)
143 . ; Store all tests accessioned in ^TMP
144 . S LA76804=0
145 . F S LA76804=$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA76804)) Q:'LA76804 D UNWIND^LA7UTIL(LA76804)
146 . I '$D(^TMP("LA7TREE",$J,+LA76241(0))) S LA7LIMIT=1 ;wasn't ordered
147 I $G(LA7LIMIT) D Q
148 . S $P(LA7RMK(0,+LA76241(0)),"^",1)=0
149 . K LA7LIMIT,^TMP("LA7TREE",$J)
150 K ^TMP("LA7TREE",$J)
151 ;
152 ; Check point of care interface for matching specimen type
153 ; for this test in #62.4
154 I LA7INTYP>19,LA7INTYP<30 D Q:'LA761
155 . N LA70070
156 . S LA761="",LA7X=$P(LA76241(2),"^",13) Q:'LA7X
157 . S LA70070=$$GET1^DIQ(61,LA7X_",","LEDI HL7:HL7 ABBR")
158 . I LA70070=LA7SPEC S LA761=LA7X
159 ;
160 ; Set data node=test value
161 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^")=LA7VAL
162 ;
163 ; Store reference ranges
164 D REFRNG^LA7VIN5A($$P^LA7VHLU(.LA7SEG,8,LA7FS))
165 ;
166 ; Store order/result codes/observation method
167 S LA7X=$P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",3)
168 I LA7ONLT S $P(LA7X,"!",1)=LA7ONLT
169 I LA7RNLT S $P(LA7X,"!",2)=LA7RNLT
170 I LA7RLNC S $P(LA7X,"!",3)=LA7RLNC
171 I LA7OBM S $P(LA7X,"!",4)=LA7OBM
172 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",3)=LA7X
173 ;
174 ; Store abnormal flags
175 D ABFLAG^LA7VIN5A($$P^LA7VHLU(.LA7SEG,9,LA7FS))
176 ;
177 ; Store units
178 I LA7UNITS'="" D
179 . S LA7X=$P($G(^LAH(LA7LWL,1,LA7ISQN,LA76304)),"^",5)
180 . S $P(LA7X,"!",7)=LA7UNITS
181 . S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=LA7X
182 ;
183 ; Store responsible observer on POC interfaces
184 I LA7RO'="",LA7INTYP>19,LA7INTYP<30 D
185 . I $P(LA7RO,"^",2) S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",4)=$P(LA7RO,"^",2)
186 ;
187 ; Store specimen type
188 I $G(LA761) D
189 . S X=$P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)
190 . S $P(X,"!")=LA761
191 . S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)=X
192 ;
193 ; Store where test was performed.
194 D PRDID^LA7VIN5A($$P^LA7VHLU(.LA7SEG,16,LA7FS),LA7SFAC,LA7CS)
195 ;
196 ; Store equipment instance identifier
197 I LA7EII'="" D EII^LA7VIN5A
198 ;
199 ; If results for LEDI interface (LA7INTYP=10) and site keeps file #60
200 ; in sync with reference lab then compare message's units and normals
201 ; with site's to detect changes(LA7FLAG=1) and notify site.
202 I LA7INTYP=10,$G(LA761),$G(^LAB(60,+$P(LA76241(0),"^"),1,LA761,.1)) D
203 . N LA760,LA7FLAG,LA7I,LA7Y,LA7X
204 . S LA760=+$P(LA76241(0),"^"),LA7Y=^LAB(60,LA760,1,LA761,0),LA7FLAG=0
205 . S LA7X=$P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",5)
206 . I $P(LA7Y,"^",7)'=$P(LA7X,"!",7) S LA7FLAG=1
207 . I 'LA7FLAG,$P(LA7Y,"^",2)=$P(LA7X,"!",2),$P(LA7Y,"^",3)=$P(LA7X,"!",3) Q
208 . I 'LA7FLAG D
209 . . N AGE,DOB,PNM,SEX
210 . . N LRDPF,LRNG,LRNGS,LRNG2,LRNG3,LRNG4,LRNG5,LRTREA,LRWRD,LRX,LRY
211 . . I $G(LRDFN) D DEM^LRX,KVAR^VADPT
212 . . S LRNG=LA7Y D NORM^LRVER5
213 . . S LA7Y=$TR(LRNG,$C(34),""),LA7X=$TR(LA7X,$C(34),"")
214 . . I $P(LA7Y,"^",2)=$P(LA7X,"!",2),$P(LA7Y,"^",3)=$P(LA7X,"!",3) Q
215 . . S LA7FLAG=1
216 . I 'LA7FLAG Q
217 . S LA7I=$O(^TMP("LA7 UNITS/NORMALS CHANGED",$J,""),-1),LA7I=LA7I+1
218 . S X=LA7LWL_"^"_LA7ISQN_"^"_LA76304_"^"_LA76248_"^"_LA76249_"^"_LA7ORS_"^"_LA7TEST_"^"_$S(LA7TEST(0)'="":LA7TEST(0),1:LA7TEST(2,0))_"^"_$$P^LA7VHLU(.LA7SEG,9,LA7FS)_"^"_LA760
219 . S ^TMP("LA7 UNITS/NORMALS CHANGED",$J,LA7I)=X
220 ;
221 ; If LEDI interface and order status change store which results
222 ; associated with ordered test. Used to determine if order status
223 ; changed bulletin needs to be generated.
224 I LA7INTYP=10,LA7SAC?1(1"A",1"G") D
225 . S LA7I=$G(LA7SAC(0)) Q:'LA7I
226 . S ^TMP("LA7 ORDER STATUS",$J,LA7I,+LA76241(0))=""
227 Q
Note: See TracBrowser for help on using the repository browser.