LA7VOBX3 ;VA/DALOI/JMC - LAB OBX Segment message builder (MI subscripts) cont'd ; 13-Aug-2013 09:09 ; MKK
;;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
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^LA7VOBX(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^LA7VOBX(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^LA7VOBX(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^LA7VOBX(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^LA7VOBX(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^LA7VOBX(LA7SUBFL,1)
S LA7VAL=$$GET1^DIQ(LA7SUBFL,LA7IENS,1)
S LA7X=$$UP^XLFSTR(LA7VAL)
I LA7X["CFU/ML" D
. S LA7OBX(6)=$$OBX6^LA7VOBX("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^LA7VOBX(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)
;
; 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)
;
; If no SNOMED then use local coding as primary
I LA7VAL="" D
. S LA7VAL=LA7X_"^"_LA7X(.01)_"^99VA61.2"
. 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")_"^99VA63"
S LA7ALT=LA7Y_"^"_LA7Y
;
S LA7OBX(8)=$$OBX8^LA7VOBX("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^LA7VOBX(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)_"^99VA62.06",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")_"^99VA63"
. 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^LA7VOBX($E(LA7VAL)) Q
. I "SIR"[$E($P(LA7X,"^",2)) S LA7OBX(8)=$$OBX8^LA7VOBX($E($P(LA7X,"^",2))) Q
;
; Determine access screen for this susceptibility
I $P(LA7X,"^",3)="" S $P(LA7X,"^",3)="A"
S LA7OBX(13)=$$OBX13^LA7VOBX($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")_"^99VA63"
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^LA7VOBX(.LA7OBXSN)
;
S LA7OBX(3)=$$OBX3^LA7VOBX($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
;
; Test value
S LA7OBX(5)=$$OBX5^LA7VOBX(LA7VAL,LA7OBX(2),LA7FS,LA7ECH)
;
; Set sub-id and save for constructing parents
I LA7ID'="" D
. S LA7OBX(4)=$$OBX4^LA7VOBX(LA7ID,LA7FS,LA7ECH)
. 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 LA7ORS="" S LA7ORS=$S('$P(LA76305(0),"^",3):"P",1:"F")
I $P(LA76305(0),"^",9) S LA7ORS="A"
S LA7OBX(11)=$$OBX11^LA7VOBX(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^LA7VOBX($P(LA76305(0),"^"))
;
; Facility that performed the testing
S LA7OBX(15)=$$OBX15^LA7VOBX(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^LA7VOBX(LA7VERP,LA7DIV,LA7FS,LA7ECH)
;
; Performing organization name/address
I LA7DIV'="" D
. N LA7DT
. S LA7OBX(23)=$$OBX23^LA7VOBX(4,LA7DIV,LA7FS,LA7ECH)
. S LA7DT=$S($P(LA76305(0),"^",3):$P(LA76305(0),"^",3),1:$$NOW^XLFDT)
. S LA7OBX(24)=$$OBX24^LA7VOBX(4,LA7DIV,LA7DT,LA7FS,LA7ECH)
;
D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
;
Q
LA7VOBX3 ;VA/DALOI/JMC - LAB OBX Segment message builder (MI subscripts) cont'd ; 13-Aug-2013 09:09 ; MKK
+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 QUIT
+20 ;
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^LA7VOBX(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^LA7VOBX(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^LA7VOBX(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^LA7VOBX(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^LA7VOBX(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^LA7VOBX(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^LA7VOBX("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^LA7VOBX(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 ; Check for SNOMED coding/local coding as alternate
+11 SET X=$$GET1^DIQ(LA7SUBFL,LA7IENS,".01:2")
+12 IF X'=""
Begin DoDot:1
+13 SET LA7VAL="E-"_X_"^"_LA7X(.01)_"^SNM"
SET $PIECE(LA7VAL,"^",4,6)=LA7X_"^"_LA7X(.01)_"^99VA61.2"
+14 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
+15 ;
+16 ; If no SNOMED then use local coding as primary
+17 IF LA7VAL=""
Begin DoDot:1
+18 SET LA7VAL=LA7X_"^"_LA7X(.01)_"^99VA61.2"
+19 IF $GET(LA7NVAF)'=1
SET LA7OBX(2)="CWE"
SET $PIECE(LA7VAL,"^",7)="5.2"
SET $PIECE(LA7VAL,"^",9)=LA7X(.01)
End DoDot:1
+20 ;
+21 SET LA7Y="MI-"_$PIECE(LRSB,",")_"-.01^"_$$GET1^DID(LA7SUBFL,.01,"","LABEL")_"^99VA63"
+22 SET LA7ALT=LA7Y_"^"_LA7Y
+23 ;
+24 SET LA7OBX(8)=$$OBX8^LA7VOBX("A")
+25 ;
+26 ; Set flag to save sub-id for parent-child relationship
+27 SET LA7SAVID=1
+28 QUIT
+29 ;
+30 ;
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^LA7VOBX(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)_"^99VA62.06"
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")_"^99VA63"
+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^LA7VOBX($EXTRACT(LA7VAL))
QUIT
+26 IF "SIR"[$EXTRACT($PIECE(LA7X,"^",2))
SET LA7OBX(8)=$$OBX8^LA7VOBX($EXTRACT($PIECE(LA7X,"^",2)))
QUIT
End DoDot:1
+27 ;
+28 ; Determine access screen for this susceptibility
+29 IF $PIECE(LA7X,"^",3)=""
SET $PIECE(LA7X,"^",3)="A"
+30 SET LA7OBX(13)=$$OBX13^LA7VOBX($PIECE(LA7X,"^",3),$SELECT($GET(LA7INTYP)=30:"MIS-HDR",1:"MIS"),LA7FS,LA7ECH)
+31 ;
+32 QUIT
+33 ;
+34 ;
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")_"^99VA63"
+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^LA7VOBX(.LA7OBXSN)
+5 ;
+6 SET LA7OBX(3)=$$OBX3^LA7VOBX($PIECE(LA7CODE,"!",2),$PIECE(LA7CODE,"!",3),LA7ALT,LA7FS,LA7ECH,$GET(LA7INTYP))
+7 ;
+8 ; Change normal coding system for DoD special
+9 IF LA7NVAF=1
IF LA7ALTCS'=""
Begin DoDot:1
+10 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
+11 ;
+12 ; Test value
+13 SET LA7OBX(5)=$$OBX5^LA7VOBX(LA7VAL,LA7OBX(2),LA7FS,LA7ECH)
+14 ;
+15 ; Set sub-id and save for constructing parents
+16 IF LA7ID'=""
Begin DoDot:1
+17 SET LA7OBX(4)=$$OBX4^LA7VOBX(LA7ID,LA7FS,LA7ECH)
+18 IF LA7SAVID
Begin DoDot:2
+19 FOR I=1,2
SET LA7ID(LA7ID,I)=LA7OBX(I+2)
+20 IF $GET(HL("VER"))="2.2"
SET LA7ID(LA7ID,3)=LA7OBX(5)
QUIT
+21 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
+22 ;
+23 ; Order result status - "P"artial, "F"inal , "A"mended results
+24 ; If no status from individual components then use status from zeroth node.
+25 ; If no release date then pending else final
+26 ; If amended, overrides all other status
+27 IF LA7ORS=""
SET LA7ORS=$SELECT('$PIECE(LA76305(0),"^",3):"P",1:"F")
+28 IF $PIECE(LA76305(0),"^",9)
SET LA7ORS="A"
+29 SET LA7OBX(11)=$$OBX11^LA7VOBX(LA7ORS)
+30 ;
+31 SET LA7DIV=$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,"RF")),"^")
+32 IF LA7DIV=""
IF $$DIV4^XUSER(.LA7DIV,$PIECE(LA76305(0),"^",4))
SET LA7DIV=$ORDER(LA7DIV(0))
+33 ;
+34 ; Observation date/time - collection date/time per HL7 standard
+35 IF $PIECE(LA76305(0),"^")
SET LA7OBX(14)=$$OBX14^LA7VOBX($PIECE(LA76305(0),"^"))
+36 ;
+37 ; Facility that performed the testing
+38 SET LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
+39 ;
+40 ; Person that verified the test
+41 IF $PIECE(LA76305(0),"^",4)
SET LA7VERP=$PIECE(LA76305(0),"^",4)
+42 IF LA7VERP
SET LA7OBX(16)=$$OBX16^LA7VOBX(LA7VERP,LA7DIV,LA7FS,LA7ECH)
+43 ;
+44 ; Performing organization name/address
+45 IF LA7DIV'=""
Begin DoDot:1
+46 NEW LA7DT
+47 SET LA7OBX(23)=$$OBX23^LA7VOBX(4,LA7DIV,LA7FS,LA7ECH)
+48 SET LA7DT=$SELECT($PIECE(LA76305(0),"^",3):$PIECE(LA76305(0),"^",3),1:$$NOW^XLFDT)
+49 SET LA7OBX(24)=$$OBX24^LA7VOBX(4,LA7DIV,LA7DT,LA7FS,LA7ECH)
End DoDot:1
+50 ;
+51 DO BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
+52 ;
+53 QUIT
