BLRMLTL ; IHS/DIR/FJE - SET IHS LAB TRANSACTION LOG - MICRO ; [ 11/18/2002 2:03 PM ]
;;5.2;BLR;**1001,1014,1015**;NOV 18, 2002
;
;S BLRIDT=LRIDT,(BLRTEST,BLRCULT)=$S($D(LRTS):LRTS,1:LRTEST),(BLRRES,BLRTESTN,BLRANTI,BLRANTN,BLRANTP,BLRSTGN,BLRORG,BLRSTG,BLRCMTS)=""
S BLRIDT=LRIDT,(BLRTEST,BLRCULT)=$S($D(LRTS):LRTS,1:LRTEST),(BLRCMPD,BLRCOLSP,BLRRES,BLRTESTN,BLRANTI,BLRANTN,BLRANTP,BLRSTGN,BLRORG,BLRSTG,BLRCMTS)="" ;IHS/DIR TUC/AAB 04/08/98
S BLREXEC=$P(^LAB(60,BLRTEST,0),U,14),BLRGBL=$P($P($P(^LAB(62.07,BLREXEC,.1),"/"),"=",2),"""",2),BLRGBL=$P($P(^DD(63.05,BLRGBL,0),U,4),";",1)
S BLRVAL=$G(^LR(LRDFN,"MI",BLRIDT,BLRGBL))
Q:(BLRVAL=""!($P(BLRVAL,U,2)'="F"))
;S BLRACCN=$P(^LR(LRDFN,"MI",BLRIDT,0),U,6),BLR60F=1,BLRSETP=0,BLRERFS=""
S BLRACCN=^LR(LRDFN,"MI",BLRIDT,0),BLRCOLSP=$P(BLRACCN,U,11),BLRACCN=$P(BLRACCN,U,6),BLR60F=1,BLRSETP=0,BLRERFS="" ;IHS/DIR TUC/AAB 04/09/98
S:+BLRTEST BLRCMPD=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,BLRTEST,0)),U,5) ;IHS/DIR TUC/AAB 04/09/98
;D
I BLRTEST'="",$D(^BLRTXLOG("AAT",BLRACCN,BLRTEST)) D ;IHS/DIR TUC/AAB 04/09/98
.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 ;
S BLRRES="NEGATIVE"
I $D(^LR(LRDFN,"MI",BLRIDT,25)) D GETRES(25) D BLDMSTR Q
I $D(^LR(LRDFN,"MI",BLRIDT,2)) D GETRES(2) S BLRTESTN="GRAM STAIN",BLRTEST=$$GETTEST(BLRTESTN) D:BLRCULT=BLRTEST BLDMSTR Q:BLRCULT=BLRTEST D LOOKTST
S BLRTESTN="",BLRRES="NEGATIVE",BLRTEST=BLRCULT
I '$D(^LR(LRDFN,"MI",BLRIDT,3)) D BLDMSTR Q
I $D(^LR(LRDFN,"MI",BLRIDT,3)),$P(^LR(LRDFN,"MI",BLRIDT,3,0),U,3)="" D BLDMSTR Q
I $D(^LR(LRDFN,"MI",BLRIDT,3)),$P(^LR(LRDFN,"MI",BLRIDT,3,0),U,4)=0 D BLDMSTR Q ;organism deleted
S BLRRES="POSITIVE",BLRTEST=LRTS D BLDMSTR S BLRSPT=3 D ORG Q
Q
;
PARAS ;
S BLRRES="NEGATIVE"
I $D(^LR(LRDFN,"MI",BLRIDT,24)) D GETRES(24),BLDMSTR Q
I '$D(^LR(LRDFN,"MI",BLRIDT,6)) D BLDMSTR Q
I $D(^LR(LRDFN,"MI",BLRIDT,6)),$P(^LR(LRDFN,"MI",BLRIDT,6,0),U,3)="" D BLDMSTR Q
S BLRRES="POSITIVE" D BLDMSTR S BLRSPT=6 D PARAS1 Q
Q
;
PARAS1 ;
S (BLRORGX,BLR60F)=0 F S BLRORGX=$O(^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX)) Q:(BLRORGX'?.N!(BLRORGX="")) S BLRORG=^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,0),BLRRES="",BLRORG=+BLRORG D LOOKORG,PARAS2
Q
PARAS2 ;
S BLRPAR=$O(^BLRTXLOG("AOG",BLRACCN,BLRORG,""))
S BLRSTG=0 F S BLRSTG=$O(^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,1,BLRSTG)) Q:(BLRSTG=""!(BLRSTG'?.N)) D
.S BLRSTGN=^LR(LRDFN,"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 ;
S BLRRES="NEGATIVE"
I $D(^LR(LRDFN,"MI",BLRIDT,15)) D GETRES(15) D BLDMSTR Q
I '$D(^LR(LRDFN,"MI",BLRIDT,9)) D BLDMSTR Q
I $D(^LR(LRDFN,"MI",BLRIDT,9)),$P(^LR(LRDFN,"MI",BLRIDT,9,0),U,3)="" D BLDMSTR Q
S BLRRES="POSITIVE" D BLDMSTR S BLRSPT=9 D ORG Q
Q
;
TB ;
I ($P(BLRVAL,U,3)'=""!($P(BLRVAL,U,4)'="")) D GETFSTAI
I BLRCULT=BLRTEST,BLRRES'="" Q
S BLRTEST=BLRCULT,BLRTESTN=""
I '$D(^LR(LRDFN,"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 ;
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 ;
S BLRTESTN="ACID FAST STAIN" S BLRTEST=$$GETTEST(BLRTESTN) I BLRTEST="" S BLRTESTN="AFB SMEAR" S BLRTEST=$$GETTEST(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 ;
S BLRRES="NEGATIVE"
I '$D(^LR(LRDFN,"MI",BLRIDT,17)) D BLDMSTR Q
I $D(^LR(LRDFN,"MI",BLRIDT,17)),$P(^LR(LRDFN,"MI",BLRIDT,17,0),U,3)="" D BLDMSTR Q
S BLRRES="POSITIVE" D BLDMSTR S BLRSPT=17 D ORG Q
Q
;
ORG ;
S (BLRORGX,BLR60F)=0 F S BLRORGX=$O(^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX)) Q:(BLRORGX'?.N!(BLRORGX="")) S BLRORG=^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,0) S BLRRES=$P(BLRORG,U,2),BLRORG=+BLRORG D LOOKORG D:BLRSPT'=17 ANTIB
Q
;
ANTIB ;
S BLRPAR=$O(^BLRTXLOG("AOG",BLRACCN,BLRORG,""))
S BLRANTI=1 F S BLRANTI=$O(^LR(LRDFN,"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
S (BLRANTI,BLRANTP)=""
Q
GETANAME ;
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 ;
S BLRSETP=1
I '$D(^BLRTXLOG("AAT",BLRACCN,BLRTEST)) S BLRPAR=$O(^BLRTXLOG("AAT",BLRACCN,BLRCULT,"")) D ^BLRMLTL1 Q
D BLDMSTR
Q
LOOKORG ;
I '$D(^BLRTXLOG("AOG",BLRACCN,BLRORG)) S BLRPAR=$O(^BLRTXLOG("AAT",BLRACCN,BLRCULT,"")) D ^BLRMLTL1 Q
D BLDMSTR
Q
;
LOOKDRG ;
I '$D(^BLRTXLOG("AOD",BLRACCN,BLRORG,BLRANTP)) D ^BLRMLTL1 Q
D BLDMSTR
Q
;
LOOKSTG ;
I '$D(^BLRTXLOG("AOS",BLRACCN,BLRORG,BLRSTG)) D ^BLRMLTL1 Q
D BLDMSTR
Q
BLDMSTR ;
S:BLR60F BLRSTR="SEQUENCE NUMBER_$$GETIEN(BLRACCN,BLRTEST)~STATUS FLAG_BLRPHASE~PANEL/TEST POINTER_BLRTEST~PANEL/TEST NAME_BLRTESTN~RESULT_BLRRES" S:BLRCMTS'="" BLRSTR=BLRSTR_"~COMMENTS_BLRCMTS"
I 'BLR60F D
.I BLRSPT'=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
.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 BLRSTR=BLRSTR_"~COLLECTION SAMPLE POINTER_BLRCOLSP" S:+BLRCMPD BLRSTR=BLRSTR_"~COMPLETE DATE_BLRCMPD" ;IHS/DIR TUC/AAB 04/08/98
D ^BLRFLTL("M",BLRSTR)
S BLRCMTS=""
Q
;
GETTEST(BLRTESTN) ;
Q $O(^LAB(60,"B",BLRTESTN,""))
;
GETRES(BLRRSUB) ;
;
S BLRYY=0 F BLRI=1:1 S BLRYY=$O(^LR(LRDFN,"MI",BLRIDT,BLRRSUB,BLRYY)) Q:BLRYY="" S:BLRI>1 BLRCMTS=BLRCMTS_$C(20) S BLRCMTS=BLRCMTS_^LR(LRDFN,"MI",BLRIDT,BLRRSUB,BLRYY,0)
I BLRCMTS'="" S BLRRES="POSITIVE"
K BLRI
Q
;
KILL ;
K BLR60F,BLRACCN,BLRANTI,BLRANTP,BLRATOM,BLRCAT,BLRCLNC,BLRCMTS,BLRCPTC,BLRCPTF,BLRCPTP,BLRCPTS,BLRCST,BLRCULT,BLRDFN,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,BLRQUIET,BLRRES,BLRSEQ,BLRSETP,BLRSPEC,BLRSPT,BLRSTG,BLRSTGN,BLRSTR,BLRSTR1,BLRTEST
;K BLRTEST1,BLRTESTN,BLRUNITS,BLRVAL,BLRXII,BLRYY,BLRZ
K BLRTEST1,BLRTESTN,BLRUNITS,BLRVAL,BLRXII,BLRYY,BLRZ,BLRCMPD,BLRCOLSP ;IHS/DIR TUC/AAB 04/08/98
Q
BLRMLTL ; IHS/DIR/FJE - SET IHS LAB TRANSACTION LOG - MICRO ; [ 11/18/2002 2:03 PM ]
+1 ;;5.2;BLR;**1001,1014,1015**;NOV 18, 2002
+2 ;
+3 ;S BLRIDT=LRIDT,(BLRTEST,BLRCULT)=$S($D(LRTS):LRTS,1:LRTEST),(BLRRES,BLRTESTN,BLRANTI,BLRANTN,BLRANTP,BLRSTGN,BLRORG,BLRSTG,BLRCMTS)=""
+4 ;IHS/DIR TUC/AAB 04/08/98
SET BLRIDT=LRIDT
SET (BLRTEST,BLRCULT)=$SELECT($DATA(LRTS):LRTS,1:LRTEST)
SET (BLRCMPD,BLRCOLSP,BLRRES,BLRTESTN,BLRANTI,BLRANTN,BLRANTP,BLRSTGN,BLRORG,BLRSTG,BLRCMTS)=""
+5 SET BLREXEC=$PIECE(^LAB(60,BLRTEST,0),U,14)
SET BLRGBL=$PIECE($PIECE($PIECE(^LAB(62.07,BLREXEC,.1),"/"),"=",2),"""",2)
SET BLRGBL=$PIECE($PIECE(^DD(63.05,BLRGBL,0),U,4),";",1)
+6 SET BLRVAL=$GET(^LR(LRDFN,"MI",BLRIDT,BLRGBL))
+7 IF (BLRVAL=""!($PIECE(BLRVAL,U,2)'="F"))
QUIT
+8 ;S BLRACCN=$P(^LR(LRDFN,"MI",BLRIDT,0),U,6),BLR60F=1,BLRSETP=0,BLRERFS=""
+9 ;IHS/DIR TUC/AAB 04/09/98
SET BLRACCN=^LR(LRDFN,"MI",BLRIDT,0)
SET BLRCOLSP=$PIECE(BLRACCN,U,11)
SET BLRACCN=$PIECE(BLRACCN,U,6)
SET BLR60F=1
SET BLRSETP=0
SET BLRERFS=""
+10 ;IHS/DIR TUC/AAB 04/09/98
IF +BLRTEST
SET BLRCMPD=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,BLRTEST,0)),U,5)
+11 ;D
+12 ;IHS/DIR TUC/AAB 04/09/98
IF BLRTEST'=""
IF $DATA(^BLRTXLOG("AAT",BLRACCN,BLRTEST))
Begin DoDot:1
+13 IF BLRGBL=1
DO BACT
QUIT
+14 IF BLRGBL=5
DO PARAS
QUIT
+15 IF BLRGBL=8
DO MYCOL
QUIT
+16 IF BLRGBL=11
DO TB
QUIT
+17 IF BLRGBL=16
DO VIROL
QUIT
End DoDot:1
+18 DO KILL
+19 QUIT
+20 ;
BACT ;
+1 SET BLRRES="NEGATIVE"
+2 IF $DATA(^LR(LRDFN,"MI",BLRIDT,25))
DO GETRES(25)
DO BLDMSTR
QUIT
+3 IF $DATA(^LR(LRDFN,"MI",BLRIDT,2))
DO GETRES(2)
SET BLRTESTN="GRAM STAIN"
SET BLRTEST=$$GETTEST(BLRTESTN)
IF BLRCULT=BLRTEST
DO BLDMSTR
IF BLRCULT=BLRTEST
QUIT
DO LOOKTST
+4 SET BLRTESTN=""
SET BLRRES="NEGATIVE"
SET BLRTEST=BLRCULT
+5 IF '$DATA(^LR(LRDFN,"MI",BLRIDT,3))
DO BLDMSTR
QUIT
+6 IF $DATA(^LR(LRDFN,"MI",BLRIDT,3))
IF $PIECE(^LR(LRDFN,"MI",BLRIDT,3,0),U,3)=""
DO BLDMSTR
QUIT
+7 ;organism deleted
IF $DATA(^LR(LRDFN,"MI",BLRIDT,3))
IF $PIECE(^LR(LRDFN,"MI",BLRIDT,3,0),U,4)=0
DO BLDMSTR
QUIT
+8 SET BLRRES="POSITIVE"
SET BLRTEST=LRTS
DO BLDMSTR
SET BLRSPT=3
DO ORG
QUIT
+9 QUIT
+10 ;
PARAS ;
+1 SET BLRRES="NEGATIVE"
+2 IF $DATA(^LR(LRDFN,"MI",BLRIDT,24))
DO GETRES(24)
DO BLDMSTR
QUIT
+3 IF '$DATA(^LR(LRDFN,"MI",BLRIDT,6))
DO BLDMSTR
QUIT
+4 IF $DATA(^LR(LRDFN,"MI",BLRIDT,6))
IF $PIECE(^LR(LRDFN,"MI",BLRIDT,6,0),U,3)=""
DO BLDMSTR
QUIT
+5 SET BLRRES="POSITIVE"
DO BLDMSTR
SET BLRSPT=6
DO PARAS1
QUIT
+6 QUIT
+7 ;
PARAS1 ;
+1 SET (BLRORGX,BLR60F)=0
FOR
SET BLRORGX=$ORDER(^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX))
IF (BLRORGX'?.N!(BLRORGX=""))
QUIT
SET BLRORG=^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,0)
SET BLRRES=""
SET BLRORG=+BLRORG
DO LOOKORG
DO PARAS2
+2 QUIT
PARAS2 ;
+1 SET BLRPAR=$ORDER(^BLRTXLOG("AOG",BLRACCN,BLRORG,""))
+2 SET BLRSTG=0
FOR
SET BLRSTG=$ORDER(^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,1,BLRSTG))
IF (BLRSTG=""!(BLRSTG'?.N))
QUIT
Begin DoDot:1
+3 SET BLRSTGN=^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,1,BLRSTG,0)
+4 SET BLRRES=$PIECE(BLRSTGN,U,2)
SET BLRSTGN=$PIECE(BLRSTGN,U,1)
+5 DO LOOKSTG
SET BLRSTGN=""
QUIT
End DoDot:1
+6 SET BLRSTG=""
+7 QUIT
+8 ;
MYCOL ;
+1 SET BLRRES="NEGATIVE"
+2 IF $DATA(^LR(LRDFN,"MI",BLRIDT,15))
DO GETRES(15)
DO BLDMSTR
QUIT
+3 IF '$DATA(^LR(LRDFN,"MI",BLRIDT,9))
DO BLDMSTR
QUIT
+4 IF $DATA(^LR(LRDFN,"MI",BLRIDT,9))
IF $PIECE(^LR(LRDFN,"MI",BLRIDT,9,0),U,3)=""
DO BLDMSTR
QUIT
+5 SET BLRRES="POSITIVE"
DO BLDMSTR
SET BLRSPT=9
DO ORG
QUIT
+6 QUIT
+7 ;
TB ;
+1 IF ($PIECE(BLRVAL,U,3)'=""!($PIECE(BLRVAL,U,4)'=""))
DO GETFSTAI
+2 IF BLRCULT=BLRTEST
IF BLRRES'=""
QUIT
+3 SET BLRTEST=BLRCULT
SET BLRTESTN=""
+4 IF '$DATA(^LR(LRDFN,"MI",BLRIDT,12))
SET BLRRES="NEGATIVE"
DO BLDMSTR
QUIT
+5 IF '$DATA(^UTILITY("TB",$JOB))
DO BLDTB
+6 SET BLRRES="POSITIVE"
DO BLDMSTR
SET BLRSPT=12
DO ORG
QUIT
+7 QUIT
+8 ;
BLDTB ;
+1 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)
+2 KILL BLRFLD,BLRPX
+3 QUIT
GETFSTAI ;
+1 SET BLRTESTN="ACID FAST STAIN"
SET BLRTEST=$$GETTEST(BLRTESTN)
IF BLRTEST=""
SET BLRTESTN="AFB SMEAR"
SET BLRTEST=$$GETTEST(BLRTESTN)
+2 SET BLRRES=$PIECE(BLRVAL,U,3)
IF BLRRES'=""
IF $PIECE(BLRVAL,U,4)'=""
SET BLRRES=BLRRES_";"_$PIECE(BLRVAL,U,4)
+3 IF BLRRES=""
SET BLRRES=$PIECE(BLRVAL,U,4)
+4 DO LOOKTST
+5 QUIT
VIROL ;
+1 SET BLRRES="NEGATIVE"
+2 IF '$DATA(^LR(LRDFN,"MI",BLRIDT,17))
DO BLDMSTR
QUIT
+3 IF $DATA(^LR(LRDFN,"MI",BLRIDT,17))
IF $PIECE(^LR(LRDFN,"MI",BLRIDT,17,0),U,3)=""
DO BLDMSTR
QUIT
+4 SET BLRRES="POSITIVE"
DO BLDMSTR
SET BLRSPT=17
DO ORG
QUIT
+5 QUIT
+6 ;
ORG ;
+1 SET (BLRORGX,BLR60F)=0
FOR
SET BLRORGX=$ORDER(^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX))
IF (BLRORGX'?.N!(BLRORGX=""))
QUIT
SET BLRORG=^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,0)
SET BLRRES=$PIECE(BLRORG,U,2)
SET BLRORG=+BLRORG
DO LOOKORG
IF BLRSPT'=17
DO ANTIB
+2 QUIT
+3 ;
ANTIB ;
+1 SET BLRPAR=$ORDER(^BLRTXLOG("AOG",BLRACCN,BLRORG,""))
+2 SET BLRANTI=1
FOR
SET BLRANTI=$ORDER(^LR(LRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,BLRANTI))
IF (BLRANTI=""!($LENGTH(BLRANTI)=1))
QUIT
SET BLRRES=$PIECE(^(BLRANTI),U,1)
IF BLRGBL'=11
SET BLRANTP=$ORDER(^LAB(62.06,"AD",BLRANTI,""))
IF BLRGBL=11
DO GETANAME
DO LOOKDRG
SET BLRERFS=""
KILL BLRERF
+3 SET (BLRANTI,BLRANTP)=""
+4 QUIT
GETANAME ;
+1 SET BLRANTP=BLRANTI
+2 SET BLRANTN=^UTILITY("TB",$JOB,BLRANTP)
+3 SET X=BLRANTN
SET DIC=62.06
SET DIC(0)="MX"
DO ^DIC
+4 IF Y'=-1
SET BLRANTP=$PIECE(Y,U,1)
QUIT
+5 SET BLRERFS="Field 1302 of file 9009022 not a valid antibiotic ien"
SET BLRERF=1
+6 QUIT
+7 ;
LOOKTST ;
+1 SET BLRSETP=1
+2 IF '$DATA(^BLRTXLOG("AAT",BLRACCN,BLRTEST))
SET BLRPAR=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRCULT,""))
DO ^BLRMLTL1
QUIT
+3 DO BLDMSTR
+4 QUIT
LOOKORG ;
+1 IF '$DATA(^BLRTXLOG("AOG",BLRACCN,BLRORG))
SET BLRPAR=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRCULT,""))
DO ^BLRMLTL1
QUIT
+2 DO BLDMSTR
+3 QUIT
+4 ;
LOOKDRG ;
+1 IF '$DATA(^BLRTXLOG("AOD",BLRACCN,BLRORG,BLRANTP))
DO ^BLRMLTL1
QUIT
+2 DO BLDMSTR
+3 QUIT
+4 ;
LOOKSTG ;
+1 IF '$DATA(^BLRTXLOG("AOS",BLRACCN,BLRORG,BLRSTG))
DO ^BLRMLTL1
QUIT
+2 DO BLDMSTR
+3 QUIT
BLDMSTR ;
+1 IF BLR60F
SET BLRSTR="SEQUENCE NUMBER_$$GETIEN(BLRACCN,BLRTEST)~STATUS FLAG_BLRPHASE~PANEL/TEST POINTER_BLRTEST~PANEL/TEST NAME_BLRTESTN~RESULT_BLRRES"
IF BLRCMTS'=""
SET BLRSTR=BLRSTR_"~COMMENTS_BLRCMTS"
+2 IF 'BLR60F
Begin DoDot:1
+3 IF BLRSPT'=6
SET BLRSTR="SEQUENCE NUMBER_$$GETOGIEN(BLRACCN,BLRORG"_$SELECT(BLRANTI="":")",1:",BLRANTP)~ANTIBIOTIC_BLRANTP")_"~STATUS FLAG_BLRPHASE~RESULT_BLRRES~ORGANISM_BLRORG~ANTIBIOTIC NAME_BLRANTN~PCC ERROR FLAG_BLRERFS"
QUIT
+4 SET BLRSTR="SEQUENCE NUMBER_$$GETOSIEN(BLRACCN,BLRORG"_$SELECT(BLRSTG="":")",1:",BLRSTG)~STAGE COUNTER_BLRSTG")_"~STATUS FLAG_BLRPHASE~RESULT_BLRRES~ORGANISM_BLRORG"
IF BLRSTGN'=""
SET BLRSTR=BLRSTR_"~STAGE NAME_BLRSTGN"
QUIT
End DoDot:1
+5 ;IHS/DIR TUC/AAB 04/08/98
SET BLRSTR=BLRSTR_"~COLLECTION SAMPLE POINTER_BLRCOLSP"
IF +BLRCMPD
SET BLRSTR=BLRSTR_"~COMPLETE DATE_BLRCMPD"
+6 DO ^BLRFLTL("M",BLRSTR)
+7 SET BLRCMTS=""
+8 QUIT
+9 ;
GETTEST(BLRTESTN) ;
+1 QUIT $ORDER(^LAB(60,"B",BLRTESTN,""))
+2 ;
GETRES(BLRRSUB) ;
+1 ;
+2 SET BLRYY=0
FOR BLRI=1:1
SET BLRYY=$ORDER(^LR(LRDFN,"MI",BLRIDT,BLRRSUB,BLRYY))
IF BLRYY=""
QUIT
IF BLRI>1
SET BLRCMTS=BLRCMTS_$CHAR(20)
SET BLRCMTS=BLRCMTS_^LR(LRDFN,"MI",BLRIDT,BLRRSUB,BLRYY,0)
+3 IF BLRCMTS'=""
SET BLRRES="POSITIVE"
+4 KILL BLRI
+5 QUIT
+6 ;
KILL ;
+1 KILL BLR60F,BLRACCN,BLRANTI,BLRANTP,BLRATOM,BLRCAT,BLRCLNC,BLRCMTS,BLRCPTC,BLRCPTF,BLRCPTP,BLRCPTS,BLRCST,BLRCULT,BLRDFN,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,BLRQUIET,BLRRES,BLRSEQ,BLRSETP,BLRSPEC,BLRSPT,BLRSTG,BLRSTGN,BLRSTR,BLRSTR1,BLRTEST
+3 ;K BLRTEST1,BLRTESTN,BLRUNITS,BLRVAL,BLRXII,BLRYY,BLRZ
+4 ;IHS/DIR TUC/AAB 04/08/98
KILL BLRTEST1,BLRTESTN,BLRUNITS,BLRVAL,BLRXII,BLRYY,BLRZ,BLRCMPD,BLRCOLSP
+5 QUIT
