LA7VORU1 ;DALOI/JMC - Builder of HL7 Lab Results Microbiology OBR/OBX/NTE ;11/18/11 14:52
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74**;Sep 27, 1994;Build 229
;
Q
;
;
MI ; Build segments for "MI" subscript
;
N LA7I,LA7IDT,LA7ISOID,LA7IENS,LA7MISB,LA7NLT,LA7REL,LA7SUBFL,LA7VNLT,LA7VT,LA7VTIEN,LRDFN,LRIDT,LRSB,LRSS
;
S LRDFN=LA("LRDFN"),LRSS=LA("SUB"),(LA7IENS,LRIDT)=LA("LRIDT")
; Flag that whole report has been released, complete date in field #.03
S LA7REL=$P(^LR(LRDFN,LRSS,LRIDT,0),"^",3)
;
; Determine if there are specific sections to send back.
I $G(LA(62.49)) D
. S LA7VNLT=$P($G(^LAHM(62.49,LA(62.49),63)),"^",5),LA7VTIEN=0
. F S LA7VTIEN=$O(^LAHM(62.49,LA(62.49),1,LA7VTIEN)) Q:'LA7VTIEN D
. . S LA7VT=^LAHM(62.49,LA(62.49),1,LA7VTIEN,0)
. . I $P(LA7VT,"^") D
. . . S LA7VT(63)=$G(^LAB(64.061,$P(LA7VT,"^"),63))
. . . I $P(LA7VT(63),"^")'="MI" Q
. . . I $P(LA7VT(63),"^",3) S LA7MISB($P(LA7VT(63),"^",2,3))=LA7VNLT
;
; Send gram stain if C&S
I $D(LA7MISB("63.05^11")) S LA7MISB("63.05^11.6;63.29")=LA7MISB("63.05^11")
;
; Send acid fast stain if AFB culture
I $D(LA7MISB("63.05^22")) S LA7MISB("63.05^24")=LA7MISB("63.05^22")
;
; If no specific section then check all sections
I '$D(LA7MISB) F LA7VT="63.05^11","63.05^11.6;63.29","63.05^14","63.05^18","63.05^22","63.05^24","63.05^33" S LA7MISB(LA7VT)=""
;
; Bacteriology Report
I $D(^LR(LRDFN,LRSS,LRIDT,1)),(LA7REL!$P($G(^LR(LRDFN,LRSS,LRIDT,1)),"^")) D
. I '$D(LA7MISB("63.05^11")),'$D(LA7MISB("63.05^11.6;63.29")) Q
. S LA7NTESN=0,LA7IDT=LRIDT,LRSB=11
. I '$D(LA7MISB("63.05^11")),$D(LA7MISB("63.05^11.6;63.29")) S LA7NLT=$S($P(LA7MISB("63.05^11.6;63.29"),"^"):$P(LA7MISB("63.05^11.6;63.29"),"^"),1:"87754.0000")
. E S LA7NLT=$S($P(LA7MISB("63.05^11"),"^"):$P(LA7MISB("63.05^11"),"^"),1:"87993.0000")
. D OBR^LA7VORU
. I LA7NVAF=1 D PLC^LA7VORUA
. D NTE^LA7VORU
. I LA7NVAF=1 D
. . S LRSB=11 D RPT^LA7VORU2
. . F LRSB=1,11.7,1.5 D RPTNTE^LA7VORU2
. I LA7NVAF'=1 F LRSB=1,11.7,1.5,11 D RPTNTE^LA7VORU2
. S LA7OBXSN=0
. ; Report urine/sputum screens
. F LA7I=5,6 I $P(^LR(LRDFN,LRSS,LRIDT,1),"^",LA7I)'="" S LRSB=$S(LA7I=5:11.58,1:11.57) D OBX
. ; Report gram stain
. I $D(^LR(LRDFN,LRSS,LRIDT,2)),$D(LA7MISB("63.05^11.6;63.29")) D GS
. N LRSB
. ; Check for organism id
. I '$D(^LR(LRDFN,LRSS,LRIDT,3)) Q
. S LRSB=12,LA7SUBFL=63.3
. D ORG,MIC
;
; Parasite report
I $D(^LR(LRDFN,LRSS,LRIDT,5)),(LA7REL!$P($G(^LR(LRDFN,LRSS,LRIDT,5)),"^")) D
. I '$D(LA7MISB("63.05^14")) Q
. S LRSB=14,LA7NTESN=0
. S LA7NLT=$S($P(LA7MISB("63.05^14"),"^"):$P(LA7MISB("63.05^14"),"^"),1:"87925.0000")
. D OBR^LA7VORU
. I LA7NVAF=1 D PLC^LA7VORUA
. D NTE^LA7VORU
. S LA7OBXSN=0
. I LA7NVAF=1 D
. . S LRSB=14 D RPT^LA7VORU2
. . F LRSB=16.5,15.51,16.4 D RPTNTE^LA7VORU2
. I LA7NVAF'=1 F LRSB=16.5,15.51,16.4,14 D RPTNTE^LA7VORU2
. ; Check for organism id
. I '$D(^LR(LRDFN,LRSS,LRIDT,6)) Q
. N LRSB
. S LA7IDT=LRIDT,LRSB=16
. D ORG
;
; Mycology report
I $D(^LR(LRDFN,LRSS,LRIDT,8)),(LA7REL!$P($G(^LR(LRDFN,LRSS,LRIDT,8)),"^")) D
. I '$D(LA7MISB("63.05^18")) Q
. S LRSB=18,LA7NTESN=0
. S LA7NLT=$S($P(LA7MISB("63.05^18"),"^"):$P(LA7MISB("63.05^18"),"^"),1:"87994.0000")
. D OBR^LA7VORU
. I LA7NVAF=1 D PLC^LA7VORUA
. D NTE^LA7VORU
. S LA7OBXSN=0
. I LA7NVAF=1 D
. . S LRSB=18 D RPT^LA7VORU2
. . F LRSB=20.5,19.6,20.4 D RPTNTE^LA7VORU2
. I LA7NVAF'=1 F LRSB=20.5,19.6,20.4,18 D RPTNTE^LA7VORU2
. ; Check for organism id
. I '$D(^LR(LRDFN,LRSS,LRIDT,9)) Q
. N LRSB
. S LA7IDT=LRIDT,LRSB=20
. D ORG
;
; Mycobacterium report
I $D(^LR(LRDFN,LRSS,LRIDT,11)),(LA7REL!$P($G(^LR(LRDFN,LRSS,LRIDT,11)),"^")) D
. I '$D(LA7MISB("63.05^22")),'$D(LA7MISB("63.05^24")) Q
. S LA7NTESN=0,LA7IDT=LRIDT,LRSB=22
. I '$D(LA7MISB("63.05^22")),$D(LA7MISB("63.05^24")) S LA7NLT=$S($P(LA7MISB("63.05^24"),"^"):$P(LA7MISB("63.05^24"),"^"),1:"87756.0000")
. E S LA7NLT=$S($P(LA7MISB("63.05^22"),"^"):$P(LA7MISB("63.05^22"),"^"),1:"87995.0000")
. D OBR^LA7VORU
. I LA7NVAF=1 D PLC^LA7VORUA
. D NTE^LA7VORU
. I LA7NVAF=1 D
. . S LRSB=22 D RPT^LA7VORU2
. . F LRSB=26.5,26.4 D RPTNTE^LA7VORU2
. I LA7NVAF'=1 F LRSB=26.5,26.4,22 D RPTNTE^LA7VORU2
. S LA7OBXSN=0
. ; Report acid fast stain
. I $P(^LR(LRDFN,LRSS,LRIDT,11),"^",3)'="" D
. . S LRSB=24 D OBX
. . I $P(^LR(LRDFN,LRSS,LRIDT,11),"^",4)'="" S LRSB=25 D OBX
. ; Check for organism id
. I '$D(^LR(LRDFN,LRSS,LRIDT,12)) Q
. N LRSB
. S LA7IDT=LRIDT,LRSB=26,LA7SUBFL=63.39
. D ORG,MIC
;
; Virology report
I $D(^LR(LRDFN,LRSS,LRIDT,16)),(LA7REL!$P($G(^LR(LRDFN,LRSS,LRIDT,16)),"^")) D
. I '$D(LA7MISB("63.05^33")) Q
. S LRSB=33,LA7NTESN=0
. S LA7NLT=$S($P(LA7MISB("63.05^33"),"^"):$P(LA7MISB("63.05^33"),"^"),1:"87996.0000")
. D OBR^LA7VORU
. I LA7NVAF=1 D PLC^LA7VORUA
. D NTE^LA7VORU
. S LA7OBXSN=0
. I LA7NVAF=1 D
. . S LRSB=33 D RPT^LA7VORU2
. . F LRSB=36.5,36.4 D RPTNTE^LA7VORU2
. I LA7NVAF'=1 F LRSB=36.5,36.4,33 D RPTNTE^LA7VORU2
. ; Check for virus id
. I '$D(^LR(LRDFN,LRSS,LRIDT,17)) Q
. N LRSB
. S LA7IDT=LRIDT,LRSB=36
. D ORG
;
; Antibiotic Levels
I $D(^LR(LRDFN,LRSS,LRIDT,14)) D
. N LA7SR
. S LRSB=28,LA7NLT="93978.0000",LA7NTESN=0
. D OBR^LA7VORU
. S LA7SR=0
. F S LA7SR=$O(^LR(LRDFN,LRSS,LRIDT,14,LA7SR)) Q:'LA7SR S LA7IDT=LRIDT_","_LA7SR D OBX
;
; Sterility results
I $D(^LR(LRDFN,LRSS,LRIDT,31)) D
. N LA7SR
. S LRSB=11.52,LA7NLT="93982.0000",LA7NTESN=0
. D OBR^LA7VORU
. S LA7SR=0
. F S LA7SR=$O(^LR(LRDFN,LRSS,LRIDT,31,LA7SR)) Q:'LA7SR S LA7IDT=LRIDT_","_LA7SR D OBX
;
; Check if specific NLT in the ORUT node for test being NP and build OBR for the NP test.
I $G(LA7VNLT)'="" D
. N LA7DISPO,LA7I
. S LA7DISPO=$$FIND1^DIC(64.061,"","OQX","X","D","I $P(^(0),U,5)=""0123""")
. S LA7I=$O(^LR(LRDFN,LRSS,LRIDT,"ORUT","B",LA7VNLT,0)) Q:'LA7I
. I LA7DISPO'="",$P(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I,0),"^",10)=LA7DISPO D
. . S LA7NLT=LA7VNLT,LRSB=$P($G(LA7VT(63)),"^",3),LA7NTESN=0,LA7IDT=LRIDT
. . S:LRSB="" LRSB=0 D OBR^LA7VORU,NTE^LA7VORU
;
Q
;
;
GS ; Report Gram stain
;
N LA7GS
;
S LA7GS=0,LRSB=11.6
F S LA7GS=$O(^LR(LRDFN,LRSS,LRIDT,2,LA7GS)) Q:'LA7GS D
. S LA7IDT=LRIDT_","_LA7GS,LA7NTESN=0
. D OBX
Q
;
;
ORG ; Build OBX segments for MI subscript organism id
;
N LA7ND,LA7ORG
;
; Bacterial organism
I LRSB=12 S LA7ND=3
; Parasite organism
I LRSB=16 S LA7ND=6
; Fungal organism
I LRSB=20 S LA7ND=9
; Mycobacteria organism
I LRSB=26 S LA7ND=12
; Viral agent
I LRSB=36 S LA7ND=17
;
S LA7ORG=0
F S LA7ORG=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG)) Q:'LA7ORG D
. S LA7IDT=LRIDT_","_LA7ORG_","
. D OBX
. I LA7ND=17 Q ; no quantity/comments on viruses
. I LA7ND=6 D PSTAGE Q
. D ORGNTE
. I $P($G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,0)),"^",2)'="" D CC
Q
;
;
CC ; Send colony count (quantity)
;
N LRSB
;
I LA7ND=3 S LRSB="12,1"
I LA7ND=9 S LRSB="20,1"
I LA7ND=12 S LRSB="26,1"
D OBX
;
Q
;
;
PSTAGE ; Send parasite's stage/quantity/comments
N LA7CMTP,LA7FMT,LA7J,LA7SB,LA7SOC,LA7NTESN,LA7TXT,LA7X,LRSB
;
; Source of comment - handle special codes for other systems, ie DOD-CHCS
S LA7SOC=$S($G(LA7NVAF)=1:"RC",1:"L")
;
S LA7FMT=0,LA7CMTYP=""
; If HDR interface then send as repetition text.
I $G(LA7INTYP)=30 S LA7FMT=2
;
S LA7SB=0
F S LA7SB=$O(^LR(LRDFN,LRSS,LRIDT,6,LA7ORG,1,LA7SB)) Q:'LA7SB D
. S LA7IDT=LRIDT_","_LA7ORG_","_LA7SB
. S LRSB="16,.01" D OBX
. S (LA7J,LA7NTESN)=0
. F S LA7J=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7SB,1,LA7J)) Q:'LA7J D
. . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7SB,1,LA7J,0))
. . I LA7X="" S LA7X=" "
. . I LA7FMT S LA7TXT(LA7J)=LA7X
. . E S LA7TXT=LA7X D NTE
. I LA7FMT,$D(LA7TXT) D NTE
. S LRSB="16,1" D OBX
Q
;
;
ORGNTE ; Send comments on organisms.
;
N LA7CMTYP,LA7FMT,LA7J,LA7SOC,LA7NTESN,LA7TXT,LA7X
;
; Source of comment - handle special codes for other systems, ie DOD-CHCS
S LA7SOC=$S($G(LA7NVAF)=1:"RC",1:"L")
;
S LA7FMT=0,LA7CMTYP=""
; If HDR interface then send as repetition text.
I $G(LA7INTYP)=30 S LA7FMT=2
;
S (LA7J,LA7NTESN)=0
F S LA7J=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7J)) Q:'LA7J D
. S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7J,0))
. I LA7X="" S LA7X=" "
. I LA7FMT S LA7TXT(LA7J)=LA7X
. E S LA7TXT=LA7X D NTE
;
; If formatted or repetition format then build each type of comments to a NTE segment.
I LA7FMT,$D(LA7TXT) D NTE
;
Q
;
;
MIC ; Build OBR/OBX segments for MI subscript susceptibilities (MIC)
;
N LA7ORG,LA7ND,LA7NLT,LA7SB,LA7SB1,LA7SOC
;
; Source of comment - handle special codes for other systems, ie DOD-CHCS
S LA7SOC=$S($G(LA7NVAF)=1:"RC",1:"L")
;
S LA7NLT=""
I LRSB=12 S LA7ND=3,LA7NLT="87565.0000"
I LRSB=26 S LA7ND=12,LA7NLT="87568.0000"
;
S LA7ORG=0,LA7SB=LRSB
F S LA7ORG=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG)) Q:'LA7ORG D
. N LA7NTESN,LA7PARNT
. ; Check for susceptibilities for this organism
. S X=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,2))
. I X<2!(X>3) Q
. S LA7PARNT=$$GETISO^LA7VHLU1(LA7SUBFL,LA7ORG_","_LRIDT_","_LRDFN_",")
. M LA7PARNT=LA7ISOID(LA7PARNT)
. D OBR^LA7VORU
. S LA7OBXSN=0,LA7SB1=2
. F S LA7SB1=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,LA7SB1)) Q:'LA7SB1!(LA7SB1>2.99) D
. . N LA7CMTYP,LA7FMT,LA7TXT,LRSB,X
. . S LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1,LRSB=LA7SB_","_LA7SB1
. . D OBX
. . S X=""
. . I LA7SB=12 S X=$O(^LAB(62.06,"AD",LA7SB1,0))
. . I LA7SB=26 S X=$O(^LAB(62.06,"AD1",LA7SB1,0))
. . I X<1 Q
. . S LA7TXT=$P($G(^LAB(62.06,X,0)),"^",3)
. . I LA7TXT'="" S (LA7NTESN,LA7FMT)=0,LA7CMTYP="" D NTE
. I LA7ND'=3 Q ; no free text antibiotics on AFB
. S LA7SB1=0
. F S LA7SB1=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,3,LA7SB1)) Q:'LA7SB1 D
. . N LA7I,LRSB
. . F LA7I=2,3 I $P(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,3,LA7SB1,0),"^",LA7I)'="" D
. . . S LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1,LRSB=LA7SB_",3,"_(LA7I-1)
. . . N LA7I D OBX
Q
;
;
OBX ; Build OBX segments for MI subscript
; Also called by AP^LA7VORU2 to build AP OBX segments.
;
N LA7DATA
D OBX^LA7VOBX(LRDFN,LRSS,LA7IDT,LRSB,.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,LA7NVAF)
;
; If OBX failed to build then don't store
I '$D(LA7DATA) Q
;
D FILESEG^LA7VHLU(GBL,.LA7DATA)
;
; Check for flag to only build message but do not file
I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
Q
;
;
NTE ; Build NTE segment with comment
;
N LA7DATA
;
D NTE^LA7VHLU3(.LA7DATA,.LA7TXT,$G(LA7SOC),LA7FS,LA7ECH,.LA7NTESN,$G(LA7CMTYP),$G(LA7FMT))
D FILESEG^LA7VHLU(GBL,.LA7DATA)
;
; Check for flag to only build message but do not file
I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VORU1 10879 printed Nov 22, 2024@16:51:14 Page 2
LA7VORU1 ;DALOI/JMC - Builder of HL7 Lab Results Microbiology OBR/OBX/NTE ;11/18/11 14:52
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74**;Sep 27, 1994;Build 229
+2 ;
+3 QUIT
+4 ;
+5 ;
MI ; Build segments for "MI" subscript
+1 ;
+2 NEW LA7I,LA7IDT,LA7ISOID,LA7IENS,LA7MISB,LA7NLT,LA7REL,LA7SUBFL,LA7VNLT,LA7VT,LA7VTIEN,LRDFN,LRIDT,LRSB,LRSS
+3 ;
+4 SET LRDFN=LA("LRDFN")
SET LRSS=LA("SUB")
SET (LA7IENS,LRIDT)=LA("LRIDT")
+5 ; Flag that whole report has been released, complete date in field #.03
+6 SET LA7REL=$PIECE(^LR(LRDFN,LRSS,LRIDT,0),"^",3)
+7 ;
+8 ; Determine if there are specific sections to send back.
+9 IF $GET(LA(62.49))
Begin DoDot:1
+10 SET LA7VNLT=$PIECE($GET(^LAHM(62.49,LA(62.49),63)),"^",5)
SET LA7VTIEN=0
+11 FOR
SET LA7VTIEN=$ORDER(^LAHM(62.49,LA(62.49),1,LA7VTIEN))
if 'LA7VTIEN
QUIT
Begin DoDot:2
+12 SET LA7VT=^LAHM(62.49,LA(62.49),1,LA7VTIEN,0)
+13 IF $PIECE(LA7VT,"^")
Begin DoDot:3
+14 SET LA7VT(63)=$GET(^LAB(64.061,$PIECE(LA7VT,"^"),63))
+15 IF $PIECE(LA7VT(63),"^")'="MI"
QUIT
+16 IF $PIECE(LA7VT(63),"^",3)
SET LA7MISB($PIECE(LA7VT(63),"^",2,3))=LA7VNLT
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 ; Send gram stain if C&S
+19 IF $DATA(LA7MISB("63.05^11"))
SET LA7MISB("63.05^11.6;63.29")=LA7MISB("63.05^11")
+20 ;
+21 ; Send acid fast stain if AFB culture
+22 IF $DATA(LA7MISB("63.05^22"))
SET LA7MISB("63.05^24")=LA7MISB("63.05^22")
+23 ;
+24 ; If no specific section then check all sections
+25 IF '$DATA(LA7MISB)
FOR LA7VT="63.05^11","63.05^11.6;63.29","63.05^14","63.05^18","63.05^22","63.05^24","63.05^33"
SET LA7MISB(LA7VT)=""
+26 ;
+27 ; Bacteriology Report
+28 IF $DATA(^LR(LRDFN,LRSS,LRIDT,1))
IF (LA7REL!$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,1)),"^"))
Begin DoDot:1
+29 IF '$DATA(LA7MISB("63.05^11"))
IF '$DATA(LA7MISB("63.05^11.6;63.29"))
QUIT
+30 SET LA7NTESN=0
SET LA7IDT=LRIDT
SET LRSB=11
+31 IF '$DATA(LA7MISB("63.05^11"))
IF $DATA(LA7MISB("63.05^11.6;63.29"))
SET LA7NLT=$SELECT($PIECE(LA7MISB("63.05^11.6;63.29"),"^"):$PIECE(LA7MISB("63.05^11.6;63.29"),"^"),1:"87754.0000")
+32 IF '$TEST
SET LA7NLT=$SELECT($PIECE(LA7MISB("63.05^11"),"^"):$PIECE(LA7MISB("63.05^11"),"^"),1:"87993.0000")
+33 DO OBR^LA7VORU
+34 IF LA7NVAF=1
DO PLC^LA7VORUA
+35 DO NTE^LA7VORU
+36 IF LA7NVAF=1
Begin DoDot:2
+37 SET LRSB=11
DO RPT^LA7VORU2
+38 FOR LRSB=1,11.7,1.5
DO RPTNTE^LA7VORU2
End DoDot:2
+39 IF LA7NVAF'=1
FOR LRSB=1,11.7,1.5,11
DO RPTNTE^LA7VORU2
+40 SET LA7OBXSN=0
+41 ; Report urine/sputum screens
+42 FOR LA7I=5,6
IF $PIECE(^LR(LRDFN,LRSS,LRIDT,1),"^",LA7I)'=""
SET LRSB=$SELECT(LA7I=5:11.58,1:11.57)
DO OBX
+43 ; Report gram stain
+44 IF $DATA(^LR(LRDFN,LRSS,LRIDT,2))
IF $DATA(LA7MISB("63.05^11.6;63.29"))
DO GS
+45 NEW LRSB
+46 ; Check for organism id
+47 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,3))
QUIT
+48 SET LRSB=12
SET LA7SUBFL=63.3
+49 DO ORG
DO MIC
End DoDot:1
+50 ;
+51 ; Parasite report
+52 IF $DATA(^LR(LRDFN,LRSS,LRIDT,5))
IF (LA7REL!$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,5)),"^"))
Begin DoDot:1
+53 IF '$DATA(LA7MISB("63.05^14"))
QUIT
+54 SET LRSB=14
SET LA7NTESN=0
+55 SET LA7NLT=$SELECT($PIECE(LA7MISB("63.05^14"),"^"):$PIECE(LA7MISB("63.05^14"),"^"),1:"87925.0000")
+56 DO OBR^LA7VORU
+57 IF LA7NVAF=1
DO PLC^LA7VORUA
+58 DO NTE^LA7VORU
+59 SET LA7OBXSN=0
+60 IF LA7NVAF=1
Begin DoDot:2
+61 SET LRSB=14
DO RPT^LA7VORU2
+62 FOR LRSB=16.5,15.51,16.4
DO RPTNTE^LA7VORU2
End DoDot:2
+63 IF LA7NVAF'=1
FOR LRSB=16.5,15.51,16.4,14
DO RPTNTE^LA7VORU2
+64 ; Check for organism id
+65 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,6))
QUIT
+66 NEW LRSB
+67 SET LA7IDT=LRIDT
SET LRSB=16
+68 DO ORG
End DoDot:1
+69 ;
+70 ; Mycology report
+71 IF $DATA(^LR(LRDFN,LRSS,LRIDT,8))
IF (LA7REL!$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,8)),"^"))
Begin DoDot:1
+72 IF '$DATA(LA7MISB("63.05^18"))
QUIT
+73 SET LRSB=18
SET LA7NTESN=0
+74 SET LA7NLT=$SELECT($PIECE(LA7MISB("63.05^18"),"^"):$PIECE(LA7MISB("63.05^18"),"^"),1:"87994.0000")
+75 DO OBR^LA7VORU
+76 IF LA7NVAF=1
DO PLC^LA7VORUA
+77 DO NTE^LA7VORU
+78 SET LA7OBXSN=0
+79 IF LA7NVAF=1
Begin DoDot:2
+80 SET LRSB=18
DO RPT^LA7VORU2
+81 FOR LRSB=20.5,19.6,20.4
DO RPTNTE^LA7VORU2
End DoDot:2
+82 IF LA7NVAF'=1
FOR LRSB=20.5,19.6,20.4,18
DO RPTNTE^LA7VORU2
+83 ; Check for organism id
+84 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,9))
QUIT
+85 NEW LRSB
+86 SET LA7IDT=LRIDT
SET LRSB=20
+87 DO ORG
End DoDot:1
+88 ;
+89 ; Mycobacterium report
+90 IF $DATA(^LR(LRDFN,LRSS,LRIDT,11))
IF (LA7REL!$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,11)),"^"))
Begin DoDot:1
+91 IF '$DATA(LA7MISB("63.05^22"))
IF '$DATA(LA7MISB("63.05^24"))
QUIT
+92 SET LA7NTESN=0
SET LA7IDT=LRIDT
SET LRSB=22
+93 IF '$DATA(LA7MISB("63.05^22"))
IF $DATA(LA7MISB("63.05^24"))
SET LA7NLT=$SELECT($PIECE(LA7MISB("63.05^24"),"^"):$PIECE(LA7MISB("63.05^24"),"^"),1:"87756.0000")
+94 IF '$TEST
SET LA7NLT=$SELECT($PIECE(LA7MISB("63.05^22"),"^"):$PIECE(LA7MISB("63.05^22"),"^"),1:"87995.0000")
+95 DO OBR^LA7VORU
+96 IF LA7NVAF=1
DO PLC^LA7VORUA
+97 DO NTE^LA7VORU
+98 IF LA7NVAF=1
Begin DoDot:2
+99 SET LRSB=22
DO RPT^LA7VORU2
+100 FOR LRSB=26.5,26.4
DO RPTNTE^LA7VORU2
End DoDot:2
+101 IF LA7NVAF'=1
FOR LRSB=26.5,26.4,22
DO RPTNTE^LA7VORU2
+102 SET LA7OBXSN=0
+103 ; Report acid fast stain
+104 IF $PIECE(^LR(LRDFN,LRSS,LRIDT,11),"^",3)'=""
Begin DoDot:2
+105 SET LRSB=24
DO OBX
+106 IF $PIECE(^LR(LRDFN,LRSS,LRIDT,11),"^",4)'=""
SET LRSB=25
DO OBX
End DoDot:2
+107 ; Check for organism id
+108 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,12))
QUIT
+109 NEW LRSB
+110 SET LA7IDT=LRIDT
SET LRSB=26
SET LA7SUBFL=63.39
+111 DO ORG
DO MIC
End DoDot:1
+112 ;
+113 ; Virology report
+114 IF $DATA(^LR(LRDFN,LRSS,LRIDT,16))
IF (LA7REL!$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,16)),"^"))
Begin DoDot:1
+115 IF '$DATA(LA7MISB("63.05^33"))
QUIT
+116 SET LRSB=33
SET LA7NTESN=0
+117 SET LA7NLT=$SELECT($PIECE(LA7MISB("63.05^33"),"^"):$PIECE(LA7MISB("63.05^33"),"^"),1:"87996.0000")
+118 DO OBR^LA7VORU
+119 IF LA7NVAF=1
DO PLC^LA7VORUA
+120 DO NTE^LA7VORU
+121 SET LA7OBXSN=0
+122 IF LA7NVAF=1
Begin DoDot:2
+123 SET LRSB=33
DO RPT^LA7VORU2
+124 FOR LRSB=36.5,36.4
DO RPTNTE^LA7VORU2
End DoDot:2
+125 IF LA7NVAF'=1
FOR LRSB=36.5,36.4,33
DO RPTNTE^LA7VORU2
+126 ; Check for virus id
+127 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,17))
QUIT
+128 NEW LRSB
+129 SET LA7IDT=LRIDT
SET LRSB=36
+130 DO ORG
End DoDot:1
+131 ;
+132 ; Antibiotic Levels
+133 IF $DATA(^LR(LRDFN,LRSS,LRIDT,14))
Begin DoDot:1
+134 NEW LA7SR
+135 SET LRSB=28
SET LA7NLT="93978.0000"
SET LA7NTESN=0
+136 DO OBR^LA7VORU
+137 SET LA7SR=0
+138 FOR
SET LA7SR=$ORDER(^LR(LRDFN,LRSS,LRIDT,14,LA7SR))
if 'LA7SR
QUIT
SET LA7IDT=LRIDT_","_LA7SR
DO OBX
End DoDot:1
+139 ;
+140 ; Sterility results
+141 IF $DATA(^LR(LRDFN,LRSS,LRIDT,31))
Begin DoDot:1
+142 NEW LA7SR
+143 SET LRSB=11.52
SET LA7NLT="93982.0000"
SET LA7NTESN=0
+144 DO OBR^LA7VORU
+145 SET LA7SR=0
+146 FOR
SET LA7SR=$ORDER(^LR(LRDFN,LRSS,LRIDT,31,LA7SR))
if 'LA7SR
QUIT
SET LA7IDT=LRIDT_","_LA7SR
DO OBX
End DoDot:1
+147 ;
+148 ; Check if specific NLT in the ORUT node for test being NP and build OBR for the NP test.
+149 IF $GET(LA7VNLT)'=""
Begin DoDot:1
+150 NEW LA7DISPO,LA7I
+151 SET LA7DISPO=$$FIND1^DIC(64.061,"","OQX","X","D","I $P(^(0),U,5)=""0123""")
+152 SET LA7I=$ORDER(^LR(LRDFN,LRSS,LRIDT,"ORUT","B",LA7VNLT,0))
if 'LA7I
QUIT
+153 IF LA7DISPO'=""
IF $PIECE(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I,0),"^",10)=LA7DISPO
Begin DoDot:2
+154 SET LA7NLT=LA7VNLT
SET LRSB=$PIECE($GET(LA7VT(63)),"^",3)
SET LA7NTESN=0
SET LA7IDT=LRIDT
+155 if LRSB=""
SET LRSB=0
DO OBR^LA7VORU
DO NTE^LA7VORU
End DoDot:2
End DoDot:1
+156 ;
+157 QUIT
+158 ;
+159 ;
GS ; Report Gram stain
+1 ;
+2 NEW LA7GS
+3 ;
+4 SET LA7GS=0
SET LRSB=11.6
+5 FOR
SET LA7GS=$ORDER(^LR(LRDFN,LRSS,LRIDT,2,LA7GS))
if 'LA7GS
QUIT
Begin DoDot:1
+6 SET LA7IDT=LRIDT_","_LA7GS
SET LA7NTESN=0
+7 DO OBX
End DoDot:1
+8 QUIT
+9 ;
+10 ;
ORG ; Build OBX segments for MI subscript organism id
+1 ;
+2 NEW LA7ND,LA7ORG
+3 ;
+4 ; Bacterial organism
+5 IF LRSB=12
SET LA7ND=3
+6 ; Parasite organism
+7 IF LRSB=16
SET LA7ND=6
+8 ; Fungal organism
+9 IF LRSB=20
SET LA7ND=9
+10 ; Mycobacteria organism
+11 IF LRSB=26
SET LA7ND=12
+12 ; Viral agent
+13 IF LRSB=36
SET LA7ND=17
+14 ;
+15 SET LA7ORG=0
+16 FOR
SET LA7ORG=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG))
if 'LA7ORG
QUIT
Begin DoDot:1
+17 SET LA7IDT=LRIDT_","_LA7ORG_","
+18 DO OBX
+19 ; no quantity/comments on viruses
IF LA7ND=17
QUIT
+20 IF LA7ND=6
DO PSTAGE
QUIT
+21 DO ORGNTE
+22 IF $PIECE($GET(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,0)),"^",2)'=""
DO CC
End DoDot:1
+23 QUIT
+24 ;
+25 ;
CC ; Send colony count (quantity)
+1 ;
+2 NEW LRSB
+3 ;
+4 IF LA7ND=3
SET LRSB="12,1"
+5 IF LA7ND=9
SET LRSB="20,1"
+6 IF LA7ND=12
SET LRSB="26,1"
+7 DO OBX
+8 ;
+9 QUIT
+10 ;
+11 ;
PSTAGE ; Send parasite's stage/quantity/comments
+1 NEW LA7CMTP,LA7FMT,LA7J,LA7SB,LA7SOC,LA7NTESN,LA7TXT,LA7X,LRSB
+2 ;
+3 ; Source of comment - handle special codes for other systems, ie DOD-CHCS
+4 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"RC",1:"L")
+5 ;
+6 SET LA7FMT=0
SET LA7CMTYP=""
+7 ; If HDR interface then send as repetition text.
+8 IF $GET(LA7INTYP)=30
SET LA7FMT=2
+9 ;
+10 SET LA7SB=0
+11 FOR
SET LA7SB=$ORDER(^LR(LRDFN,LRSS,LRIDT,6,LA7ORG,1,LA7SB))
if 'LA7SB
QUIT
Begin DoDot:1
+12 SET LA7IDT=LRIDT_","_LA7ORG_","_LA7SB
+13 SET LRSB="16,.01"
DO OBX
+14 SET (LA7J,LA7NTESN)=0
+15 FOR
SET LA7J=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7SB,1,LA7J))
if 'LA7J
QUIT
Begin DoDot:2
+16 SET LA7X=$GET(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7SB,1,LA7J,0))
+17 IF LA7X=""
SET LA7X=" "
+18 IF LA7FMT
SET LA7TXT(LA7J)=LA7X
+19 IF '$TEST
SET LA7TXT=LA7X
DO NTE
End DoDot:2
+20 IF LA7FMT
IF $DATA(LA7TXT)
DO NTE
+21 SET LRSB="16,1"
DO OBX
End DoDot:1
+22 QUIT
+23 ;
+24 ;
ORGNTE ; Send comments on organisms.
+1 ;
+2 NEW LA7CMTYP,LA7FMT,LA7J,LA7SOC,LA7NTESN,LA7TXT,LA7X
+3 ;
+4 ; Source of comment - handle special codes for other systems, ie DOD-CHCS
+5 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"RC",1:"L")
+6 ;
+7 SET LA7FMT=0
SET LA7CMTYP=""
+8 ; If HDR interface then send as repetition text.
+9 IF $GET(LA7INTYP)=30
SET LA7FMT=2
+10 ;
+11 SET (LA7J,LA7NTESN)=0
+12 FOR
SET LA7J=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7J))
if 'LA7J
QUIT
Begin DoDot:1
+13 SET LA7X=$GET(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7J,0))
+14 IF LA7X=""
SET LA7X=" "
+15 IF LA7FMT
SET LA7TXT(LA7J)=LA7X
+16 IF '$TEST
SET LA7TXT=LA7X
DO NTE
End DoDot:1
+17 ;
+18 ; If formatted or repetition format then build each type of comments to a NTE segment.
+19 IF LA7FMT
IF $DATA(LA7TXT)
DO NTE
+20 ;
+21 QUIT
+22 ;
+23 ;
MIC ; Build OBR/OBX segments for MI subscript susceptibilities (MIC)
+1 ;
+2 NEW LA7ORG,LA7ND,LA7NLT,LA7SB,LA7SB1,LA7SOC
+3 ;
+4 ; Source of comment - handle special codes for other systems, ie DOD-CHCS
+5 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"RC",1:"L")
+6 ;
+7 SET LA7NLT=""
+8 IF LRSB=12
SET LA7ND=3
SET LA7NLT="87565.0000"
+9 IF LRSB=26
SET LA7ND=12
SET LA7NLT="87568.0000"
+10 ;
+11 SET LA7ORG=0
SET LA7SB=LRSB
+12 FOR
SET LA7ORG=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG))
if 'LA7ORG
QUIT
Begin DoDot:1
+13 NEW LA7NTESN,LA7PARNT
+14 ; Check for susceptibilities for this organism
+15 SET X=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,2))
+16 IF X<2!(X>3)
QUIT
+17 SET LA7PARNT=$$GETISO^LA7VHLU1(LA7SUBFL,LA7ORG_","_LRIDT_","_LRDFN_",")
+18 MERGE LA7PARNT=LA7ISOID(LA7PARNT)
+19 DO OBR^LA7VORU
+20 SET LA7OBXSN=0
SET LA7SB1=2
+21 FOR
SET LA7SB1=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,LA7SB1))
if 'LA7SB1!(LA7SB1>2.99)
QUIT
Begin DoDot:2
+22 NEW LA7CMTYP,LA7FMT,LA7TXT,LRSB,X
+23 SET LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1
SET LRSB=LA7SB_","_LA7SB1
+24 DO OBX
+25 SET X=""
+26 IF LA7SB=12
SET X=$ORDER(^LAB(62.06,"AD",LA7SB1,0))
+27 IF LA7SB=26
SET X=$ORDER(^LAB(62.06,"AD1",LA7SB1,0))
+28 IF X<1
QUIT
+29 SET LA7TXT=$PIECE($GET(^LAB(62.06,X,0)),"^",3)
+30 IF LA7TXT'=""
SET (LA7NTESN,LA7FMT)=0
SET LA7CMTYP=""
DO NTE
End DoDot:2
+31 ; no free text antibiotics on AFB
IF LA7ND'=3
QUIT
+32 SET LA7SB1=0
+33 FOR
SET LA7SB1=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,3,LA7SB1))
if 'LA7SB1
QUIT
Begin DoDot:2
+34 NEW LA7I,LRSB
+35 FOR LA7I=2,3
IF $PIECE(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,3,LA7SB1,0),"^",LA7I)'=""
Begin DoDot:3
+36 SET LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1
SET LRSB=LA7SB_",3,"_(LA7I-1)
+37 NEW LA7I
DO OBX
End DoDot:3
End DoDot:2
End DoDot:1
+38 QUIT
+39 ;
+40 ;
OBX ; Build OBX segments for MI subscript
+1 ; Also called by AP^LA7VORU2 to build AP OBX segments.
+2 ;
+3 NEW LA7DATA
+4 DO OBX^LA7VOBX(LRDFN,LRSS,LA7IDT,LRSB,.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,LA7NVAF)
+5 ;
+6 ; If OBX failed to build then don't store
+7 IF '$DATA(LA7DATA)
QUIT
+8 ;
+9 DO FILESEG^LA7VHLU(GBL,.LA7DATA)
+10 ;
+11 ; Check for flag to only build message but do not file
+12 IF '$GET(LA7NOMSG)
DO FILE6249^LA7VHLU(LA76249,.LA7DATA)
+13 QUIT
+14 ;
+15 ;
NTE ; Build NTE segment with comment
+1 ;
+2 NEW LA7DATA
+3 ;
+4 DO NTE^LA7VHLU3(.LA7DATA,.LA7TXT,$GET(LA7SOC),LA7FS,LA7ECH,.LA7NTESN,$GET(LA7CMTYP),$GET(LA7FMT))
+5 DO FILESEG^LA7VHLU(GBL,.LA7DATA)
+6 ;
+7 ; Check for flag to only build message but do not file
+8 IF '$GET(LA7NOMSG)
DO FILE6249^LA7VHLU(LA76249,.LA7DATA)
+9 ;
+10 QUIT
