LA7CORU1 ;VA/DALOI/JMC - Builder of HL7 Lab Results Microbiology OBR/OBX/NTE ; 22-Oct-2013 09:22 ; MAW
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033**;NOV 1, 1997
;
Q
;
;
MI ; Build segments for "MI" subscript
;
N LA7I,LA7ID,LA7IDT,LA7IENS,LA7NLT,LRDFN,LRIDT,LRSB,LRSS
S LA7ORCSN=1
;
S LRDFN=LA("LRDFN"),LRSS=LA("SUB"),(LA7IENS,LRIDT)=LA("LRIDT")
;
; Bacteriology Report
I $D(^LR(LRDFN,LRSS,LRIDT,1)) D
. S LA7IDT=LRIDT,LRSB=11,LA7NLT="87993.0000"
. ;I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
. D OBR^LA7CORU
. D NTE^LA7CORU
. F LRSB=1,11.7,1.5,11 D RPTNTE
. N LRSB
. 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 GS
. ; Check for organism id
. I '$D(^LR(LRDFN,LRSS,LRIDT,3)) Q
. S LRSB=12
. D ORG
. D MIC
;
; Parasite report
I $D(^LR(LRDFN,LRSS,LRIDT,5)) D
. S LRSB=14,LA7NLT="87505.0000"
. ;I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
. D OBR^LA7CORU
. D NTE^LA7CORU
. F LRSB=16.5,15.51,16.4,14 D RPTNTE
. ; Check for organism id
. I '$D(^LR(LRDFN,LRSS,LRIDT,6)) Q
. N LRSB
. S LA7OBXSN=0,LA7IDT=LRIDT,LRSB=16
. D ORG
;
; Mycology report
I $D(^LR(LRDFN,LRSS,LRIDT,8)) D
. S LRSB=18,LA7NLT="87994.0000"
. ;I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
. D OBR^LA7CORU
. D NTE^LA7CORU
. F LRSB=20.5,19.6,20.4,18 D RPTNTE
. ; Check for organism id
. I '$D(^LR(LRDFN,LRSS,LRIDT,9)) Q
. N LRSB
. S LA7OBXSN=0,LA7IDT=LRIDT,LRSB=20
. D ORG
;
; Mycobacterium report
I $D(^LR(LRDFN,LRSS,LRIDT,11)) D
. S LRSB=22,LA7NLT="87995.0000"
. ;I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
. D OBR^LA7CORU
. D NTE^LA7CORU
. F LRSB=26.5,26.4,22 D RPTNTE
. N LRSB
. S LA7OBXSN=0,LA7IDT=LRIDT
. ; Report acid fast stain
. I $P(^LR(LRDFN,LRSS,LRIDT,11),"^",3)'="" D
. . S LRSB=24 D OBX
. . S LRSB=25 D OBX
. ; Check for organism id
. I '$D(^LR(LRDFN,LRSS,LRIDT,12)) Q
. S LRSB=26
. D ORG
. D MIC
;
; Virology report
I $D(^LR(LRDFN,LRSS,LRIDT,16)) D
. S LRSB=33,LA7NLT="87996.0000"
. ;I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
. D OBR^LA7CORU
. D NTE^LA7CORU
. F LRSB=36.5,36.4,33 D RPTNTE
. ; Check for virus id
. I '$D(^LR(LRDFN,LRSS,LRIDT,17)) Q
. N LRSB
. S LA7OBXSN=0,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
.; I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
. D OBR^LA7CORU
. S LA7SR=0
. F S LA7SR=$O(^LR(LRDFN,LRSS,LRIDT,14,LA7SR)) Q:'LA7SR S LA7IDT=LRIDT_","_LA7SR D OBX
;
Q
;
;
GS ; Report Gram stain
;
N LA7GS
;
S LRSB=11.6,LA7GS=0
F S LA7GS=$O(^LR(LRDFN,LRSS,LRIDT,2,LA7GS)) Q:'LA7GS D
. S LA7IDT=LRIDT_","_LA7GS
. D OBX
Q
;
;
RPTNTE ; Send report comments
;
N LA7CMTYP,LA7FMT,LA7J,LA7ND,LA7SOC,LA7TXT,LA7X
;
; Source of comment - handle special codes for other systems, i,e. DOD-CHCS
S LA7SOC=$S($G(LA7NVAF)=1:"AC",1:"L"),LA7ND=0
;
S LA7FMT=0
; If HDR interface then send as repetition text.
I $G(LA7INTYP)=30 S LA7FMT=2
;
D
. ; Bacterial preliminary/report/tests remark
. I LRSB=11 S LA7ND=4,LA7CMTYP="VA-LRMI010" Q
. I LRSB=1 S LA7ND=19,LA7CMTYP="VA-LRMI011" Q
. I LRSB=1.5 S LA7ND=26,LA7CMTYP="VA-LRMI012" Q
. I LRSB=11.7 S LA7ND=25,LA7CMTYP="VA-LRMI013" Q
. ; Parasite preliminary/report/tests remark
. I LRSB=14 S LA7ND=7,LA7CMTYP="VA-LRMI020" Q
. I LRSB=16.5 S LA7ND=21,LA7CMTYP="VA-LRMI021" Q
. I LRSB=16.4 S LA7ND=27,LA7CMTYP="VA-LRMI022" Q
. I LRSB=15.1 S LA7ND=24,LA7CMTYP="VA-LRMI023" Q
. ; Fungal preliminary/report/tests remark
. I LRSB=18 S LA7ND=10,LA7CMTYP="VA-LRMI030" Q
. I LRSB=20.5 S LA7ND=22,LA7CMTYP="VA-LRMI031" Q
. I LRSB=20.4 S LA7ND=28,LA7CMTYP="VA-LRMI032" Q
. I LRSB=19.6 S LA7ND=15,LA7CMTYP="VA-LRMI033" Q
. ; Mycobacteria preliminary/report/tests remark
. I LRSB=22 S LA7ND=13,LA7CMTYP="VA-LRMI040" Q
. I LRSB=26.5 S LA7ND=23,LA7CMTYP="VA-LRMI041" Q
. I LRSB=26.4 S LA7ND=29,LA7CMTYP="VA-LRMI042" Q
. ; Viral preliminary/report/tests remark
. I LRSB=33 S LA7ND=18,LA7CMTYP="VA-LRMI050" Q
. I LRSB=36.5 S LA7ND=20,LA7CMTYP="VA-LRMI051" Q
. I LRSB=36.4 S LA7ND=30,LA7CMTYP="VA-LRMI052" Q
;
I LA7ND'>0 Q
;
S LA7J=0
F S LA7J=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J)) Q:'LA7J D
. S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J,0))
. I LA7FMT=0 S LA7TXT=LA7X D NTE^LA7CORU1 Q
. S LA7TXT(LA7J)=LA7X
;
; If formatted or repetition format then build comments to a NTE segment.
I LA7FMT,$D(LA7TXT) D NTE^LA7CORU1
;
Q
;
;
ORG ; Build OBR/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
. D ORGNTE
. I $P($G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,0)),"^",2)'="" D CC
S SPM(0)=$$SPM^LA7CORU(LA7FS,LA7ECH,LA7UID)
D FILE6249^LA7VHLU(LA76249,.SPM)
D FILESEG^LA7VHLU(GBL,.SPM)
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
;
;
ORGNTE ; Send comments on organisms.
;
N LA7CMTYP,LA7FMT,LA7J,LA7SOC,LA7NTESN,LA7TXT,LA7X
;
; Source of comment - handle special codes for other systems, i,e. 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=0 S LA7TXT=LA7X D NTE Q
. S LA7TXT(LA7J)=LA7X
;
; If formatted or repetition format then build comments to a NTE segment.
I LA7FMT,$D(LA7TXT) D NTE^LA7CORU1
;
Q
;
;
MIC ; Build OBR/OBX segments for MI subscript susceptibilities(MIC)
;
N LA7ORG,LA7ND,LA7NLT,LA7SB,LA7SB1,LA7SOC,LA7FLAG
S LA7FLAG="" ;MU2 check for existence so SPM can be created
;
; Source of comment - handle special codes for other systems, i,e. DOD-CHCS
S LA7SOC=$S($G(LA7NVAF)=1:"RC",1:"L")
;
S (LA7NLT,LA7NLT(1))=""
I LRSB=12 S LA7ND=3,LA7NLT="87565.0000",LA7NLT(1)="87993.0000"
I LRSB=26 S LA7ND=12,LA7NLT="87899.0000",LA7NLT(1)="87525.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 LA7FLAG=1
. S LA7PARNT=LA7SB_"-"_LA7ORG
. M LA7PARNT=LA7ID(LA7PARNT)
. I $G(LA7INPT) D
. .S LA7ORCSN=LA7ORCSN+1
. .D ORC^LA7CORU ;mu2 inpatient
. D OBR^LA7CORU
. 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
. . S LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1,LRSB=LA7SB_","_LA7SB1
. . D OBX
. . S X=$O(^LAB(62.06,"AD",LA7SB1,0)) Q:'X
. . 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 LRSB
. . S LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1
. . S LRSB=LA7SB_",3,1" D OBX
. . S LRSB=LA7SB_",3,2" D OBX
I $G(LA7FLAG) D
. N LROSPEC,LRISPEC
. S LROSPEC=LRSPEC
. S LRISPEC=$S($P($G(LA7CODE),"!"):$O(^LAM("E",$P(LA7CODE,"!"),0)),1:"")
. I LRISPEC S LRSPEC=$S($O(^LAM(LRISPEC,5,"B",0)):$O(^LAM(LRISPEC,5,"B",0)),1:LRSPEC)
. I '$G(LA7INPT) D
. .S SPM(0)=$$SPM^LA7CORU(LA7FS,LA7ECH,LA7UID)
. .D FILE6249^LA7VHLU(LA76249,.SPM)
. .D FILESEG^LA7VHLU(GBL,.SPM)
. S LRSPEC=LROSPEC
;
Q
;
;
OBX ; Build OBX segments for MI subscript
; Also called by AP^LA7VORU2 to build AP OBX segments.
;
N LA7DATA
D OBX^LA7COBX(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 meesage but do not file
I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
Q
;
;
NTE ; Build NTE segment with comment
;
N LA7DATA
;
D NTE^LA7CHLU3(.LA7DATA,.LA7TXT,$G(LA7SOC),LA7FS,LA7ECH,.LA7NTESN,$G(LA7CMTYP),$G(LA7FMT))
D FILESEG^LA7VHLU(GBL,.LA7DATA)
;
; Check for flag to only build meesage but do not file
I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
;
Q
LA7CORU1 ;VA/DALOI/JMC - Builder of HL7 Lab Results Microbiology OBR/OBX/NTE ; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033**;NOV 1, 1997
+2 ;
+3 QUIT
+4 ;
+5 ;
MI ; Build segments for "MI" subscript
+1 ;
+2 NEW LA7I,LA7ID,LA7IDT,LA7IENS,LA7NLT,LRDFN,LRIDT,LRSB,LRSS
+3 SET LA7ORCSN=1
+4 ;
+5 SET LRDFN=LA("LRDFN")
SET LRSS=LA("SUB")
SET (LA7IENS,LRIDT)=LA("LRIDT")
+6 ;
+7 ; Bacteriology Report
+8 IF $DATA(^LR(LRDFN,LRSS,LRIDT,1))
Begin DoDot:1
+9 SET LA7IDT=LRIDT
SET LRSB=11
SET LA7NLT="87993.0000"
+10 ;I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
+11 DO OBR^LA7CORU
+12 DO NTE^LA7CORU
+13 FOR LRSB=1,11.7,1.5,11
DO RPTNTE
+14 NEW LRSB
+15 SET LA7OBXSN=0
+16 ; Report urine/sputum screens
+17 FOR LA7I=5,6
IF $PIECE(^LR(LRDFN,LRSS,LRIDT,1),"^",LA7I)'=""
SET LRSB=$SELECT(LA7I=5:11.58,1:11.57)
DO OBX
+18 ; Report gram stain
+19 IF $DATA(^LR(LRDFN,LRSS,LRIDT,2))
DO GS
+20 ; Check for organism id
+21 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,3))
QUIT
+22 SET LRSB=12
+23 DO ORG
+24 DO MIC
End DoDot:1
+25 ;
+26 ; Parasite report
+27 IF $DATA(^LR(LRDFN,LRSS,LRIDT,5))
Begin DoDot:1
+28 SET LRSB=14
SET LA7NLT="87505.0000"
+29 ;I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
+30 DO OBR^LA7CORU
+31 DO NTE^LA7CORU
+32 FOR LRSB=16.5,15.51,16.4,14
DO RPTNTE
+33 ; Check for organism id
+34 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,6))
QUIT
+35 NEW LRSB
+36 SET LA7OBXSN=0
SET LA7IDT=LRIDT
SET LRSB=16
+37 DO ORG
End DoDot:1
+38 ;
+39 ; Mycology report
+40 IF $DATA(^LR(LRDFN,LRSS,LRIDT,8))
Begin DoDot:1
+41 SET LRSB=18
SET LA7NLT="87994.0000"
+42 ;I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
+43 DO OBR^LA7CORU
+44 DO NTE^LA7CORU
+45 FOR LRSB=20.5,19.6,20.4,18
DO RPTNTE
+46 ; Check for organism id
+47 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,9))
QUIT
+48 NEW LRSB
+49 SET LA7OBXSN=0
SET LA7IDT=LRIDT
SET LRSB=20
+50 DO ORG
End DoDot:1
+51 ;
+52 ; Mycobacterium report
+53 IF $DATA(^LR(LRDFN,LRSS,LRIDT,11))
Begin DoDot:1
+54 SET LRSB=22
SET LA7NLT="87995.0000"
+55 ;I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
+56 DO OBR^LA7CORU
+57 DO NTE^LA7CORU
+58 FOR LRSB=26.5,26.4,22
DO RPTNTE
+59 NEW LRSB
+60 SET LA7OBXSN=0
SET LA7IDT=LRIDT
+61 ; Report acid fast stain
+62 IF $PIECE(^LR(LRDFN,LRSS,LRIDT,11),"^",3)'=""
Begin DoDot:2
+63 SET LRSB=24
DO OBX
+64 SET LRSB=25
DO OBX
End DoDot:2
+65 ; Check for organism id
+66 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,12))
QUIT
+67 SET LRSB=26
+68 DO ORG
+69 DO MIC
End DoDot:1
+70 ;
+71 ; Virology report
+72 IF $DATA(^LR(LRDFN,LRSS,LRIDT,16))
Begin DoDot:1
+73 SET LRSB=33
SET LA7NLT="87996.0000"
+74 ;I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
+75 DO OBR^LA7CORU
+76 DO NTE^LA7CORU
+77 FOR LRSB=36.5,36.4,33
DO RPTNTE
+78 ; Check for virus id
+79 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,17))
QUIT
+80 NEW LRSB
+81 SET LA7OBXSN=0
SET LA7IDT=LRIDT
SET LRSB=36
+82 DO ORG
End DoDot:1
+83 ;
+84 ; Antibiotic Levels
+85 IF $DATA(^LR(LRDFN,LRSS,LRIDT,14))
Begin DoDot:1
+86 NEW LA7SR
+87 SET LRSB=28
SET LA7NLT="93978.0000"
SET LA7NTESN=0
+88 ; I $G(LA7INPT) D ORC^LA7CORU ;mu2 inpatient
+89 DO OBR^LA7CORU
+90 SET LA7SR=0
+91 FOR
SET LA7SR=$ORDER(^LR(LRDFN,LRSS,LRIDT,14,LA7SR))
IF 'LA7SR
QUIT
SET LA7IDT=LRIDT_","_LA7SR
DO OBX
End DoDot:1
+92 ;
+93 QUIT
+94 ;
+95 ;
GS ; Report Gram stain
+1 ;
+2 NEW LA7GS
+3 ;
+4 SET LRSB=11.6
SET LA7GS=0
+5 FOR
SET LA7GS=$ORDER(^LR(LRDFN,LRSS,LRIDT,2,LA7GS))
IF 'LA7GS
QUIT
Begin DoDot:1
+6 SET LA7IDT=LRIDT_","_LA7GS
+7 DO OBX
End DoDot:1
+8 QUIT
+9 ;
+10 ;
RPTNTE ; Send report comments
+1 ;
+2 NEW LA7CMTYP,LA7FMT,LA7J,LA7ND,LA7SOC,LA7TXT,LA7X
+3 ;
+4 ; Source of comment - handle special codes for other systems, i,e. DOD-CHCS
+5 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"AC",1:"L")
SET LA7ND=0
+6 ;
+7 SET LA7FMT=0
+8 ; If HDR interface then send as repetition text.
+9 IF $GET(LA7INTYP)=30
SET LA7FMT=2
+10 ;
+11 Begin DoDot:1
+12 ; Bacterial preliminary/report/tests remark
+13 IF LRSB=11
SET LA7ND=4
SET LA7CMTYP="VA-LRMI010"
QUIT
+14 IF LRSB=1
SET LA7ND=19
SET LA7CMTYP="VA-LRMI011"
QUIT
+15 IF LRSB=1.5
SET LA7ND=26
SET LA7CMTYP="VA-LRMI012"
QUIT
+16 IF LRSB=11.7
SET LA7ND=25
SET LA7CMTYP="VA-LRMI013"
QUIT
+17 ; Parasite preliminary/report/tests remark
+18 IF LRSB=14
SET LA7ND=7
SET LA7CMTYP="VA-LRMI020"
QUIT
+19 IF LRSB=16.5
SET LA7ND=21
SET LA7CMTYP="VA-LRMI021"
QUIT
+20 IF LRSB=16.4
SET LA7ND=27
SET LA7CMTYP="VA-LRMI022"
QUIT
+21 IF LRSB=15.1
SET LA7ND=24
SET LA7CMTYP="VA-LRMI023"
QUIT
+22 ; Fungal preliminary/report/tests remark
+23 IF LRSB=18
SET LA7ND=10
SET LA7CMTYP="VA-LRMI030"
QUIT
+24 IF LRSB=20.5
SET LA7ND=22
SET LA7CMTYP="VA-LRMI031"
QUIT
+25 IF LRSB=20.4
SET LA7ND=28
SET LA7CMTYP="VA-LRMI032"
QUIT
+26 IF LRSB=19.6
SET LA7ND=15
SET LA7CMTYP="VA-LRMI033"
QUIT
+27 ; Mycobacteria preliminary/report/tests remark
+28 IF LRSB=22
SET LA7ND=13
SET LA7CMTYP="VA-LRMI040"
QUIT
+29 IF LRSB=26.5
SET LA7ND=23
SET LA7CMTYP="VA-LRMI041"
QUIT
+30 IF LRSB=26.4
SET LA7ND=29
SET LA7CMTYP="VA-LRMI042"
QUIT
+31 ; Viral preliminary/report/tests remark
+32 IF LRSB=33
SET LA7ND=18
SET LA7CMTYP="VA-LRMI050"
QUIT
+33 IF LRSB=36.5
SET LA7ND=20
SET LA7CMTYP="VA-LRMI051"
QUIT
+34 IF LRSB=36.4
SET LA7ND=30
SET LA7CMTYP="VA-LRMI052"
QUIT
End DoDot:1
+35 ;
+36 IF LA7ND'>0
QUIT
+37 ;
+38 SET LA7J=0
+39 FOR
SET LA7J=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J))
IF 'LA7J
QUIT
Begin DoDot:1
+40 SET LA7X=$GET(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J,0))
+41 IF LA7FMT=0
SET LA7TXT=LA7X
DO NTE^LA7CORU1
QUIT
+42 SET LA7TXT(LA7J)=LA7X
End DoDot:1
+43 ;
+44 ; If formatted or repetition format then build comments to a NTE segment.
+45 IF LA7FMT
IF $DATA(LA7TXT)
DO NTE^LA7CORU1
+46 ;
+47 QUIT
+48 ;
+49 ;
ORG ; Build OBR/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 DO ORGNTE
+21 IF $PIECE($GET(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,0)),"^",2)'=""
DO CC
End DoDot:1
+22 SET SPM(0)=$$SPM^LA7CORU(LA7FS,LA7ECH,LA7UID)
+23 DO FILE6249^LA7VHLU(LA76249,.SPM)
+24 DO FILESEG^LA7VHLU(GBL,.SPM)
+25 QUIT
+26 ;
+27 ;
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 ;
+8 DO OBX
+9 ;
+10 QUIT
+11 ;
+12 ;
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, i,e. 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=0
SET LA7TXT=LA7X
DO NTE
QUIT
+16 SET LA7TXT(LA7J)=LA7X
End DoDot:1
+17 ;
+18 ; If formatted or repetition format then build comments to a NTE segment.
+19 IF LA7FMT
IF $DATA(LA7TXT)
DO NTE^LA7CORU1
+20 ;
+21 QUIT
+22 ;
+23 ;
MIC ; Build OBR/OBX segments for MI subscript susceptibilities(MIC)
+1 ;
+2 NEW LA7ORG,LA7ND,LA7NLT,LA7SB,LA7SB1,LA7SOC,LA7FLAG
+3 ;MU2 check for existence so SPM can be created
SET LA7FLAG=""
+4 ;
+5 ; Source of comment - handle special codes for other systems, i,e. DOD-CHCS
+6 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"RC",1:"L")
+7 ;
+8 SET (LA7NLT,LA7NLT(1))=""
+9 IF LRSB=12
SET LA7ND=3
SET LA7NLT="87565.0000"
SET LA7NLT(1)="87993.0000"
+10 IF LRSB=26
SET LA7ND=12
SET LA7NLT="87899.0000"
SET LA7NLT(1)="87525.0000"
+11 ;
+12 SET LA7ORG=0
SET LA7SB=LRSB
+13 FOR
SET LA7ORG=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG))
IF 'LA7ORG
QUIT
Begin DoDot:1
+14 NEW LA7NTESN,LA7PARNT
+15 ; Check for susceptibilities for this organism
+16 SET X=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,2))
+17 IF X<2!(X>3)
QUIT
+18 SET LA7FLAG=1
+19 SET LA7PARNT=LA7SB_"-"_LA7ORG
+20 MERGE LA7PARNT=LA7ID(LA7PARNT)
+21 IF $GET(LA7INPT)
Begin DoDot:2
+22 SET LA7ORCSN=LA7ORCSN+1
+23 ;mu2 inpatient
DO ORC^LA7CORU
End DoDot:2
+24 DO OBR^LA7CORU
+25 SET LA7OBXSN=0
SET LA7SB1=2
+26 FOR
SET LA7SB1=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,LA7SB1))
IF 'LA7SB1!(LA7SB1>2.99)
QUIT
Begin DoDot:2
+27 NEW LA7CMTYP,LA7FMT,LA7TXT,LRSB
+28 SET LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1
SET LRSB=LA7SB_","_LA7SB1
+29 DO OBX
+30 SET X=$ORDER(^LAB(62.06,"AD",LA7SB1,0))
IF 'X
QUIT
+31 SET LA7TXT=$PIECE($GET(^LAB(62.06,X,0)),"^",3)
+32 IF LA7TXT'=""
SET (LA7NTESN,LA7FMT)=0
SET LA7CMTYP=""
DO NTE
End DoDot:2
+33 ; no free text antibiotics on AFB
IF LA7ND'=3
QUIT
+34 SET LA7SB1=0
+35 FOR
SET LA7SB1=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,3,LA7SB1))
IF 'LA7SB1
QUIT
Begin DoDot:2
+36 NEW LRSB
+37 SET LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1
+38 SET LRSB=LA7SB_",3,1"
DO OBX
+39 SET LRSB=LA7SB_",3,2"
DO OBX
End DoDot:2
End DoDot:1
+40 IF $GET(LA7FLAG)
Begin DoDot:1
+41 NEW LROSPEC,LRISPEC
+42 SET LROSPEC=LRSPEC
+43 SET LRISPEC=$SELECT($PIECE($GET(LA7CODE),"!"):$ORDER(^LAM("E",$PIECE(LA7CODE,"!"),0)),1:"")
+44 IF LRISPEC
SET LRSPEC=$SELECT($ORDER(^LAM(LRISPEC,5,"B",0)):$ORDER(^LAM(LRISPEC,5,"B",0)),1:LRSPEC)
+45 IF '$GET(LA7INPT)
Begin DoDot:2
+46 SET SPM(0)=$$SPM^LA7CORU(LA7FS,LA7ECH,LA7UID)
+47 DO FILE6249^LA7VHLU(LA76249,.SPM)
+48 DO FILESEG^LA7VHLU(GBL,.SPM)
End DoDot:2
+49 SET LRSPEC=LROSPEC
End DoDot:1
+50 ;
+51 QUIT
+52 ;
+53 ;
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^LA7COBX(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 meesage 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^LA7CHLU3(.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 meesage but do not file
+8 IF '$GET(LA7NOMSG)
DO FILE6249^LA7VHLU(LA76249,.LA7DATA)
+9 ;
+10 QUIT
