- LR7OSMZ5 ;slc/dcm - Silent Micro rpt - BACTERIA, ANTIBIOTICS ;8/11/97
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;5.2;LAB SERVICE;**121,187,244**;Sep 27, 1994
- BACT ;from LR7OSMZ2
- Q:+$O(^LR(LRDFN,"MI",LRIDT,3,0))<1
- S LRFMT=$P(^LAB(69.9,1,0),U,11),LRFMT=$S(LRFMT="":"I",1:LRFMT)
- K LRRES,LRINT
- N X,LRBUG,LRABCNT,LRBN,LRAO,LRACNT
- S (LRBUG,LRABCNT,LRBN,LRAO,LRACNT)=0
- F A=1:1 S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 S:+$O(^(LRBUG,2))'["2." A=A-1 I +$O(^(2))["2." D CHECK
- F S LRBN=+$O(LRRES(LRBN)) Q:LRBN<1 S LRABCNT=LRABCNT+1
- Q:'LRABCNT!($G(LREND))
- D LINE^LR7OSUM4,LINE^LR7OSUM4
- S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"ANTIBIOTIC SUSCEPTIBILITY TEST RESULTS:")
- D BUGHDR
- S LRCOMTAB=$S(LRFMT="B":A*13+17,1:A*5+17)
- F S LRAO=$O(^LAB(62.06,"AO",LRAO)) Q:LRAO<.001!($G(LREND)) S B=$O(^LAB(62.06,"AO",LRAO,0)) I B>0,$D(^LAB(62.06,B,0)) D AB
- D LINE^LR7OSUM4
- K LR1PASS,LRRES,LRINT
- Q
- CHECK ;
- N LRBN,LR1PASS,LRFLAG,B,B1,B2,B3
- S LRFLAG=0,LRBN=2
- F S LRBN=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN)) Q:LRBN'["2."!($G(LREND)) S B=^(LRBN),B1=$P(B,U),B2=$P(B,U,2) I $L(B1),$D(^LAB(62.06,"AI",LRBN,B1)) S X=^(B1) D FIRST
- S LRBN=2
- F S LRBN=+$O(LR1PASS(LRBN)) Q:LRBN<1!($G(LREND)) S B=LR1PASS(LRBN),B1=$P(B,U),B2=$P(B,U,2),B3=$P(B,U,3) D LAB
- Q
- FIRST ;
- S B2=$S(B2]"":B2,1:X),B3=$P(B,U,3)
- S:$E(B2)'="R"&("A"[B3) LRFLAG=1
- S LR1PASS(LRBN)=B1_U_B2_U_B3,^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN)=LR1PASS(LRBN)
- Q
- LAB ;
- I $D(^XUSEC("LRLAB",DUZ)),'$D(LRWRDVEW) S $P(LRRES(LRBN),U,A)=$S(B3="N"!(B3="R"&LRFLAG):B1_"*",1:B1),$P(LRINT(LRBN),U,A)=$S(B3="N"!(B3="R"&LRFLAG):B2_"*",1:B2) Q
- I B3=""!(B3="A")!(B3="R"&'LRFLAG) S $P(LRRES(LRBN),U,A)=B1,$P(LRINT(LRBN),U,A)=B2
- Q
- AB ;
- Q:$G(LREND)
- S X=^LAB(62.06,B,0),J=$P(X,U,2)
- I $D(LRINT(J)),LRINT(J)'?."^" D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,$E($P(X,U),1,14)) S LRDCOM=$P(X,U,3),LRACNT=LRACNT+1 D SIR
- Q
- BUGHDR ;
- S LRBUG=0
- F A=0:1 S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1!($G(LREND)) S LRORG=$P(^(LRBUG,0),U),LRORG=$P(^LAB(61.2,LRORG,0),U) S:+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2))'["2." A=A-1 I +$O(^(2))["2." D ORG
- I LRFMT="B" D LN^LR7OSMZ1 S ^TMP("LRC",$J,GCNT,0)="" F J=1:1:A S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(J-1*13+15,CCNT,":")
- D LN^LR7OSMZ1
- S ^TMP("LRC",$J,GCNT,0)=""
- F J=1:1:A D
- . I LRFMT'="B" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(J*5+10,CCNT,":")
- . I LRFMT="B" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(J-1*13+15,CCNT,"SUSC INTP")
- Q
- ORG ;
- D LINE^LR7OSUM4
- S ^TMP("LRC",$J,GCNT,0)=""
- F J=1:1:A S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS($S(LRFMT="B":J-1*13+15,1:J*5+10),CCNT,":") ;I A>0 BEFORE FOR LOOP
- S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS($S(LRFMT="B":A*13+15,1:A*5+15),CCNT,$S(LR2ORMOR:LRBUG_". ",1:"")_LRORG)
- Q
- SIR ;
- F II=1:1:10 D:$P(LRINT(J),U,II,10)="" DCOM Q:$P(LRINT(J),U,II,10)="" S:LRFMT'="B" ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(II*5+10,CCNT,$S(LRFMT="I":$P(LRINT(J),U,II),1:$P(LRRES(J),U,II))) I LRFMT="B" D SIR1
- Q
- DCOM ;
- S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCOMTAB,CCNT,LRDCOM) I $D(LRDCOM(J)) S K=0,A=0 D
- . F S A=+$O(LRDCOM(J,A)) Q:A<1 D:'('K&(LRDCOM="")) LINE^LR7OSUM4 S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCOMTAB,CCNT,LRDCOM(J,A)) S K=1
- Q
- SIR1 ;
- S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(II-1*13+15,CCNT,$S($D(LRRES(J)):$P(LRRES(J),U,II),1:""))_$$S^LR7OS(II-1*13+21,CCNT,$P(LRINT(J),U,II)_" ")
- Q
- D LINE^LR7OSUM4
- S X="",$P(X,"-",GIOM)="",^TMP("LRC",$J,GCNT,0)=X
- D LINE^LR7OSUM4
- S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"PATIENT'S IDENTIFICATION")_$$S^LR7OS(60,CCNT,"MICROBIOLOGY REPORT")
- D LINE^LR7OSUM4
- S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"ACCESSION: "_LRACC)_$$S^LR7OS(25,CCNT,"TAKEN:"_LRTK)_$$S^LR7OS(52,CCNT,"RECEIVED:"_LRRC)
- Q
- LR7OSMZ5 ;slc/dcm - Silent Micro rpt - BACTERIA, ANTIBIOTICS ;8/11/97
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**121,187,244**;Sep 27, 1994
- BACT ;from LR7OSMZ2
- +1 IF +$ORDER(^LR(LRDFN,"MI",LRIDT,3,0))<1
- QUIT
- +2 SET LRFMT=$PIECE(^LAB(69.9,1,0),U,11)
- SET LRFMT=$SELECT(LRFMT="":"I",1:LRFMT)
- +3 KILL LRRES,LRINT
- +4 NEW X,LRBUG,LRABCNT,LRBN,LRAO,LRACNT
- +5 SET (LRBUG,LRABCNT,LRBN,LRAO,LRACNT)=0
- +6 FOR A=1:1
- SET LRBUG=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG))
- IF LRBUG<1
- QUIT
- IF +$ORDER(^(LRBUG,2))'["2."
- SET A=A-1
- IF +$ORDER(^(2))["2."
- DO CHECK
- +7 FOR
- SET LRBN=+$ORDER(LRRES(LRBN))
- IF LRBN<1
- QUIT
- SET LRABCNT=LRABCNT+1
- +8 IF 'LRABCNT!($GET(LREND))
- QUIT
- +9 DO LINE^LR7OSUM4
- DO LINE^LR7OSUM4
- +10 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"ANTIBIOTIC SUSCEPTIBILITY TEST RESULTS:")
- +11 DO BUGHDR
- +12 SET LRCOMTAB=$SELECT(LRFMT="B":A*13+17,1:A*5+17)
- +13 FOR
- SET LRAO=$ORDER(^LAB(62.06,"AO",LRAO))
- IF LRAO<.001!($GET(LREND))
- QUIT
- SET B=$ORDER(^LAB(62.06,"AO",LRAO,0))
- IF B>0
- IF $DATA(^LAB(62.06,B,0))
- DO AB
- +14 DO LINE^LR7OSUM4
- +15 KILL LR1PASS,LRRES,LRINT
- +16 QUIT
- CHECK ;
- +1 NEW LRBN,LR1PASS,LRFLAG,B,B1,B2,B3
- +2 SET LRFLAG=0
- SET LRBN=2
- +3 FOR
- SET LRBN=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN))
- IF LRBN'["2."!($GET(LREND))
- QUIT
- SET B=^(LRBN)
- SET B1=$PIECE(B,U)
- SET B2=$PIECE(B,U,2)
- IF $LENGTH(B1)
- IF $DATA(^LAB(62.06,"AI",LRBN,B1))
- SET X=^(B1)
- DO FIRST
- +4 SET LRBN=2
- +5 FOR
- SET LRBN=+$ORDER(LR1PASS(LRBN))
- IF LRBN<1!($GET(LREND))
- QUIT
- SET B=LR1PASS(LRBN)
- SET B1=$PIECE(B,U)
- SET B2=$PIECE(B,U,2)
- SET B3=$PIECE(B,U,3)
- DO LAB
- +6 QUIT
- FIRST ;
- +1 SET B2=$SELECT(B2]"":B2,1:X)
- SET B3=$PIECE(B,U,3)
- +2 IF $EXTRACT(B2)'="R"&("A"[B3)
- SET LRFLAG=1
- +3 SET LR1PASS(LRBN)=B1_U_B2_U_B3
- SET ^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN)=LR1PASS(LRBN)
- +4 QUIT
- LAB ;
- +1 IF $DATA(^XUSEC("LRLAB",DUZ))
- IF '$DATA(LRWRDVEW)
- SET $PIECE(LRRES(LRBN),U,A)=$SELECT(B3="N"!(B3="R"&LRFLAG):B1_"*",1:B1)
- SET $PIECE(LRINT(LRBN),U,A)=$SELECT(B3="N"!(B3="R"&LRFLAG):B2_"*",1:B2)
- QUIT
- +2 IF B3=""!(B3="A")!(B3="R"&'LRFLAG)
- SET $PIECE(LRRES(LRBN),U,A)=B1
- SET $PIECE(LRINT(LRBN),U,A)=B2
- +3 QUIT
- AB ;
- +1 IF $GET(LREND)
- QUIT
- +2 SET X=^LAB(62.06,B,0)
- SET J=$PIECE(X,U,2)
- +3 IF $DATA(LRINT(J))
- IF LRINT(J)'?."^"
- DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,$EXTRACT($PIECE(X,U),1,14))
- SET LRDCOM=$PIECE(X,U,3)
- SET LRACNT=LRACNT+1
- DO SIR
- +4 QUIT
- BUGHDR ;
- +1 SET LRBUG=0
- +2 FOR A=0:1
- SET LRBUG=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG))
- IF LRBUG<1!($GET(LREND))
- QUIT
- SET LRORG=$PIECE(^(LRBUG,0),U)
- SET LRORG=$PIECE(^LAB(61.2,LRORG,0),U)
- IF +$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2))'["2."
- SET A=A-1
- IF +$ORDER(^(2))["2."
- DO ORG
- +3 IF LRFMT="B"
- DO LN^LR7OSMZ1
- SET ^TMP("LRC",$JOB,GCNT,0)=""
- FOR J=1:1:A
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(J-1*13+15,CCNT,":")
- +4 DO LN^LR7OSMZ1
- +5 SET ^TMP("LRC",$JOB,GCNT,0)=""
- +6 FOR J=1:1:A
- Begin DoDot:1
- +7 IF LRFMT'="B"
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(J*5+10,CCNT,":")
- +8 IF LRFMT="B"
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(J-1*13+15,CCNT,"SUSC INTP")
- End DoDot:1
- +9 QUIT
- ORG ;
- +1 DO LINE^LR7OSUM4
- +2 SET ^TMP("LRC",$JOB,GCNT,0)=""
- +3 ;I A>0 BEFORE FOR LOOP
- FOR J=1:1:A
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS($SELECT(LRFMT="B":J-1*13+15,1:J*5+10),CCNT,":")
- +4 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS($SELECT(LRFMT="B":A*13+15,1:A*5+15),CCNT,$SELECT(LR2ORMOR:LRBUG_". ",1:"")_LRORG)
- +5 QUIT
- SIR ;
- +1 FOR II=1:1:10
- IF $PIECE(LRINT(J),U,II,10)=""
- DO DCOM
- IF $PIECE(LRINT(J),U,II,10)=""
- QUIT
- IF LRFMT'="B"
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(II*5+10,CCNT,$SELECT(LRFMT="I":$PIECE(LRINT(J),U,II),1:$PIECE(LRRES(J),U,II)))
- IF LRFMT="B"
- DO SIR1
- +2 QUIT
- DCOM ;
- +1 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRCOMTAB,CCNT,LRDCOM)
- IF $DATA(LRDCOM(J))
- SET K=0
- SET A=0
- Begin DoDot:1
- +2 FOR
- SET A=+$ORDER(LRDCOM(J,A))
- IF A<1
- QUIT
- IF '('K&(LRDCOM=""))
- DO LINE^LR7OSUM4
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRCOMTAB,CCNT,LRDCOM(J,A))
- SET K=1
- End DoDot:1
- +3 QUIT
- SIR1 ;
- +1 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(II-1*13+15,CCNT,$SELECT($DATA(LRRES(J)):$PIECE(LRRES(J),U,II),1:""))_$$S^LR7OS(II-1*13+21,CCNT,$PIECE(LRINT(J),U,II)_" ")
- +2 QUIT
- +3 DO LINE^LR7OSUM4
- +4 SET X=""
- SET $PIECE(X,"-",GIOM)=""
- SET ^TMP("LRC",$JOB,GCNT,0)=X
- +5 DO LINE^LR7OSUM4
- +6 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"PATIENT'S IDENTIFICATION")_$$S^LR7OS(60,CCNT,"MICROBIOLOGY REPORT")
- +7 DO LINE^LR7OSUM4
- +8 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"ACCESSION: "_LRACC)_$$S^LR7OS(25,CCNT,"TAKEN:"_LRTK)_$$S^LR7OS(52,CCNT,"RECEIVED:"_LRRC)
- +9 QUIT