LA7VOBX4 ;DALOI/JMC - LAB OBX Segment message builder (MI subscripts) cont'd ;11/18/11 14:48
;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
;
; Continuation of LA7VOBX3
;
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))
;
; Test value
S LA7OBX(5)=$$OBX5^LA7VOBX(LA7VAL,LA7OBX(2),LA7FS,LA7ECH)
;
; Set sub-id and save for constructing parents
I LA7ISOID'="" D
. S LA7OBX(4)=$$OBX4^LA7VOBX(LA7ISOID,LA7FS,LA7ECH)
. I LA7SAVID D
. . F I=1,2 S LA7ISOID(LA7ISOID,I)=LA7OBX(I+2)
. . I $G(HL("VER"))="2.2" S LA7ISOID(LA7ISOID,3)=LA7OBX(5) Q
. . F I=2,4 I $P(LA7OBX(5),$E(LA7ECH,1),I)'="" S LA7ISOID(LA7ISOID,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
;
S LA7OBX(11)=$$OBX11^LA7VOBX(LA7RS)
;
; Observation date/time - collection date/time per HL7 standard
I $P(LA76305(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76305(0),"^"))
;
S LA7DIV=""
I LA7PLREF'="" S LA7DIV=$P($$RESPL^LA7VHLU2(LA7PLREF),"^")
I 'LA7DIV S LA7DIV=$P($G(^LR(LRDFN,"MI",LRIDT,"RF")),"^")
I 'LA7DIV,$$DIV4^XUSER(.LA7DIV,$P(LA76305(0),"^",4)) S LA7DIV=$O(LA7DIV(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
;
;
CC ; Organism's Colony count
; If "CFU/ml" found then move units to OBX-6 (Units).
N LA7X
;
S LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
S LA7OBX(2)=$$OBX2^LA7VOBX(LA7SUBFL,1)
;
; Isolate ID as sub-id
S LA7ISOID=$$GETISO^LA7VHLU1(LA7SUBFL,LA7IENS)
;
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
S LA7PLREF=LRDFN_",MI,"_LRIDT_",3,"_LRIDT(2)
;
Q
;
;
ORG ; Organism
;
N LA7X,LA7Y
;
S LA7OBX(2)=$$OBX2^LA7VOBX(LA7SUBFL,.01)
S LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
S LA7VAL=""
;
; Isolate ID as sub-id
S LA7ISOID=$$GETISO^LA7VHLU1(LA7SUBFL,LA7IENS)
;
I $G(LA7NVAF)=1 S LA7OBX(2)="CE"
S LA7X=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01,"I"),LA7X(.01)=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01)
; Check for SNOMED coding/local coding as alternate
S LA7Y=$$IEN2SCT^LA7VHLU6(61.2,LA7X,DT)
I LA7Y D
. S LA7VAL=$P(LA7Y,"^",1,3),$P(LA7VAL,"^",4,6)=LA7X_"^"_LA7X(.01)_"^99VA61.2"
. I $G(LA7NVAF)'=1 S LA7OBX(2)="CWE",$P(LA7VAL,"^",7,8)=$P(LA7Y,"^",4)_"^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")
;
S LA7PLREF=LRDFN_",MI,"_LRIDT_","_$P(LRSB,",")_","_LRIDT(2)_",0"
;
; Set flag to save sub-id for parent-child relationship
S LA7SAVID=1
Q
;
;
MIC ; Organism's susceptibilities
;
N LA7IENS,LA7SCT,LA7SUB,LA7X,LA7Y
;
; 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 (LA7ALT,LA7X,LA7Y)=""
I $P(LRSB,",")=12 S LA7X=$O(^LAB(62.06,"AD",$P(LRSB,",",2),0))
I $P(LRSB,",")=26 S LA7X=$O(^LAB(62.06,"AD1",$P(LRSB,",",2),0))
I LA7X S LA7Y=LA7X_"^"_$$GET1^DIQ(62.06,LA7X_",",.01)_"^99VA62.06"
I LA7Y="" D
. S LA7X=$P(LRSB,",",2),LA7Y=$O(^DD(LA7SUBFL,"GL",LA7X,1,0))
. I LA7Y<1 Q
. S LA7Y="MIAB"_$P(LRSB,",")_"-"_$P(LRSB,",",2)_"^"_$$GET1^DID(LA7SUBFL,LA7Y,"","LABEL")_"^99VA63"
I $P(LA7CODE,"!",2)=""!($P(LA7CODE,"!",3)="") S LA7ALT=LA7Y
S $P(LA7ALT,"^",4,6)=LA7Y
;
S LA7X=$G(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),LRIDT(3)))
I $P(LA7X,"^",2)'="" S $P(LA7X,"^",2)=$$TRIM^XLFSTR($P(LA7X,"^",2),"RL"," ")
S LA7VAL=$$TRIM^XLFSTR($P(LA7X,"^"),"RL"," ")
I LA7VAL'="" D
. I "MSIR"[$E(LA7VAL),$G(LA7NVAF)'=1 D
. . S LA7Y=$S(LA7VAL="S":131196009,LA7VAL="MS":260357007,LA7VAL="R":30714006,LA7VAL="I":264841006,1:"")
. . I LA7Y D MTSCT
. I $E($P(LA7X,"^",2))?1(1"S",1"I",1"R") S LA7OBX(8)=$$OBX8^LA7VOBX($E($P(LA7X,"^",2))) Q
. I $E($P(LA7X,"^",2),1,2)?1(1"MS",1"VS") S LA7OBX(8)=$$OBX8^LA7VOBX($E($P(LA7X,"^",2),1,2))
;
; 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)
;
S LA7PLREF=LRDFN_",MI,"_LRIDT_","_LA7SUB_","_LRIDT(2)_","_LRIDT(3)
;
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
;
;
PSTAGE ; Parasite's stage
;
N LA7IENS,LA7SUB,LA7X,LA7Y
;
S LA7SUB=6,LA7VAL=""
S LA7OBX(2)=$$OBX2^LA7VOBX(63.35,.01)
;
; Isolate ID as sub-id
S LA7ISOID=$$GETISO^LA7VHLU1(63.34,LRIDT(2)_","_LRIDT_","_LRDFN_",")
;
S LA7IENS=LRIDT(3)_","_LRIDT(2)_","_LRIDT_","_LRDFN_","
S LA7VAL=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01,"E")
S LA7X=$P($G(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),1,LRIDT(3),0)),"^")
S LA7Y=$S(LA7X="T":103551003,LA7X="C":103552005,LA7X="E":116990009,LA7X="L":48458007,LA7X="S":284701003,LA7X="G":103537003,LA7X="M":2105009,LA7X="R":103568004,LA7X="F":2105009,1:"")
I LA7Y S LA7X=LA7VAL D MTSCT
;
S LA7Y="MI-"_$P(LRSB,",")_"-.01^"_$$GET1^DID(63.35,.01,"","LABEL")_"^99VA63"
S LA7ALT=LA7Y_"^"_LA7Y
;
I LA7VAL'="" S LA7OBX(8)=$$OBX8^LA7VOBX("A")
;
S LA7PLREF=LRDFN_",MI,"_LRIDT_",6,"_LRIDT(2)_",1,"_LRIDT(3)
;
Q
;
;
PQTY ; Parasite's stage quantity
;
N LA7IENS,LA7SUB
;
S LA7SUB=6,LA7VAL=""
S LA7OBX(2)=$$OBX2^LA7VOBX(63.35,1)
;
; Isolate ID as sub-id
S LA7ISOID=$$GETISO^LA7VHLU1(63.34,LRIDT(2)_","_LRIDT_","_LRDFN_",")
;
S LA7X=$G(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),1,LRIDT(3),0))
S LA7VAL=$P(LA7X,"^",2)
;
S LA7Y="MI-"_$P(LRSB,",")_"-1^"_$$GET1^DID(63.35,1,"","LABEL")_"^99VA63"
S LA7ALT=LA7Y_"^"_LA7Y
;
I LA7VAL'="" S LA7OBX(8)=$$OBX8^LA7VOBX("A")
;
S LA7PLREF=LRDFN_",MI,"_LRIDT_",6,"_LRIDT(2)_",1,"_LRIDT(3)
;
Q
;
;
MTSCT ; Map specific values to SNOMED CT
; Required variables
; LA7X = local reportable result - Will be inserted in 9th component as local term
; LA7Y = SCT code to lookup
; LA7VAL = encoded SCT term with local term
;
N LA7SCT
I $$CODE^LEXTRAN(LA7Y,"SCT",DT,"LA7SCT")>0 D
. S LA7VAL=$P(LA7SCT(0),"^")_"^"_LA7SCT("P")_"^SCT"
. I $G(LA7NVAF)'=1 S LA7OBX(2)="CWE",$P(LA7VAL,"^",7)=$P(LA7SCT(0),"^",3),$P(LA7VAL,"^",9)=$P(LA7X,"^")
. E S LA7OBX(2)="CE"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VOBX4 8309 printed Oct 16, 2024@17:41:45 Page 2
LA7VOBX4 ;DALOI/JMC - LAB OBX Segment message builder (MI subscripts) cont'd ;11/18/11 14:48
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
+2 ;
+3 ; Continuation of LA7VOBX3
+4 ;
+5 QUIT
+6 ;
+7 ;
GEN ; Fields common to all MI OBX segments.
+1 ;
+2 ;
+3 ; Initialize OBX segment
+4 SET LA7OBX(0)="OBX"
+5 SET LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
+6 ;
+7 SET LA7OBX(3)=$$OBX3^LA7VOBX($PIECE(LA7CODE,"!",2),$PIECE(LA7CODE,"!",3),LA7ALT,LA7FS,LA7ECH,$GET(LA7INTYP))
+8 ;
+9 ; Test value
+10 SET LA7OBX(5)=$$OBX5^LA7VOBX(LA7VAL,LA7OBX(2),LA7FS,LA7ECH)
+11 ;
+12 ; Set sub-id and save for constructing parents
+13 IF LA7ISOID'=""
Begin DoDot:1
+14 SET LA7OBX(4)=$$OBX4^LA7VOBX(LA7ISOID,LA7FS,LA7ECH)
+15 IF LA7SAVID
Begin DoDot:2
+16 FOR I=1,2
SET LA7ISOID(LA7ISOID,I)=LA7OBX(I+2)
+17 IF $GET(HL("VER"))="2.2"
SET LA7ISOID(LA7ISOID,3)=LA7OBX(5)
QUIT
+18 FOR I=2,4
IF $PIECE(LA7OBX(5),$EXTRACT(LA7ECH,1),I)'=""
SET LA7ISOID(LA7ISOID,3)=$PIECE(LA7OBX(5),$EXTRACT(LA7ECH,1),I)
QUIT
End DoDot:2
End DoDot:1
+19 ;
+20 ; Order result status - "P"artial, "F"inal , "A"mended results
+21 ; If no status from individual components then use status from zeroth node.
+22 ; If no release date then pending else final
+23 ; If amended, overrides all other status
+24 ;
+25 SET LA7OBX(11)=$$OBX11^LA7VOBX(LA7RS)
+26 ;
+27 ; Observation date/time - collection date/time per HL7 standard
+28 IF $PIECE(LA76305(0),"^")
SET LA7OBX(14)=$$OBX14^LA7VOBX($PIECE(LA76305(0),"^"))
+29 ;
+30 SET LA7DIV=""
+31 IF LA7PLREF'=""
SET LA7DIV=$PIECE($$RESPL^LA7VHLU2(LA7PLREF),"^")
+32 IF 'LA7DIV
SET LA7DIV=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,"RF")),"^")
+33 IF 'LA7DIV
IF $$DIV4^XUSER(.LA7DIV,$PIECE(LA76305(0),"^",4))
SET LA7DIV=$ORDER(LA7DIV(0))
+34 ;
+35 ; Facility that performed the testing
+36 SET LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
+37 ;
+38 ; Person that verified the test
+39 IF $PIECE(LA76305(0),"^",4)
SET LA7VERP=$PIECE(LA76305(0),"^",4)
+40 IF LA7VERP
SET LA7OBX(16)=$$OBX16^LA7VOBX(LA7VERP,LA7DIV,LA7FS,LA7ECH)
+41 ;
+42 ; Performing organization name/address
+43 IF LA7DIV'=""
Begin DoDot:1
+44 NEW LA7DT
+45 SET LA7OBX(23)=$$OBX23^LA7VOBX(4,LA7DIV,LA7FS,LA7ECH)
+46 SET LA7DT=$SELECT($PIECE(LA76305(0),"^",3):$PIECE(LA76305(0),"^",3),1:$$NOW^XLFDT)
+47 SET LA7OBX(24)=$$OBX24^LA7VOBX(4,LA7DIV,LA7DT,LA7FS,LA7ECH)
End DoDot:1
+48 ;
+49 DO BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
+50 ;
+51 QUIT
+52 ;
+53 ;
CC ; Organism's Colony count
+1 ; If "CFU/ml" found then move units to OBX-6 (Units).
+2 NEW LA7X
+3 ;
+4 SET LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
+5 SET LA7OBX(2)=$$OBX2^LA7VOBX(LA7SUBFL,1)
+6 ;
+7 ; Isolate ID as sub-id
+8 SET LA7ISOID=$$GETISO^LA7VHLU1(LA7SUBFL,LA7IENS)
+9 ;
+10 SET LA7VAL=$$GET1^DIQ(LA7SUBFL,LA7IENS,1)
+11 SET LA7X=$$UP^XLFSTR(LA7VAL)
+12 IF LA7X["CFU/ML"
Begin DoDot:1
+13 SET LA7OBX(6)=$$OBX6^LA7VOBX("CFU/ml","",LA7FS,LA7ECH,$GET(LA7INTYP))
+14 SET LA7X("CFU/ml")=""
SET LA7X("CFU/ML")=""
+15 SET LA7VAL=$$REPLACE^XLFSTR(LA7VAL,.LA7X)
End DoDot:1
+16 ;
+17 SET LA7Y="MI-"_$PIECE(LRSB,",")_"-1^"_$$GET1^DID(LA7SUBFL,1,"","LABEL")_"^99VA63"
+18 SET LA7ALT=LA7Y_"^"_LA7Y
+19 SET LA7PLREF=LRDFN_",MI,"_LRIDT_",3,"_LRIDT(2)
+20 ;
+21 QUIT
+22 ;
+23 ;
ORG ; Organism
+1 ;
+2 NEW LA7X,LA7Y
+3 ;
+4 SET LA7OBX(2)=$$OBX2^LA7VOBX(LA7SUBFL,.01)
+5 SET LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
+6 SET LA7VAL=""
+7 ;
+8 ; Isolate ID as sub-id
+9 SET LA7ISOID=$$GETISO^LA7VHLU1(LA7SUBFL,LA7IENS)
+10 ;
+11 IF $GET(LA7NVAF)=1
SET LA7OBX(2)="CE"
+12 SET LA7X=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01,"I")
SET LA7X(.01)=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01)
+13 ; Check for SNOMED coding/local coding as alternate
+14 SET LA7Y=$$IEN2SCT^LA7VHLU6(61.2,LA7X,DT)
+15 IF LA7Y
Begin DoDot:1
+16 SET LA7VAL=$PIECE(LA7Y,"^",1,3)
SET $PIECE(LA7VAL,"^",4,6)=LA7X_"^"_LA7X(.01)_"^99VA61.2"
+17 IF $GET(LA7NVAF)'=1
SET LA7OBX(2)="CWE"
SET $PIECE(LA7VAL,"^",7,8)=$PIECE(LA7Y,"^",4)_"^5.2"
SET $PIECE(LA7VAL,"^",9)=LA7X(.01)
End DoDot:1
+18 ; If no SNOMED then use local coding as primary
+19 IF LA7VAL=""
Begin DoDot:1
+20 SET LA7VAL=LA7X_"^"_LA7X(.01)_"^99VA61.2"
+21 IF $GET(LA7NVAF)'=1
SET LA7OBX(2)="CWE"
SET $PIECE(LA7VAL,"^",7)="5.2"
SET $PIECE(LA7VAL,"^",9)=LA7X(.01)
End DoDot:1
+22 ;
+23 SET LA7Y="MI-"_$PIECE(LRSB,",")_"-.01^"_$$GET1^DID(LA7SUBFL,.01,"","LABEL")_"^99VA63"
+24 SET LA7ALT=LA7Y_"^"_LA7Y
+25 ;
+26 SET LA7OBX(8)=$$OBX8^LA7VOBX("A")
+27 ;
+28 SET LA7PLREF=LRDFN_",MI,"_LRIDT_","_$PIECE(LRSB,",")_","_LRIDT(2)_",0"
+29 ;
+30 ; Set flag to save sub-id for parent-child relationship
+31 SET LA7SAVID=1
+32 QUIT
+33 ;
+34 ;
MIC ; Organism's susceptibilities
+1 ;
+2 NEW LA7IENS,LA7SCT,LA7SUB,LA7X,LA7Y
+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 (LA7ALT,LA7X,LA7Y)=""
+13 IF $PIECE(LRSB,",")=12
SET LA7X=$ORDER(^LAB(62.06,"AD",$PIECE(LRSB,",",2),0))
+14 IF $PIECE(LRSB,",")=26
SET LA7X=$ORDER(^LAB(62.06,"AD1",$PIECE(LRSB,",",2),0))
+15 IF LA7X
SET LA7Y=LA7X_"^"_$$GET1^DIQ(62.06,LA7X_",",.01)_"^99VA62.06"
+16 IF LA7Y=""
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 LA7Y="MIAB"_$PIECE(LRSB,",")_"-"_$PIECE(LRSB,",",2)_"^"_$$GET1^DID(LA7SUBFL,LA7Y,"","LABEL")_"^99VA63"
End DoDot:1
+20 IF $PIECE(LA7CODE,"!",2)=""!($PIECE(LA7CODE,"!",3)="")
SET LA7ALT=LA7Y
+21 SET $PIECE(LA7ALT,"^",4,6)=LA7Y
+22 ;
+23 SET LA7X=$GET(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),LRIDT(3)))
+24 IF $PIECE(LA7X,"^",2)'=""
SET $PIECE(LA7X,"^",2)=$$TRIM^XLFSTR($PIECE(LA7X,"^",2),"RL"," ")
+25 SET LA7VAL=$$TRIM^XLFSTR($PIECE(LA7X,"^"),"RL"," ")
+26 IF LA7VAL'=""
Begin DoDot:1
+27 IF "MSIR"[$EXTRACT(LA7VAL)
IF $GET(LA7NVAF)'=1
Begin DoDot:2
+28 SET LA7Y=$SELECT(LA7VAL="S":131196009,LA7VAL="MS":260357007,LA7VAL="R":30714006,LA7VAL="I":264841006,1:"")
+29 IF LA7Y
DO MTSCT
End DoDot:2
+30 IF $EXTRACT($PIECE(LA7X,"^",2))?1(1"S",1"I",1"R")
SET LA7OBX(8)=$$OBX8^LA7VOBX($EXTRACT($PIECE(LA7X,"^",2)))
QUIT
+31 IF $EXTRACT($PIECE(LA7X,"^",2),1,2)?1(1"MS",1"VS")
SET LA7OBX(8)=$$OBX8^LA7VOBX($EXTRACT($PIECE(LA7X,"^",2),1,2))
End DoDot:1
+32 ;
+33 ; Determine access screen for this susceptibility
+34 IF $PIECE(LA7X,"^",3)=""
SET $PIECE(LA7X,"^",3)="A"
+35 SET LA7OBX(13)=$$OBX13^LA7VOBX($PIECE(LA7X,"^",3),$SELECT($GET(LA7INTYP)=30:"MIS-HDR",1:"MIS"),LA7FS,LA7ECH)
+36 ;
+37 SET LA7PLREF=LRDFN_",MI,"_LRIDT_","_LA7SUB_","_LRIDT(2)_","_LRIDT(3)
+38 ;
+39 QUIT
+40 ;
+41 ;
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 ;
PSTAGE ; Parasite's stage
+1 ;
+2 NEW LA7IENS,LA7SUB,LA7X,LA7Y
+3 ;
+4 SET LA7SUB=6
SET LA7VAL=""
+5 SET LA7OBX(2)=$$OBX2^LA7VOBX(63.35,.01)
+6 ;
+7 ; Isolate ID as sub-id
+8 SET LA7ISOID=$$GETISO^LA7VHLU1(63.34,LRIDT(2)_","_LRIDT_","_LRDFN_",")
+9 ;
+10 SET LA7IENS=LRIDT(3)_","_LRIDT(2)_","_LRIDT_","_LRDFN_","
+11 SET LA7VAL=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01,"E")
+12 SET LA7X=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),1,LRIDT(3),0)),"^")
+13 SET LA7Y=$SELECT(LA7X="T":103551003,LA7X="C":103552005,LA7X="E":116990009,LA7X="L":48458007,LA7X="S":284701003,LA7X="G":103537003,LA7X="M":2105009,LA7X="R":103568004,LA7X="F":2105009,1:"")
+14 IF LA7Y
SET LA7X=LA7VAL
DO MTSCT
+15 ;
+16 SET LA7Y="MI-"_$PIECE(LRSB,",")_"-.01^"_$$GET1^DID(63.35,.01,"","LABEL")_"^99VA63"
+17 SET LA7ALT=LA7Y_"^"_LA7Y
+18 ;
+19 IF LA7VAL'=""
SET LA7OBX(8)=$$OBX8^LA7VOBX("A")
+20 ;
+21 SET LA7PLREF=LRDFN_",MI,"_LRIDT_",6,"_LRIDT(2)_",1,"_LRIDT(3)
+22 ;
+23 QUIT
+24 ;
+25 ;
PQTY ; Parasite's stage quantity
+1 ;
+2 NEW LA7IENS,LA7SUB
+3 ;
+4 SET LA7SUB=6
SET LA7VAL=""
+5 SET LA7OBX(2)=$$OBX2^LA7VOBX(63.35,1)
+6 ;
+7 ; Isolate ID as sub-id
+8 SET LA7ISOID=$$GETISO^LA7VHLU1(63.34,LRIDT(2)_","_LRIDT_","_LRDFN_",")
+9 ;
+10 SET LA7X=$GET(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),1,LRIDT(3),0))
+11 SET LA7VAL=$PIECE(LA7X,"^",2)
+12 ;
+13 SET LA7Y="MI-"_$PIECE(LRSB,",")_"-1^"_$$GET1^DID(63.35,1,"","LABEL")_"^99VA63"
+14 SET LA7ALT=LA7Y_"^"_LA7Y
+15 ;
+16 IF LA7VAL'=""
SET LA7OBX(8)=$$OBX8^LA7VOBX("A")
+17 ;
+18 SET LA7PLREF=LRDFN_",MI,"_LRIDT_",6,"_LRIDT(2)_",1,"_LRIDT(3)
+19 ;
+20 QUIT
+21 ;
+22 ;
MTSCT ; Map specific values to SNOMED CT
+1 ; Required variables
+2 ; LA7X = local reportable result - Will be inserted in 9th component as local term
+3 ; LA7Y = SCT code to lookup
+4 ; LA7VAL = encoded SCT term with local term
+5 ;
+6 NEW LA7SCT
+7 IF $$CODE^LEXTRAN(LA7Y,"SCT",DT,"LA7SCT")>0
Begin DoDot:1
+8 SET LA7VAL=$PIECE(LA7SCT(0),"^")_"^"_LA7SCT("P")_"^SCT"
+9 IF $GET(LA7NVAF)'=1
SET LA7OBX(2)="CWE"
SET $PIECE(LA7VAL,"^",7)=$PIECE(LA7SCT(0),"^",3)
SET $PIECE(LA7VAL,"^",9)=$PIECE(LA7X,"^")
+10 IF '$TEST
SET LA7OBX(2)="CE"
End DoDot:1
+11 QUIT
