LA7CORU1.m

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