Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LAMIAUT3

LAMIAUT3.m

Go to the documentation of this file.
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