LA7VORU1 ;VA/DALOI/JMC - Builder of HL7 Lab Results Microbiology OBR/OBX/NTE ; 13-Aug-2013 09:09 ; MKK
;;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 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"
. D OBR^LA7VORU
. D NTE^LA7VORU
. 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"
. D OBR^LA7VORU
. D NTE^LA7VORU
. 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"
. D OBR^LA7VORU
. D NTE^LA7VORU
. 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"
. D OBR^LA7VORU
. D NTE^LA7VORU
. 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"
. D OBR^LA7VORU
. D NTE^LA7VORU
. 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
. D OBR^LA7VORU
. 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^LA7VORU1 Q
. S LA7TXT(LA7J)=LA7X
;
; If formatted or repetition format then build comments to a NTE segment.
I LA7FMT,$D(LA7TXT) D NTE^LA7VORU1
;
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
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^LA7VORU1
;
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, 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 LA7PARNT=LA7SB_"-"_LA7ORG
. M LA7PARNT=LA7ID(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
. . 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
;
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 meesage 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 meesage but do not file
I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
;
Q
LA7VORU1 ;VA/DALOI/JMC - Builder of HL7 Lab Results Microbiology OBR/OBX/NTE ; 13-Aug-2013 09:09 ; MKK
+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 ;
+4 SET LRDFN=LA("LRDFN")
SET LRSS=LA("SUB")
SET (LA7IENS,LRIDT)=LA("LRIDT")
+5 ;
+6 ; Bacteriology Report
+7 IF $DATA(^LR(LRDFN,LRSS,LRIDT,1))
Begin DoDot:1
+8 SET LA7IDT=LRIDT
SET LRSB=11
SET LA7NLT="87993.0000"
+9 DO OBR^LA7VORU
+10 DO NTE^LA7VORU
+11 FOR LRSB=1,11.7,1.5,11
DO RPTNTE
+12 NEW LRSB
+13 SET LA7OBXSN=0
+14 ; Report urine/sputum screens
+15 FOR LA7I=5,6
IF $PIECE(^LR(LRDFN,LRSS,LRIDT,1),"^",LA7I)'=""
SET LRSB=$SELECT(LA7I=5:11.58,1:11.57)
DO OBX
+16 ; Report gram stain
+17 IF $DATA(^LR(LRDFN,LRSS,LRIDT,2))
DO GS
+18 ; Check for organism id
+19 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,3))
QUIT
+20 SET LRSB=12
+21 DO ORG
+22 DO MIC
End DoDot:1
+23 ;
+24 ; Parasite report
+25 IF $DATA(^LR(LRDFN,LRSS,LRIDT,5))
Begin DoDot:1
+26 SET LRSB=14
SET LA7NLT="87505.0000"
+27 DO OBR^LA7VORU
+28 DO NTE^LA7VORU
+29 FOR LRSB=16.5,15.51,16.4,14
DO RPTNTE
+30 ; Check for organism id
+31 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,6))
QUIT
+32 NEW LRSB
+33 SET LA7OBXSN=0
SET LA7IDT=LRIDT
SET LRSB=16
+34 DO ORG
End DoDot:1
+35 ;
+36 ; Mycology report
+37 IF $DATA(^LR(LRDFN,LRSS,LRIDT,8))
Begin DoDot:1
+38 SET LRSB=18
SET LA7NLT="87994.0000"
+39 DO OBR^LA7VORU
+40 DO NTE^LA7VORU
+41 FOR LRSB=20.5,19.6,20.4,18
DO RPTNTE
+42 ; Check for organism id
+43 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,9))
QUIT
+44 NEW LRSB
+45 SET LA7OBXSN=0
SET LA7IDT=LRIDT
SET LRSB=20
+46 DO ORG
End DoDot:1
+47 ;
+48 ; Mycobacterium report
+49 IF $DATA(^LR(LRDFN,LRSS,LRIDT,11))
Begin DoDot:1
+50 SET LRSB=22
SET LA7NLT="87995.0000"
+51 DO OBR^LA7VORU
+52 DO NTE^LA7VORU
+53 FOR LRSB=26.5,26.4,22
DO RPTNTE
+54 NEW LRSB
+55 SET LA7OBXSN=0
SET LA7IDT=LRIDT
+56 ; Report acid fast stain
+57 IF $PIECE(^LR(LRDFN,LRSS,LRIDT,11),"^",3)'=""
Begin DoDot:2
+58 SET LRSB=24
DO OBX
+59 SET LRSB=25
DO OBX
End DoDot:2
+60 ; Check for organism id
+61 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,12))
QUIT
+62 SET LRSB=26
+63 DO ORG
+64 DO MIC
End DoDot:1
+65 ;
+66 ; Virology report
+67 IF $DATA(^LR(LRDFN,LRSS,LRIDT,16))
Begin DoDot:1
+68 SET LRSB=33
SET LA7NLT="87996.0000"
+69 DO OBR^LA7VORU
+70 DO NTE^LA7VORU
+71 FOR LRSB=36.5,36.4,33
DO RPTNTE
+72 ; Check for virus id
+73 IF '$DATA(^LR(LRDFN,LRSS,LRIDT,17))
QUIT
+74 NEW LRSB
+75 SET LA7OBXSN=0
SET LA7IDT=LRIDT
SET LRSB=36
+76 DO ORG
End DoDot:1
+77 ;
+78 ; Antibiotic Levels
+79 IF $DATA(^LR(LRDFN,LRSS,LRIDT,14))
Begin DoDot:1
+80 NEW LA7SR
+81 SET LRSB=28
SET LA7NLT="93978.0000"
SET LA7NTESN=0
+82 DO OBR^LA7VORU
+83 SET LA7SR=0
+84 FOR
SET LA7SR=$ORDER(^LR(LRDFN,LRSS,LRIDT,14,LA7SR))
IF 'LA7SR
QUIT
SET LA7IDT=LRIDT_","_LA7SR
DO OBX
End DoDot:1
+85 ;
+86 QUIT
+87 ;
+88 ;
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^LA7VORU1
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^LA7VORU1
+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 QUIT
+23 ;
+24 ;
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^LA7VORU1
+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, i,e. DOD-CHCS
+5 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"RC",1:"L")
+6 ;
+7 SET (LA7NLT,LA7NLT(1))=""
+8 IF LRSB=12
SET LA7ND=3
SET LA7NLT="87565.0000"
SET LA7NLT(1)="87993.0000"
+9 IF LRSB=26
SET LA7ND=12
SET LA7NLT="87899.0000"
SET LA7NLT(1)="87525.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=LA7SB_"-"_LA7ORG
+18 MERGE LA7PARNT=LA7ID(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
+23 SET LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1
SET LRSB=LA7SB_","_LA7SB1
+24 DO OBX
+25 SET X=$ORDER(^LAB(62.06,"AD",LA7SB1,0))
IF 'X
QUIT
+26 SET LA7TXT=$PIECE($GET(^LAB(62.06,X,0)),"^",3)
+27 IF LA7TXT'=""
SET (LA7NTESN,LA7FMT)=0
SET LA7CMTYP=""
DO NTE
End DoDot:2
+28 ; no free text antibiotics on AFB
IF LA7ND'=3
QUIT
+29 SET LA7SB1=0
+30 FOR
SET LA7SB1=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,3,LA7SB1))
IF 'LA7SB1
QUIT
Begin DoDot:2
+31 NEW LRSB
+32 SET LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1
+33 SET LRSB=LA7SB_",3,1"
DO OBX
+34 SET LRSB=LA7SB_",3,2"
DO OBX
End DoDot:2
End DoDot:1
+35 ;
+36 QUIT
+37 ;
+38 ;
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 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^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 meesage but do not file
+8 IF '$GET(LA7NOMSG)
DO FILE6249^LA7VHLU(LA76249,.LA7DATA)
+9 ;
+10 QUIT
