- 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
