LREPI1 ;VA/DALOI/SED - EMERGING PATHOGENS HL7 BUILDER ; 5/9/98
;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
;;5.2;LAB SERVICE;**132,157,175,260,281,320**;Sep 27, 1994
; Reference to ^DD supported by IA #999
; Reference to ^XLFSTR supported by IA #10104
EN(LRDFN,SS,IVDT,SEQ) ;Entry to build the HL7 Segment
;LRDFN=Patient ID
;SS=Subscripts in file 63 for results
;IVDT=Inverted Date and Time
;SEQ=Sequence Number
;S LRCS=$E(HL("ECH"))
K ^TMP("HL7",$J)
S:+$G(SEQ)'>0 SEQ=1
S CNT=1
Q:'$G(LRDFN)!('$G(IVDT))!('$L($G(SS)))
I $L($T(@SS)) D @SS
EXIT ;KILL THEN EXIT
K CNT,IND,LRAND,LRANT,LRDATA,LRES,LRINLT,LRNT,LRRDTE,LRREF,LRTST,LRUNIT
K ND,NLT,NLTP,ORGNB,ORGPT,SEQX,SITE,TYPE,LRCODE,LRFLD
Q SEQ
CY D CY^LREPI1A
Q
SITECD ;Determine the HL7 Speciman code from the Site and return LRCODE
S LRCODE=""
Q:'$D(SITE)
S LRCODE=$P($G(^LAB(61,SITE,0)),U,8) ;Use if LEDI is not defined
S LRIPT=$P($G(^LAB(61,SITE,0)),U,9) Q:+LRIPT'>0
Q:'$D(^LAB(64.061,LRIPT,0))
Q:$P(^LAB(64.061,LRIPT,0),U,3)=""
S LRCODE=$P(^LAB(64.061,LRIPT,0),U,3)
Q
CH ;BUILD HL7 MSG FOR CH SUBSCRIPT
;TO BUILD OBR SEGMENT FOR CHEM
I '$D(^LR(LRDFN,SS,IVDT,0)) Q
K LRDATA
S $P(LRDATA,HLFS,1)=$G(SEQ)
S $P(LRDATA,HLFS,4)="81121.0000"_LRCS_"CHEMISTRY TEST"_LRCS_"VANLT"
S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
S LRRDTE=$P($G(^LR(LRDFN,SS,IVDT,0)),U,3)
S:+LRRDTE>0 LRRDTE=$$HLDATE^HLFNC(LRRDTE)
S SITE=$P($G(^LR(LRDFN,SS,IVDT,0)),U,5)
D SITECD
S $P(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$P($G(^LAB(61,SITE,0)),U)
S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
;TO BUILD OBX SEGMENT CHEM
S (IND,SEQX)=1
F S IND=$O(^LR(LRDFN,"CH",IVDT,IND)) Q:+IND'>0 D
.S LRES=^LR(LRDFN,"CH",IVDT,IND)
.Q:LRES=""
.Q:'$D(^LAB(60,"C","CH;"_IND_";1"))
.K LRDATA
.S LRTST=$O(^LAB(60,"C","CH;"_IND_";1",0))
.Q:'$D(^TMP($J,"T",LRTST,LRPATH))
.S $P(LRDATA,HLFS,1)=SEQX,$P(LRDATA,HLFS,2)="ST"
.S LRUNIT=$P($G(^LAB(60,LRTST,1,SITE,0)),U,7)
.S LRREF=$P($G(^LAB(60,LRTST,1,SITE,0)),U,2)_"-"
.S LRREF=LRREF_$P($G(^LAB(60,LRTST,1,SITE,0)),U,3)
.S LRINLT=+$G(^LAB(60,LRTST,64)),LRNLT=LRCS_LRCS_LRCS
.I LRINLT'="",$D(^LAM(LRINLT,0)) D
..S $P(LRNLT,LRCS,2)=$P(^LAM(LRINLT,0),U,1)
..S $P(LRNLT,LRCS,1)=$P(^LAM(LRINLT,0),U,2)
..S $P(LRNLT,LRCS,3)="VANLT"
.S $P(LRDATA,HLFS,3)=LRNLT_LRTST_LRCS_$P(^LAB(60,LRTST,0),U)_LRCS_"VA60"
.;ADD LOINC
.S LRLOINC=$P($P(LRES,U,3),"!",3),LRLNCNAM=""
.S:LRLOINC'="" LRLNCNAM=$E($P($G(^LAB(95.3,LRLOINC,80)),U),1,30)
.S $P(LRDATA,HLFS,3)=$P(LRDATA,HLFS,3)_LRCS_LRLOINC_LRCS_LRLNCNAM_LRCS_"LOINC"
.S $P(LRDATA,HLFS,5)=$P(LRES,U,1),$P(LRDATA,HLFS,8)=$P(LRES,U,2)
.S $P(LRDATA,HLFS,6)=LRUNIT,$P(LRDATA,HLFS,7)=LRREF
.S:LRRDTE>0 $P(LRDATA,HLFS,14)=LRRDTE
.S:LRRDTE=0 $P(LRDATA,HLFS,14)=""
.S CNT=CNT+1,SEQX=SEQX+1,^TMP("HL7",$J,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
K LRLNCNAM,LRLOINC
Q
MI ;TO BUILD INITIAL OBR SEGMENT FOR MICRO
I '$D(^LR(LRDFN,SS,IVDT,0)) Q
K LRDATA
S $P(LRDATA,HLFS,1)=$G(SEQ)
S $P(LRDATA,HLFS,4)="87999.0000"_LRCS_"MICRO CULTURE"_LRCS_"VANLT"
S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
S $P(LRDATA,HLFS,18)=$P(^LR(LRDFN,SS,IVDT,0),U,6)
S SITE=$P(^LR(LRDFN,SS,IVDT,0),U,5)
D SITECD
S $P(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$P($G(^LAB(61,SITE,0)),U)
S ^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
;LOOK INTO ALL MICRO SUB NODES FOR DATA AND BUILD FIRST OBX
F ND=3,6,9,12,17 I $D(^LR(LRDFN,SS,IVDT,ND,0)) D TYPE,MIORG
;SECOND LOOP TO BUILD SECONDARY OBR AND OBX
F ND=3,12 I $D(^LR(LRDFN,SS,IVDT,ND,0)) D TYPE,@("SEC"_ND)
Q
TYPE ;DETERMINES THE CORRECT NLT CODE TO USE
S:ND=3 TYPE="87993.0000"_LRCS_"BACTERIOLOGY CULTURE"_LRCS_"VANLT"
S:ND=6 TYPE="87505.0000"_LRCS_"PARASITOLOGY"_LRCS_"VANLT"
S:ND=9 TYPE="87994.0000"_LRCS_"MYCOLOGY CULTURE"_LRCS_"VANLT"
S:ND=12 TYPE="87995.0000"_LRCS_"MYCOBACTERIUM CULTURE"_LRCS_"VANLT"
S:ND=17 TYPE="87996.0000"_LRCS_"VIROLOGY CULTURE"_LRCS_"VANLT"
Q
;
MIORG ;TO BUILD ORGANISM OBX SEGMENT FOR MICRO
S ORGNB=0 F S ORGNB=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB)) Q:+ORGNB'>0 D
.Q:'$D(^LR(LRDFN,SS,IVDT,ND,ORGNB,0))
.S LRRDTE=""
.S:ND=3 LRRDTE=+$P($G(^LR(LRDFN,SS,IVDT,1)),U,1)
.S:ND'=3 LRRDTE=+$P($G(^LR(LRDFN,SS,IVDT,(ND-1))),U,1)
.S:+LRRDTE>0 LRRDTE=$$HLDATE^HLFNC(LRRDTE)
.S ORGPT=+$P($G(^LR(LRDFN,SS,IVDT,ND,ORGNB,0)),U,1)
.Q:'$D(^LAB(61.2,ORGPT,0))
.K LRDATA
.S $P(LRDATA,HLFS,1)=ORGNB,$P(LRDATA,HLFS,2)="CE"
.S $P(LRDATA,HLFS,3)=TYPE
.S $P(LRDATA,HLFS,4)=ORGNB
.S:LRRDTE'=0 $P(LRDATA,HLFS,14)=LRRDTE
.E S $P(LRDATA,HLFS,14)=""
.S $P(LRDATA,HLFS,5)=LRCS_$P(^LAB(61.2,ORGPT,0),U,1)
.S CNT=CNT+1,^TMP("HL7",$J,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
Q
SEC3 ;BUILD SUSCEPTIBILTY FOR ORGANISMS
;FIRST BUILD OBR THEN OBX FOR THE ANTIMICROBIAL TESTING
S ORGNB=0 F S ORGNB=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB)) Q:+ORGNB'>0 D
.Q:'$D(^LR(LRDFN,SS,IVDT,ND,ORGNB,0))
.;CHECK TO SEE IF ANY ANTIMICROBIAL INFORMATION BEFORE PROCEEDING
.S LRAND=1,LRANDFG=1
.F S LRAND=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND)) Q:+LRAND'>0 D
..Q:'$D(^LAB(62.06,"AD",LRAND))
..S:$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)'="" LRANDFG=0
.Q:LRANDFG
.K LRDATA,LRANDFG S SEQ=SEQ+1
.S $P(LRDATA,HLFS,1)=SEQ
.S $P(LRDATA,HLFS,4)="87518.0000"_LRCS_"ANTIBIOTIC MIC"_LRCS_"VANLT"
.S $P(LRDATA,HLFS,26)=$P(TYPE,LRCS,1)_LRCS_ORGNB
.S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
.S SITE=$P(^LR(LRDFN,SS,IVDT,0),U,5)
.D SITECD
.S $P(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$P($G(^LAB(61,SITE,0)),U)
.S CNT=CNT+1,^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
ANTI3 .;NOW GET ANTIMICROBIAL INFORMATION
.S SEQX=1,LRAND=1
.F S LRAND=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND)) Q:+LRAND'>0 D
..Q:'$D(^LAB(62.06,"AD",LRAND))
..Q:$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)=""
..K LRDATA
..S LRANT=$O(^LAB(62.06,"AD",LRAND,0))
..S $P(LRDATA,HLFS,1)=SEQX,$P(LRDATA,HLFS,2)="ST"
..S NLT=LRCS_LRCS_LRCS_LRANT_LRCS_$P(^LAB(62.06,LRANT,0),U,1)_LRCS_"VA62.06"
..S NLTP=+$G(^LAB(62.06,LRANT,64))
..S:$D(^LAM(NLTP,0)) $P(NLT,LRCS,1)=$P(^LAM(NLTP,0),U,2),$P(NLT,LRCS,2)=$P($P(^LAM(NLTP,0),U,1),LRCS),$P(NLT,LRCS,3)="VANLT"
..S $P(LRDATA,HLFS,3)=NLT
..S $P(LRDATA,HLFS,5)=$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U)
..S $P(LRDATA,HLFS,8)=$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)
..S SEQX=SEQX+1,CNT=CNT+1,^TMP("HL7",$J,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
Q
SEC12 ;
;FIRST BUILD OBR THEN OBX FOR THE ANTIMICROBIAL TESTING
S ORGNB=0 F S ORGNB=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB)) Q:+ORGNB'>0 D
.Q:'$D(^LR(LRDFN,SS,IVDT,ND,ORGNB,0))
.;FIRST CHECK FOR ANTIMICROBIAL INFORMATION
.S LRAND=1,LRANDFG=1
.F S LRAND=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND)) Q:+LRAND'>0 D
..S:$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)'="" LRANDFG=0
.Q:LRANDFG
.K LRDATA,LRANDFG S SEQ=SEQ+1
.S $P(LRDATA,HLFS,1)=SEQ
.S $P(LRDATA,HLFS,4)="87518.0000"_LRCS_"ANTIBIOTIC MIC"_LRCS_"VANLT"
.S $P(LRDATA,HLFS,26)=$P(TYPE,LRCS,1)_LRCS_ORGNB
.S $P(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
.S SITE=$P(^LR(LRDFN,SS,IVDT,0),U,5)
.D SITECD
.S $P(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$P($G(^LAB(61,SITE,0)),U)
.S CNT=CNT+1,^TMP("HL7",$J,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
ANTI12 .;NOW GET ANTIMICROBIAL INFORMATION FOR THE MYCOBACTERIUM
.S SEQX=1,LRAND=1
.F S LRAND=$O(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND)) Q:+LRAND'>0 D
..Q:$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)=""
..K LRDATA
..S LRNT=$O(^DD(63.39,"GL",LRAND,1,0))
.. S LRFILE=63.39,LRFLD=LRNT,LRANT=$$GET1^DID(LRFILE,LRFLD,"","TITLE","","LRERR")
..;S LRANT=$P($G(^DD(63.39,LRNT,.1)),U,1)replaced w/supported reference
..S:LRANT="" LRANT=$P(^DD(63.39,LRNT,0),U,1)
..S $P(LRDATA,HLFS,1)=SEQX,$P(LRDATA,HLFS,2)="ST"
..S $P(LRDATA,HLFS,3)=LRCS_LRCS_LRCS_LRAND_LRCS_LRANT_LRCS_"VA63.39"
..S $P(LRDATA,HLFS,5)=$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U)
..S $P(LRDATA,HLFS,8)=$P(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)
..S SEQX=SEQX+1,CNT=CNT+1,^TMP("HL7",$J,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
Q
LREPI1 ;VA/DALOI/SED - EMERGING PATHOGENS HL7 BUILDER ; 5/9/98
+1 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
+2 ;;5.2;LAB SERVICE;**132,157,175,260,281,320**;Sep 27, 1994
+3 ; Reference to ^DD supported by IA #999
+4 ; Reference to ^XLFSTR supported by IA #10104
EN(LRDFN,SS,IVDT,SEQ) ;Entry to build the HL7 Segment
+1 ;LRDFN=Patient ID
+2 ;SS=Subscripts in file 63 for results
+3 ;IVDT=Inverted Date and Time
+4 ;SEQ=Sequence Number
+5 ;S LRCS=$E(HL("ECH"))
+6 KILL ^TMP("HL7",$JOB)
+7 IF +$GET(SEQ)'>0
SET SEQ=1
+8 SET CNT=1
+9 IF '$GET(LRDFN)!('$GET(IVDT))!('$LENGTH($GET(SS)))
QUIT
+10 IF $LENGTH($TEXT(@SS))
DO @SS
EXIT ;KILL THEN EXIT
+1 KILL CNT,IND,LRAND,LRANT,LRDATA,LRES,LRINLT,LRNT,LRRDTE,LRREF,LRTST,LRUNIT
+2 KILL ND,NLT,NLTP,ORGNB,ORGPT,SEQX,SITE,TYPE,LRCODE,LRFLD
+3 QUIT SEQ
CY DO CY^LREPI1A
+1 QUIT
SITECD ;Determine the HL7 Speciman code from the Site and return LRCODE
+1 SET LRCODE=""
+2 IF '$DATA(SITE)
QUIT
+3 ;Use if LEDI is not defined
SET LRCODE=$PIECE($GET(^LAB(61,SITE,0)),U,8)
+4 SET LRIPT=$PIECE($GET(^LAB(61,SITE,0)),U,9)
IF +LRIPT'>0
QUIT
+5 IF '$DATA(^LAB(64.061,LRIPT,0))
QUIT
+6 IF $PIECE(^LAB(64.061,LRIPT,0),U,3)=""
QUIT
+7 SET LRCODE=$PIECE(^LAB(64.061,LRIPT,0),U,3)
+8 QUIT
CH ;BUILD HL7 MSG FOR CH SUBSCRIPT
+1 ;TO BUILD OBR SEGMENT FOR CHEM
+2 IF '$DATA(^LR(LRDFN,SS,IVDT,0))
QUIT
+3 KILL LRDATA
+4 SET $PIECE(LRDATA,HLFS,1)=$GET(SEQ)
+5 SET $PIECE(LRDATA,HLFS,4)="81121.0000"_LRCS_"CHEMISTRY TEST"_LRCS_"VANLT"
+6 SET $PIECE(LRDATA,HLFS,18)=$PIECE(^LR(LRDFN,SS,IVDT,0),U,6)
+7 SET $PIECE(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
+8 SET LRRDTE=$PIECE($GET(^LR(LRDFN,SS,IVDT,0)),U,3)
+9 IF +LRRDTE>0
SET LRRDTE=$$HLDATE^HLFNC(LRRDTE)
+10 SET SITE=$PIECE($GET(^LR(LRDFN,SS,IVDT,0)),U,5)
+11 DO SITECD
+12 SET $PIECE(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$PIECE($GET(^LAB(61,SITE,0)),U)
+13 SET ^TMP("HL7",$JOB,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
+14 ;TO BUILD OBX SEGMENT CHEM
+15 SET (IND,SEQX)=1
+16 FOR
SET IND=$ORDER(^LR(LRDFN,"CH",IVDT,IND))
IF +IND'>0
QUIT
Begin DoDot:1
+17 SET LRES=^LR(LRDFN,"CH",IVDT,IND)
+18 IF LRES=""
QUIT
+19 IF '$DATA(^LAB(60,"C","CH;"_IND_";1"))
QUIT
+20 KILL LRDATA
+21 SET LRTST=$ORDER(^LAB(60,"C","CH;"_IND_";1",0))
+22 IF '$DATA(^TMP($JOB,"T",LRTST,LRPATH))
QUIT
+23 SET $PIECE(LRDATA,HLFS,1)=SEQX
SET $PIECE(LRDATA,HLFS,2)="ST"
+24 SET LRUNIT=$PIECE($GET(^LAB(60,LRTST,1,SITE,0)),U,7)
+25 SET LRREF=$PIECE($GET(^LAB(60,LRTST,1,SITE,0)),U,2)_"-"
+26 SET LRREF=LRREF_$PIECE($GET(^LAB(60,LRTST,1,SITE,0)),U,3)
+27 SET LRINLT=+$GET(^LAB(60,LRTST,64))
SET LRNLT=LRCS_LRCS_LRCS
+28 IF LRINLT'=""
IF $DATA(^LAM(LRINLT,0))
Begin DoDot:2
+29 SET $PIECE(LRNLT,LRCS,2)=$PIECE(^LAM(LRINLT,0),U,1)
+30 SET $PIECE(LRNLT,LRCS,1)=$PIECE(^LAM(LRINLT,0),U,2)
+31 SET $PIECE(LRNLT,LRCS,3)="VANLT"
End DoDot:2
+32 SET $PIECE(LRDATA,HLFS,3)=LRNLT_LRTST_LRCS_$PIECE(^LAB(60,LRTST,0),U)_LRCS_"VA60"
+33 ;ADD LOINC
+34 SET LRLOINC=$PIECE($PIECE(LRES,U,3),"!",3)
SET LRLNCNAM=""
+35 IF LRLOINC'=""
SET LRLNCNAM=$EXTRACT($PIECE($GET(^LAB(95.3,LRLOINC,80)),U),1,30)
+36 SET $PIECE(LRDATA,HLFS,3)=$PIECE(LRDATA,HLFS,3)_LRCS_LRLOINC_LRCS_LRLNCNAM_LRCS_"LOINC"
+37 SET $PIECE(LRDATA,HLFS,5)=$PIECE(LRES,U,1)
SET $PIECE(LRDATA,HLFS,8)=$PIECE(LRES,U,2)
+38 SET $PIECE(LRDATA,HLFS,6)=LRUNIT
SET $PIECE(LRDATA,HLFS,7)=LRREF
+39 IF LRRDTE>0
SET $PIECE(LRDATA,HLFS,14)=LRRDTE
+40 IF LRRDTE=0
SET $PIECE(LRDATA,HLFS,14)=""
+41 SET CNT=CNT+1
SET SEQX=SEQX+1
SET ^TMP("HL7",$JOB,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
End DoDot:1
+42 KILL LRLNCNAM,LRLOINC
+43 QUIT
MI ;TO BUILD INITIAL OBR SEGMENT FOR MICRO
+1 IF '$DATA(^LR(LRDFN,SS,IVDT,0))
QUIT
+2 KILL LRDATA
+3 SET $PIECE(LRDATA,HLFS,1)=$GET(SEQ)
+4 SET $PIECE(LRDATA,HLFS,4)="87999.0000"_LRCS_"MICRO CULTURE"_LRCS_"VANLT"
+5 SET $PIECE(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
+6 SET $PIECE(LRDATA,HLFS,18)=$PIECE(^LR(LRDFN,SS,IVDT,0),U,6)
+7 SET SITE=$PIECE(^LR(LRDFN,SS,IVDT,0),U,5)
+8 DO SITECD
+9 SET $PIECE(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$PIECE($GET(^LAB(61,SITE,0)),U)
+10 SET ^TMP("HL7",$JOB,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
+11 ;LOOK INTO ALL MICRO SUB NODES FOR DATA AND BUILD FIRST OBX
+12 FOR ND=3,6,9,12,17
IF $DATA(^LR(LRDFN,SS,IVDT,ND,0))
DO TYPE
DO MIORG
+13 ;SECOND LOOP TO BUILD SECONDARY OBR AND OBX
+14 FOR ND=3,12
IF $DATA(^LR(LRDFN,SS,IVDT,ND,0))
DO TYPE
DO @("SEC"_ND)
+15 QUIT
TYPE ;DETERMINES THE CORRECT NLT CODE TO USE
+1 IF ND=3
SET TYPE="87993.0000"_LRCS_"BACTERIOLOGY CULTURE"_LRCS_"VANLT"
+2 IF ND=6
SET TYPE="87505.0000"_LRCS_"PARASITOLOGY"_LRCS_"VANLT"
+3 IF ND=9
SET TYPE="87994.0000"_LRCS_"MYCOLOGY CULTURE"_LRCS_"VANLT"
+4 IF ND=12
SET TYPE="87995.0000"_LRCS_"MYCOBACTERIUM CULTURE"_LRCS_"VANLT"
+5 IF ND=17
SET TYPE="87996.0000"_LRCS_"VIROLOGY CULTURE"_LRCS_"VANLT"
+6 QUIT
+7 ;
MIORG ;TO BUILD ORGANISM OBX SEGMENT FOR MICRO
+1 SET ORGNB=0
FOR
SET ORGNB=$ORDER(^LR(LRDFN,SS,IVDT,ND,ORGNB))
IF +ORGNB'>0
QUIT
Begin DoDot:1
+2 IF '$DATA(^LR(LRDFN,SS,IVDT,ND,ORGNB,0))
QUIT
+3 SET LRRDTE=""
+4 IF ND=3
SET LRRDTE=+$PIECE($GET(^LR(LRDFN,SS,IVDT,1)),U,1)
+5 IF ND'=3
SET LRRDTE=+$PIECE($GET(^LR(LRDFN,SS,IVDT,(ND-1))),U,1)
+6 IF +LRRDTE>0
SET LRRDTE=$$HLDATE^HLFNC(LRRDTE)
+7 SET ORGPT=+$PIECE($GET(^LR(LRDFN,SS,IVDT,ND,ORGNB,0)),U,1)
+8 IF '$DATA(^LAB(61.2,ORGPT,0))
QUIT
+9 KILL LRDATA
+10 SET $PIECE(LRDATA,HLFS,1)=ORGNB
SET $PIECE(LRDATA,HLFS,2)="CE"
+11 SET $PIECE(LRDATA,HLFS,3)=TYPE
+12 SET $PIECE(LRDATA,HLFS,4)=ORGNB
+13 IF LRRDTE'=0
SET $PIECE(LRDATA,HLFS,14)=LRRDTE
+14 IF '$TEST
SET $PIECE(LRDATA,HLFS,14)=""
+15 SET $PIECE(LRDATA,HLFS,5)=LRCS_$PIECE(^LAB(61.2,ORGPT,0),U,1)
+16 SET CNT=CNT+1
SET ^TMP("HL7",$JOB,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
End DoDot:1
+17 QUIT
SEC3 ;BUILD SUSCEPTIBILTY FOR ORGANISMS
+1 ;FIRST BUILD OBR THEN OBX FOR THE ANTIMICROBIAL TESTING
+2 SET ORGNB=0
FOR
SET ORGNB=$ORDER(^LR(LRDFN,SS,IVDT,ND,ORGNB))
IF +ORGNB'>0
QUIT
Begin DoDot:1
+3 IF '$DATA(^LR(LRDFN,SS,IVDT,ND,ORGNB,0))
QUIT
+4 ;CHECK TO SEE IF ANY ANTIMICROBIAL INFORMATION BEFORE PROCEEDING
+5 SET LRAND=1
SET LRANDFG=1
+6 FOR
SET LRAND=$ORDER(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND))
IF +LRAND'>0
QUIT
Begin DoDot:2
+7 IF '$DATA(^LAB(62.06,"AD",LRAND))
QUIT
+8 IF $PIECE(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)'=""
SET LRANDFG=0
End DoDot:2
+9 IF LRANDFG
QUIT
+10 KILL LRDATA,LRANDFG
SET SEQ=SEQ+1
+11 SET $PIECE(LRDATA,HLFS,1)=SEQ
+12 SET $PIECE(LRDATA,HLFS,4)="87518.0000"_LRCS_"ANTIBIOTIC MIC"_LRCS_"VANLT"
+13 SET $PIECE(LRDATA,HLFS,26)=$PIECE(TYPE,LRCS,1)_LRCS_ORGNB
+14 SET $PIECE(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
+15 SET SITE=$PIECE(^LR(LRDFN,SS,IVDT,0),U,5)
+16 DO SITECD
+17 SET $PIECE(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$PIECE($GET(^LAB(61,SITE,0)),U)
+18 SET CNT=CNT+1
SET ^TMP("HL7",$JOB,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
ANTI3 ;NOW GET ANTIMICROBIAL INFORMATION
+1 SET SEQX=1
SET LRAND=1
+2 FOR
SET LRAND=$ORDER(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND))
IF +LRAND'>0
QUIT
Begin DoDot:2
+3 IF '$DATA(^LAB(62.06,"AD",LRAND))
QUIT
+4 IF $PIECE(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)=""
QUIT
+5 KILL LRDATA
+6 SET LRANT=$ORDER(^LAB(62.06,"AD",LRAND,0))
+7 SET $PIECE(LRDATA,HLFS,1)=SEQX
SET $PIECE(LRDATA,HLFS,2)="ST"
+8 SET NLT=LRCS_LRCS_LRCS_LRANT_LRCS_$PIECE(^LAB(62.06,LRANT,0),U,1)_LRCS_"VA62.06"
+9 SET NLTP=+$GET(^LAB(62.06,LRANT,64))
+10 IF $DATA(^LAM(NLTP,0))
SET $PIECE(NLT,LRCS,1)=$PIECE(^LAM(NLTP,0),U,2)
SET $PIECE(NLT,LRCS,2)=$PIECE($PIECE(^LAM(NLTP,0),U,1),LRCS)
SET $PIECE(NLT,LRCS,3)="VANLT"
+11 SET $PIECE(LRDATA,HLFS,3)=NLT
+12 SET $PIECE(LRDATA,HLFS,5)=$PIECE(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U)
+13 SET $PIECE(LRDATA,HLFS,8)=$PIECE(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)
+14 SET SEQX=SEQX+1
SET CNT=CNT+1
SET ^TMP("HL7",$JOB,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
End DoDot:2
End DoDot:1
+15 QUIT
SEC12 ;
+1 ;FIRST BUILD OBR THEN OBX FOR THE ANTIMICROBIAL TESTING
+2 SET ORGNB=0
FOR
SET ORGNB=$ORDER(^LR(LRDFN,SS,IVDT,ND,ORGNB))
IF +ORGNB'>0
QUIT
Begin DoDot:1
+3 IF '$DATA(^LR(LRDFN,SS,IVDT,ND,ORGNB,0))
QUIT
+4 ;FIRST CHECK FOR ANTIMICROBIAL INFORMATION
+5 SET LRAND=1
SET LRANDFG=1
+6 FOR
SET LRAND=$ORDER(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND))
IF +LRAND'>0
QUIT
Begin DoDot:2
+7 IF $PIECE(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)'=""
SET LRANDFG=0
End DoDot:2
+8 IF LRANDFG
QUIT
+9 KILL LRDATA,LRANDFG
SET SEQ=SEQ+1
+10 SET $PIECE(LRDATA,HLFS,1)=SEQ
+11 SET $PIECE(LRDATA,HLFS,4)="87518.0000"_LRCS_"ANTIBIOTIC MIC"_LRCS_"VANLT"
+12 SET $PIECE(LRDATA,HLFS,26)=$PIECE(TYPE,LRCS,1)_LRCS_ORGNB
+13 SET $PIECE(LRDATA,HLFS,7)=$$HLDATE^HLFNC(9999999-IVDT)
+14 SET SITE=$PIECE(^LR(LRDFN,SS,IVDT,0),U,5)
+15 DO SITECD
+16 SET $PIECE(LRDATA,HLFS,15)=LRCODE_LRCS_LRCS_$PIECE($GET(^LAB(61,SITE,0)),U)
+17 SET CNT=CNT+1
SET ^TMP("HL7",$JOB,CNT)="OBR"_HLFS_$$UP^XLFSTR(LRDATA)
ANTI12 ;NOW GET ANTIMICROBIAL INFORMATION FOR THE MYCOBACTERIUM
+1 SET SEQX=1
SET LRAND=1
+2 FOR
SET LRAND=$ORDER(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND))
IF +LRAND'>0
QUIT
Begin DoDot:2
+3 IF $PIECE(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)=""
QUIT
+4 KILL LRDATA
+5 SET LRNT=$ORDER(^DD(63.39,"GL",LRAND,1,0))
+6 SET LRFILE=63.39
SET LRFLD=LRNT
SET LRANT=$$GET1^DID(LRFILE,LRFLD,"","TITLE","","LRERR")
+7 ;S LRANT=$P($G(^DD(63.39,LRNT,.1)),U,1)replaced w/supported reference
+8 IF LRANT=""
SET LRANT=$PIECE(^DD(63.39,LRNT,0),U,1)
+9 SET $PIECE(LRDATA,HLFS,1)=SEQX
SET $PIECE(LRDATA,HLFS,2)="ST"
+10 SET $PIECE(LRDATA,HLFS,3)=LRCS_LRCS_LRCS_LRAND_LRCS_LRANT_LRCS_"VA63.39"
+11 SET $PIECE(LRDATA,HLFS,5)=$PIECE(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U)
+12 SET $PIECE(LRDATA,HLFS,8)=$PIECE(^LR(LRDFN,SS,IVDT,ND,ORGNB,LRAND),U,2)
+13 SET SEQX=SEQX+1
SET CNT=CNT+1
SET ^TMP("HL7",$JOB,CNT)="OBX"_HLFS_$$UP^XLFSTR(LRDATA)
End DoDot:2
End DoDot:1
+14 QUIT
