source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LROR4B.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1LROR4B ;AVAMC/REG/SLC/CJS/BA - MICRO PATIENT REPORT - BACTERIA, ANTIBIOTICS ; 3/16/88 3:47 PM ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3BACT ;from LRMIPSZ2
4 Q:+$O(^LR(LRDFN,"MI",LRIDT,3,0))<1
5 S LRFMT=$P(^LAB(69.9,1,0),U,11),LRFMT=$S(LRFMT="":"I",1:LRFMT)
6 K LRRES,LRINT
7 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
8 S (LRABCNT,LRBN)=0 F I=0:0 S LRBN=+$O(LRRES(LRBN)) Q:LRBN<1 S LRABCNT=LRABCNT+1
9 Q:'LRABCNT D:$Y>(IOSL-LRABCNT-LRFLIP-1) NHDR Q:LREND W !!,"ANTIBIOTIC SUSCEPTIBILITY TEST RESULTS:" W:$D(^XUSEC("LRLAB",DUZ))&'$D(LRWRDVEW) " ('*' indcates display is suppressed)" W:LRHC ! D BUGHDR
10 S LRCOMTAB=$S(LRFMT="B":A*13+17,1:A*5+17)
11 S (LRAO,LRACNT)=0 F I=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
12 W ! K LR1PASS,LRRES,LRINT,LRBN
13 Q
14CHECK S LRFLAG=0,LRBN=2 K LR1PASS F I=0:0 S LRBN=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN)) Q:LRBN'["2." S B=^(LRBN),B1=$P(B,U) I $L(B1),$D(^LAB(62.06,"AI",LRBN,B1)) D FIRST
15 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
16 K LRBN,LR1PASS,LRFLAG,B,B1,B2,B3
17 Q
18FIRST S B2=$S($L($P(B,U,2)):$P(B,U,2),1:B1),B3=$P(B,U,3) S:$E(B2)'="R"&("A"[B3) LRFLAG=1 S LR1PASS(LRBN)=B1_U_B2_U_B3
19 Q
20LAB 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
21 I B3=""!(B3="A")!(B3="R"&'LRFLAG) S $P(LRRES(LRBN),U,A)=B1,$P(LRINT(LRBN),U,A)=B2
22 Q
23AB 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 I $Y>(IOSL-4),LRACNT<LRABCNT D FH^LROR4 Q:LREND D BUGHDR
24 Q
25BUGHDR S LRBUG=0 F A=0:1 S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 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
26 I LRFMT="B" W ! F J=1:1:A W ?J-1*13+15,":"
27 W ! F J=1:1:A W:LRFMT'="B" ?(J*5+10),":" I LRFMT="B" W ?J-1*13+15,"SUSC INTP"
28 Q
29ORG W ! I A>0 F J=1:1:A W ?($S(LRFMT="B":J-1*13+15,1:J*5+10)),":"
30 W ?($S(LRFMT="B":A*13+15,1:A*5+15)),$S(LR2ORMOR:LRBUG_". ",1:""),LRORG
31 Q
32SIR 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
33 K II Q
34DCOM W ?LRCOMTAB,LRDCOM I $D(LRDCOM(J)) S K=0,A=0 F I=0:0 S A=+$O(LRDCOM(J,A)) Q:A<1 W:'('K&(LRDCOM="")) ! W ?LRCOMTAB,LRDCOM(J,A) S K=1
35 Q
36SIR1 W ?(II-1*13+15),$S($D(LRRES(J)):$P(LRRES(J),U,II),1:""),?(II-1*13+21),$P(LRINT(J),U,II)," "
37 Q
38NHDR F X=1:1 W ! Q:$Y>(IOSL-LRFLIP)
39 I 'LRHC D FH^LROR4 Q
40 W ! F X=1:1:80 W "-"
41 W !,"PATIENT'S IDENTIFICATION",?60,"MICROBIOLOGY REPORT"
42 W !!,PNM,?$X+3,SSN,?$X+3,SEX,?$X+3,"DOB: ",DOB," WARD: ",LRWRD,!,"ADM: ",LRADM," ADM DX: ",LRADX
43 S LRPG=LRPG+1 W @IOF,!,?18,"MICROBIOLOGY LAB ",$S($D(^DD("SITE")):^DD("SITE"),1:"") S X="T" D ^%DT,D^LRU W ?$X+10,Y,! F X=1:1:80 W "-"
44 W !,"ACCESSION: ",LRACC,?25,"TAKEN:",LRTK,?52,"RECEIVED:",LRRC
45 Q
Note: See TracBrowser for help on using the repository browser.