source: ccr/trunk/p/LA7VOBX1.m@ 433

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

lab changes for RPMS - LOINC codes from V Lab file
File size: 4.5 KB
Line 
1LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd ;Apr 8, 2009
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63,64,71**;Sep 27, 1994
3 ; JMC - mods to check for IHS V LAB file
4 ;
5CH ; Observation/Result segment for "CH" subscript results.
6 ; Called by LA7VOBX
7 ;
8 N LA76304,LA7ALT,LA7DIV,LA7I,LA7RS,LA7X,LA7Y,X
9 ;
10 ; "CH" subscript requires a dataname
11 I '$G(LRSB) Q
12 ;
13 ; get result node from LR global.
14 S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
15 S LA7RS=$P(LRSB,"^",2),LRSB=$P(LRSB,"^")
16 S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
17 ; If previous results have been corrected then send corrected status
18 I LA7RS="",$P(LA7VAL,"^",10)=2 S LA7RS="C"
19 ;
20 ; Check if test is OK to send - (O)utput or (B)oth
21 S LA7X=$P(LA7VAL,"^",12)
22 I LA7X]"","BO"'[LA7X Q
23 I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",7)) Q
24 ;
25 ; If no result NLT or LOINC try to determine from file #60
26 S LA7X=$P(LA7VAL,"^",3)
27 ;
28 ; Check for no LOINC in 63 and LOINC found in V LAB file.
29 I $P(LA7X,"!",3)="",$D(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)) S $P(LA7X,"!",3)=$P(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB),"^")
30 ;
31 I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5))
32 ; No result NLT code - log error
33 I $P($P(LA7VAL,"^",3),"!",2)="" D
34 . N LA7X
35 . S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
36 . D CREATE^LA7LOG(36)
37 ;
38 ; something missing - No NLT code, etc.
39 I LA7VAL="" Q
40 ;
41 ; Check for missing units/reference ranges
42 S LA7X=$P(LA7VAL,"^",5)
43 ;
44 ; Results missing units, lookup in file #60
45 I $P(LA7X,"!",7)="" S $P(LA7X,"!",7)=$P($$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5)),"^",3)
46 ;
47 ; If results missing reference ranges, use values from file #60.
48 I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
49 . S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5))
50 . S $P(LA7X,"!",2)=$P(LA7Y,"^")
51 . S $P(LA7X,"!",3)=$P(LA7Y,"^",2)
52 . S $P(LA7X,"!",11)=$P(LA7Y,"^",6)
53 . S $P(LA7X,"!",12)=$P(LA7Y,"^",7)
54 ; Use therapeutic low/high if low/high missing.
55 I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D
56 . S $P(LA7X,"!",2)=$P(LA7X,"!",11)
57 . S $P(LA7X,"!",3)=$P(LA7X,"!",12)
58 ;
59 ; Evaluate low/high reference ranges in case M code in these fields.
60 S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99
61 F LA7I=2,3 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D
62 . S @("X="_$P(LA7X,"!",LA7I))
63 . S $P(LA7X,"!",LA7I)=X
64 ;
65 ; Put units/reference ranges back in variable LA7VAL
66 S $P(LA7VAL,"^",5)=LA7X
67 ;
68 ; Initialize OBX segment
69 S LA7OBX(0)="OBX"
70 S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
71 ;
72 ; Value type
73 ; If result is "cancel" or "comment" then data type is ST - string data
74 S LA7X=$S("canccomment"[$P(LA7VAL,"^"):1,1:0)
75 I LA7X S LA7OBX(2)="ST"
76 E S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
77 ;
78 ; Observation identifer
79 ; build alternate code based on dataname from file #63 in case it's needed
80 S LA7X=$P(LA7VAL,"^",3)
81 S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^"_"99VA63"
82 S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH)
83 ;
84 ; Test value
85 ; If DoD and "canc" then report "PL Cancelled" per Lab Interop ICD.
86 S LA7X=$P(LA7VAL,"^")
87 I LA7X'="canc",$$GET1^DID(63.04,LRSB,"","TYPE","","LA7ERR")="SET" D
88 . S LA7X=$$EXTERNAL^DILFD(63.04,LRSB,"",LA7X)
89 . I LA7X="" S LA7X=$P(LA7VAL,"^")
90 I $G(LA7NVAF)=1,LA7X="canc" S LA7X="PL Cancelled"
91 S LA7OBX(5)=$$OBX5^LA7VOBX(LA7X,LA7OBX(2),LA7FS,LA7ECH)
92 ;
93 ; Units
94 S LA7X=$P(LA7VAL,"^",5)
95 S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH)
96 ;
97 ; Reference range
98 S LA7OBX(7)=$$OBX7^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7FS,LA7ECH)
99 ;
100 ; Abnormal flags
101 S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,"^",2))
102 ;
103 ; "P"artial or "F"inal results
104 S LA7X=$S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F")
105 I LA7RS="C" S LA7X=LA7RS
106 S LA7OBX(11)=$$OBX11^LA7VOBX(LA7X)
107 ;
108 ; Observation date/time - collection date/time per HL7 standard
109 I $P(LA76304(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76304(0),"^"))
110 ;
111 S LA7DIV=$P(LA7VAL,"^",9)
112 I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0))
113 ;
114 ; Facility that performed the testing
115 S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
116 ;
117 ; Person that verified the test
118 S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
119 ;
120 ; Observation method
121 S LA7X=$P($P(LA7VAL,"^",3),"!",4)
122 I LA7X S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7FS,LA7ECH)
123 ;
124 ; Equipment entity identifier
125 I $L($P(LA7VAL,"^",11)) S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)
126 ;
127 D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
128 ;
129 Q
Note: See TracBrowser for help on using the repository browser.