- LAMIAUT3 ; IHS/DIR/FJE - MICRO DISPLAY ANTIBIOTICS FOR VERIFY ; 22-Oct-2013 09:22 ; MKK
- ;;5.2;LA;**1002,1033**;NOV 01, 1997
- ;
- BACT ;from LRMIV1
- S LR2ORMOR=1,LREND=0 Q:+$O(^LR(LRDFN,"MI",LRIDT,3,0))<1
- ;D BUGHDR ;W @IOF,!?5,PNM," SSN: ",SSN,!,LRACCN," ",$P(^LAB(62,LRSAMP,0),U)," ",$P(^LAB(61,LRSPEC,0),U),!
- D BUGHDR ;W @IOF,!?5,PNM," HRCN: ",HRCN,!,LRACCN," ",$P(^LAB(62,LRSAMP,0),U)," ",$P(^LAB(61,LRSPEC,0),U),! ;IHS/ANMC/CLS 11/95
- K LRRES,LRINT
- S LRBUG=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
- S LRABCNT=0 F LRBN=0:0 S LRBN=+$O(LRRES(LRBN)) Q:LRBN<1 S LRABCNT=LRABCNT+1
- ; I 'LRABCNT W !!?10,"There are NO antibiotics in the patients file",!! Q
- ;
- ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
- I 'LRABCNT D Q
- . Q:$D(^TMP("BLRMIAUT",$J,"HL7"))
- . I $G(BLRHL7IN)'="YES" W !!?10,"There are NO antibiotics in the patient's file",!!
- ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
- ;
- Q:LREND
- S LRCOMTAB=$S(LRFMT="B":A*13+17,1:A*5+17)
- S (LREND,LRACNT)=0 F LRAO=0:0 S LRAO=$O(^LAB(62.06,"AO",LRAO)) Q:LRAO<.001 S B=$O(^LAB(62.06,"AO",LRAO,0)) I B>0,$D(^LAB(62.06,B,0)) D AB I $Y>(IOSL-3) D WAIT Q:LREND
- W ! K LR1PASS,LRRES,LRINT,LRBN
- Q
- CHECK S LRFLAG=0 K LR1PASS F LRBN=2:0 S LRBN=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN)) Q:$E(LRBN,1,2)'="2." S B=^(LRBN),B1=$P(B,U),B2=$P(B,U,2),B3=$P(B,U,3) I $L(B1),$D(^LAB(62.06,"AI",LRBN,B1)) D FIRST
- S LRBN=2 F I=0:0 S LRBN=+$O(LR1PASS(LRBN)) Q:LRBN<1 S B=LR1PASS(LRBN),B1=$P(B,U),B2=$P(B,U,2),B3=$P(B,U,3) D LAB
- K LRBN,LR1PASS,LRFLAG,B,B1,B2,B3
- Q
- FIRST S B2=$S(B2]"":B2,1:^(B1)) 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(LRLABKY),'$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 S J=$P(^LAB(62.06,B,0),U,2) I $D(LRINT(J)),LRINT(J)'?."^" W !,$E($P(^(0),U),1,14) S LRDCOM=$P(^(0),U,3),LRACNT=LRACNT+1 D SIR
- Q
- BUGHDR ;W @IOF W !?5,PNM," SSN: ",SSN,!,LRACCN," ",$P(^LAB(62,LRSAMP,0),U)," ",$P(^LAB(61,LRSPEC,0),U),!
- W @IOF W !?5,PNM," HRCN: ",HRCN,!,LRACCN," ",$P(^LAB(62,LRSAMP,0),U)," ",$P(^LAB(61,LRSPEC,0),U),! ;IHS/ANMC/CLS 11/1/95
- S LRBUG=0 F A=0:1 S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 I $D(^(LRBUG,0)) I ^(0) S LRORG=$P(^(0),U),LRORGCOM=$P(^(0),U,2),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" W ! F J=1:1:A W ?J-1*13+15,":"
- W ! F J=1:1:A W:LRFMT'="B" ?(J*5+10),":" I LRFMT="B" W ?J-1*13+15,"SUSC INTP"
- Q
- ORG W ! I A>0 F J=1:1:A W ?($S(LRFMT="B":J-1*13+15,1:J*5+10)),":"
- W ?($S(LRFMT="B":A*13+15,1:A*5+15)),$S(LR2ORMOR:LRBUG_". ",1:""),LRORG,$S($L(LRORGCOM):" ("_LRORGCOM_")",1:"")
- Q
- SIR F II=1:1:10 D:$P(LRINT(J),U,II,10)="" DCOM Q:$P(LRINT(J),U,II,10)="" W:LRFMT'="B" ?(II*5+10),$S(LRFMT="I":$P(LRINT(J),U,II),1:$P(LRRES(J),U,II)) I LRFMT="B" D SIR1
- Q
- DCOM W ?LRCOMTAB,LRDCOM I $D(LRDCOM(J)) S K=0 F A=0:0 S A=+$O(LRDCOM(J,A)) Q:A<1 W:'('K&(LRDCOM="")) ! W ?LRCOMTAB,LRDCOM(J,A) S K=1
- Q
- SIR1 W ?(II-1*13+15),$S($D(LRRES(J)):$P(LRRES(J),U,II),1:""),?(II-1*13+21),$P(LRINT(J),U,II)," "
- Q
- WAIT W !?10,"PRESS RETURN FOR MORE " R X:DTIME S:$E(X)="^" LREND=1 Q:LREND W @IOF D BUGHDR
- LAMIAUT3 ; IHS/DIR/FJE - MICRO DISPLAY ANTIBIOTICS FOR VERIFY ; 22-Oct-2013 09:22 ; MKK
- +1 ;;5.2;LA;**1002,1033**;NOV 01, 1997
- +2 ;
- BACT ;from LRMIV1
- +1 SET LR2ORMOR=1
- SET LREND=0
- IF +$ORDER(^LR(LRDFN,"MI",LRIDT,3,0))<1
- QUIT
- +2 ;D BUGHDR ;W @IOF,!?5,PNM," SSN: ",SSN,!,LRACCN," ",$P(^LAB(62,LRSAMP,0),U)," ",$P(^LAB(61,LRSPEC,0),U),!
- +3 ;W @IOF,!?5,PNM," HRCN: ",HRCN,!,LRACCN," ",$P(^LAB(62,LRSAMP,0),U)," ",$P(^LAB(61,LRSPEC,0),U),! ;IHS/ANMC/CLS 11/95
- DO BUGHDR
- +4 KILL LRRES,LRINT
- +5 SET LRBUG=0
- 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
- +6 SET LRABCNT=0
- FOR LRBN=0:0
- SET LRBN=+$ORDER(LRRES(LRBN))
- IF LRBN<1
- QUIT
- SET LRABCNT=LRABCNT+1
- +7 ; I 'LRABCNT W !!?10,"There are NO antibiotics in the patients file",!! Q
- +8 ;
- +9 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
- +10 IF 'LRABCNT
- Begin DoDot:1
- +11 IF $DATA(^TMP("BLRMIAUT",$JOB,"HL7"))
- QUIT
- +12 IF $GET(BLRHL7IN)'="YES"
- WRITE !!?10,"There are NO antibiotics in the patient's file",!!
- End DoDot:1
- QUIT
- +13 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
- +14 ;
- +15 IF LREND
- QUIT
- +16 SET LRCOMTAB=$SELECT(LRFMT="B":A*13+17,1:A*5+17)
- +17 SET (LREND,LRACNT)=0
- FOR LRAO=0:0
- SET LRAO=$ORDER(^LAB(62.06,"AO",LRAO))
- IF LRAO<.001
- QUIT
- SET B=$ORDER(^LAB(62.06,"AO",LRAO,0))
- IF B>0
- IF $DATA(^LAB(62.06,B,0))
- DO AB
- IF $Y>(IOSL-3)
- DO WAIT
- IF LREND
- QUIT
- +18 WRITE !
- KILL LR1PASS,LRRES,LRINT,LRBN
- +19 QUIT
- CHECK SET LRFLAG=0
- KILL LR1PASS
- FOR LRBN=2:0
- SET LRBN=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN))
- IF $EXTRACT(LRBN,1,2)'="2."
- QUIT
- SET B=^(LRBN)
- SET B1=$PIECE(B,U)
- SET B2=$PIECE(B,U,2)
- SET B3=$PIECE(B,U,3)
- IF $LENGTH(B1)
- IF $DATA(^LAB(62.06,"AI",LRBN,B1))
- DO FIRST
- +1 SET LRBN=2
- FOR I=0:0
- SET LRBN=+$ORDER(LR1PASS(LRBN))
- IF LRBN<1
- QUIT
- SET B=LR1PASS(LRBN)
- SET B1=$PIECE(B,U)
- SET B2=$PIECE(B,U,2)
- SET B3=$PIECE(B,U,3)
- DO LAB
- +2 KILL LRBN,LR1PASS,LRFLAG,B,B1,B2,B3
- +3 QUIT
- FIRST SET B2=$SELECT(B2]"":B2,1:^(B1))
- IF $EXTRACT(B2)'="R"&("A"[B3)
- SET LRFLAG=1
- SET LR1PASS(LRBN)=B1_U_B2_U_B3
- SET ^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN)=LR1PASS(LRBN)
- +1 QUIT
- LAB IF $DATA(LRLABKY)
- 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
- +1 IF B3=""!(B3="A")!(B3="R"&'LRFLAG)
- SET $PIECE(LRRES(LRBN),U,A)=B1
- SET $PIECE(LRINT(LRBN),U,A)=B2
- +2 QUIT
- AB SET J=$PIECE(^LAB(62.06,B,0),U,2)
- IF $DATA(LRINT(J))
- IF LRINT(J)'?."^"
- WRITE !,$EXTRACT($PIECE(^(0),U),1,14)
- SET LRDCOM=$PIECE(^(0),U,3)
- SET LRACNT=LRACNT+1
- DO SIR
- +1 QUIT
- BUGHDR ;W @IOF W !?5,PNM," SSN: ",SSN,!,LRACCN," ",$P(^LAB(62,LRSAMP,0),U)," ",$P(^LAB(61,LRSPEC,0),U),!
- +1 ;IHS/ANMC/CLS 11/1/95
- WRITE @IOF
- WRITE !?5,PNM," HRCN: ",HRCN,!,LRACCN," ",$PIECE(^LAB(62,LRSAMP,0),U)," ",$PIECE(^LAB(61,LRSPEC,0),U),!
- +2 SET LRBUG=0
- FOR A=0:1
- SET LRBUG=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG))
- IF LRBUG<1
- QUIT
- IF $DATA(^(LRBUG,0))
- IF ^(0)
- SET LRORG=$PIECE(^(0),U)
- SET LRORGCOM=$PIECE(^(0),U,2)
- 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"
- WRITE !
- FOR J=1:1:A
- WRITE ?J-1*13+15,":"
- +4 WRITE !
- FOR J=1:1:A
- IF LRFMT'="B"
- WRITE ?(J*5+10),":"
- IF LRFMT="B"
- WRITE ?J-1*13+15,"SUSC INTP"
- +5 QUIT
- ORG WRITE !
- IF A>0
- FOR J=1:1:A
- WRITE ?($SELECT(LRFMT="B":J-1*13+15,1:J*5+10)),":"
- +1 WRITE ?($SELECT(LRFMT="B":A*13+15,1:A*5+15)),$SELECT(LR2ORMOR:LRBUG_". ",1:""),LRORG,$SELECT($LENGTH(LRORGCOM):" ("_LRORGCOM_")",1:"")
- +2 QUIT
- SIR 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"
- WRITE ?(II*5+10),$SELECT(LRFMT="I":$PIECE(LRINT(J),U,II),1:$PIECE(LRRES(J),U,II))
- IF LRFMT="B"
- DO SIR1
- +1 QUIT
- DCOM WRITE ?LRCOMTAB,LRDCOM
- IF $DATA(LRDCOM(J))
- SET K=0
- FOR A=0:0
- SET A=+$ORDER(LRDCOM(J,A))
- IF A<1
- QUIT
- IF '('K&(LRDCOM=""))
- WRITE !
- WRITE ?LRCOMTAB,LRDCOM(J,A)
- SET K=1
- +1 QUIT
- SIR1 WRITE ?(II-1*13+15),$SELECT($DATA(LRRES(J)):$PIECE(LRRES(J),U,II),1:""),?(II-1*13+21),$PIECE(LRINT(J),U,II)," "
- +1 QUIT
- WAIT WRITE !?10,"PRESS RETURN FOR MORE "
- READ X:DTIME
- IF $EXTRACT(X)="^"
- SET LREND=1
- IF LREND
- QUIT
- WRITE @IOF
- DO BUGHDR
