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

LREPI1.m

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