LRBLPB ;AVAMC/REG - PATIENT ANTIBODIES ;2/18/93  09:40 ;
 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
 ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021
 D END S X="BLOOD BANK" D ^LRUTL G:Y=-1 END
 W !!?20,"Patient antibody list"
 S ZTRTN="QUE^LRBLPB" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO K ^TMP($J) D L^LRU,S^LRU
 S A=0 F LRDFN=0:0 S LRDFN=$O(^LR(LRDFN)) Q:'LRDFN  I $D(^LR(LRDFN,"BB")) S X=^LR(LRDFN,0) D A
 S ^TMP($J,0)=A
 D END^LRUTL,END Q
A S A=A+1 Q:'$D(^LR(LRDFN,1.7))  S Y=$P(X,"^",3),Z=^DIC($P(X,"^",2),0,"GL"),Z=@(Z_Y_",0)"),Z(1)=$P(Z,"^")_" "_$P(Z,"^",9)
 F B=0:0 S B=$O(^LR(LRDFN,1.7,B)) Q:'B  S ^TMP($J,B,Z(1))="",^TMP($J,Z(1),B)=""
 Q
END D V^LRU Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLPB   717     printed  Sep 23, 2025@19:47:19                                                                                                                                                                                                       Page 2
LRBLPB    ;AVAMC/REG - PATIENT ANTIBODIES ;2/18/93  09:40 ;
 +1       ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
 +2       ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021
 +3        DO END
           SET X="BLOOD BANK"
           DO ^LRUTL
           if Y=-1
               GOTO END
 +4        WRITE !!?20,"Patient antibody list"
 +5        SET ZTRTN="QUE^LRBLPB"
           DO BEG^LRUTL
           if POP!($DATA(ZTSK))
               GOTO END
QUE        USE IO
           KILL ^TMP($JOB)
           DO L^LRU
           DO S^LRU
 +1        SET A=0
           FOR LRDFN=0:0
               SET LRDFN=$ORDER(^LR(LRDFN))
               if 'LRDFN
                   QUIT 
               IF $DATA(^LR(LRDFN,"BB"))
                   SET X=^LR(LRDFN,0)
                   DO A
 +2        SET ^TMP($JOB,0)=A
 +3        DO END^LRUTL
           DO END
           QUIT 
A          SET A=A+1
           if '$DATA(^LR(LRDFN,1.7))
               QUIT 
           SET Y=$PIECE(X,"^",3)
           SET Z=^DIC($PIECE(X,"^",2),0,"GL")
           SET Z=@(Z_Y_",0)")
           SET Z(1)=$PIECE(Z,"^")_" "_$PIECE(Z,"^",9)
 +1        FOR B=0:0
               SET B=$ORDER(^LR(LRDFN,1.7,B))
               if 'B
                   QUIT 
               SET ^TMP($JOB,B,Z(1))=""
               SET ^TMP($JOB,Z(1),B)=""
 +2        QUIT 
END        DO V^LRU
           QUIT