- LREPI1 ;DALOI/SED - EMERGING PATHOGENS HL7 BUILDER ; 5/9/98
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPI1 7991 printed Jan 18, 2025@03:14:52 Page 2
- LREPI1 ;DALOI/SED - EMERGING PATHOGENS HL7 BUILDER ; 5/9/98
- +1 ;;5.2;LAB SERVICE;**132,157,175,260,281,320**;Sep 27, 1994
- +2 ; Reference to ^DD supported by IA #999
- +3 ; 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