LRUCNBB ;AVAMC/REG - COOMBS/ANTIBODY REPORT ;02/12/89  12:30 ;
 ;;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
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUCNBB   1850     printed  Sep 23, 2025@19:57:01                                                                                                                                                                                                     Page 2
LRUCNBB   ;AVAMC/REG - COOMBS/ANTIBODY REPORT ;02/12/89  12:30 ;
 +1       ;;5.2;LAB SERVICE;;Sep 27, 1994
 +2        KILL LRE,LRB
           SET X=^LR(LRDFN,0)
           SET LRPABO=$PIECE(X,"^",5)
           SET LRPRH=$PIECE(X,"^",6)
 +3        IF '$ORDER(^LR(LRDFN,1.7,0))
               WRITE !!,"No serum antibodies present."
               if '$DATA(LRI)
                   GOTO F
 +4        IF $DATA(LRI)
               IF '$ORDER(^LR(LRDFN,1.7,0))
                   IF '$ORDER(^LR(LRDFN,LRSS,LRI,"EA",0))
                       DO E
                       DO P1
                       GOTO F
 +5        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
 +6        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
 +7        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
 +8        SET LRB=1
           FOR LRA=0:0
               SET LRA=$ORDER(LRB(LRA))
               if 'LRA
                   QUIT 
               SET LRB=LRB*LRB(LRA)
 +9        WRITE !,"Patient is ",LRPABO," ",LRPRH,".  ",$JUSTIFY(LRB*100,5,1)," % OF THE POPULATION WILL BE COMPATIBLE."
 +10       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