LRBLSUM.m

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 ---LRBLSUM   810     printed  Apr 09, 2024@21:08:35                                                                                                                                                                                                      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