source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VOBXA.m@ 738

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

initial load of WorldVistAEHR
File size: 5.8 KB
Line 
1LA7VOBXA ;DALOI/JMC - LAB OBX Segment message builder (cont'd) ; 5 June 2003
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,70,64**;Sep 27, 1994
3 ;
4 Q
5 ;
6OBX2 ; Build OBX-2 sequence - Value type
7 ;
8 ; default value - string data
9 S LA7VAL="ST"
10 S LA7TYP="",LA7FILE=$G(LA7FILE),LA7FIELD=$G(LA7FIELD)
11 ;
12 I LA7FILE,LA7FIELD S LA7TYP=$$GET1^DID(LA7FILE,LA7FIELD,"","TYPE","","LA7ERR")
13 ;
14 I LA7TYP="DATE/TIME" S LA7VAL="TS"
15 I LA7TYP="FREE TEXT" S LA7VAL="ST"
16 I LA7TYP="WORD-PROCESSING" S LA7VAL="FT"
17 I LA7TYP="NUMERIC" S LA7VAL="NM"
18 I LA7TYP="SET" S LA7VAL="ST"
19 I LA7TYP="POINTER" S LA7VAL="CE"
20 ;
21 Q
22 ;
23 ;
24OBX3 ; Build OBX-3 sequence - Observation identifier field
25 ;
26 ; Initialize variables
27 S LA7J=1,LA7Y=""
28 ;
29 ; Build sequence using LOINC codes only
30 ; LOINC code/code name/"LN"
31 I LA7953'="" D
32 . N LA7IENS,LA7Z
33 . S LA7953=$P(LA7953,"-"),LA7IENS=LA7953_","
34 . D GETS^DIQ(95.3,LA7IENS,".01;80","E","LA7X")
35 . ; Invalid code???
36 . I $G(LA7X(95.3,LA7IENS,.01,"E"))="" Q
37 . S LA7Z=LA7X(95.3,LA7IENS,.01,"E")
38 . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
39 . S $P(LA7Y,$E(LA7ECH,1),LA7J)=LA7Z
40 . S LA7Z=$G(LA7X(95.3,LA7IENS,80,"E")),LA7Z=$TR(LA7Z,"~","^")
41 . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
42 . S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=LA7Z
43 . S $P(LA7Y,$E(LA7ECH,1),LA7J+2)="LN"
44 . S LA7J=4
45 ;
46 ; Build sequence using NLT codes
47 ; File #64 NLT code/NLT code name/"99VA64"
48 ; If LOINC is primary make NLT alternate, otherwise NLT primary.
49 I LA7NLT'="" D
50 . N LA7642,LA7Z
51 . S LA764=$O(^LAM("E",LA7NLT,0)),LA7Z=""
52 . S $P(LA7Y,$E(LA7ECH,1),LA7J)=LA7NLT
53 . I LA764 S LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
54 . I LA7Z="" D
55 . . S LA764=$O(^LAM("E",$P(LA7NLT,".")_".0000",0))
56 . . I LA764 S LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
57 . . S LA7642=$O(^LAB(64.2,"C","."_$P(LA7NLT,".",2),0))
58 . . I LA764,LA7642 S LA7Z=LA7Z_"~"_$$GET1^DIQ(64.2,LA7642_",",.01,"I")
59 . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
60 . S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=LA7Z
61 . S $P(LA7Y,$E(LA7ECH,1),LA7J+2)="99VA64"
62 . S LA7J=LA7J+3
63 ;
64 ; Non-standard/non-VA code
65 ; Don't use alternate code when it's "99VA63" and we've already encoded
66 ; a primary and alternate. If alternate is a non-VA code then use as
67 ; alternate code.
68 ; If primary and alternate are not 99VA63 then code 3rd triplet with
69 ; 99VA63 per Julius Chou for Clinical Case Registry (JMC/May 13, 2004)
70 I LA7ALT="" Q
71 I $P(LA7ALT,"^",3)'="99VA63",LA7J>4 S LA7J=4
72 I $P(LA7ALT,"^",3)="99VA63" D Q:LA7J=0
73 . I $P(LA7Y,$E(LA7ECH,1),3)="99VA63" S LA7J=0 Q
74 . I LA7J>4,$P(LA7Y,$E(LA7ECH,1),6)="99VA63" S LA7J=0 Q
75 . I LA7J>4 S LA7J=7
76 S $P(LA7Y,$E(LA7ECH,1),LA7J)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^"),LA7FS_LA7ECH)
77 S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^",2),LA7FS_LA7ECH)
78 S $P(LA7Y,$E(LA7ECH,1),LA7J+2)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^",3),LA7FS_LA7ECH)
79 ;
80 Q
81 ;
82 ;
83OBX5 ; Build OBX-5 sequence - Observation value
84 ; Removes trailing spaces on string and text results.
85 ; Removes leading & trailing spaces on numeric results.
86 ;
87 S LA7Y=""
88 ;
89 I $G(LA7OBX2)="" S LA7OBX2="ST" ; default value type
90 I LA7OBX2="ST"!(LA7OBX2="TX") D
91 . S LA7VAL=$$TRIM^XLFSTR(LA7VAL,"R"," ")
92 . S LA7Y=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
93 I LA7OBX2="NM" S LA7Y=$$TRIM^XLFSTR(LA7VAL,"RL"," ")
94 I LA7OBX2="TS" D
95 . S LA7VAL=$$CHKDT^LA7VHLU1(LA7VAL)
96 . S LA7Y=$$FMTHL7^XLFDT(LA7VAL)
97 I LA7OBX2="CE" D
98 . N I,X
99 . F I=1:1:6 D
100 . . I '$L($P(LA7VAL,"^",I)) Q
101 . . S X=$$CHKDATA^LA7VHLU3($P(LA7VAL,"^",I),LA7FS_LA7ECH)
102 . . S $P(LA7Y,$E(LA7ECH),I)=X
103 ;
104 Q
105 ;
106 ;
107OBX5M ; Build OBX-5 sequence - Observation value - multi-line textual result
108 ;
109 K LA7WP
110 ;
111 S LA7WP=""
112 S LA7TYPE=$$GET1^DID(LA7FN,LA7FLD,"","TYPE","LA7ERR(1)")
113 ;
114 ; Process word-processing type field.
115 ; Check and encode data
116 I LA7TYPE="WORD-PROCESSING" D Q
117 . N DIWF,DIWL,DIWR,X
118 . S LA7WP=$$GET1^DIQ(LA7FN,LA7IENS,LA7FLD,"","LA7WP","LA7ERR(2)")
119 . K ^UTILITY($J,"W")
120 . S DIWL=1,DIWR=245,DIWF="",LA7I=0
121 . I $$GET1^DID(+$$GET1^DID(LA7FN,LA7FLD,"","SPECIFIER","LA7ERR(1)"),.01,"","SPECIFIER","LA7ERR(3)")["L" S DIWF="N"
122 . F S LA7I=$O(LA7WP(LA7I)) Q:'LA7I S X=LA7WP(LA7I) D ^DIWP
123 . K LA7WP
124 . S LA7I=0
125 . F S LA7I=$O(^UTILITY($J,"W",DIWL,LA7I)) Q:'LA7I D
126 . . S LA7WP(LA7I)=$$CHKDATA^LA7VHLU3(^UTILITY($J,"W",DIWL,LA7I,0),LA7FS_LA7ECH)
127 . . I LA7I>1 S LA7WP(LA7I)=$E(LA7ECH,3)_".br"_$E(LA7ECH,3)_LA7WP(LA7I)
128 . K ^UTILITY($J,"W")
129 ;
130 ; Free text, assumes multiple valued
131 I LA7TYPE="FREE TEXT" D
132 . D GETS^DIQ(LA7FN,LA7IENS,LA7FLD_"*","","LA7WP","LA7ERR")
133 ;
134 Q
135 ;
136 ;
137OBX5R ; Build OBX-5 sequence with repetition - Observation value
138 ;
139 S (LA7I,LA7Y)=""
140 F S LA7I=$O(LA7VAL(LA7I)) Q:'LA7I D
141 . S LA7Y=LA7Y_$$OBX5^LA7VOBX(LA7VAL(LA7I),LA7OBX2,LA7FS,LA7ECH)_$E(LA7ECH,2)
142 ;
143 Q
144 ;
145 ;
146OBX6 ; Build OBX-6 sequence - Units
147 ;
148 S LA7ECH=$G(LA7ECH),LA7Y=""
149 ;
150 ; Units - remove leading and trailing spaces
151 I $G(LA7VAL)'="" S LA7Y=$$TRIM^XLFSTR(LA7VAL,"LR"," ")
152 ;
153 ; Build sequence using LOINC codes only
154 ; LOINC code/code name/"LN"
155 I $G(LA764061) D
156 . N LA7IENS,LA7X,LA7Z
157 . S LA7IENS=LA764061_","
158 . D GETS^DIQ(64.061,LA7IENS,".01;1","E","LA7X")
159 . ; LOINC code
160 . S LA7Z=$G(LA7X(64.061,LA7IENS,.01,"E"))
161 . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
162 . S $P(LA7Y,$E(LA7ECH,1),1)=LA7Z
163 . ; LOINC code name
164 . S LA7Z=$G(LA7X(64.061,LA7IENS,1,"E"))
165 . S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
166 . S $P(LA7Y,$E(LA7ECH,1),2)=LA7Z
167 . S $P(LA7Y,$E(LA7ECH,1),3)="LN"
168 ;
169 Q
170 ;
171 ;
172OBX7 ; Build OBX-7 sequence - Reference range
173 ; Removes leading and trailing quote marks ("").
174 ;
175 S LA7Y=""
176 ;
177 I $G(LA7LOW)'="" D
178 . S LA7LOW=$$TRIM^XLFSTR(LA7LOW,"RL","""")
179 . I LA7LOW?1A.E S LA7Y=LA7Y_LA7LOW Q ; alphabetic value
180 . I $G(LA7HIGH)="",$E(LA7LOW)'=">" S LA7Y=">"
181 . S LA7Y=LA7Y_LA7LOW
182 ;
183 I $G(LA7HIGH)'="" D
184 . S LA7HIGH=$$TRIM^XLFSTR(LA7HIGH,"RL","""")
185 . I LA7HIGH?1A.E S LA7Y=LA7Y_LA7HIGH Q ; alphabetic value
186 . I $G(LA7LOW)="" D Q
187 . . I $E(LA7HIGH)'="<" S LA7Y="<"
188 . . S LA7Y=LA7Y_LA7HIGH
189 . S LA7Y=LA7Y_"-"_LA7HIGH
190 ;
191 S LA7Y=$$CHKDATA^LA7VHLU3(LA7Y,LA7FS_LA7ECH)
192 ;
193 Q
Note: See TracBrowser for help on using the repository browser.