source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7UIIN2.m@ 1170

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1LA7UIIN2 ;DALOI/JRR - Process Incoming UI Msgs, continued ; 12/3/1997
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,23,27,46**;Sep 27, 1994
3 ;This routine is a continuation of LA7UIIN1 and is only called from there.
4 ;It is called to begin processing the NTE & OBX segments.
5 QUIT
6 ;
7NTE ; Process NTE segments that follow the OBR and OBX segments
8 ; These NTE segments contain comments from instruments or other facilities.
9 ; NTE segments following OBR's contain comments which refer to the entire test battery.
10 ; NTE segments following OBX's contain comments which are test specific.
11 ; Test specific comments can be prefaced with a site defined prefix -
12 ; see field REMARK PREFIX (#19) in CHEM TEST multiple of AUTOMATED INSTRUMENT (#62.4 file.
13 ; NTE segments are not allowed anywhere except after the OBR or OBX segments.
14 ; There can be more than one NTE, each will be stored as a comment in ^LAH.
15 ;
16 F LA762495=LA762495:0 S LA762495=$O(^LAHM(62.49,LA76249,150,LA762495)) Q:'LA762495 S LA7NTE=$G(^(LA762495,0)) Q:$E(LA7NTE,1,3)'="NTE" D
17 . N LA7,LA7I
18 . S LA7RMK=$P(LA7NTE,LA7FS,4)
19 . S LA7=$RE(LA7RMK)
20 . F LA7I=1:1:$L(LA7) Q:$E(LA7,LA7I)'=" " ; Find start of trailing spaces.
21 . S LA7RMK=$E(LA7RMK,1,($L(LA7RMK)-LA7I+1)) ; Truncate trailing spaces.
22 . I LA7RMK=$TR($P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,3)),"^",6),"~") Q ; Don't store remark if same as specimen comment (without "~").
23 . I LA7RMK=$G(^LR(+$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),.091)) Q ; or patient info (#.091 in file 63) - info previously downloaded
24 . I LA7RMK="" Q ; No remark to store.
25 . I $O(LA7RMK(0,0)) D Q ; If test specific, store test name with comments (see below)
26 . . N LA7I
27 . . S LA7I=0
28 . . F S LA7I=$O(LA7RMK(0,LA7I)) Q:'LA7I I $P(LA7RMK(0,LA7I),"^") D RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,$P(LA7RMK(0,LA7I),"^",2))
29 . I $P(LA7INST,"^",17) D RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,"") ;store comment in 1 node of ^LAH global
30 K LA7RMK
31 Q:LA762495="" ;no more segments to process
32 ;
33OBX F LA762495=LA762495-1:0 S LA762495=$O(^LAHM(62.49,LA76249,150,LA762495)) Q:'LA762495 K LA7OBX S LA7OBX=^(LA762495,0) Q:$E(LA7OBX,1,3)'="OBX" D
34 . K LA7RMK
35 . S LA7TEST=$P($P(LA7OBX,LA7FS,4),LA7CS,1)
36 . I LA7TEST="" D QUIT
37 . . D CREATE^LA7LOG(15)
38 . I '$D(^LAB(62.4,LA7624,3,"AC",LA7TEST)) D QUIT ;test code not found in auto inst file
39 . . D CREATE^LA7LOG(16)
40 . S LA76241=0 ; Process results for all tests which use this test code.
41 . F S LA76241=$O(^LAB(62.4,LA7624,3,"AC",LA7TEST,LA76241)) Q:'LA76241 D
42 . . S LA7VAL=$P(LA7OBX,LA7FS,6)
43 . . F LA7I=0,1,2 S LA76241(LA7I)=$G(^LAB(62.4,LA7624,3,LA76241,LA7I))
44 . . I (LA76241(0)="")!(LA76241(1)="") D QUIT ;chem test fields incorrect
45 . . . D CREATE^LA7LOG(18)
46 . . ; Setup LA7RMK(0) variable in case comments (NTE) sent with test results.
47 . . S LA7RMK(0,+LA76241(0))=+$P(LA76241(2),"^",7)_"^"_$P(LA76241(2),"^",8)
48 . . K LA7XFORM ;this array can be set from inside PARAM 1
49 . . X $P(LA76241(0),"^",2) ;execute PARAM 1
50 . . I LA7VAL="" D QUIT ;no value
51 . . . D CREATE^LA7LOG(17)
52 . . D XFORM ;transform result based on fields in file 62.4
53 . . Q:LA7VAL=""
54 . . I $G(LA7LIMIT)=1 D ;flag to not store if wasn't explicitly ordered
55 . . . K LA7LIMIT,LA7TREEN,^TMP("LA7TREE",$J)
56 . . . F LA76804=0:0 S LA76804=$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA76804)) Q:'LA76804 D UNWIND^LA7UTIL(LA76804) ;store all tests accessioned in ^TMP
57 . . . I '$D(^TMP("LA7TREE",$J,+LA76241(0))) S LA7LIMIT=1 ;wasn't ordered
58 . . I $G(LA7LIMIT) D QUIT ;don't store
59 . . . S $P(LA7RMK(0,+LA76241(0)),"^",1)=0 ; Set flag to not store comments if any.
60 . . . K LA7LIMIT,^TMP("LA7TREE",$J)
61 . . K ^TMP("LA7TREE",$J)
62 . . S LA76304=+$P(LA76241(1),"(",2) ;lab data field
63 . . I LA76304'>1 D Q ; No dataname for this result
64 . . . D CREATE^LA7LOG(18)
65 . . S ^LAH(LA7LWL,1,LA7ISQN,LA76304)=LA7VAL ;set data node=test value
66 . . D REFRNG($P(LA7OBX,LA7FS,8)) ; Store reference ranges
67 . . D ABFLAG($P(LA7OBX,LA7FS,9)) ; Store abnormal flags
68 . . D PRDID($P(LA7OBX,LA7FS,16),LA7CS) ; Store where test was performed.
69 I $E(LA7OBX,1,3)="NTE" S LA762495=LA762495-1 G NTE
70 K LA7RMK
71 Q
72 ;
73XFORM ; Transform the result based on fields 12,13,14,16,17 in the Chem Test
74 ; multiple in the Auto Instrument file (62.4), or set on the fly
75 ; from PARAM 1
76 N LA7I
77 S LA7XFORM=LA76241(2)
78 ; get PARAM 1 overides
79 I $D(LA7XFORM(1)),LA7XFORM(1)?1.N S $P(LA7XFORM,"^")=LA7XFORM(1)
80 F LA7I=2,3,5,6 I $D(LA7XFORM(LA7I)) S $P(LA7XFORM,"^",LA7I)=LA7XFORM(LA7I)
81 ; set up defaults if field was not answered
82 ;
83 ; accept results,yes
84 I $P(LA7XFORM,"^",3)="" S $P(LA7XFORM,"^",3)=1
85 ; strip spaces,yes
86 I $P(LA7XFORM,"^",6)="" S $P(LA7XFORM,"^",6)=1
87 ;
88 ; now transform
89 ; don't accept results
90 I '$P(LA7XFORM,"^",3) S LA7VAL="" Q
91 ; accept ordered tests only
92 I $P(LA7XFORM,"^",5) S LA7LIMIT=1
93 ; decimal places if result start with number or decimal point
94 ; skip results i.e. ">100".
95 I $P(LA7XFORM,"^")?1.N,LA7VAL?1(1N.E,1".".E) D
96 . S LA7VAL=$FN(LA7VAL,"",+LA7XFORM)
97 ; strip spaces
98 I $P(LA7XFORM,"^",6) S LA7VAL=$TR(LA7VAL," ","")
99 ; make result a comment, store comment in ^LAH global
100 ; set value to null after making into remark, don't store twice.
101 I $P(LA7XFORM,"^",2) D
102 . D RMKSET^LASET(LA7LWL,LA7ISQN,LA7VAL,"")
103 . S LA7VAL=""
104 Q
105 ;
106 ;
107PRDID(LA7PRDID,LA7CS) ; Process/Store Producer's ID
108 ; Store where test was performed.
109 ; Call with LA7PRDID = Producer's ID field
110 ; LA7CS = component encoding character
111 N LA7X,LA7Y
112 S LA7PRDID=$G(LA7PRDID),LA7CS=$G(LA7CS)
113 ; Don't store producer's id.
114 I LA7PRDID=""!('$P(LA76241(2),"^",9))!(LA7CS="") Q
115 ;
116 S LA7X=$P(LA7PRDID,LA7CS,2)
117 I $L($P(LA7PRDID,LA7CS)) S LA7X=LA7X_$S($L(LA7X):" ",1:"")_"["_$P(LA7PRDID,LA7CS)_"]"
118 I LA7X="" Q
119 S LA7X="results from "_LA7X
120 S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
121 ; If no prefix, use test name.
122 I '$L(LA7Y) S LA7Y=$P($G(^LAB(60,+LA76241(0),0)),"^")_": "
123 D RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
124 Q
125 ;
126 ;
127REFRNG(LA7X) ; Process/Store References Range.
128 ; Call with LA7X = reference range to store.
129 N LA7Y
130 S LA7X=$G(LA7X)
131 ; No ref range or don't store ref range.
132 I LA7X=""!('$P(LA76241(2),"^",10)) Q
133 S LA7X="ref range - "_LA7X
134 S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
135 ; If no prefix, use test name.
136 I '$L(LA7Y) S LA7Y=$P($G(^LAB(60,+LA76241(0),0)),"^")_": "
137 D RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
138 Q
139 ;
140 ;
141ABFLAG(LA7X) ; Process/Store Abnormal Flags.
142 ; Call with LA7X = abnormal flags to store.
143 ; Converts flag to interpretation based on HL7 Table 0078.
144 ; If no match store code instead of interpretation
145 ;
146 N I,LA7Y,LA7Z
147 ;
148 S LA7X=$G(LA7X)
149 ; No flag or don't store abnormal flags.
150 I LA7X=""!('$P(LA76241(2),"^",11)) Q
151 F I=1:1:18 I LA7X=$P("L^H^LL^HH^<^>^N^A^AA^U^D^B^W^S^R^I^MS^VS","^",I) S LA7X=$P($T(ABFLAGS+I),";;",2) Q
152 S LA7X="normalcy status - "_LA7X
153 S LA7Y=$P(LA7RMK(0,+LA76241(0)),"^",2)
154 ;
155 ; If no prefix, use test name.
156 I '$L(LA7Y) S LA7Y=$P($G(^LAB(60,+LA76241(0),0)),"^")_": "
157 ;
158 D RMKSET^LASET(LA7LWL,LA7ISQN,LA7X,LA7Y)
159 Q
160 ;
161ABFLAGS ;; HL7 Table 0078 Abnormal flags
162 ;;Below low normal;;
163 ;;Above high normal;;
164 ;;Below lower panic limits;;
165 ;;Above upper panic limits;;
166 ;;Below absolute low-off instrument scale;;
167 ;;Above absolute high-off instrument scale;;
168 ;;Normal;;
169 ;;Abnormal;;
170 ;;Very abnormal;;
171 ;;Significant change up;;
172 ;;Significant change down;;
173 ;;Better;;
174 ;;Worse;;
175 ;;Susceptible;;
176 ;;Resistant;;
177 ;;Intermediate;;
178 ;;Moderately susceptible;;
179 ;;Very susceptible;;
Note: See TracBrowser for help on using the repository browser.