source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LREPI1.m@ 1470

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