LRUCNBB ; IHS/DIR/FJE - COOMBS/ANTIBODY REPORT 02/12/89 12:30 ;
;;5.2;LR;**1013**;JUL 15, 2002
;
;;5.2;LAB SERVICE;;Sep 27, 1994
K LRE,LRB S X=^LR(LRDFN,0),LRPABO=$P(X,"^",5),LRPRH=$P(X,"^",6)
I '$O(^LR(LRDFN,1.7,0)) W !!,"No serum antibodies present." G:'$D(LRI) F
I $D(LRI),'$O(^LR(LRDFN,1.7,0)),'$O(^LR(LRDFN,LRSS,LRI,"EA",0)) D E,P1 G F
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
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
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
S LRB=1 F LRA=0:0 S LRA=$O(LRB(LRA)) Q:'LRA S LRB=LRB*LRB(LRA)
W !,"Patient is ",LRPABO," ",LRPRH,". ",$J(LRB*100,5,1)," % OF THE POPULATION WILL BE COMPATIBLE."
I $D(LRI),'$O(^LR(LRDFN,"BB",LRI,"EA",0)) D E,P1
F S LRE=1 D F^LRUCN Q
W 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
D:$Y>(IOSL-12) H
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
D:LRZ ^DIWW
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
Q
L 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,!
Q
H D F^LRUCN,H^LRUCN Q
P1 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
D:LRZ ^DIWW Q
E 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
LRUCNBB ; IHS/DIR/FJE - COOMBS/ANTIBODY REPORT 02/12/89 12:30 ;
+1 ;;5.2;LR;**1013**;JUL 15, 2002
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
+4 KILL LRE,LRB
SET X=^LR(LRDFN,0)
SET LRPABO=$PIECE(X,"^",5)
SET LRPRH=$PIECE(X,"^",6)
+5 IF '$ORDER(^LR(LRDFN,1.7,0))
WRITE !!,"No serum antibodies present."
IF '$DATA(LRI)
GOTO F
+6 IF $DATA(LRI)
IF '$ORDER(^LR(LRDFN,1.7,0))
IF '$ORDER(^LR(LRDFN,LRSS,LRI,"EA",0))
DO E
DO P1
GOTO F
+7 KILL ^TMP($JOB)
WRITE !!
SET LRC=0
FOR LRZ=0:1
SET LRC=$ORDER(^LAB(65.9,LRL,2,LRC))
IF 'LRC
QUIT
IF $Y>(IOSL-12)
DO H
SET X=^LAB(65.9,LRL,2,LRC,0)
DO ^DIWP
+8 IF LRZ
DO ^DIWW
SET LRF="SERUM "
FOR LRA=0:0
SET LRA=$ORDER(^LR(LRDFN,1.7,LRA))
IF 'LRA
QUIT
SET LRX=^(LRA,0)
IF $Y>(IOSL-12)
DO H
DO W
+9 IF $DATA(LRI)
SET LRF="ELUATE"
FOR LRA=0:0
SET LRA=$ORDER(^LR(LRDFN,"BB",LRI,"EA",LRA))
IF 'LRA
QUIT
IF $Y>(IOSL-12)
DO H
DO W
+10 SET LRB=1
FOR LRA=0:0
SET LRA=$ORDER(LRB(LRA))
IF 'LRA
QUIT
SET LRB=LRB*LRB(LRA)
+11 WRITE !,"Patient is ",LRPABO," ",LRPRH,". ",$JUSTIFY(LRB*100,5,1)," % OF THE POPULATION WILL BE COMPATIBLE."
+12 IF $DATA(LRI)
IF '$ORDER(^LR(LRDFN,"BB",LRI,"EA",0))
DO E
DO P1
F SET LRE=1
DO F^LRUCN
QUIT
W SET X=^LAB(61.3,LRA,0)
SET Y=$PIECE(X,"^",6)
WRITE !,LRF," ANTIBODY: ",$PIECE(X,"^")
IF Y]""
WRITE ?40,"% Compatible Units: ",$JUSTIFY(Y*100,3,1)
SET LRB(LRA)=Y
+1 IF $Y>(IOSL-12)
DO H
+2 KILL ^TMP($JOB)
WRITE !
SET LRC=0
FOR LRZ=0:1
SET LRC=$ORDER(^LAB(61.3,LRA,7,LRC))
IF 'LRC
QUIT
IF $Y>(IOSL-12)
DO H
SET X=^LAB(61.3,LRA,7,LRC,0)
DO ^DIWP
+3 IF LRZ
DO ^DIWW
+4 FOR LRC=0:0
SET LRC=$ORDER(^LAB(61.3,LRA,"JR",LRC))
IF 'LRC
QUIT
IF $PIECE(^(LRC,0),"^",7)
SET LRX=^(0)
DO L
+5 QUIT
L IF $Y>(IOSL-12)
DO H
WRITE !,"Reference: ",$PIECE(LRX,"^"),!,$PIECE(LRX,"^",2),!
IF $PIECE(LRX,"^",3)
WRITE $PIECE(^LAB(95,$PIECE(LRX,"^",3),0),"^")," Vol.",$PIECE(LRX,"^",4)," Pg:",$PIECE(LRX,"^",5)
SET Y=$PIECE(LRX,"^",6)
DO D^LRU
WRITE " Date:",Y,!
+1 QUIT
H DO F^LRUCN
DO H^LRUCN
QUIT
P1 KILL ^TMP($JOB)
IF $Y>(IOSL-12)
DO H
WRITE !
SET LRC=0
FOR LRZ=0:1
SET LRC=$ORDER(^LAB(65.9,LRL,4,LRC))
IF 'LRC
QUIT
IF $Y>(IOSL-12)
DO H
SET X=^LAB(65.9,LRL,4,LRC,0)
DO ^DIWP
+1 IF LRZ
DO ^DIWW
QUIT
E IF $Y>(IOSL-12)
DO H
WRITE !!
KILL ^TMP($JOB)
SET X="Patient has a positive Direct Coombs Test; however, no eluate antibodies are present for specimen dated: "_LRI(1)
DO ^DIWP
DO ^DIWW
QUIT
