Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7VORU1

LA7VORU1.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. MI ; Build segments for "MI" subscript
  1.  ;
  1.  N LA7I,LA7IDT,LA7ISOID,LA7IENS,LA7MISB,LA7NLT,LA7REL,LA7SUBFL,LA7VNLT,LA7VT,LA7VTIEN,LRDFN,LRIDT,LRSB,LRSS
  1.  ;
  1.  S LRDFN=LA("LRDFN"),LRSS=LA("SUB"),(LA7IENS,LRIDT)=LA("LRIDT")
  1.  ; Flag that whole report has been released, complete date in field  #.03
  1.  S LA7REL=$P(^LR(LRDFN,LRSS,LRIDT,0),"^",3)
  1.  ;
  1.  ; Determine if there are specific sections to send back.
  1.  I $G(LA(62.49)) D
  1.  . S LA7VNLT=$P($G(^LAHM(62.49,LA(62.49),63)),"^",5),LA7VTIEN=0
  1.  . F  S LA7VTIEN=$O(^LAHM(62.49,LA(62.49),1,LA7VTIEN)) Q:'LA7VTIEN  D
  1.  . . S LA7VT=^LAHM(62.49,LA(62.49),1,LA7VTIEN,0)
  1.  . . I $P(LA7VT,"^") D
  1.  . . . S LA7VT(63)=$G(^LAB(64.061,$P(LA7VT,"^"),63))
  1.  . . . I $P(LA7VT(63),"^")'="MI" Q
  1.  . . . I $P(LA7VT(63),"^",3) S LA7MISB($P(LA7VT(63),"^",2,3))=LA7VNLT
  1.  ;
  1.  ; Send gram stain if C&S
  1.  I $D(LA7MISB("63.05^11")) S LA7MISB("63.05^11.6;63.29")=LA7MISB("63.05^11")
  1.  ;
  1.  ; Send acid fast stain if AFB culture
  1.  I $D(LA7MISB("63.05^22")) S LA7MISB("63.05^24")=LA7MISB("63.05^22")
  1.  ;
  1.  ; If no specific section then check all sections
  1.  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)=""
  1.  ;
  1.  ; Bacteriology Report
  1.  I $D(^LR(LRDFN,LRSS,LRIDT,1)),(LA7REL!$P($G(^LR(LRDFN,LRSS,LRIDT,1)),"^")) D
  1.  . I '$D(LA7MISB("63.05^11")),'$D(LA7MISB("63.05^11.6;63.29"))  Q
  1.  . S LA7NTESN=0,LA7IDT=LRIDT,LRSB=11
  1.  . 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")
  1.  . E  S LA7NLT=$S($P(LA7MISB("63.05^11"),"^"):$P(LA7MISB("63.05^11"),"^"),1:"87993.0000")
  1.  . D OBR^LA7VORU
  1.  . I LA7NVAF=1 D PLC^LA7VORUA
  1.  . D NTE^LA7VORU
  1.  . I LA7NVAF=1 D
  1.  . . S LRSB=11 D RPT^LA7VORU2
  1.  . . F LRSB=1,11.7,1.5 D RPTNTE^LA7VORU2
  1.  . I LA7NVAF'=1 F LRSB=1,11.7,1.5,11 D RPTNTE^LA7VORU2
  1.  . S LA7OBXSN=0
  1.  . ; Report urine/sputum screens
  1.  . F LA7I=5,6 I $P(^LR(LRDFN,LRSS,LRIDT,1),"^",LA7I)'="" S LRSB=$S(LA7I=5:11.58,1:11.57) D OBX
  1.  . ; Report gram stain
  1.  . I $D(^LR(LRDFN,LRSS,LRIDT,2)),$D(LA7MISB("63.05^11.6;63.29")) D GS
  1.  . N LRSB
  1.  . ; Check for organism id
  1.  . I '$D(^LR(LRDFN,LRSS,LRIDT,3)) Q
  1.  . S LRSB=12,LA7SUBFL=63.3
  1.  . D ORG,MIC
  1.  ;
  1.  ; Parasite report
  1.  I $D(^LR(LRDFN,LRSS,LRIDT,5)),(LA7REL!$P($G(^LR(LRDFN,LRSS,LRIDT,5)),"^")) D
  1.  . I '$D(LA7MISB("63.05^14")) Q
  1.  . S LRSB=14,LA7NTESN=0
  1.  . S LA7NLT=$S($P(LA7MISB("63.05^14"),"^"):$P(LA7MISB("63.05^14"),"^"),1:"87925.0000")
  1.  . D OBR^LA7VORU
  1.  . I LA7NVAF=1 D PLC^LA7VORUA
  1.  . D NTE^LA7VORU
  1.  . S LA7OBXSN=0
  1.  . I LA7NVAF=1 D
  1.  . . S LRSB=14 D RPT^LA7VORU2
  1.  . . F LRSB=16.5,15.51,16.4 D RPTNTE^LA7VORU2
  1.  . I LA7NVAF'=1 F LRSB=16.5,15.51,16.4,14 D RPTNTE^LA7VORU2
  1.  . ; Check for organism id
  1.  . I '$D(^LR(LRDFN,LRSS,LRIDT,6)) Q
  1.  . N LRSB
  1.  . S LA7IDT=LRIDT,LRSB=16
  1.  . D ORG
  1.  ;
  1.  ; Mycology report
  1.  I $D(^LR(LRDFN,LRSS,LRIDT,8)),(LA7REL!$P($G(^LR(LRDFN,LRSS,LRIDT,8)),"^")) D
  1.  . I '$D(LA7MISB("63.05^18")) Q
  1.  . S LRSB=18,LA7NTESN=0
  1.  . S LA7NLT=$S($P(LA7MISB("63.05^18"),"^"):$P(LA7MISB("63.05^18"),"^"),1:"87994.0000")
  1.  . D OBR^LA7VORU
  1.  . I LA7NVAF=1 D PLC^LA7VORUA
  1.  . D NTE^LA7VORU
  1.  . S LA7OBXSN=0
  1.  . I LA7NVAF=1 D
  1.  . . S LRSB=18 D RPT^LA7VORU2
  1.  . . F LRSB=20.5,19.6,20.4 D RPTNTE^LA7VORU2
  1.  . I LA7NVAF'=1 F LRSB=20.5,19.6,20.4,18 D RPTNTE^LA7VORU2
  1.  . ; Check for organism id
  1.  . I '$D(^LR(LRDFN,LRSS,LRIDT,9)) Q
  1.  . N LRSB
  1.  . S LA7IDT=LRIDT,LRSB=20
  1.  . D ORG
  1.  ;
  1.  ; Mycobacterium report
  1.  I $D(^LR(LRDFN,LRSS,LRIDT,11)),(LA7REL!$P($G(^LR(LRDFN,LRSS,LRIDT,11)),"^")) D
  1.  . I '$D(LA7MISB("63.05^22")),'$D(LA7MISB("63.05^24"))  Q
  1.  . S LA7NTESN=0,LA7IDT=LRIDT,LRSB=22
  1.  . 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")
  1.  . E  S LA7NLT=$S($P(LA7MISB("63.05^22"),"^"):$P(LA7MISB("63.05^22"),"^"),1:"87995.0000")
  1.  . D OBR^LA7VORU
  1.  . I LA7NVAF=1 D PLC^LA7VORUA
  1.  . D NTE^LA7VORU
  1.  . I LA7NVAF=1 D
  1.  . . S LRSB=22 D RPT^LA7VORU2
  1.  . . F LRSB=26.5,26.4 D RPTNTE^LA7VORU2
  1.  . I LA7NVAF'=1 F LRSB=26.5,26.4,22 D RPTNTE^LA7VORU2
  1.  . S LA7OBXSN=0
  1.  . ; Report acid fast stain
  1.  . I $P(^LR(LRDFN,LRSS,LRIDT,11),"^",3)'="" D
  1.  . . S LRSB=24 D OBX
  1.  . . I $P(^LR(LRDFN,LRSS,LRIDT,11),"^",4)'="" S LRSB=25 D OBX
  1.  . ; Check for organism id
  1.  . I '$D(^LR(LRDFN,LRSS,LRIDT,12)) Q
  1.  . N LRSB
  1.  . S LA7IDT=LRIDT,LRSB=26,LA7SUBFL=63.39
  1.  . D ORG,MIC
  1.  ;
  1.  ; Virology report
  1.  I $D(^LR(LRDFN,LRSS,LRIDT,16)),(LA7REL!$P($G(^LR(LRDFN,LRSS,LRIDT,16)),"^")) D
  1.  . I '$D(LA7MISB("63.05^33")) Q
  1.  . S LRSB=33,LA7NTESN=0
  1.  . S LA7NLT=$S($P(LA7MISB("63.05^33"),"^"):$P(LA7MISB("63.05^33"),"^"),1:"87996.0000")
  1.  . D OBR^LA7VORU
  1.  . I LA7NVAF=1 D PLC^LA7VORUA
  1.  . D NTE^LA7VORU
  1.  . S LA7OBXSN=0
  1.  . I LA7NVAF=1 D
  1.  . . S LRSB=33 D RPT^LA7VORU2
  1.  . . F LRSB=36.5,36.4 D RPTNTE^LA7VORU2
  1.  . I LA7NVAF'=1 F LRSB=36.5,36.4,33 D RPTNTE^LA7VORU2
  1.  . ; Check for virus id
  1.  . I '$D(^LR(LRDFN,LRSS,LRIDT,17)) Q
  1.  . N LRSB
  1.  . S LA7IDT=LRIDT,LRSB=36
  1.  . D ORG
  1.  ;
  1.  ; Antibiotic Levels
  1.  I $D(^LR(LRDFN,LRSS,LRIDT,14)) D
  1.  . N LA7SR
  1.  . S LRSB=28,LA7NLT="93978.0000",LA7NTESN=0
  1.  . D OBR^LA7VORU
  1.  . S LA7SR=0
  1.  . F  S LA7SR=$O(^LR(LRDFN,LRSS,LRIDT,14,LA7SR)) Q:'LA7SR  S LA7IDT=LRIDT_","_LA7SR D OBX
  1.  ;
  1.  ; Sterility results
  1.  I $D(^LR(LRDFN,LRSS,LRIDT,31)) D
  1.  . N LA7SR
  1.  . S LRSB=11.52,LA7NLT="93982.0000",LA7NTESN=0
  1.  . D OBR^LA7VORU
  1.  . S LA7SR=0
  1.  . F  S LA7SR=$O(^LR(LRDFN,LRSS,LRIDT,31,LA7SR)) Q:'LA7SR  S LA7IDT=LRIDT_","_LA7SR D OBX
  1.  ;
  1.  ; Check if specific NLT in the ORUT node for test being NP and build OBR for the NP test.
  1.  I $G(LA7VNLT)'="" D
  1.  . N LA7DISPO,LA7I
  1.  . S LA7DISPO=$$FIND1^DIC(64.061,"","OQX","X","D","I $P(^(0),U,5)=""0123""")
  1.  . S LA7I=$O(^LR(LRDFN,LRSS,LRIDT,"ORUT","B",LA7VNLT,0)) Q:'LA7I
  1.  . I LA7DISPO'="",$P(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7I,0),"^",10)=LA7DISPO D
  1.  . . S LA7NLT=LA7VNLT,LRSB=$P($G(LA7VT(63)),"^",3),LA7NTESN=0,LA7IDT=LRIDT
  1.  . . S:LRSB="" LRSB=0 D OBR^LA7VORU,NTE^LA7VORU
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. GS ; Report Gram stain
  1.  ;
  1.  N LA7GS
  1.  ;
  1.  S LA7GS=0,LRSB=11.6
  1.  F  S LA7GS=$O(^LR(LRDFN,LRSS,LRIDT,2,LA7GS)) Q:'LA7GS  D
  1.  . S LA7IDT=LRIDT_","_LA7GS,LA7NTESN=0
  1.  . D OBX
  1.  Q
  1.  ;
  1.  ;
  1. ORG ; Build OBX segments for MI subscript organism id
  1.  ;
  1.  N LA7ND,LA7ORG
  1.  ;
  1.  ; Bacterial organism
  1.  I LRSB=12 S LA7ND=3
  1.  ; Parasite organism
  1.  I LRSB=16 S LA7ND=6
  1.  ; Fungal organism
  1.  I LRSB=20 S LA7ND=9
  1.  ; Mycobacteria organism
  1.  I LRSB=26 S LA7ND=12
  1.  ; Viral agent
  1.  I LRSB=36 S LA7ND=17
  1.  ;
  1.  S LA7ORG=0
  1.  F  S LA7ORG=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG)) Q:'LA7ORG  D
  1.  . S LA7IDT=LRIDT_","_LA7ORG_","
  1.  . D OBX
  1.  . I LA7ND=17 Q  ; no quantity/comments on viruses
  1.  . I LA7ND=6 D PSTAGE Q
  1.  . D ORGNTE
  1.  . I $P($G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,0)),"^",2)'="" D CC
  1.  Q
  1.  ;
  1.  ;
  1. CC ; Send colony count (quantity)
  1.  ;
  1.  N LRSB
  1.  ;
  1.  I LA7ND=3 S LRSB="12,1"
  1.  I LA7ND=9 S LRSB="20,1"
  1.  I LA7ND=12 S LRSB="26,1"
  1.  D OBX
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. PSTAGE ; Send parasite's stage/quantity/comments
  1.  N LA7CMTP,LA7FMT,LA7J,LA7SB,LA7SOC,LA7NTESN,LA7TXT,LA7X,LRSB
  1.  ;
  1.  ; Source of comment - handle special codes for other systems, ie DOD-CHCS
  1.  S LA7SOC=$S($G(LA7NVAF)=1:"RC",1:"L")
  1.  ;
  1.  S LA7FMT=0,LA7CMTYP=""
  1.  ; If HDR interface then send as repetition text.
  1.  I $G(LA7INTYP)=30 S LA7FMT=2
  1.  ;
  1.  S LA7SB=0
  1.  F  S LA7SB=$O(^LR(LRDFN,LRSS,LRIDT,6,LA7ORG,1,LA7SB)) Q:'LA7SB  D
  1.  . S LA7IDT=LRIDT_","_LA7ORG_","_LA7SB
  1.  . S LRSB="16,.01" D OBX
  1.  . S (LA7J,LA7NTESN)=0
  1.  . F  S LA7J=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7SB,1,LA7J)) Q:'LA7J  D
  1.  . . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7SB,1,LA7J,0))
  1.  . . I LA7X="" S LA7X=" "
  1.  . . I LA7FMT S LA7TXT(LA7J)=LA7X
  1.  . . E  S LA7TXT=LA7X D NTE
  1.  . I LA7FMT,$D(LA7TXT) D NTE
  1.  . S LRSB="16,1" D OBX
  1.  Q
  1.  ;
  1.  ;
  1. ORGNTE ; Send comments on organisms.
  1.  ;
  1.  N LA7CMTYP,LA7FMT,LA7J,LA7SOC,LA7NTESN,LA7TXT,LA7X
  1.  ;
  1.  ; Source of comment - handle special codes for other systems, ie DOD-CHCS
  1.  S LA7SOC=$S($G(LA7NVAF)=1:"RC",1:"L")
  1.  ;
  1.  S LA7FMT=0,LA7CMTYP=""
  1.  ; If HDR interface then send as repetition text.
  1.  I $G(LA7INTYP)=30 S LA7FMT=2
  1.  ;
  1.  S (LA7J,LA7NTESN)=0
  1.  F  S LA7J=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7J)) Q:'LA7J  D
  1.  . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7J,0))
  1.  . I LA7X="" S LA7X=" "
  1.  . I LA7FMT S LA7TXT(LA7J)=LA7X
  1.  . E  S LA7TXT=LA7X D NTE
  1.  ;
  1.  ; If formatted or repetition format then build each type of comments to a NTE segment.
  1.  I LA7FMT,$D(LA7TXT) D NTE
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. MIC ; Build OBR/OBX segments for MI subscript susceptibilities (MIC)
  1.  ;
  1.  N LA7ORG,LA7ND,LA7NLT,LA7SB,LA7SB1,LA7SOC
  1.  ;
  1.  ; Source of comment - handle special codes for other systems, ie DOD-CHCS
  1.  S LA7SOC=$S($G(LA7NVAF)=1:"RC",1:"L")
  1.  ;
  1.  S LA7NLT=""
  1.  I LRSB=12 S LA7ND=3,LA7NLT="87565.0000"
  1.  I LRSB=26 S LA7ND=12,LA7NLT="87568.0000"
  1.  ;
  1.  S LA7ORG=0,LA7SB=LRSB
  1.  F  S LA7ORG=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG)) Q:'LA7ORG  D
  1.  . N LA7NTESN,LA7PARNT
  1.  . ; Check for susceptibilities for this organism
  1.  . S X=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,2))
  1.  . I X<2!(X>3) Q
  1.  . S LA7PARNT=$$GETISO^LA7VHLU1(LA7SUBFL,LA7ORG_","_LRIDT_","_LRDFN_",")
  1.  . M LA7PARNT=LA7ISOID(LA7PARNT)
  1.  . D OBR^LA7VORU
  1.  . S LA7OBXSN=0,LA7SB1=2
  1.  . F  S LA7SB1=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,LA7SB1)) Q:'LA7SB1!(LA7SB1>2.99)  D
  1.  . . N LA7CMTYP,LA7FMT,LA7TXT,LRSB,X
  1.  . . S LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1,LRSB=LA7SB_","_LA7SB1
  1.  . . D OBX
  1.  . . S X=""
  1.  . . I LA7SB=12 S X=$O(^LAB(62.06,"AD",LA7SB1,0))
  1.  . . I LA7SB=26 S X=$O(^LAB(62.06,"AD1",LA7SB1,0))
  1.  . . I X<1 Q
  1.  . . S LA7TXT=$P($G(^LAB(62.06,X,0)),"^",3)
  1.  . . I LA7TXT'="" S (LA7NTESN,LA7FMT)=0,LA7CMTYP="" D NTE
  1.  . I LA7ND'=3 Q  ; no free text antibiotics on AFB
  1.  . S LA7SB1=0
  1.  . F  S LA7SB1=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,3,LA7SB1)) Q:'LA7SB1  D
  1.  . . N LA7I,LRSB
  1.  . . F LA7I=2,3 I $P(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,3,LA7SB1,0),"^",LA7I)'="" D
  1.  . . . S LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1,LRSB=LA7SB_",3,"_(LA7I-1)
  1.  . . . N LA7I D OBX
  1.  Q
  1.  ;
  1.  ;
  1. OBX ; Build OBX segments for MI subscript
  1.  ; Also called by AP^LA7VORU2 to build AP OBX segments.
  1.  ;
  1.  N LA7DATA
  1.  D OBX^LA7VOBX(LRDFN,LRSS,LA7IDT,LRSB,.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,LA7NVAF)
  1.  ;
  1.  ; If OBX failed to build then don't store
  1.  I '$D(LA7DATA) Q
  1.  ;
  1.  D FILESEG^LA7VHLU(GBL,.LA7DATA)
  1.  ;
  1.  ; Check for flag to only build message but do not file
  1.  I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
  1.  Q
  1.  ;
  1.  ;
  1. NTE ; Build NTE segment with comment
  1.  ;
  1.  N LA7DATA
  1.  ;
  1.  D NTE^LA7VHLU3(.LA7DATA,.LA7TXT,$G(LA7SOC),LA7FS,LA7ECH,.LA7NTESN,$G(LA7CMTYP),$G(LA7FMT))
  1.  D FILESEG^LA7VHLU(GBL,.LA7DATA)
  1.  ;
  1.  ; Check for flag to only build message but do not file
  1.  I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
  1.  ;
  1.  Q