BLRTNM ; IHS/HQT/MJL - SET IHS LAB TRANSACTION LOG - MICRO ;MAY 06, 2009 9:58 AM
;;5.2;IHS LABORATORY;**1011,1014,1015,1025,1026,1030**;NOV 01, 1997
;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER ^BLRTNM")
S BLRLRDFN=$G(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRDFN"))
S BLRIDT=$G(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRIDT"))
S (BLRTEST,BLRCULT)=$G(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"BLRTEST"))
S (BLRCMPD,BLRCOLSP,BLRRES,BLRTESTN,BLRANTI,BLRANTN,BLRANTP,BLRSTGN,BLRORG,BLRSTG,BLRCMTS)=""
;
I 'BLRTEST D KILL Q
;
;
S BLREXEC=$P($G(^LAB(60,BLRTEST,0)),U,14) ;'EDIT CODE'
;
; ----- BEGIN IHS/OIT/MKK LR*5.2*1025 MODIFICATIONS
; Check to make sure Edit code exists.
; If not, set error message and quit because it's
; not possible to process the transaction.
I +$G(BLREXEC)<1 D Q
. S BLRERR=1
. S BLRERROR(1)="Null/Zero Edit code for Lab Test IEN:"_BLRTEST_". Invalid."
; ----- END ISH/OIT/MKK LR*5.2*1025 MODICATIONS
;
;GET FIRST FIELD # IN THE EXECUTE CODE???
; S BLRGBL=$P($P($P($G(^LAB(62.07,BLREXEC,.1)),"/"),"=",2),"""",2)
S BLRGBL=+$P($P($P($G(^LAB(62.07,BLREXEC,.1)),"/"),"=",2),"""",2) ; IHS/OIT/MKK - LR*5.2*1030 -- Cow Creek Correction
;
;LOOK AT 'MICROBIOLOGY SUB-FIELD'
; S BLRGBL=$P($P($G(^DD(63.05,BLRGBL,0)),U,4),";",1) ;GET THE SUBSCRIPT
S BLRGBL=+$P($P($G(^DD(63.05,BLRGBL,0)),U,4),";",1) ;GET THE SUBSCRIPT ; IHS/OIT/MKK - LR*5.2*1030 -- Cow Creek Correction
;GET THAT SUBSCRIPT LEVEL'S VALUE
S BLRVAL=$G(^LR(BLRLRDFN,"MI",BLRIDT,BLRGBL))
S BLRACCN=$G(^LR(BLRLRDFN,"MI",BLRIDT,0))
Q:$G(BLRACCN)="" ;IHS/ITSC/TPF 06/06/02 CAN'T PROCESS IF NO ACCESSION
; DUE TO A DELETION
S BLRCOLSP=$P(BLRACCN,U,11),BLRACCN=$P(BLRACCN,U,6),BLR60F=1,BLRSETP=0,BLRERFS=""
Q:(BLRVAL=""!($P(BLRVAL,U,2)'="F"))
S BLRAA=$G(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRAA")),BLRAD=$G(^("LRAD")),BLRAN=$G(^("LRAN")),BLRSS=$G(^("LRSS")),BLRODT=$G(^("LRODT")),BLRSEQ=$G(^("LRSN")),BLRSPEC=$G(^("LRSPEC"))
S:+BLRTEST BLRCMPD=$P($G(^LRO(68,BLRAA,1,BLRAD,1,BLRAN,4,BLRTEST,0)),U,5)
I BLRTEST'="",$D(^BLRTXLOG("AAT",BLRACCN,BLRTEST)) D
.I BLRGBL=1 D BACT Q
.I BLRGBL=5 D PARAS Q
.I BLRGBL=8 D MYCOL Q
.I BLRGBL=11 D TB Q
.I BLRGBL=16 D VIROL Q
D KILL
Q
;
BACT ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER BACT^BLRTNM")
S BLRRES="NEGATIVE"
I $D(^LR(BLRLRDFN,"MI",BLRIDT,25)) D GETRES(25) D BLDMSTR Q
I $D(^LR(BLRLRDFN,"MI",BLRIDT,2)) D GETRES(2) S BLRTESTN="GRAM STAIN",BLRTEST=$O(^LAB(60,"B",BLRTESTN,"")) D:BLRCULT=BLRTEST BLDMSTR Q:BLRCULT=BLRTEST D LOOKTST
S BLRTESTN="",BLRRES="NEGATIVE",BLRTEST=BLRCULT
I '$D(^LR(BLRLRDFN,"MI",BLRIDT,3)) D BLDMSTR Q
I $D(^LR(BLRLRDFN,"MI",BLRIDT,3)),$P(^LR(BLRLRDFN,"MI",BLRIDT,3,0),U,3)="" D BLDMSTR Q
I $D(^LR(BLRLRDFN,"MI",BLRIDT,3)),$P(^LR(BLRLRDFN,"MI",BLRIDT,3,0),U,4)=0 D BLDMSTR Q ;organism deleted
S BLRRES="POSITIVE",BLRTEST=^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"BLRTEST") D BLDMSTR S BLRSPT=3 D ORG Q
Q
;
PARAS ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER PARAS^BLRTNM")
S BLRRES="NEGATIVE"
I $D(^LR(BLRLRDFN,"MI",BLRIDT,24)) D GETRES(24),BLDMSTR Q
I '$D(^LR(BLRLRDFN,"MI",BLRIDT,6)) D BLDMSTR Q
I $D(^LR(BLRLRDFN,"MI",BLRIDT,6)),$P(^LR(BLRLRDFN,"MI",BLRIDT,6,0),U,3)="" D BLDMSTR Q
S BLRRES="POSITIVE" D BLDMSTR S BLRSPT=6 D PARAS1 Q
Q
;
PARAS1 ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER PARAS1^BLRTNM")
S (BLRORGX,BLR60F)=0 F S BLRORGX=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX)) Q:(BLRORGX'?.N!(BLRORGX="")) S BLRORG=^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,0),BLRRES="",BLRORG=+BLRORG D LOOKORG,PARAS2
Q
PARAS2 ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER PARAS2^BLRTNM")
S BLRPAR=$O(^BLRTXLOG("AOG",BLRACCN,BLRORG,""))
S BLRSTG=0 F S BLRSTG=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,1,BLRSTG)) Q:(BLRSTG=""!(BLRSTG'?.N)) D
.S BLRSTGN=^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,1,BLRSTG,0)
.S BLRRES=$P(BLRSTGN,U,2),BLRSTGN=$P(BLRSTGN,U,1)
.D LOOKSTG S BLRSTGN="" Q
S BLRSTG=""
Q
;
MYCOL ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER MYCOL^BLRTNM")
S BLRRES="NEGATIVE"
I $D(^LR(BLRLRDFN,"MI",BLRIDT,15)) D GETRES(15) D BLDMSTR Q
I '$D(^LR(BLRLRDFN,"MI",BLRIDT,9)) D BLDMSTR Q
I $D(^LR(BLRLRDFN,"MI",BLRIDT,9)),$P(^LR(BLRLRDFN,"MI",BLRIDT,9,0),U,3)="" D BLDMSTR Q
S BLRRES="POSITIVE" D BLDMSTR S BLRSPT=9 D ORG Q
Q
;
TB ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER TB^BLRTNM")
I ($P(BLRVAL,U,3)'=""!($P(BLRVAL,U,4)'="")) D GETFSTAI
I BLRCULT=BLRTEST,BLRRES'="" Q
S BLRTEST=BLRCULT,BLRTESTN=""
I '$D(^LR(BLRLRDFN,"MI",BLRIDT,12)) S BLRRES="NEGATIVE" D BLDMSTR Q
D:'$D(^UTILITY("TB",$J)) BLDTB
S BLRRES="POSITIVE" D BLDMSTR S BLRSPT=12 D ORG Q
Q
;
BLDTB ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER BLDTB^BLRTNM")
S BLRPX=1 F S BLRPX=$O(^DD(63.39,"GL",BLRPX)) Q:BLRPX="" S BLRFLD=$O(^DD(63.39,"GL",BLRPX,1,"")),^UTILITY("TB",$J,BLRPX)=$P(^DD(63.39,BLRFLD,0),U,1)
K BLRFLD,BLRPX
Q
GETFSTAI ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETFSTAI^BLRTNM")
S BLRTESTN="ACID FAST STAIN" S BLRTEST=$O(^LAB(60,"B",BLRTESTN,"")) I BLRTEST="" S BLRTESTN="AFB SMEAR" S BLRTEST=$O(^LAB(60,"B",BLRTESTN,""))
S BLRRES=$P(BLRVAL,U,3) I BLRRES'="",$P(BLRVAL,U,4)'="" S BLRRES=BLRRES_";"_$P(BLRVAL,U,4)
S:BLRRES="" BLRRES=$P(BLRVAL,U,4)
D LOOKTST
Q
VIROL ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VIROL^BLRTNM")
S BLRRES="NEGATIVE"
I '$D(^LR(BLRLRDFN,"MI",BLRIDT,17)) D BLDMSTR Q
I $D(^LR(BLRLRDFN,"MI",BLRIDT,17)),$P(^LR(BLRLRDFN,"MI",BLRIDT,17,0),U,3)="" D BLDMSTR Q
S BLRRES="POSITIVE" D BLDMSTR S BLRSPT=17 D ORG Q
Q
;
ORG ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER ORG^BLRTNM")
S (BLRORGX,BLR60F)=0 F S BLRORGX=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX)) Q:(BLRORGX'?.N!(BLRORGX="")) S BLRORG=^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,0) S BLRRES=$P(BLRORG,U,2),BLRORG=+BLRORG D LOOKORG D:BLRSPT'=17 ANTIB
Q
;
ANTIB ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER ANTIB^BLRTNM")
S BLRPAR=$O(^BLRTXLOG("AOG",BLRACCN,BLRORG,""))
; S BLRANTI=1 F S BLRANTI=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,BLRANTI)) Q:(BLRANTI=""!($L(BLRANTI)=1)) S BLRRES=$P(^(BLRANTI),U,1) S:BLRGBL'=11 BLRANTP=$O(^LAB(62.06,"AD",BLRANTI,"")) D:BLRGBL=11 GETANAME D LOOKDRG S BLRERFS="" K BLRERF
; ----- BEGIN IHS/OIT/MKK LR*5.2*1025 -- Need to bypass non-existent Drug Nodes in the ANTIMICROBIAL SUSCEPTIBILITY dictionary
S BLRANTI=1
F S BLRANTI=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,BLRANTI)) Q:(BLRANTI=""!($L(BLRANTI)=1)) D
. S BLRRES=$P($G(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,BLRANTI)),U,1)
. S:BLRGBL'=11 BLRANTP=$O(^LAB(62.06,"AD",BLRANTI,""))
. D:BLRGBL=11 GETANAME
. D:$G(BLRANTP)'="" LOOKDRG
. S BLRERFS=""
. K BLRERF
; ----- END IHS/OIT/MKK LR*5.2*1025 -- Need to bypass non-existent Antibiotics
S (BLRANTI,BLRANTP)=""
Q
GETANAME ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETANAME^BLRTNM")
S BLRANTP=BLRANTI
S BLRANTN=^UTILITY("TB",$J,BLRANTP)
S X=BLRANTN,DIC=62.06,DIC(0)="MX" D ^DIC
I Y'=-1 S BLRANTP=$P(Y,U,1) Q
S BLRERFS="Field 1302 of file 9009022 not a valid antibiotic ien",BLRERF=1
Q
;
LOOKTST ;
; ----- BEGIN IHS/OIT/MKK LR*5.2*1026 - Make sure BLRTEST variable exists
I +$G(BLRTEST)<1 Q
; ----- BEGIN IHS/OIT/MKK LR*5.2*1026 MODIFICATIONS
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER LOOKTST^BLRTNM")
S BLRSETP=1
I '$D(^BLRTXLOG("AAT",BLRACCN,BLRTEST)) S BLRPAR=$O(^BLRTXLOG("AAT",BLRACCN,BLRCULT,"")) D ^BLRTNM1 Q
D BLDMSTR
Q
LOOKORG ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER LOOKORG^BLRTNM")
I '$D(^BLRTXLOG("AOG",BLRACCN,BLRORG)) S BLRPAR=$O(^BLRTXLOG("AAT",BLRACCN,BLRCULT,"")) D ^BLRTNM1 Q
D BLDMSTR
Q
;
LOOKDRG ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER LOOKDRG^BLRTNM")
I '$D(^BLRTXLOG("AOD",BLRACCN,BLRORG,BLRANTP)) D ^BLRTNM1 Q
D BLDMSTR
Q
;
LOOKSTG ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER LOOKSTG^BLRTNM")
I '$D(^BLRTXLOG("AOS",BLRACCN,BLRORG,BLRSTG)) D ^BLRTNM1 Q
D BLDMSTR
Q
BLDMSTR ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER BLDMSTR^BLRTNM")
S BLRCMF="M"
I BLR60F S BLRCRSBS="""AAT"",BLRACCN,BLRTEST",BLRDIR=-1,BLROKCK="",BLRBADCK="",BLR("PANEL/TEST POINTER")=BLRTEST,BLR("PANEL/TEST NAME")=BLRTESTN,BLR("RESULT")=BLRRES S:BLRCMTS'="" BLR("COMMENTS")=BLRCMTS
I 'BLR60F D
.I BLRSPT'=6 D Q
..;S BLRSTR="SEQUENCE NUMBER_$$GETOGIEN(BLRACCN,BLRORG"_$S(BLRANTI="":")",1:",BLRANTP)~ANTIBIOTIC_BLRANTP")_"~STATUS FLAG_BLRPHASE~RESULT_BLRRES~ORGANISM_BLRORG~ANTIBIOTIC NAME_BLRANTN~PCC ERROR FLAG_BLRERFS" Q
..S BLRCRSBS=""""_$S(BLRANTP'="":"AOD",1:"AOG")_""",BLRACCN,BLRORG",BLRDIR=-1,BLROKCK="CHKDT",BLRBADCK=""
..S BLR("RESULT")=BLRRES,BLR("ORGANISM")=BLRORG,BLR("ANTIBIOTIC NAME")=BLRANTN,BLR("PCC ERROR FLAG")=BLRERFS
..S:BLRANTP'="" BLRCRSBS=BLRCRSBS_",BLRANTP",BLR("ANTIBIOTIC")=BLRANTP
.;S BLRSTR="SEQUENCE NUMBER_$$GETOSIEN(BLRACCN,BLRORG"_$S(BLRSTG="":")",1:",BLRSTG)~STAGE COUNTER_BLRSTG")_"~STATUS FLAG_BLRPHASE~RESULT_BLRRES~ORGANISM_BLRORG" S:BLRSTGN'="" BLRSTR=BLRSTR_"~STAGE NAME_BLRSTGN" Q
.S BLRCRSBS=""""_$S(BLRSTG'="":"AOS",1:"AOG")_""",BLRACCN,BLRORG",BLRDIR=-1,BLROKCK="CHKDT",BLRBADCK=""
.S BLR("RESULT")=BLRRES,BLR("ORGANISM")=BLRORG S:BLRSTGN'="" BLR("STAGE NAME")=BLRSTGN Q
.S:BLRSTG'="" BLRCRSBS=BLRCRSBS_",BLRSTG",BLR("STAGE COUNTER")=BLRSTG
S BLR("COLLECTION SAMPLE POINTER")=BLRCOLSP S:+BLRCMPD BLR("COMPLETE DATE")=BLRCMPD
S BLR("SEQUENCE NUMBER")=$$GETIEN D:'BLRERR ^BLRNFLTL
S BLRCMTS=""
K BLR
Q
;
GETRES(BLRRSUB) ;
;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETRES^BLRTNM")
S BLRYY=0 F BLRI=1:1 S BLRYY=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRRSUB,BLRYY)) Q:BLRYY="" S:BLRI>1 BLRCMTS=BLRCMTS_$C(20) S BLRCMTS=BLRCMTS_^LR(BLRLRDFN,"MI",BLRIDT,BLRRSUB,BLRYY,0)
I BLRCMTS'="" S BLRRES="POSITIVE"
K BLRI
Q
;
GETIEN() ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETIEN^BLRTNM")
S BLRERR=0 I BLRCMF="C" D GETNEW Q BLRENT
D
.S BLRCRGL="^BLRTXLOG("_BLRCRSBS_")",BLRENT=$O(@BLRCRGL@(""),BLRDIR)
.S:'BLRENT BLRERR=1
.I BLRENT,BLROKCK'="" D @BLROKCK
.I 'BLRERR,BLRBADCK'="" D @BLRBADCK
.I BLRERR D EMSG Q
.S BLRIEN=BLRENT_"," Q
Q BLRENT
;
GETNEW ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETNEW^BLRTNM")
S BLRENT=$G(^BLRTXLOG("SEQ"))
I 'BLRENT S BLRENT=$O(^BLRTXLOG("@"),-1) I BLRENT,'$D(^BLRTXLOG(1)) S BLRENT=0
F BLRENT=BLRENT+1:1 Q:'$D(^BLRTXLOG(BLRENT))
S BLRENTS="BLRENTS",BLRENTS(1)=BLRENT,^BLRTXLOG("SEQ")=BLRENT,BLRIEN="+1,"
Q
;
CHKDT ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER CHKDT^BLRTNM")
S BLRCDT=$P(^BLRTXLOG(BLRENT,12),U)
Q:$E(BLRCDT,1,3)=$E(DT,1,3)
I ($E(BLRCDT,1,3)+1)'=$E(DT,1,3) S BLRERR=1,BLRDTER=1 Q ;MORE THAN 1 YEAR AHEAD
I $E(BLRCDT,4,5)<11 S BLRERR=1,BLRDTER=1 Q
Q
;
EMSG ;
; Log an error because the crossreference isn't set.
I 'BLRENT D
.S BLRERR=1,BLRERROR(1)="Something wrong -- problem with IHS Lab Transaction Log Cross Reference: "_BLRCRGL
Q
;
;
KILL ;
K BLR60F,BLRANTI,BLRANTP,BLRATOM,BLRCAT,BLRCLNC,BLRCMTS,BLRCPTC,BLRCPTF,BLRCPTP,BLRCPTS,BLRCST,BLRCULT,BLRLRDFN,BLRDTC,BLRDUZ,BLRDUZ2,BLRDUZN,BLRENT,BLREXEC,BLRFID,BLRFILE,BLRFOUND,BLRANTN,BLRERFS,BLRERF
K BLRGBL,BLRIDT,BLRL60,BLRLOC,BLRLOCN,BLRLOGDA,BLRLRDFN,BLRODT,BLRODTM,BLRORG,BLRORGX,BLRPAR,BLRPROV,BLRPROVN,BLRRES,BLRSEQ,BLRSETP,BLRSPEC,BLRSPT,BLRSTG,BLRSTGN,BLRSTR,BLRSTR1,BLRTEST
K BLRTEST1,BLRTESTN,BLRUNITS,BLRVAL,BLRXII,BLRYY,BLRZ,BLRCMPD,BLRCOLSP
Q
BLRTNM ; IHS/HQT/MJL - SET IHS LAB TRANSACTION LOG - MICRO ;MAY 06, 2009 9:58 AM
+1 ;;5.2;IHS LABORATORY;**1011,1014,1015,1025,1026,1030**;NOV 01, 1997
+2 ;
+3 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER ^BLRTNM")
+4 SET BLRLRDFN=$GET(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRDFN"))
+5 SET BLRIDT=$GET(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRIDT"))
+6 SET (BLRTEST,BLRCULT)=$GET(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"BLRTEST"))
+7 SET (BLRCMPD,BLRCOLSP,BLRRES,BLRTESTN,BLRANTI,BLRANTN,BLRANTP,BLRSTGN,BLRORG,BLRSTG,BLRCMTS)=""
+8 ;
+9 IF 'BLRTEST
DO KILL
QUIT
+10 ;
+11 ;
+12 ;'EDIT CODE'
SET BLREXEC=$PIECE($GET(^LAB(60,BLRTEST,0)),U,14)
+13 ;
+14 ; ----- BEGIN IHS/OIT/MKK LR*5.2*1025 MODIFICATIONS
+15 ; Check to make sure Edit code exists.
+16 ; If not, set error message and quit because it's
+17 ; not possible to process the transaction.
+18 IF +$GET(BLREXEC)<1
Begin DoDot:1
+19 SET BLRERR=1
+20 SET BLRERROR(1)="Null/Zero Edit code for Lab Test IEN:"_BLRTEST_". Invalid."
End DoDot:1
QUIT
+21 ; ----- END ISH/OIT/MKK LR*5.2*1025 MODICATIONS
+22 ;
+23 ;GET FIRST FIELD # IN THE EXECUTE CODE???
+24 ; S BLRGBL=$P($P($P($G(^LAB(62.07,BLREXEC,.1)),"/"),"=",2),"""",2)
+25 ; IHS/OIT/MKK - LR*5.2*1030 -- Cow Creek Correction
SET BLRGBL=+$PIECE($PIECE($PIECE($GET(^LAB(62.07,BLREXEC,.1)),"/"),"=",2),"""",2)
+26 ;
+27 ;LOOK AT 'MICROBIOLOGY SUB-FIELD'
+28 ; S BLRGBL=$P($P($G(^DD(63.05,BLRGBL,0)),U,4),";",1) ;GET THE SUBSCRIPT
+29 ;GET THE SUBSCRIPT ; IHS/OIT/MKK - LR*5.2*1030 -- Cow Creek Correction
SET BLRGBL=+$PIECE($PIECE($GET(^DD(63.05,BLRGBL,0)),U,4),";",1)
+30 ;GET THAT SUBSCRIPT LEVEL'S VALUE
+31 SET BLRVAL=$GET(^LR(BLRLRDFN,"MI",BLRIDT,BLRGBL))
+32 SET BLRACCN=$GET(^LR(BLRLRDFN,"MI",BLRIDT,0))
+33 ;IHS/ITSC/TPF 06/06/02 CAN'T PROCESS IF NO ACCESSION
IF $GET(BLRACCN)=""
QUIT
+34 ; DUE TO A DELETION
+35 SET BLRCOLSP=$PIECE(BLRACCN,U,11)
SET BLRACCN=$PIECE(BLRACCN,U,6)
SET BLR60F=1
SET BLRSETP=0
SET BLRERFS=""
+36 IF (BLRVAL=""!($PIECE(BLRVAL,U,2)'="F"))
QUIT
+37 SET BLRAA=$GET(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRAA"))
SET BLRAD=$GET(^("LRAD"))
SET BLRAN=$GET(^("LRAN"))
SET BLRSS=$GET(^("LRSS"))
SET BLRODT=$GET(^("LRODT"))
SET BLRSEQ=$GET(^("LRSN"))
SET BLRSPEC=$GET(^("LRSPEC"))
+38 IF +BLRTEST
SET BLRCMPD=$PIECE($GET(^LRO(68,BLRAA,1,BLRAD,1,BLRAN,4,BLRTEST,0)),U,5)
+39 IF BLRTEST'=""
IF $DATA(^BLRTXLOG("AAT",BLRACCN,BLRTEST))
Begin DoDot:1
+40 IF BLRGBL=1
DO BACT
QUIT
+41 IF BLRGBL=5
DO PARAS
QUIT
+42 IF BLRGBL=8
DO MYCOL
QUIT
+43 IF BLRGBL=11
DO TB
QUIT
+44 IF BLRGBL=16
DO VIROL
QUIT
End DoDot:1
+45 DO KILL
+46 QUIT
+47 ;
BACT ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER BACT^BLRTNM")
+2 SET BLRRES="NEGATIVE"
+3 IF $DATA(^LR(BLRLRDFN,"MI",BLRIDT,25))
DO GETRES(25)
DO BLDMSTR
QUIT
+4 IF $DATA(^LR(BLRLRDFN,"MI",BLRIDT,2))
DO GETRES(2)
SET BLRTESTN="GRAM STAIN"
SET BLRTEST=$ORDER(^LAB(60,"B",BLRTESTN,""))
IF BLRCULT=BLRTEST
DO BLDMSTR
IF BLRCULT=BLRTEST
QUIT
DO LOOKTST
+5 SET BLRTESTN=""
SET BLRRES="NEGATIVE"
SET BLRTEST=BLRCULT
+6 IF '$DATA(^LR(BLRLRDFN,"MI",BLRIDT,3))
DO BLDMSTR
QUIT
+7 IF $DATA(^LR(BLRLRDFN,"MI",BLRIDT,3))
IF $PIECE(^LR(BLRLRDFN,"MI",BLRIDT,3,0),U,3)=""
DO BLDMSTR
QUIT
+8 ;organism deleted
IF $DATA(^LR(BLRLRDFN,"MI",BLRIDT,3))
IF $PIECE(^LR(BLRLRDFN,"MI",BLRIDT,3,0),U,4)=0
DO BLDMSTR
QUIT
+9 SET BLRRES="POSITIVE"
SET BLRTEST=^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"BLRTEST")
DO BLDMSTR
SET BLRSPT=3
DO ORG
QUIT
+10 QUIT
+11 ;
PARAS ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER PARAS^BLRTNM")
+2 SET BLRRES="NEGATIVE"
+3 IF $DATA(^LR(BLRLRDFN,"MI",BLRIDT,24))
DO GETRES(24)
DO BLDMSTR
QUIT
+4 IF '$DATA(^LR(BLRLRDFN,"MI",BLRIDT,6))
DO BLDMSTR
QUIT
+5 IF $DATA(^LR(BLRLRDFN,"MI",BLRIDT,6))
IF $PIECE(^LR(BLRLRDFN,"MI",BLRIDT,6,0),U,3)=""
DO BLDMSTR
QUIT
+6 SET BLRRES="POSITIVE"
DO BLDMSTR
SET BLRSPT=6
DO PARAS1
QUIT
+7 QUIT
+8 ;
PARAS1 ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER PARAS1^BLRTNM")
+2 SET (BLRORGX,BLR60F)=0
FOR
SET BLRORGX=$ORDER(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX))
IF (BLRORGX'?.N!(BLRORGX=""))
QUIT
SET BLRORG=^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,0)
SET BLRRES=""
SET BLRORG=+BLRORG
DO LOOKORG
DO PARAS2
+3 QUIT
PARAS2 ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER PARAS2^BLRTNM")
+2 SET BLRPAR=$ORDER(^BLRTXLOG("AOG",BLRACCN,BLRORG,""))
+3 SET BLRSTG=0
FOR
SET BLRSTG=$ORDER(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,1,BLRSTG))
IF (BLRSTG=""!(BLRSTG'?.N))
QUIT
Begin DoDot:1
+4 SET BLRSTGN=^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,1,BLRSTG,0)
+5 SET BLRRES=$PIECE(BLRSTGN,U,2)
SET BLRSTGN=$PIECE(BLRSTGN,U,1)
+6 DO LOOKSTG
SET BLRSTGN=""
QUIT
End DoDot:1
+7 SET BLRSTG=""
+8 QUIT
+9 ;
MYCOL ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER MYCOL^BLRTNM")
+2 SET BLRRES="NEGATIVE"
+3 IF $DATA(^LR(BLRLRDFN,"MI",BLRIDT,15))
DO GETRES(15)
DO BLDMSTR
QUIT
+4 IF '$DATA(^LR(BLRLRDFN,"MI",BLRIDT,9))
DO BLDMSTR
QUIT
+5 IF $DATA(^LR(BLRLRDFN,"MI",BLRIDT,9))
IF $PIECE(^LR(BLRLRDFN,"MI",BLRIDT,9,0),U,3)=""
DO BLDMSTR
QUIT
+6 SET BLRRES="POSITIVE"
DO BLDMSTR
SET BLRSPT=9
DO ORG
QUIT
+7 QUIT
+8 ;
TB ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER TB^BLRTNM")
+2 IF ($PIECE(BLRVAL,U,3)'=""!($PIECE(BLRVAL,U,4)'=""))
DO GETFSTAI
+3 IF BLRCULT=BLRTEST
IF BLRRES'=""
QUIT
+4 SET BLRTEST=BLRCULT
SET BLRTESTN=""
+5 IF '$DATA(^LR(BLRLRDFN,"MI",BLRIDT,12))
SET BLRRES="NEGATIVE"
DO BLDMSTR
QUIT
+6 IF '$DATA(^UTILITY("TB",$JOB))
DO BLDTB
+7 SET BLRRES="POSITIVE"
DO BLDMSTR
SET BLRSPT=12
DO ORG
QUIT
+8 QUIT
+9 ;
BLDTB ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER BLDTB^BLRTNM")
+2 SET BLRPX=1
FOR
SET BLRPX=$ORDER(^DD(63.39,"GL",BLRPX))
IF BLRPX=""
QUIT
SET BLRFLD=$ORDER(^DD(63.39,"GL",BLRPX,1,""))
SET ^UTILITY("TB",$JOB,BLRPX)=$PIECE(^DD(63.39,BLRFLD,0),U,1)
+3 KILL BLRFLD,BLRPX
+4 QUIT
GETFSTAI ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER GETFSTAI^BLRTNM")
+2 SET BLRTESTN="ACID FAST STAIN"
SET BLRTEST=$ORDER(^LAB(60,"B",BLRTESTN,""))
IF BLRTEST=""
SET BLRTESTN="AFB SMEAR"
SET BLRTEST=$ORDER(^LAB(60,"B",BLRTESTN,""))
+3 SET BLRRES=$PIECE(BLRVAL,U,3)
IF BLRRES'=""
IF $PIECE(BLRVAL,U,4)'=""
SET BLRRES=BLRRES_";"_$PIECE(BLRVAL,U,4)
+4 IF BLRRES=""
SET BLRRES=$PIECE(BLRVAL,U,4)
+5 DO LOOKTST
+6 QUIT
VIROL ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER VIROL^BLRTNM")
+2 SET BLRRES="NEGATIVE"
+3 IF '$DATA(^LR(BLRLRDFN,"MI",BLRIDT,17))
DO BLDMSTR
QUIT
+4 IF $DATA(^LR(BLRLRDFN,"MI",BLRIDT,17))
IF $PIECE(^LR(BLRLRDFN,"MI",BLRIDT,17,0),U,3)=""
DO BLDMSTR
QUIT
+5 SET BLRRES="POSITIVE"
DO BLDMSTR
SET BLRSPT=17
DO ORG
QUIT
+6 QUIT
+7 ;
ORG ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER ORG^BLRTNM")
+2 SET (BLRORGX,BLR60F)=0
FOR
SET BLRORGX=$ORDER(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX))
IF (BLRORGX'?.N!(BLRORGX=""))
QUIT
SET BLRORG=^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,0)
SET BLRRES=$PIECE(BLRORG,U,2)
SET BLRORG=+BLRORG
DO LOOKORG
IF BLRSPT'=17
DO ANTIB
+3 QUIT
+4 ;
ANTIB ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER ANTIB^BLRTNM")
+2 SET BLRPAR=$ORDER(^BLRTXLOG("AOG",BLRACCN,BLRORG,""))
+3 ; S BLRANTI=1 F S BLRANTI=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,BLRANTI)) Q:(BLRANTI=""!($L(BLRANTI)=1)) S BLRRES=$P(^(BLRANTI),U,1) S:BLRGBL'=11 BLRANTP=$O(^LAB(62.06,"AD",BLRANTI,"")) D:BLRGBL=11 GETANAME D LOOKDRG S BLRERFS="" K BLRERF
+4 ; ----- BEGIN IHS/OIT/MKK LR*5.2*1025 -- Need to bypass non-existent Drug Nodes in the ANTIMICROBIAL SUSCEPTIBILITY dictionary
+5 SET BLRANTI=1
+6 FOR
SET BLRANTI=$ORDER(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,BLRANTI))
IF (BLRANTI=""!($LENGTH(BLRANTI)=1))
QUIT
Begin DoDot:1
+7 SET BLRRES=$PIECE($GET(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,BLRANTI)),U,1)
+8 IF BLRGBL'=11
SET BLRANTP=$ORDER(^LAB(62.06,"AD",BLRANTI,""))
+9 IF BLRGBL=11
DO GETANAME
+10 IF $GET(BLRANTP)'=""
DO LOOKDRG
+11 SET BLRERFS=""
+12 KILL BLRERF
End DoDot:1
+13 ; ----- END IHS/OIT/MKK LR*5.2*1025 -- Need to bypass non-existent Antibiotics
+14 SET (BLRANTI,BLRANTP)=""
+15 QUIT
GETANAME ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER GETANAME^BLRTNM")
+2 SET BLRANTP=BLRANTI
+3 SET BLRANTN=^UTILITY("TB",$JOB,BLRANTP)
+4 SET X=BLRANTN
SET DIC=62.06
SET DIC(0)="MX"
DO ^DIC
+5 IF Y'=-1
SET BLRANTP=$PIECE(Y,U,1)
QUIT
+6 SET BLRERFS="Field 1302 of file 9009022 not a valid antibiotic ien"
SET BLRERF=1
+7 QUIT
+8 ;
LOOKTST ;
+1 ; ----- BEGIN IHS/OIT/MKK LR*5.2*1026 - Make sure BLRTEST variable exists
+2 IF +$GET(BLRTEST)<1
QUIT
+3 ; ----- BEGIN IHS/OIT/MKK LR*5.2*1026 MODIFICATIONS
+4 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER LOOKTST^BLRTNM")
+5 SET BLRSETP=1
+6 IF '$DATA(^BLRTXLOG("AAT",BLRACCN,BLRTEST))
SET BLRPAR=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRCULT,""))
DO ^BLRTNM1
QUIT
+7 DO BLDMSTR
+8 QUIT
LOOKORG ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER LOOKORG^BLRTNM")
+2 IF '$DATA(^BLRTXLOG("AOG",BLRACCN,BLRORG))
SET BLRPAR=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRCULT,""))
DO ^BLRTNM1
QUIT
+3 DO BLDMSTR
+4 QUIT
+5 ;
LOOKDRG ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER LOOKDRG^BLRTNM")
+2 IF '$DATA(^BLRTXLOG("AOD",BLRACCN,BLRORG,BLRANTP))
DO ^BLRTNM1
QUIT
+3 DO BLDMSTR
+4 QUIT
+5 ;
LOOKSTG ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER LOOKSTG^BLRTNM")
+2 IF '$DATA(^BLRTXLOG("AOS",BLRACCN,BLRORG,BLRSTG))
DO ^BLRTNM1
QUIT
+3 DO BLDMSTR
+4 QUIT
BLDMSTR ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER BLDMSTR^BLRTNM")
+2 SET BLRCMF="M"
+3 IF BLR60F
SET BLRCRSBS="""AAT"",BLRACCN,BLRTEST"
SET BLRDIR=-1
SET BLROKCK=""
SET BLRBADCK=""
SET BLR("PANEL/TEST POINTER")=BLRTEST
SET BLR("PANEL/TEST NAME")=BLRTESTN
SET BLR("RESULT")=BLRRES
IF BLRCMTS'=""
SET BLR("COMMENTS")=BLRCMTS
+4 IF 'BLR60F
Begin DoDot:1
+5 IF BLRSPT'=6
Begin DoDot:2
+6 ;S BLRSTR="SEQUENCE NUMBER_$$GETOGIEN(BLRACCN,BLRORG"_$S(BLRANTI="":")",1:",BLRANTP)~ANTIBIOTIC_BLRANTP")_"~STATUS FLAG_BLRPHASE~RESULT_BLRRES~ORGANISM_BLRORG~ANTIBIOTIC NAME_BLRANTN~PCC ERROR FLAG_BLRERFS" Q
+7 SET BLRCRSBS=""""_$SELECT(BLRANTP'="":"AOD",1:"AOG")_""",BLRACCN,BLRORG"
SET BLRDIR=-1
SET BLROKCK="CHKDT"
SET BLRBADCK=""
+8 SET BLR("RESULT")=BLRRES
SET BLR("ORGANISM")=BLRORG
SET BLR("ANTIBIOTIC NAME")=BLRANTN
SET BLR("PCC ERROR FLAG")=BLRERFS
+9 IF BLRANTP'=""
SET BLRCRSBS=BLRCRSBS_",BLRANTP"
SET BLR("ANTIBIOTIC")=BLRANTP
End DoDot:2
QUIT
+10 ;S BLRSTR="SEQUENCE NUMBER_$$GETOSIEN(BLRACCN,BLRORG"_$S(BLRSTG="":")",1:",BLRSTG)~STAGE COUNTER_BLRSTG")_"~STATUS FLAG_BLRPHASE~RESULT_BLRRES~ORGANISM_BLRORG" S:BLRSTGN'="" BLRSTR=BLRSTR_"~STAGE NAME_BLRSTGN" Q
+11 SET BLRCRSBS=""""_$SELECT(BLRSTG'="":"AOS",1:"AOG")_""",BLRACCN,BLRORG"
SET BLRDIR=-1
SET BLROKCK="CHKDT"
SET BLRBADCK=""
+12 SET BLR("RESULT")=BLRRES
SET BLR("ORGANISM")=BLRORG
IF BLRSTGN'=""
SET BLR("STAGE NAME")=BLRSTGN
QUIT
+13 IF BLRSTG'=""
SET BLRCRSBS=BLRCRSBS_",BLRSTG"
SET BLR("STAGE COUNTER")=BLRSTG
End DoDot:1
+14 SET BLR("COLLECTION SAMPLE POINTER")=BLRCOLSP
IF +BLRCMPD
SET BLR("COMPLETE DATE")=BLRCMPD
+15 SET BLR("SEQUENCE NUMBER")=$$GETIEN
IF 'BLRERR
DO ^BLRNFLTL
+16 SET BLRCMTS=""
+17 KILL BLR
+18 QUIT
+19 ;
GETRES(BLRRSUB) ;
+1 ;
+2 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER GETRES^BLRTNM")
+3 SET BLRYY=0
FOR BLRI=1:1
SET BLRYY=$ORDER(^LR(BLRLRDFN,"MI",BLRIDT,BLRRSUB,BLRYY))
IF BLRYY=""
QUIT
IF BLRI>1
SET BLRCMTS=BLRCMTS_$CHAR(20)
SET BLRCMTS=BLRCMTS_^LR(BLRLRDFN,"MI",BLRIDT,BLRRSUB,BLRYY,0)
+4 IF BLRCMTS'=""
SET BLRRES="POSITIVE"
+5 KILL BLRI
+6 QUIT
+7 ;
GETIEN() ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER GETIEN^BLRTNM")
+2 SET BLRERR=0
IF BLRCMF="C"
DO GETNEW
QUIT BLRENT
+3 Begin DoDot:1
+4 SET BLRCRGL="^BLRTXLOG("_BLRCRSBS_")"
SET BLRENT=$ORDER(@BLRCRGL@(""),BLRDIR)
+5 IF 'BLRENT
SET BLRERR=1
+6 IF BLRENT
IF BLROKCK'=""
DO @BLROKCK
+7 IF 'BLRERR
IF BLRBADCK'=""
DO @BLRBADCK
+8 IF BLRERR
DO EMSG
QUIT
+9 SET BLRIEN=BLRENT_","
QUIT
End DoDot:1
+10 QUIT BLRENT
+11 ;
GETNEW ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER GETNEW^BLRTNM")
+2 SET BLRENT=$GET(^BLRTXLOG("SEQ"))
+3 IF 'BLRENT
SET BLRENT=$ORDER(^BLRTXLOG("@"),-1)
IF BLRENT
IF '$DATA(^BLRTXLOG(1))
SET BLRENT=0
+4 FOR BLRENT=BLRENT+1:1
IF '$DATA(^BLRTXLOG(BLRENT))
QUIT
+5 SET BLRENTS="BLRENTS"
SET BLRENTS(1)=BLRENT
SET ^BLRTXLOG("SEQ")=BLRENT
SET BLRIEN="+1,"
+6 QUIT
+7 ;
CHKDT ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ENTER CHKDT^BLRTNM")
+2 SET BLRCDT=$PIECE(^BLRTXLOG(BLRENT,12),U)
+3 IF $EXTRACT(BLRCDT,1,3)=$EXTRACT(DT,1,3)
QUIT
+4 ;MORE THAN 1 YEAR AHEAD
IF ($EXTRACT(BLRCDT,1,3)+1)'=$EXTRACT(DT,1,3)
SET BLRERR=1
SET BLRDTER=1
QUIT
+5 IF $EXTRACT(BLRCDT,4,5)<11
SET BLRERR=1
SET BLRDTER=1
QUIT
+6 QUIT
+7 ;
EMSG ;
+1 ; Log an error because the crossreference isn't set.
+2 IF 'BLRENT
Begin DoDot:1
+3 SET BLRERR=1
SET BLRERROR(1)="Something wrong -- problem with IHS Lab Transaction Log Cross Reference: "_BLRCRGL
End DoDot:1
+4 QUIT
+5 ;
+6 ;
KILL ;
+1 KILL BLR60F,BLRANTI,BLRANTP,BLRATOM,BLRCAT,BLRCLNC,BLRCMTS,BLRCPTC,BLRCPTF,BLRCPTP,BLRCPTS,BLRCST,BLRCULT,BLRLRDFN,BLRDTC,BLRDUZ,BLRDUZ2,BLRDUZN,BLRENT,BLREXEC,BLRFID,BLRFILE,BLRFOUND,BLRANTN,BLRERFS,BLRERF
+2 KILL BLRGBL,BLRIDT,BLRL60,BLRLOC,BLRLOCN,BLRLOGDA,BLRLRDFN,BLRODT,BLRODTM,BLRORG,BLRORGX,BLRPAR,BLRPROV,BLRPROVN,BLRRES,BLRSEQ,BLRSETP,BLRSPEC,BLRSPT,BLRSTG,BLRSTGN,BLRSTR,BLRSTR1,BLRTEST
+3 KILL BLRTEST1,BLRTESTN,BLRUNITS,BLRVAL,BLRXII,BLRYY,BLRZ,BLRCMPD,BLRCOLSP
+4 QUIT
