LA7COBX3 ;VA/DALOI/JMC - LAB OBX Segment message builder (MI subscripts) cont'd ; 22-Oct-2013 09:22 ; MAW
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033**;NOV 01, 1997
;
; Reference to ^DD supported by DBIA #999
;
MI ; Build OBX segments for results that are microbiology subscript.
; Called by LA7VOBX
;
N I,LA761,LA76305,LA7ALT,LA7ALTCS,LA7CODE,LA7DIV,LA7IENS,LA7LOINC,LA7NLT,LA7OBX,LA7ORS,LA7PARNT,LA7SAVID,LA7SUBFL,LA7VAL,LA7VERP
;
I $P(LRIDT,",",2) S LRIDT(2)=$P(LRIDT,",",2),LRIDT(3)=$P(LRIDT,",",3),LRIDT=$P(LRIDT,",")
;
I '$D(^LR(LRDFN,LRSS,LRIDT)) Q
;
F I=0,1,5,8,11,16 S LA76305(I)=$G(^LR(LRDFN,LRSS,LRIDT,I))
;
S (LA7ALT,LA7ALTCS,LA7CODE,LA7ID,LA7LOINC,LA7NLT,LA7ORS,LA7SAVID,LA7SUBFL,LA7VAL,LA7VERP)=""
;
; Specimen topography
S LA761=$P(LA76305(0),"^",5)
; Default codes
S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7CODE,LA761)
;
D SEC,GEN
;S LRSPEC=$P($G(LA76305(0)),U,11) ;MU2 get the microsusept specimen for SPM from collection sample field
Q
;
SEC ; Build section specific fields
N LA7X,LA7Y
;
; Urine screen
I LRSB=11.57 D Q
. N LA7ERR
. S LA7VERP=$P(LA76305(1),"^",3),LA7ORS=$P(LA76305(1),"^",2)
. S LA7OBX(2)=$$OBX2^LA7COBX(63.05,11.57)
. S LA7IENS=LRIDT_","_LRDFN_","
. S LA7VAL=$$GET1^DIQ(63.05,LA7IENS,11.57,"","LA7ERR")
. S LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,11.57,"","LABEL")_"^99VA63"
. S LA7ALT=LA7Y_"^"_LA7Y
;
; Sputum Screen
I LRSB=11.58 D Q
. N LA7ERR
. S LA7VERP=$P(LA76305(1),"^",3)
. S LA7ORS=$P(LA76305(1),"^",2)
. S LA7OBX(2)=$$OBX2^LA7COBX(63.05,11.58)
. S LA7VAL=$P(^LR(LRDFN,LRSS,LRIDT,1),"^",5)
. S LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,11.58,"","LABEL")_"^99VA63"
. S LA7ALT=LA7Y_"^"_LA7Y
;
; Gram stain
I LRSB=11.6 D Q
. N LA7ERR
. S LA7VERP=$P(LA76305(1),"^",3)
. S LA7ORS=$P(LA76305(1),"^",2)
. S LA7OBX(2)=$$OBX2^LA7COBX(63.05,11.6)
. S LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
. S LA7VAL=$$GET1^DIQ(63.29,LA7IENS,.01,"","LA7ERR")
. S LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.29,.01,"","LABEL")_"^99VA63"
. S LA7ALT=LA7Y_"^"_LA7Y
. ; Setup DoD special coding system
. I LA7NVAF=1,$P(LA7CODE,"!",2) S LA7ALTCS="99VA64MG"
;
; Micro organism
I $P(LRSB,",")=12 D Q
. S LA7VERP=$P(LA76305(1),"^",3)
. S LA7ORS=$P(LA76305(1),"^",2)
. S LA7SUBFL=63.3
. ; Working on colony count
. I $P(LRSB,",",2)=1 D CC Q
. ; Working on organism
. I $G(LRIDT(3))="" D ORG Q
. ; Working on susceptibilities
. I $P(LA76305(1),"^",4) S LA7VERP=$P(LA76305(1),"^",4)
. I $P(LRSB,",",2)<3 D MIC Q
. I $P(LRSB,",",2)=3 D MICA Q
;
; Parasite organism
I $P(LRSB,",")=16 D Q
. S LA7ORS=$P(LA76305(5),"^",2)
. S LA7VERP=$P(LA76305(5),"^",3)
. ; Working on organism
. S LA7SUBFL=63.34 D ORG
;
; Mycology organism
I $P(LRSB,",")=20 D Q
. S LA7ORS=$P(LA76305(8),"^",2)
. S LA7VERP=$P(LA76305(8),"^",3)
. S LA7SUBFL=63.37
. ; Working on colony count
. I $P(LRSB,",",2)=1 D CC Q
. ; Working on organism
. D ORG
;
; Acid Fast stain
I LRSB=24 D Q
. N LA7ERR
. S LA7VERP=$P(LA76305(11),"^",3)
. S LA7ORS=$P(LA76305(11),"^",2)
. S LA7OBX(2)=$$OBX2^LA7COBX(63.05,24)
. S LA7IENS=LRIDT_","_LRDFN_","
. S LA7VAL=$$GET1^DIQ(63.05,LA7IENS,24,"","LA7ERR")
. S LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,24,"","LABEL")_"^99VA63"
. S LA7ALT=LA7Y_"^"_LA7Y
;
; Acid Fast stain quantity
I LRSB=25 D Q
. N LA7ERR
. S LA7VERP=$P(LA76305(11),"^",3)
. S LA7ORS=$P(LA76305(11),"^",2)
. S LA7OBX(2)=$$OBX2^LA7COBX(63.05,25)
. S LA7IENS=LRIDT_","_LRDFN_","
. S LA7VAL=$$GET1^DIQ(63.05,LA7IENS,25,"","LA7ERR")
. S LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,25,"","LABEL")_"^99VA63"
. S LA7ALT=LA7Y_"^"_LA7Y
;
; TB organism
I $P(LRSB,",")=26 D Q
. S LA7ORS=$P(LA76305(11),"^",2)
. S LA7VERP=$P(LA76305(11),"^",5)
. S LA7SUBFL=63.39
. ; Working on colony count
. I $P(LRSB,",",2)=1 D CC Q
. ; Working on organism
. I $G(LRIDT(3))="" D ORG Q
. ; Working on susceptibilities
. D MIC
;
; Virology virus
I $P(LRSB,",")=36 D Q
. S LA7ORS=$P(LA76305(16),"^",2)
. S LA7VERP=$P(LA76305(16),"^",3)
. ; Working on virus
. S LA7SUBFL=63.43
. D ORG
;
; Antibiotic levels
I $P(LRSB,",")=28 D Q
. S LA7VERP=$P(LA76305(1),"^",3)
. S LA7ORS=$P(LA76305(1),"^",2)
. S LA7SUBFL=63.42
. S LA7OBX(2)="SN"
. S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,14,LRIDT(2),0))
. S $P(LA7CODE,"!",2)="93978.0000"
. S $P(LA7CODE,"!",3)=$S($P(LA7X,"^",2)="P":44433,$P(LA7X,"^",2)="T":44434,1:23816)
. S LA7VAL=$P(LA7X,"^",3)
. S LA7Y="MI-"_$P(LRSB,",")_"-"_$P(LRSB,",",2)_"^"_$P(LA7X,"^")_"^99VA63"
. S LA7ALT=LA7Y_"^"_LA7Y
;
;
Q
;
;
CC ; Organism's Colony count
; If "CFU/ml" found then move units to OBX-6 (Units).
N LA7X
;
S LA7ID=$P(LRSB,",")_"-"_LRIDT(2)
S LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
S LA7OBX(2)=$$OBX2^LA7COBX(LA7SUBFL,1)
S LA7VAL=$$GET1^DIQ(LA7SUBFL,LA7IENS,1)
S LA7X=$$UP^XLFSTR(LA7VAL)
I LA7X["CFU/ML" D
. S LA7OBX(6)=$$OBX6^LA7COBX("CFU/ml","",LA7FS,LA7ECH,$G(LA7INTYP))
. S LA7X("CFU/ml")="",LA7X("CFU/ML")=""
. S LA7VAL=$$REPLACE^XLFSTR(LA7VAL,.LA7X)
;
S LA7Y="MI-"_$P(LRSB,",")_"-1^"_$$GET1^DID(LA7SUBFL,1,"","LABEL")_"^99VA63"
S LA7ALT=LA7Y_"^"_LA7Y
;
Q
;
;
ORG ; Organism
;
N LA7X,LA7Y,X
;
S LA7ID=LRSB_"-"_LRIDT(2)
S LA7OBX(2)=$$OBX2^LA7COBX(LA7SUBFL,.01)
S LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
S LA7VAL=""
S LA7X=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01,"I"),LA7X(.01)=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01)
;
S LA7NORG=$$FNDORG(LRDFN,LRIDT,LA7ND,LA7ORG) ;MU2
; Check for SNOMED coding/local coding as alternate
S X=$$GET1^DIQ(LA7SUBFL,LA7IENS,".01:2")
;I X'="" D
;. S LA7VAL="E-"_X_"^"_LA7X(.01)_"^SNM",$P(LA7VAL,"^",4,6)=LA7X_"^"_LA7X(.01)_"^99VA61.2"
;. I $G(LA7NVAF)'=1 S LA7OBX(2)="CWE",$P(LA7VAL,"^",7,8)="1974^5.2",$P(LA7VAL,"^",9)=LA7X(.01)
I X'="" D ;mu2
. S LA7VAL=X_"^"_LA7X(.01)_"^SCT",$P(LA7VAL,"^",4,6)=$E(LA7X(.01),1,3)_"^"_LA7X(.01)_"^L"
. I $G(LA7NVAF)'=1 S LA7OBX(2)="CWE",$P(LA7VAL,"^",7,8)="1974^5.2",$P(LA7VAL,"^",9)=LA7X(.01)
;
; If no SNOMED then use local coding as primary
I LA7VAL="" D
. S LA7VAL=LA7X_"^"_LA7X(.01)_"^L"
. I $G(LA7NVAF)'=1 S LA7OBX(2)="CWE",$P(LA7VAL,"^",7)="5.2",$P(LA7VAL,"^",9)=LA7X(.01)
;
S LA7Y="MI-"_$P(LRSB,",")_"-.01^"_$$GET1^DID(LA7SUBFL,.01,"","LABEL")_"^L"
S LA7ALT=LA7Y_"^"_LA7Y
;
;TODO mu2 may need this back in a different way
;S LA7OBX(8)=$$OBX8^LA7COBX("A")
;
; Set flag to save sub-id for parent-child relationship
S LA7SAVID=1
Q
;
;
MIC ; Organism's susceptibilities
;
N LA7IENS,LA7SUB
;
; Bact or TB organism
S LA7SUB=$S($P(LRSB,",")=12:3,1:12)
;
S LA7OBX(2)=$$OBX2^LA7COBX(62.06,.01)
;
; Determine local code for antibiotic if not mapped to NLT or in file #62.06
; - Use file #62.06 entry if available otherwise generate from drug node field in file #63
; also used to convey local display name in 9th component
S LA7X=""
I $P(LRSB,",")=12 D
. S LA7X=$O(^LAB(62.06,"AD",$P(LRSB,",",2),0))
. I LA7X S LA7ALT=LA7X_"^"_$$GET1^DIQ(62.06,LA7X_",",.01)_"^L",LA7ALT=LA7ALT_"^"_LA7ALT
I LA7ALT="" D
. S LA7X=$P(LRSB,",",2),LA7Y=$O(^DD(LA7SUBFL,"GL",LA7X,1,0))
. I LA7Y<1 Q
. S LA7ALT="MIAB"_$P(LRSB,",")_"-"_$P(LRSB,",",2)_"^"_$$GET1^DID(LA7SUBFL,LA7Y,"","LABEL")_"^L"
. S LA7ALT=LA7ALT_"^"_LA7ALT
;
S LA7X=$G(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),LRIDT(3)))
S LA7VAL=$P(LA7X,"^")
I LA7VAL'="" D
. I "SIR"[$E(LA7VAL) S LA7OBX(8)=$$OBX8^LA7COBX($E(LA7VAL)) Q
. I "SIR"[$E($P(LA7X,"^",2)) D Q
.. S LA7OBX(8)=$$LOOKTAB^LA7CQRY1("HL7","0078",$E($P(LA7X,"^",2)),$E(LA7ECH))
.. S $P(LA7OBX(8),$E(LA7ECH),7)="2.7"
.. ;S LA7OBX(8)=$$OBX8^LA7COBX($E($P(LA7X,"^",2)))
;
; Determine access screen for this susceptibility
I $P(LA7X,"^",3)="" S $P(LA7X,"^",3)="A"
I $G(LA7INPT),$G(LRSS)="MI",$G(LA7OBRSN)>1 S LA7VAL="S" ;mu2 inpatient mu2 micro
S LA7OBX(13)=$$OBX13^LA7COBX($P(LA7X,"^",3),$S($G(LA7INTYP)=30:"MIS-HDR",1:"MIS"),LA7FS,LA7ECH)
;
Q
;
;
MICA ; Bacteria organism's susceptibilities - free text
;
N LA7SUB,LA7X
S LA7OBX(2)="NM"
;
; Bact organism
S LA7SUB=3
;
; Determine local code for free text antibiotic also used to convey local display name in 9th component
S LA7X=$G(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),3,LRIDT(3),0))
S LA7ALT="MIAB"_$P(LRSB,",")_"-"_$P(LRSB,",",2)_"-"_$P(LRSB,",",3)_"^"_$P(LA7X,"^")_$S($P(LRSB,",",3)=1:" MIC",1:" MBC")_"^L"
S LA7ALT=LA7ALT_"^"_LA7ALT
S $P(LA7CODE,"!",2)="87565.0000"
S $P(LA7CODE,"!",3)=$S($P(LRSB,",",3)=1:21070,1:23658)
;
S LA7VAL=$P(LA7X,"^",$S($P(LRSB,",",3)=1:2,1:3))
;
S LA7OBX(6)="UG/ML"
S LA7OBX(8)=""
;
Q
;
;
GEN ; Fields common to all MI OBX segments.
;
; Initialize OBX segment
S LA7OBX(0)="OBX"
S LA7OBX(1)=$$OBX1^LA7COBX(.LA7OBXSN)
;
N LA7WKI
;I $P(LA7CODE,"!",2)]"",$G(LA7953)="" S LA7WKI=$O(^LAM("E",$P(LA7CODE,"!",2),0)) ;will this break script #3 & #4 MU2
;need to figure out these codes here for micro
I $P(LA7CODE,"!",2)]"" S LA7WKI=$O(^LAM("E",$P(LA7CODE,"!",2),0)) ;will this break script #9 MU2
;the following 2 lines will look up the org if there
;I $G(LA7NORG) S LA7WKI=$O(^LAB(61.2,LA7NORG,9,"B",0))
I $G(LA7WKI) S LA7953=$P($G(^LAM(LA7WKI,9)),U)
;MU2 added 3 below lines for NIST 9 testing, this seems to work for both NIST 4 and NIST 9, will leave this in for now, until retesting
I $G(LA7NORG),$G(LA7OBRSN)=1 D
. S LA7WKI=$O(^LAB(61.2,LA7NORG,9,"B",0))
. S LA7953=$P($G(^LAM(LA7WKI,9)),U)
S LA7OBX(3)=$$OBX3^LA7COBX($P(LA7CODE,"!",2),$S($G(LA7953):LA7953,1:$P(LA7CODE,"!",3)),LA7ALT,LA7FS,LA7ECH,$G(LA7INTYP))
I $G(LA7INPT) S $P(LA7OBX(3),$E(LA7ECH),9)=$E($P(LA7OBX(3),$E(LA7ECH),2),1,30) ;mu2 inpatient
K LA7NORG
;S LA7OBX(3)=$$OBX3^LA7COBX($P(LA7CODE,"!",2),$P(LA7CODE,"!",3),LA7ALT,LA7FS,LA7ECH,$G(LA7INTYP))
;
; Change normal coding system for DoD special
I LA7NVAF=1,LA7ALTCS'="" D
. F I=3,6 I $P(LA7OBX(3),$E(LA7ECH,1),I)="99VA64" S $P(LA7OBX(3),$E(LA7ECH,1),I)=LA7ALTCS Q
;
I $G(LA7INPT) S LA7OBX(4)=$P($G(LA7OBXSN),"-",2) ;mu2 inpatient micro
I $G(LA7INPT),$G(LA7OBX(4))="" S LA7OBX(4)=1
; Test value
K LA75UNIT
S LA7OBX(5)=$$OBX5^LA7COBX(LA7VAL,LA7OBX(2),LA7FS,LA7ECH)
I $G(LA7OBX(5))["-" S LA7OBX(5)=$P(LA7OBX(5),"-",2)
I $G(LA7OBX(2))="SN",$P(LA7OBX(5)," ",2)]"" D
. S LA75UNIT=$P(LA7OBX(5)," ",2)
. S LA7OBX(5)=$P(LA7OBX(5)," ")
;
; units
I $G(LA7INPT),$G(LA75UNIT)="" S LA75UNIT="ug/mL" ;mu2 inpatient micro
I $G(LA75UNIT)]"" D
. S $P(LA7OBX(6),$E(LA7ECH))=LA75UNIT
. S $P(LA7OBX(6),$E(LA7ECH),2)=$P($$LOOKTAB^LA7CQRY1("","UCUM",LA75UNIT,$E(LA7ECH)),$E(LA7ECH),2)
. S $P(LA7OBX(6),$E(LA7ECH),3)="UCUM"
. S $P(LA7OBX(6),$E(LA7ECH),4)=LA75UNIT
. S $P(LA7OBX(6),$E(LA7ECH),6)="L"
. S $P(LA7OBX(6),$E(LA7ECH),7)="1.8.2"
; Set sub-id and save for constructing parents
I LA7ID'="" D
. S LA7OBX(4)=$$OBX4^LA7COBX(LA7ID,LA7FS,LA7ECH)
. I $G(LA7INPT),$G(LA7OBX(4))["-" S LA7OBX(4)=$P(LA7OBX(4),"-",2)
. I $G(LA7INPT),$G(LA7OBX(4))="" S LA7OBX(4)=1
. I LA7SAVID D
. . F I=1,2 S LA7ID(LA7ID,I)=LA7OBX(I+2)
. . I $G(HL("VER"))="2.2" S LA7ID(LA7ID,3)=LA7OBX(5) Q
. . F I=2,4 I $P(LA7OBX(5),$E(LA7ECH,1),I)'="" S LA7ID(LA7ID,3)=$P(LA7OBX(5),$E(LA7ECH,1),I) Q
;
; Order result status - "P"artial, "F"inal , "A"mended results
; If no status from individual components then use status from zeroth node.
; If no release date then pending else final
; If amended, overrides all other status
I $G(LA7INPT) S LA7OBX(8)="A" ;mu2 inpatient
I LA7ORS="" S LA7ORS=$S('$P(LA76305(0),"^",3):"P",1:"F")
I $P(LA76305(0),"^",9) S LA7ORS="A"
S LA7OBX(11)=$$OBX11^LA7COBX(LA7ORS)
;
S LA7DIV=$P($G(^LR(LRDFN,LRSS,LRIDT,"RF")),"^")
I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA76305(0),"^",4)) S LA7DIV=$O(LA7DIV(0))
;
; Observation date/time - collection date/time per HL7 standard
I $P(LA76305(0),"^") S LA7OBX(14)=$$OBX14^LA7COBX($P(LA76305(0),"^"))
;
; Facility that performed the testing
S LA7OBX(15)=$$OBX15^LA7COBX(LA7DIV,LA7FS,LA7ECH)
;
; Person that verified the test
I $P(LA76305(0),"^",4) S LA7VERP=$P(LA76305(0),"^",4)
I LA7VERP S LA7OBX(16)=$$OBX16^LA7COBX(LA7VERP,LA7DIV,LA7FS,LA7ECH)
;
; Date/time of the analysis
I $P(LA76305(0),"^",10)'="" S LA7OBX(19)=$$OBX19^LA7COBX($P(LA76305(0),"^",10))
I $G(LA7OBX(19))="" S LA7OBX(19)=$G(LA7OBX(14))
;
; Performing organization name/address
I LA7DIV="" S LA7DIV=DUZ(2) ;MU2
I LA7DIV'="" D
. N LA7DT
. S LA7OBX(23)=$$OBX23^LA7COBX(4,LA7DIV,LA7FS,LA7ECH)
. S $P(LA7OBX(23),$E(LA7ECH,1),6)="CLIA"_$E(LA7ECH,4)_"2.16.840.1.113883.4.7"_$E(LA7ECH,4)_"ISO"
. S $P(LA7OBX(23),$E(LA7ECH,1),7)="XX"
. S $P(LA7OBX(23),$E(LA7ECH,1),10)=$P($G(^DIC(4,LA7DIV,99)),U)
. S LA7DT=$S($P(LA76305(0),"^",3):$P(LA76305(0),"^",3),1:$$NOW^XLFDT)
. S LA7OBX(24)=$$OBX24^LA7COBX(4,LA7DIV,LA7DT,LA7FS,LA7ECH)
. S $P(LA7OBX(24),$E(LA7ECH),6)="USA"
. S $P(LA7OBX(24),$E(LA7ECH),7)="L"
. S $P(LA7OBX(24),$E(LA7ECH),9)=$P(LA7OBX(24),$E(LA7ECH),5) ;MU2 county code same as zip for now
;
S LA7OBX(25)=$$OBX25^LA7COBX($$GET1^DIQ(9009029,DUZ(2),3027,"I"),DUZ(2),LA7FS,LA7ECH)
S $P(LA7OBX(25),$E(LA7ECH),9)="NPI"_$E(LA7ECH,4)_"2.16.840.1.113883.4.6"_$E(LA7ECH,4)_"ISO"
S $P(LA7OBX(25),$E(LA7ECH),10)="L"
S $P(LA7OBX(25),$E(LA7ECH),13)="NPI"
S $P(LA7OBX(25),$E(LA7ECH),14)="NPI_Facility"_$E(LA7ECH,4)_"2.16.840.1.113883.3.72.5.26"_$E(LA7ECH,4)_"ISO"
S $P(LA7OBX(25),$E(LA7ECH),21)=$P(LA7OBX(25),$E(LA7ECH),6)
I $G(LA7INPT) S $P(LA7OBX(25),$E(LA7ECH),7)="" ;mu2 inpatient
;
D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
;
Q
;
FNDORG(DF,IDT,ND,ORG) ;-- return the org IEN for file 61.2
N ORGI
S ORGI=$P($G(^LR(DF,LRSS,IDT,ND,ORG,0)),U)
Q ORGI
;
LA7COBX3 ;VA/DALOI/JMC - LAB OBX Segment message builder (MI subscripts) cont'd ; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033**;NOV 01, 1997
+2 ;
+3 ; Reference to ^DD supported by DBIA #999
+4 ;
MI ; Build OBX segments for results that are microbiology subscript.
+1 ; Called by LA7VOBX
+2 ;
+3 NEW I,LA761,LA76305,LA7ALT,LA7ALTCS,LA7CODE,LA7DIV,LA7IENS,LA7LOINC,LA7NLT,LA7OBX,LA7ORS,LA7PARNT,LA7SAVID,LA7SUBFL,LA7VAL,LA7VERP
+4 ;
+5 IF $PIECE(LRIDT,",",2)
SET LRIDT(2)=$PIECE(LRIDT,",",2)
SET LRIDT(3)=$PIECE(LRIDT,",",3)
SET LRIDT=$PIECE(LRIDT,",")
+6 ;
+7 IF '$DATA(^LR(LRDFN,LRSS,LRIDT))
QUIT
+8 ;
+9 FOR I=0,1,5,8,11,16
SET LA76305(I)=$GET(^LR(LRDFN,LRSS,LRIDT,I))
+10 ;
+11 SET (LA7ALT,LA7ALTCS,LA7CODE,LA7ID,LA7LOINC,LA7NLT,LA7ORS,LA7SAVID,LA7SUBFL,LA7VAL,LA7VERP)=""
+12 ;
+13 ; Specimen topography
+14 SET LA761=$PIECE(LA76305(0),"^",5)
+15 ; Default codes
+16 SET LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7CODE,LA761)
+17 ;
+18 DO SEC
DO GEN
+19 ;S LRSPEC=$P($G(LA76305(0)),U,11) ;MU2 get the microsusept specimen for SPM from collection sample field
+20 QUIT
+21 ;
SEC ; Build section specific fields
+1 NEW LA7X,LA7Y
+2 ;
+3 ; Urine screen
+4 IF LRSB=11.57
Begin DoDot:1
+5 NEW LA7ERR
+6 SET LA7VERP=$PIECE(LA76305(1),"^",3)
SET LA7ORS=$PIECE(LA76305(1),"^",2)
+7 SET LA7OBX(2)=$$OBX2^LA7COBX(63.05,11.57)
+8 SET LA7IENS=LRIDT_","_LRDFN_","
+9 SET LA7VAL=$$GET1^DIQ(63.05,LA7IENS,11.57,"","LA7ERR")
+10 SET LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,11.57,"","LABEL")_"^99VA63"
+11 SET LA7ALT=LA7Y_"^"_LA7Y
End DoDot:1
QUIT
+12 ;
+13 ; Sputum Screen
+14 IF LRSB=11.58
Begin DoDot:1
+15 NEW LA7ERR
+16 SET LA7VERP=$PIECE(LA76305(1),"^",3)
+17 SET LA7ORS=$PIECE(LA76305(1),"^",2)
+18 SET LA7OBX(2)=$$OBX2^LA7COBX(63.05,11.58)
+19 SET LA7VAL=$PIECE(^LR(LRDFN,LRSS,LRIDT,1),"^",5)
+20 SET LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,11.58,"","LABEL")_"^99VA63"
+21 SET LA7ALT=LA7Y_"^"_LA7Y
End DoDot:1
QUIT
+22 ;
+23 ; Gram stain
+24 IF LRSB=11.6
Begin DoDot:1
+25 NEW LA7ERR
+26 SET LA7VERP=$PIECE(LA76305(1),"^",3)
+27 SET LA7ORS=$PIECE(LA76305(1),"^",2)
+28 SET LA7OBX(2)=$$OBX2^LA7COBX(63.05,11.6)
+29 SET LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
+30 SET LA7VAL=$$GET1^DIQ(63.29,LA7IENS,.01,"","LA7ERR")
+31 SET LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.29,.01,"","LABEL")_"^99VA63"
+32 SET LA7ALT=LA7Y_"^"_LA7Y
+33 ; Setup DoD special coding system
+34 IF LA7NVAF=1
IF $PIECE(LA7CODE,"!",2)
SET LA7ALTCS="99VA64MG"
End DoDot:1
QUIT
+35 ;
+36 ; Micro organism
+37 IF $PIECE(LRSB,",")=12
Begin DoDot:1
+38 SET LA7VERP=$PIECE(LA76305(1),"^",3)
+39 SET LA7ORS=$PIECE(LA76305(1),"^",2)
+40 SET LA7SUBFL=63.3
+41 ; Working on colony count
+42 IF $PIECE(LRSB,",",2)=1
DO CC
QUIT
+43 ; Working on organism
+44 IF $GET(LRIDT(3))=""
DO ORG
QUIT
+45 ; Working on susceptibilities
+46 IF $PIECE(LA76305(1),"^",4)
SET LA7VERP=$PIECE(LA76305(1),"^",4)
+47 IF $PIECE(LRSB,",",2)<3
DO MIC
QUIT
+48 IF $PIECE(LRSB,",",2)=3
DO MICA
QUIT
End DoDot:1
QUIT
+49 ;
+50 ; Parasite organism
+51 IF $PIECE(LRSB,",")=16
Begin DoDot:1
+52 SET LA7ORS=$PIECE(LA76305(5),"^",2)
+53 SET LA7VERP=$PIECE(LA76305(5),"^",3)
+54 ; Working on organism
+55 SET LA7SUBFL=63.34
DO ORG
End DoDot:1
QUIT
+56 ;
+57 ; Mycology organism
+58 IF $PIECE(LRSB,",")=20
Begin DoDot:1
+59 SET LA7ORS=$PIECE(LA76305(8),"^",2)
+60 SET LA7VERP=$PIECE(LA76305(8),"^",3)
+61 SET LA7SUBFL=63.37
+62 ; Working on colony count
+63 IF $PIECE(LRSB,",",2)=1
DO CC
QUIT
+64 ; Working on organism
+65 DO ORG
End DoDot:1
QUIT
+66 ;
+67 ; Acid Fast stain
+68 IF LRSB=24
Begin DoDot:1
+69 NEW LA7ERR
+70 SET LA7VERP=$PIECE(LA76305(11),"^",3)
+71 SET LA7ORS=$PIECE(LA76305(11),"^",2)
+72 SET LA7OBX(2)=$$OBX2^LA7COBX(63.05,24)
+73 SET LA7IENS=LRIDT_","_LRDFN_","
+74 SET LA7VAL=$$GET1^DIQ(63.05,LA7IENS,24,"","LA7ERR")
+75 SET LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,24,"","LABEL")_"^99VA63"
+76 SET LA7ALT=LA7Y_"^"_LA7Y
End DoDot:1
QUIT
+77 ;
+78 ; Acid Fast stain quantity
+79 IF LRSB=25
Begin DoDot:1
+80 NEW LA7ERR
+81 SET LA7VERP=$PIECE(LA76305(11),"^",3)
+82 SET LA7ORS=$PIECE(LA76305(11),"^",2)
+83 SET LA7OBX(2)=$$OBX2^LA7COBX(63.05,25)
+84 SET LA7IENS=LRIDT_","_LRDFN_","
+85 SET LA7VAL=$$GET1^DIQ(63.05,LA7IENS,25,"","LA7ERR")
+86 SET LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,25,"","LABEL")_"^99VA63"
+87 SET LA7ALT=LA7Y_"^"_LA7Y
End DoDot:1
QUIT
+88 ;
+89 ; TB organism
+90 IF $PIECE(LRSB,",")=26
Begin DoDot:1
+91 SET LA7ORS=$PIECE(LA76305(11),"^",2)
+92 SET LA7VERP=$PIECE(LA76305(11),"^",5)
+93 SET LA7SUBFL=63.39
+94 ; Working on colony count
+95 IF $PIECE(LRSB,",",2)=1
DO CC
QUIT
+96 ; Working on organism
+97 IF $GET(LRIDT(3))=""
DO ORG
QUIT
+98 ; Working on susceptibilities
+99 DO MIC
End DoDot:1
QUIT
+100 ;
+101 ; Virology virus
+102 IF $PIECE(LRSB,",")=36
Begin DoDot:1
+103 SET LA7ORS=$PIECE(LA76305(16),"^",2)
+104 SET LA7VERP=$PIECE(LA76305(16),"^",3)
+105 ; Working on virus
+106 SET LA7SUBFL=63.43
+107 DO ORG
End DoDot:1
QUIT
+108 ;
+109 ; Antibiotic levels
+110 IF $PIECE(LRSB,",")=28
Begin DoDot:1
+111 SET LA7VERP=$PIECE(LA76305(1),"^",3)
+112 SET LA7ORS=$PIECE(LA76305(1),"^",2)
+113 SET LA7SUBFL=63.42
+114 SET LA7OBX(2)="SN"
+115 SET LA7X=$GET(^LR(LRDFN,LRSS,LRIDT,14,LRIDT(2),0))
+116 SET $PIECE(LA7CODE,"!",2)="93978.0000"
+117 SET $PIECE(LA7CODE,"!",3)=$SELECT($PIECE(LA7X,"^",2)="P":44433,$PIECE(LA7X,"^",2)="T":44434,1:23816)
+118 SET LA7VAL=$PIECE(LA7X,"^",3)
+119 SET LA7Y="MI-"_$PIECE(LRSB,",")_"-"_$PIECE(LRSB,",",2)_"^"_$PIECE(LA7X,"^")_"^99VA63"
+120 SET LA7ALT=LA7Y_"^"_LA7Y
End DoDot:1
QUIT
+121 ;
+122 ;
+123 QUIT
+124 ;
+125 ;
CC ; Organism's Colony count
+1 ; If "CFU/ml" found then move units to OBX-6 (Units).
+2 NEW LA7X
+3 ;
+4 SET LA7ID=$PIECE(LRSB,",")_"-"_LRIDT(2)
+5 SET LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
+6 SET LA7OBX(2)=$$OBX2^LA7COBX(LA7SUBFL,1)
+7 SET LA7VAL=$$GET1^DIQ(LA7SUBFL,LA7IENS,1)
+8 SET LA7X=$$UP^XLFSTR(LA7VAL)
+9 IF LA7X["CFU/ML"
Begin DoDot:1
+10 SET LA7OBX(6)=$$OBX6^LA7COBX("CFU/ml","",LA7FS,LA7ECH,$GET(LA7INTYP))
+11 SET LA7X("CFU/ml")=""
SET LA7X("CFU/ML")=""
+12 SET LA7VAL=$$REPLACE^XLFSTR(LA7VAL,.LA7X)
End DoDot:1
+13 ;
+14 SET LA7Y="MI-"_$PIECE(LRSB,",")_"-1^"_$$GET1^DID(LA7SUBFL,1,"","LABEL")_"^99VA63"
+15 SET LA7ALT=LA7Y_"^"_LA7Y
+16 ;
+17 QUIT
+18 ;
+19 ;
ORG ; Organism
+1 ;
+2 NEW LA7X,LA7Y,X
+3 ;
+4 SET LA7ID=LRSB_"-"_LRIDT(2)
+5 SET LA7OBX(2)=$$OBX2^LA7COBX(LA7SUBFL,.01)
+6 SET LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
+7 SET LA7VAL=""
+8 SET LA7X=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01,"I")
SET LA7X(.01)=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01)
+9 ;
+10 ;MU2
SET LA7NORG=$$FNDORG(LRDFN,LRIDT,LA7ND,LA7ORG)
+11 ; Check for SNOMED coding/local coding as alternate
+12 SET X=$$GET1^DIQ(LA7SUBFL,LA7IENS,".01:2")
+13 ;I X'="" D
+14 ;. S LA7VAL="E-"_X_"^"_LA7X(.01)_"^SNM",$P(LA7VAL,"^",4,6)=LA7X_"^"_LA7X(.01)_"^99VA61.2"
+15 ;. I $G(LA7NVAF)'=1 S LA7OBX(2)="CWE",$P(LA7VAL,"^",7,8)="1974^5.2",$P(LA7VAL,"^",9)=LA7X(.01)
+16 ;mu2
IF X'=""
Begin DoDot:1
+17 SET LA7VAL=X_"^"_LA7X(.01)_"^SCT"
SET $PIECE(LA7VAL,"^",4,6)=$EXTRACT(LA7X(.01),1,3)_"^"_LA7X(.01)_"^L"
+18 IF $GET(LA7NVAF)'=1
SET LA7OBX(2)="CWE"
SET $PIECE(LA7VAL,"^",7,8)="1974^5.2"
SET $PIECE(LA7VAL,"^",9)=LA7X(.01)
End DoDot:1
+19 ;
+20 ; If no SNOMED then use local coding as primary
+21 IF LA7VAL=""
Begin DoDot:1
+22 SET LA7VAL=LA7X_"^"_LA7X(.01)_"^L"
+23 IF $GET(LA7NVAF)'=1
SET LA7OBX(2)="CWE"
SET $PIECE(LA7VAL,"^",7)="5.2"
SET $PIECE(LA7VAL,"^",9)=LA7X(.01)
End DoDot:1
+24 ;
+25 SET LA7Y="MI-"_$PIECE(LRSB,",")_"-.01^"_$$GET1^DID(LA7SUBFL,.01,"","LABEL")_"^L"
+26 SET LA7ALT=LA7Y_"^"_LA7Y
+27 ;
+28 ;TODO mu2 may need this back in a different way
+29 ;S LA7OBX(8)=$$OBX8^LA7COBX("A")
+30 ;
+31 ; Set flag to save sub-id for parent-child relationship
+32 SET LA7SAVID=1
+33 QUIT
+34 ;
+35 ;
MIC ; Organism's susceptibilities
+1 ;
+2 NEW LA7IENS,LA7SUB
+3 ;
+4 ; Bact or TB organism
+5 SET LA7SUB=$SELECT($PIECE(LRSB,",")=12:3,1:12)
+6 ;
+7 SET LA7OBX(2)=$$OBX2^LA7COBX(62.06,.01)
+8 ;
+9 ; Determine local code for antibiotic if not mapped to NLT or in file #62.06
+10 ; - Use file #62.06 entry if available otherwise generate from drug node field in file #63
+11 ; also used to convey local display name in 9th component
+12 SET LA7X=""
+13 IF $PIECE(LRSB,",")=12
Begin DoDot:1
+14 SET LA7X=$ORDER(^LAB(62.06,"AD",$PIECE(LRSB,",",2),0))
+15 IF LA7X
SET LA7ALT=LA7X_"^"_$$GET1^DIQ(62.06,LA7X_",",.01)_"^L"
SET LA7ALT=LA7ALT_"^"_LA7ALT
End DoDot:1
+16 IF LA7ALT=""
Begin DoDot:1
+17 SET LA7X=$PIECE(LRSB,",",2)
SET LA7Y=$ORDER(^DD(LA7SUBFL,"GL",LA7X,1,0))
+18 IF LA7Y<1
QUIT
+19 SET LA7ALT="MIAB"_$PIECE(LRSB,",")_"-"_$PIECE(LRSB,",",2)_"^"_$$GET1^DID(LA7SUBFL,LA7Y,"","LABEL")_"^L"
+20 SET LA7ALT=LA7ALT_"^"_LA7ALT
End DoDot:1
+21 ;
+22 SET LA7X=$GET(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),LRIDT(3)))
+23 SET LA7VAL=$PIECE(LA7X,"^")
+24 IF LA7VAL'=""
Begin DoDot:1
+25 IF "SIR"[$EXTRACT(LA7VAL)
SET LA7OBX(8)=$$OBX8^LA7COBX($EXTRACT(LA7VAL))
QUIT
+26 IF "SIR"[$EXTRACT($PIECE(LA7X,"^",2))
Begin DoDot:2
+27 SET LA7OBX(8)=$$LOOKTAB^LA7CQRY1("HL7","0078",$EXTRACT($PIECE(LA7X,"^",2)),$EXTRACT(LA7ECH))
+28 SET $PIECE(LA7OBX(8),$EXTRACT(LA7ECH),7)="2.7"
+29 ;S LA7OBX(8)=$$OBX8^LA7COBX($E($P(LA7X,"^",2)))
End DoDot:2
QUIT
End DoDot:1
+30 ;
+31 ; Determine access screen for this susceptibility
+32 IF $PIECE(LA7X,"^",3)=""
SET $PIECE(LA7X,"^",3)="A"
+33 ;mu2 inpatient mu2 micro
IF $GET(LA7INPT)
IF $GET(LRSS)="MI"
IF $GET(LA7OBRSN)>1
SET LA7VAL="S"
+34 SET LA7OBX(13)=$$OBX13^LA7COBX($PIECE(LA7X,"^",3),$SELECT($GET(LA7INTYP)=30:"MIS-HDR",1:"MIS"),LA7FS,LA7ECH)
+35 ;
+36 QUIT
+37 ;
+38 ;
MICA ; Bacteria organism's susceptibilities - free text
+1 ;
+2 NEW LA7SUB,LA7X
+3 SET LA7OBX(2)="NM"
+4 ;
+5 ; Bact organism
+6 SET LA7SUB=3
+7 ;
+8 ; Determine local code for free text antibiotic also used to convey local display name in 9th component
+9 SET LA7X=$GET(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),3,LRIDT(3),0))
+10 SET LA7ALT="MIAB"_$PIECE(LRSB,",")_"-"_$PIECE(LRSB,",",2)_"-"_$PIECE(LRSB,",",3)_"^"_$PIECE(LA7X,"^")_$SELECT($PIECE(LRSB,",",3)=1:" MIC",1:" MBC")_"^L"
+11 SET LA7ALT=LA7ALT_"^"_LA7ALT
+12 SET $PIECE(LA7CODE,"!",2)="87565.0000"
+13 SET $PIECE(LA7CODE,"!",3)=$SELECT($PIECE(LRSB,",",3)=1:21070,1:23658)
+14 ;
+15 SET LA7VAL=$PIECE(LA7X,"^",$SELECT($PIECE(LRSB,",",3)=1:2,1:3))
+16 ;
+17 SET LA7OBX(6)="UG/ML"
+18 SET LA7OBX(8)=""
+19 ;
+20 QUIT
+21 ;
+22 ;
GEN ; Fields common to all MI OBX segments.
+1 ;
+2 ; Initialize OBX segment
+3 SET LA7OBX(0)="OBX"
+4 SET LA7OBX(1)=$$OBX1^LA7COBX(.LA7OBXSN)
+5 ;
+6 NEW LA7WKI
+7 ;I $P(LA7CODE,"!",2)]"",$G(LA7953)="" S LA7WKI=$O(^LAM("E",$P(LA7CODE,"!",2),0)) ;will this break script #3 & #4 MU2
+8 ;need to figure out these codes here for micro
+9 ;will this break script #9 MU2
IF $PIECE(LA7CODE,"!",2)]""
SET LA7WKI=$ORDER(^LAM("E",$PIECE(LA7CODE,"!",2),0))
+10 ;the following 2 lines will look up the org if there
+11 ;I $G(LA7NORG) S LA7WKI=$O(^LAB(61.2,LA7NORG,9,"B",0))
+12 IF $GET(LA7WKI)
SET LA7953=$PIECE($GET(^LAM(LA7WKI,9)),U)
+13 ;MU2 added 3 below lines for NIST 9 testing, this seems to work for both NIST 4 and NIST 9, will leave this in for now, until retesting
+14 IF $GET(LA7NORG)
IF $GET(LA7OBRSN)=1
Begin DoDot:1
+15 SET LA7WKI=$ORDER(^LAB(61.2,LA7NORG,9,"B",0))
+16 SET LA7953=$PIECE($GET(^LAM(LA7WKI,9)),U)
End DoDot:1
+17 SET LA7OBX(3)=$$OBX3^LA7COBX($PIECE(LA7CODE,"!",2),$SELECT($GET(LA7953):LA7953,1:$PIECE(LA7CODE,"!",3)),LA7ALT,LA7FS,LA7ECH,$GET(LA7INTYP))
+18 ;mu2 inpatient
IF $GET(LA7INPT)
SET $PIECE(LA7OBX(3),$EXTRACT(LA7ECH),9)=$EXTRACT($PIECE(LA7OBX(3),$EXTRACT(LA7ECH),2),1,30)
+19 KILL LA7NORG
+20 ;S LA7OBX(3)=$$OBX3^LA7COBX($P(LA7CODE,"!",2),$P(LA7CODE,"!",3),LA7ALT,LA7FS,LA7ECH,$G(LA7INTYP))
+21 ;
+22 ; Change normal coding system for DoD special
+23 IF LA7NVAF=1
IF LA7ALTCS'=""
Begin DoDot:1
+24 FOR I=3,6
IF $PIECE(LA7OBX(3),$EXTRACT(LA7ECH,1),I)="99VA64"
SET $PIECE(LA7OBX(3),$EXTRACT(LA7ECH,1),I)=LA7ALTCS
QUIT
End DoDot:1
+25 ;
+26 ;mu2 inpatient micro
IF $GET(LA7INPT)
SET LA7OBX(4)=$PIECE($GET(LA7OBXSN),"-",2)
+27 IF $GET(LA7INPT)
IF $GET(LA7OBX(4))=""
SET LA7OBX(4)=1
+28 ; Test value
+29 KILL LA75UNIT
+30 SET LA7OBX(5)=$$OBX5^LA7COBX(LA7VAL,LA7OBX(2),LA7FS,LA7ECH)
+31 IF $GET(LA7OBX(5))["-"
SET LA7OBX(5)=$PIECE(LA7OBX(5),"-",2)
+32 IF $GET(LA7OBX(2))="SN"
IF $PIECE(LA7OBX(5)," ",2)]""
Begin DoDot:1
+33 SET LA75UNIT=$PIECE(LA7OBX(5)," ",2)
+34 SET LA7OBX(5)=$PIECE(LA7OBX(5)," ")
End DoDot:1
+35 ;
+36 ; units
+37 ;mu2 inpatient micro
IF $GET(LA7INPT)
IF $GET(LA75UNIT)=""
SET LA75UNIT="ug/mL"
+38 IF $GET(LA75UNIT)]""
Begin DoDot:1
+39 SET $PIECE(LA7OBX(6),$EXTRACT(LA7ECH))=LA75UNIT
+40 SET $PIECE(LA7OBX(6),$EXTRACT(LA7ECH),2)=$PIECE($$LOOKTAB^LA7CQRY1("","UCUM",LA75UNIT,$EXTRACT(LA7ECH)),$EXTRACT(LA7ECH),2)
+41 SET $PIECE(LA7OBX(6),$EXTRACT(LA7ECH),3)="UCUM"
+42 SET $PIECE(LA7OBX(6),$EXTRACT(LA7ECH),4)=LA75UNIT
+43 SET $PIECE(LA7OBX(6),$EXTRACT(LA7ECH),6)="L"
+44 SET $PIECE(LA7OBX(6),$EXTRACT(LA7ECH),7)="1.8.2"
End DoDot:1
+45 ; Set sub-id and save for constructing parents
+46 IF LA7ID'=""
Begin DoDot:1
+47 SET LA7OBX(4)=$$OBX4^LA7COBX(LA7ID,LA7FS,LA7ECH)
+48 IF $GET(LA7INPT)
IF $GET(LA7OBX(4))["-"
SET LA7OBX(4)=$PIECE(LA7OBX(4),"-",2)
+49 IF $GET(LA7INPT)
IF $GET(LA7OBX(4))=""
SET LA7OBX(4)=1
+50 IF LA7SAVID
Begin DoDot:2
+51 FOR I=1,2
SET LA7ID(LA7ID,I)=LA7OBX(I+2)
+52 IF $GET(HL("VER"))="2.2"
SET LA7ID(LA7ID,3)=LA7OBX(5)
QUIT
+53 FOR I=2,4
IF $PIECE(LA7OBX(5),$EXTRACT(LA7ECH,1),I)'=""
SET LA7ID(LA7ID,3)=$PIECE(LA7OBX(5),$EXTRACT(LA7ECH,1),I)
QUIT
End DoDot:2
End DoDot:1
+54 ;
+55 ; Order result status - "P"artial, "F"inal , "A"mended results
+56 ; If no status from individual components then use status from zeroth node.
+57 ; If no release date then pending else final
+58 ; If amended, overrides all other status
+59 ;mu2 inpatient
IF $GET(LA7INPT)
SET LA7OBX(8)="A"
+60 IF LA7ORS=""
SET LA7ORS=$SELECT('$PIECE(LA76305(0),"^",3):"P",1:"F")
+61 IF $PIECE(LA76305(0),"^",9)
SET LA7ORS="A"
+62 SET LA7OBX(11)=$$OBX11^LA7COBX(LA7ORS)
+63 ;
+64 SET LA7DIV=$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,"RF")),"^")
+65 IF LA7DIV=""
IF $$DIV4^XUSER(.LA7DIV,$PIECE(LA76305(0),"^",4))
SET LA7DIV=$ORDER(LA7DIV(0))
+66 ;
+67 ; Observation date/time - collection date/time per HL7 standard
+68 IF $PIECE(LA76305(0),"^")
SET LA7OBX(14)=$$OBX14^LA7COBX($PIECE(LA76305(0),"^"))
+69 ;
+70 ; Facility that performed the testing
+71 SET LA7OBX(15)=$$OBX15^LA7COBX(LA7DIV,LA7FS,LA7ECH)
+72 ;
+73 ; Person that verified the test
+74 IF $PIECE(LA76305(0),"^",4)
SET LA7VERP=$PIECE(LA76305(0),"^",4)
+75 IF LA7VERP
SET LA7OBX(16)=$$OBX16^LA7COBX(LA7VERP,LA7DIV,LA7FS,LA7ECH)
+76 ;
+77 ; Date/time of the analysis
+78 IF $PIECE(LA76305(0),"^",10)'=""
SET LA7OBX(19)=$$OBX19^LA7COBX($PIECE(LA76305(0),"^",10))
+79 IF $GET(LA7OBX(19))=""
SET LA7OBX(19)=$GET(LA7OBX(14))
+80 ;
+81 ; Performing organization name/address
+82 ;MU2
IF LA7DIV=""
SET LA7DIV=DUZ(2)
+83 IF LA7DIV'=""
Begin DoDot:1
+84 NEW LA7DT
+85 SET LA7OBX(23)=$$OBX23^LA7COBX(4,LA7DIV,LA7FS,LA7ECH)
+86 SET $PIECE(LA7OBX(23),$EXTRACT(LA7ECH,1),6)="CLIA"_$EXTRACT(LA7ECH,4)_"2.16.840.1.113883.4.7"_$EXTRACT(LA7ECH,4)_"ISO"
+87 SET $PIECE(LA7OBX(23),$EXTRACT(LA7ECH,1),7)="XX"
+88 SET $PIECE(LA7OBX(23),$EXTRACT(LA7ECH,1),10)=$PIECE($GET(^DIC(4,LA7DIV,99)),U)
+89 SET LA7DT=$SELECT($PIECE(LA76305(0),"^",3):$PIECE(LA76305(0),"^",3),1:$$NOW^XLFDT)
+90 SET LA7OBX(24)=$$OBX24^LA7COBX(4,LA7DIV,LA7DT,LA7FS,LA7ECH)
+91 SET $PIECE(LA7OBX(24),$EXTRACT(LA7ECH),6)="USA"
+92 SET $PIECE(LA7OBX(24),$EXTRACT(LA7ECH),7)="L"
+93 ;MU2 county code same as zip for now
SET $PIECE(LA7OBX(24),$EXTRACT(LA7ECH),9)=$PIECE(LA7OBX(24),$EXTRACT(LA7ECH),5)
End DoDot:1
+94 ;
+95 SET LA7OBX(25)=$$OBX25^LA7COBX($$GET1^DIQ(9009029,DUZ(2),3027,"I"),DUZ(2),LA7FS,LA7ECH)
+96 SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),9)="NPI"_$EXTRACT(LA7ECH,4)_"2.16.840.1.113883.4.6"_$EXTRACT(LA7ECH,4)_"ISO"
+97 SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),10)="L"
+98 SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),13)="NPI"
+99 SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),14)="NPI_Facility"_$EXTRACT(LA7ECH,4)_"2.16.840.1.113883.3.72.5.26"_$EXTRACT(LA7ECH,4)_"ISO"
+100 SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),21)=$PIECE(LA7OBX(25),$EXTRACT(LA7ECH),6)
+101 ;mu2 inpatient
IF $GET(LA7INPT)
SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),7)=""
+102 ;
+103 DO BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
+104 ;
+105 QUIT
+106 ;
FNDORG(DF,IDT,ND,ORG) ;-- return the org IEN for file 61.2
+1 NEW ORGI
+2 SET ORGI=$PIECE($GET(^LR(DF,LRSS,IDT,ND,ORG,0)),U)
+3 QUIT ORGI
+4 ;
