source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRUCNBB.m@ 1489

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1LRUCNBB ;AVAMC/REG - COOMBS/ANTIBODY REPORT ;02/12/89 12:30 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 K LRE,LRB S X=^LR(LRDFN,0),LRPABO=$P(X,"^",5),LRPRH=$P(X,"^",6)
4 I '$O(^LR(LRDFN,1.7,0)) W !!,"No serum antibodies present." G:'$D(LRI) F
5 I $D(LRI),'$O(^LR(LRDFN,1.7,0)),'$O(^LR(LRDFN,LRSS,LRI,"EA",0)) D E,P1 G F
6 K ^TMP($J) W !! S LRC=0 F LRZ=0:1 S LRC=$O(^LAB(65.9,LRL,2,LRC)) Q:'LRC D:$Y>(IOSL-12) H S X=^LAB(65.9,LRL,2,LRC,0) D ^DIWP
7 D:LRZ ^DIWW S LRF="SERUM " F LRA=0:0 S LRA=$O(^LR(LRDFN,1.7,LRA)) Q:'LRA S LRX=^(LRA,0) D:$Y>(IOSL-12) H D W
8 I $D(LRI) S LRF="ELUATE" F LRA=0:0 S LRA=$O(^LR(LRDFN,"BB",LRI,"EA",LRA)) Q:'LRA D:$Y>(IOSL-12) H D W
9 S LRB=1 F LRA=0:0 S LRA=$O(LRB(LRA)) Q:'LRA S LRB=LRB*LRB(LRA)
10 W !,"Patient is ",LRPABO," ",LRPRH,". ",$J(LRB*100,5,1)," % OF THE POPULATION WILL BE COMPATIBLE."
11 I $D(LRI),'$O(^LR(LRDFN,"BB",LRI,"EA",0)) D E,P1
12F S LRE=1 D F^LRUCN Q
13W S X=^LAB(61.3,LRA,0),Y=$P(X,"^",6) W !,LRF," ANTIBODY: ",$P(X,"^") I Y]"" W ?40,"% Compatible Units: ",$J(Y*100,3,1) S LRB(LRA)=Y
14 D:$Y>(IOSL-12) H
15 K ^TMP($J) W ! S LRC=0 F LRZ=0:1 S LRC=$O(^LAB(61.3,LRA,7,LRC)) Q:'LRC D:$Y>(IOSL-12) H S X=^LAB(61.3,LRA,7,LRC,0) D ^DIWP
16 D:LRZ ^DIWW
17 F LRC=0:0 S LRC=$O(^LAB(61.3,LRA,"JR",LRC)) Q:'LRC I $P(^(LRC,0),"^",7) S LRX=^(0) D L
18 Q
19L D:$Y>(IOSL-12) H W !,"Reference: ",$P(LRX,"^"),!,$P(LRX,"^",2),! I $P(LRX,"^",3) W $P(^LAB(95,$P(LRX,"^",3),0),"^")," Vol.",$P(LRX,"^",4)," Pg:",$P(LRX,"^",5) S Y=$P(LRX,"^",6) D D^LRU W " Date:",Y,!
20 Q
21H D F^LRUCN,H^LRUCN Q
22P1 K ^TMP($J) D:$Y>(IOSL-12) H W ! S LRC=0 F LRZ=0:1 S LRC=$O(^LAB(65.9,LRL,4,LRC)) Q:'LRC D:$Y>(IOSL-12) H S X=^LAB(65.9,LRL,4,LRC,0) D ^DIWP
23 D:LRZ ^DIWW Q
24E D:$Y>(IOSL-12) H W !! K ^TMP($J) S X="Patient has a positive Direct Coombs Test; however, no eluate antibodies are present for specimen dated: "_LRI(1) D ^DIWP,^DIWW Q
Note: See TracBrowser for help on using the repository browser.