LRBLSUM ;AVAMC/REG - BLOOD BANK SUMMARY ;3/28/94 12:10 ;
;;5.2;LAB SERVICE;**247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
Q:'$O(^LR(LRDFN,"BB",0))
S LRAA=$O(^LRO(68,"B","BLOOD BANK",0)) Q:'LRAA S LRAA(1)="BLOOD BANK",LRSS="BB" D L^LRU,S^LRU F X=2.91,8,10.3,11.3 S LRN(X)=$P(^DD(63.01,X,0),"^")
S W=^LR(LRDFN,0),LRDPF=$P(W,U,2),Y=$P(W,"^",3),X=^DIC($P(W,"^",2),0,"GL"),X=@(X_Y_",0)"),Z=+$G(^(.104)),Z(1)="^"_$P($G(^DD(LRDPF,.104,0)),"^",3)
I Z,$D(@(Z(1)_Z_",0)")) S LRMD=$P(^(0),"^")
I 'Z S Z=$S($D(^LR(LRDFN,.2)):+^(.2),1:"") I Z,$D(^VA(200,Z,0)) S LRMD=$P(^(0),"^")
S SSN=$P(X,"^",9) D SSN^LRU S N=$P(X,"^"),LR=$P(X,"^",3)_"^"_SSN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6)_"^"_LRMD,G=LRLLOC
D ^LRBLPBR1,K^LRU K LR,LRAA,LRSS,LRI,LRN Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLSUM 810 printed Sep 23, 2025@19:47:59 Page 2
LRBLSUM ;AVAMC/REG - BLOOD BANK SUMMARY ;3/28/94 12:10 ;
+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 if '$ORDER(^LR(LRDFN,"BB",0))
QUIT
+4 SET LRAA=$ORDER(^LRO(68,"B","BLOOD BANK",0))
if 'LRAA
QUIT
SET LRAA(1)="BLOOD BANK"
SET LRSS="BB"
DO L^LRU
DO S^LRU
FOR X=2.91,8,10.3,11.3
SET LRN(X)=$PIECE(^DD(63.01,X,0),"^")
+5 SET W=^LR(LRDFN,0)
SET LRDPF=$PIECE(W,U,2)
SET Y=$PIECE(W,"^",3)
SET X=^DIC($PIECE(W,"^",2),0,"GL")
SET X=@(X_Y_",0)")
SET Z=+$GET(^(.104))
SET Z(1)="^"_$PIECE($GET(^DD(LRDPF,.104,0)),"^",3)
+6 IF Z
IF $DATA(@(Z(1)_Z_",0)"))
SET LRMD=$PIECE(^(0),"^")
+7 IF 'Z
SET Z=$SELECT($DATA(^LR(LRDFN,.2)):+^(.2),1:"")
IF Z
IF $DATA(^VA(200,Z,0))
SET LRMD=$PIECE(^(0),"^")
+8 SET SSN=$PIECE(X,"^",9)
DO SSN^LRU
SET N=$PIECE(X,"^")
SET LR=$PIECE(X,"^",3)_"^"_SSN_"^"_$PIECE(W,"^",5)_"^"_$PIECE(W,"^",6)_"^"_LRMD
SET G=LRLLOC
+9 DO ^LRBLPBR1
DO K^LRU
KILL LR,LRAA,LRSS,LRI,LRN
QUIT
