source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LREPI1.m@ 1042

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

initial load of WorldVistAEHR
File size: 7.6 KB
RevLine 
[613]1LREPI1 ;DALOI/SED - EMERGING PATHOGENS HL7 BUILDER ; 5/9/98
2 ;;5.2;LAB SERVICE;**132,157,175,260,281,320**;Sep 27, 1994
3 ; Reference to ^DD supported by IA #999
4 ; Reference to ^XLFSTR supported by IA #10104
5EN(LRDFN,SS,IVDT,SEQ) ;Entry to build the HL7 Segment
6 ;LRDFN=Patient ID
7 ;SS=Subscripts in file 63 for results
8 ;IVDT=Inverted Date and Time
9 ;SEQ=Sequence Number
10 ;S LRCS=$E(HL("ECH"))
11 K ^TMP("HL7",$J)
12 S:+$G(SEQ)'>0 SEQ=1
13 S CNT=1
14 Q:'$G(LRDFN)!('$G(IVDT))!('$L($G(SS)))
15 I $L($T(@SS)) D @SS
16EXIT ;KILL THEN EXIT
17 K CNT,IND,LRAND,LRANT,LRDATA,LRES,LRINLT,LRNT,LRRDTE,LRREF,LRTST,LRUNIT
18 K ND,NLT,NLTP,ORGNB,ORGPT,SEQX,SITE,TYPE,LRCODE,LRFLD
19 Q SEQ
20CY D CY^LREPI1A
21 Q
22SITECD ;Determine the HL7 Speciman code from the Site and return LRCODE
23 S LRCODE=""
24 Q:'$D(SITE)
25 S LRCODE=$P($G(^LAB(61,SITE,0)),U,8) ;Use if LEDI is not defined
26 S LRIPT=$P($G(^LAB(61,SITE,0)),U,9) Q:+LRIPT'>0
27 Q:'$D(^LAB(64.061,LRIPT,0))
28 Q:$P(^LAB(64.061,LRIPT,0),U,3)=""
29 S LRCODE=$P(^LAB(64.061,LRIPT,0),U,3)
30 Q
31CH ;BUILD HL7 MSG FOR CH SUBSCRIPT
32 ;TO BUILD OBR SEGMENT FOR CHEM
33 I '$D(^LR(LRDFN,SS,IVDT,0)) Q
34 K LRDATA
35 S $P(LRDATA,HLFS,1)=$G(SEQ)
36 S $P(LRDATA,HLFS,4)="81121.0000"_LRCS_"CHEMISTRY TEST"_LRCS_"VANLT"
37 S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
38 S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
39 S LRRDTE=$P($G(^LR(LRDFN,SS,IVDT,0)),U,3)
40 S:+LRRDTE>0 LRRDTE=$$HLDATE^HLFNC(LRRDTE)
41 S SITE=$P($G(^LR(LRDFN,SS,IVDT,0)),U,5)
42 D SITECD
43 S $P(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$P($G(^LAB(61,SITE,0)),U)
44 S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
45 ;TO BUILD OBX SEGMENT CHEM
46 S (IND,SEQX)=1
47 F S IND=$O(^LR(LRDFN,"CH",IVDT,IND)) Q:+IND'>0 D
48 .S LRES=^LR(LRDFN,"CH",IVDT,IND)
49 .Q:LRES=""
50 .Q:'$D(^LAB(60,"C","CH;"_IND_";1"))
51 .K LRDATA
52 .S LRTST=$O(^LAB(60,"C","CH;"_IND_";1",0))
53 .Q:'$D(^TMP($J,"T",LRTST,LRPATH))
54 .S $P(LRDATA,HLFS,1)=SEQX,$P(LRDATA,HLFS,2)="ST"
55 .S LRUNIT=$P($G(^LAB(60,LRTST,1,SITE,0)),U,7)
56 .S LRREF=$P($G(^LAB(60,LRTST,1,SITE,0)),U,2)_"-"
57 .S LRREF=LRREF_$P($G(^LAB(60,LRTST,1,SITE,0)),U,3)
58 .S LRINLT=+$G(^LAB(60,LRTST,64)),LRNLT=LRCS_LRCS_LRCS
59 .I LRINLT'="",$D(^LAM(LRINLT,0)) D
60 ..S $P(LRNLT,LRCS,2)=$P(^LAM(LRINLT,0),U,1)
61 ..S $P(LRNLT,LRCS,1)=$P(^LAM(LRINLT,0),U,2)
62 ..S $P(LRNLT,LRCS,3)="VANLT"
63 .S $P(LRDATA,HLFS,3)=LRNLT_LRTST_LRCS_$P(^LAB(60,LRTST,0),U)_LRCS_"VA60"
64 .;ADD LOINC
65 .S LRLOINC=$P($P(LRES,U,3),"!",3),LRLNCNAM=""
66 .S:LRLOINC'="" LRLNCNAM=$E($P($G(^LAB(95.3,LRLOINC,80)),U),1,30)
67 .S $P(LRDATA,HLFS,3)=$P(LRDATA,HLFS,3)_LRCS_LRLOINC_LRCS_LRLNCNAM_LRCS_"LOINC"
68 .S $P(LRDATA,HLFS,5)=$P(LRES,U,1),$P(LRDATA,HLFS,8)=$P(LRES,U,2)
69 .S $P(LRDATA,HLFS,6)=LRUNIT,$P(LRDATA,HLFS,7)=LRREF
70 .S:LRRDTE>0 $P(LRDATA,HLFS,14)=LRRDTE
71 .S:LRRDTE=0 $P(LRDATA,HLFS,14)=""
72 .S CNT=CNT+1,SEQX=SEQX+1,^TMP("HL7",$J,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
73 K LRLNCNAM,LRLOINC
74 Q
75MI ;TO BUILD INITIAL OBR SEGMENT FOR MICRO
76 I '$D(^LR(LRDFN,SS,IVDT,0)) Q
77 K LRDATA
78 S $P(LRDATA,HLFS,1)=$G(SEQ)
79 S $P(LRDATA,HLFS,4)="87999.0000"_LRCS_"MICRO CULTURE"_LRCS_"VANLT"
80 S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
81 S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
82 S SITE=$P(^LR(LRDFN,SS,IVDT,0),U,5)
83 D SITECD
84 S $P(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$P($G(^LAB(61,SITE,0)),U)
85 S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
86 ;LOOK INTO ALL MICRO SUB NODES FOR DATA AND BUILD FIRST OBX
87 F ND=3,6,9,12,17 I $D(^LR(LRDFN,SS,IVDT,ND,0)) D TYPE,MIORG
88 ;SECOND LOOP TO BUILD SECONDARY OBR AND OBX
89 F ND=3,12 I $D(^LR(LRDFN,SS,IVDT,ND,0)) D TYPE,@("SEC"_ND)
90 Q
91TYPE ;DETERMINES THE CORRECT NLT CODE TO USE
92 S:ND=3 TYPE="87993.0000"_LRCS_"BACTERIOLOGY CULTURE"_LRCS_"VANLT"
93 S:ND=6 TYPE="87505.0000"_LRCS_"PARASITOLOGY"_LRCS_"VANLT"
94 S:ND=9 TYPE="87994.0000"_LRCS_"MYCOLOGY CULTURE"_LRCS_"VANLT"
95 S:ND=12 TYPE="87995.0000"_LRCS_"MYCOBACTERIUM CULTURE"_LRCS_"VANLT"
96 S:ND=17 TYPE="87996.0000"_LRCS_"VIROLOGY CULTURE"_LRCS_"VANLT"
97 Q
98 ;
99MIORG ;TO BUILD ORGANISM OBX SEGMENT FOR MICRO
100 S ORGNB=0 F S ORGNB=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB)) Q:+ORGNB'>0 D
101 .Q:'$D(^LR(LRDFN,SS,IVDT,ND,ORGNB,0))
102 .S LRRDTE=""
103 .S:ND=3 LRRDTE=+$P($G(^LR(LRDFN,SS,IVDT,1)),U,1)
104 .S:ND'=3 LRRDTE=+$P($G(^LR(LRDFN,SS,IVDT,(ND-1))),U,1)
105 .S:+LRRDTE>0 LRRDTE=$$HLDATE^HLFNC(LRRDTE)
106 .S ORGPT=+$P($G(^LR(LRDFN,SS,IVDT,ND,ORGNB,0)),U,1)
107 .Q:'$D(^LAB(61.2,ORGPT,0))
108 .K LRDATA
109 .S $P(LRDATA,HLFS,1)=ORGNB,$P(LRDATA,HLFS,2)="CE"
110 .S $P(LRDATA,HLFS,3)=TYPE
111 .S $P(LRDATA,HLFS,4)=ORGNB
112 .S:LRRDTE'=0 $P(LRDATA,HLFS,14)=LRRDTE
113 .E S $P(LRDATA,HLFS,14)=""
114 .S $P(LRDATA,HLFS,5)=LRCS_$P(^LAB(61.2,ORGPT,0),U,1)
115 .S CNT=CNT+1,^TMP("HL7",$J,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
116 Q
117SEC3 ;BUILD SUSCEPTIBILTY FOR ORGANISMS
118 ;FIRST BUILD OBR THEN OBX FOR THE ANTIMICROBIAL TESTING
119 S ORGNB=0 F S ORGNB=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB)) Q:+ORGNB'>0 D
120 .Q:'$D(^LR(LRDFN,SS,IVDT,ND,ORGNB,0))
121 .;CHECK TO SEE IF ANY ANTIMICROBIAL INFORMATION BEFORE PROCEEDING
122 .S LRAND=1,LRANDFG=1
123 .F S LRAND=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND)) Q:+LRAND'>0 D
124 ..Q:'$D(^LAB(62.06,"AD",LRAND))
125 ..S:$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)'="" LRANDFG=0
126 .Q:LRANDFG
127 .K LRDATA,LRANDFG S SEQ=SEQ+1
128 .S $P(LRDATA,HLFS,1)=SEQ
129 .S $P(LRDATA,HLFS,4)="87518.0000"_LRCS_"ANTIBIOTIC MIC"_LRCS_"VANLT"
130 .S $P(LRDATA,HLFS,26)=$P(TYPE,LRCS,1)_LRCS_ORGNB
131 .S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
132 .S SITE=$P(^LR(LRDFN,SS,IVDT,0),U,5)
133 .D SITECD
134 .S $P(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$P($G(^LAB(61,SITE,0)),U)
135 .S CNT=CNT+1,^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
136ANTI3 .;NOW GET ANTIMICROBIAL INFORMATION
137 .S SEQX=1,LRAND=1
138 .F S LRAND=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND)) Q:+LRAND'>0 D
139 ..Q:'$D(^LAB(62.06,"AD",LRAND))
140 ..Q:$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)=""
141 ..K LRDATA
142 ..S LRANT=$O(^LAB(62.06,"AD",LRAND,0))
143 ..S $P(LRDATA,HLFS,1)=SEQX,$P(LRDATA,HLFS,2)="ST"
144 ..S NLT=LRCS_LRCS_LRCS_LRANT_LRCS_$P(^LAB(62.06,LRANT,0),U,1)_LRCS_"VA62.06"
145 ..S NLTP=+$G(^LAB(62.06,LRANT,64))
146 ..S:$D(^LAM(NLTP,0)) $P(NLT,LRCS,1)=$P(^LAM(NLTP,0),U,2),$P(NLT,LRCS,2)=$P($P(^LAM(NLTP,0),U,1),LRCS),$P(NLT,LRCS,3)="VANLT"
147 ..S $P(LRDATA,HLFS,3)=NLT
148 ..S $P(LRDATA,HLFS,5)=$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U)
149 ..S $P(LRDATA,HLFS,8)=$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)
150 ..S SEQX=SEQX+1,CNT=CNT+1,^TMP("HL7",$J,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
151 Q
152SEC12 ;
153 ;FIRST BUILD OBR THEN OBX FOR THE ANTIMICROBIAL TESTING
154 S ORGNB=0 F S ORGNB=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB)) Q:+ORGNB'>0 D
155 .Q:'$D(^LR(LRDFN,SS,IVDT,ND,ORGNB,0))
156 .;FIRST CHECK FOR ANTIMICROBIAL INFORMATION
157 .S LRAND=1,LRANDFG=1
158 .F S LRAND=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND)) Q:+LRAND'>0 D
159 ..S:$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)'="" LRANDFG=0
160 .Q:LRANDFG
161 .K LRDATA,LRANDFG S SEQ=SEQ+1
162 .S $P(LRDATA,HLFS,1)=SEQ
163 .S $P(LRDATA,HLFS,4)="87518.0000"_LRCS_"ANTIBIOTIC MIC"_LRCS_"VANLT"
164 .S $P(LRDATA,HLFS,26)=$P(TYPE,LRCS,1)_LRCS_ORGNB
165 .S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
166 .S SITE=$P(^LR(LRDFN,SS,IVDT,0),U,5)
167 .D SITECD
168 .S $P(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$P($G(^LAB(61,SITE,0)),U)
169 .S CNT=CNT+1,^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
170ANTI12 .;NOW GET ANTIMICROBIAL INFORMATION FOR THE MYCOBACTERIUM
171 .S SEQX=1,LRAND=1
172 .F S LRAND=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND)) Q:+LRAND'>0 D
173 ..Q:$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)=""
174 ..K LRDATA
175 ..S LRNT=$O(^DD(63.39,"GL",LRAND,1,0))
176 .. S LRFILE=63.39,LRFLD=LRNT,LRANT=$$GET1^DID(LRFILE,LRFLD,"","TITLE","","LRERR")
177 ..;S LRANT=$P($G(^DD(63.39,LRNT,.1)),U,1)replaced w/supported reference
178 ..S:LRANT="" LRANT=$P(^DD(63.39,LRNT,0),U,1)
179 ..S $P(LRDATA,HLFS,1)=SEQX,$P(LRDATA,HLFS,2)="ST"
180 ..S $P(LRDATA,HLFS,3)=LRCS_LRCS_LRCS_LRAND_LRCS_LRANT_LRCS_"VA63.39"
181 ..S $P(LRDATA,HLFS,5)=$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U)
182 ..S $P(LRDATA,HLFS,8)=$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)
183 ..S SEQX=SEQX+1,CNT=CNT+1,^TMP("HL7",$J,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
184 Q
Note: See TracBrowser for help on using the repository browser.