185 lines
7.6 KiB
Mathematica
185 lines
7.6 KiB
Mathematica
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
|