LRBLDPAW.m

LRBLDPAW ;AVAMC/REG - BLOOD DONOR PRINT  ;6/24/90  20:57 ;

 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994

 ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021

 D:$Y>(IOSL-6) M^LRBLDPA1 Q:LR("Q")  W !! D T

 F LRT=0:0 S LRT=$O(^LRE(LR,5,LRI,99,LRT)) Q:'LRT!(LR("Q"))  F LRD=0:0 S LRD=$O(^LRE(LR,5,LRI,99,LRT,1,LRD)) Q:'LRD!(LR("Q"))  S LRX=^(LRD,0) D W

 Q

W D:$Y>(IOSL-6) H Q:LR("Q")  S Y=LRD D A^LRU S X=+$P(LRX,"^",2),X=$S($D(^VA(200,X,0)):$P(^(0),"^"),1:X),LRX(1)=Y,LRX(2)=X W !,$P(^LAB(60,LRT,0),"^"),?32,Y,?49,X

 F LRC=0:0 S LRC=$O(^LRE(LR,5,LRI,99,LRT,1,LRD,1,LRC)) Q:'LRC!(LR("Q"))  S LRW=^(LRC,0) D:$Y>(IOSL-6) H1 Q:LR("Q")  W !?2,$P(^LAM(LRC,0),"^"),?35,"CAP Count:",$J($P(LRW,"^",2),3),?50,"Counted: ",$S($P(LRW,"^",3):"YES",1:"NO")

 Q

 ;

H D M^LRBLDPA1 Q:LR("Q")  D T Q

H1 D H Q:LR("Q")  W !,$P(^LAB(60,LRT,0),"^"),?32,LRX(1),?49,LRX(2) Q

T W !,"Workload Entry",?36,"Date",?54,"Tech" Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRBLDPAW   939     printed  Apr 09, 2024@21:07:39                                                                                                                                                                                                     Page 2

LRBLDPAW  ;AVAMC/REG - BLOOD DONOR PRINT  ;6/24/90  20:57 ;

 +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 $Y>(IOSL-6)

               DO M^LRBLDPA1

           if LR("Q")

               QUIT 

           WRITE !!

           DO T

 +4        FOR LRT=0:0

               SET LRT=$ORDER(^LRE(LR,5,LRI,99,LRT))

               if 'LRT!(LR("Q"))

                   QUIT 

               FOR LRD=0:0

                   SET LRD=$ORDER(^LRE(LR,5,LRI,99,LRT,1,LRD))

                   if 'LRD!(LR("Q"))

                       QUIT 

                   SET LRX=^(LRD,0)

                   DO W

 +5        QUIT 

W          if $Y>(IOSL-6)

               DO H

           if LR("Q")

               QUIT 

           SET Y=LRD

           DO A^LRU

           SET X=+$PIECE(LRX,"^",2)

           SET X=$SELECT($DATA(^VA(200,X,0)):$PIECE(^(0),"^"),1:X)

           SET LRX(1)=Y

           SET LRX(2)=X

           WRITE !,$PIECE(^LAB(60,LRT,0),"^"),?32,Y,?49,X

 +1        FOR LRC=0:0

               SET LRC=$ORDER(^LRE(LR,5,LRI,99,LRT,1,LRD,1,LRC))

               if 'LRC!(LR("Q"))

                   QUIT 

               SET LRW=^(LRC,0)

               if $Y>(IOSL-6)

                   DO H1

               if LR("Q")

                   QUIT 

               WRITE !?2,$PIECE(^LAM(LRC,0),"^"),?35,"CAP Count:",$JUSTIFY($PIECE(LRW,"^",2),3),?50,"Counted: ",$SELECT($PIECE(LRW,"^",3):"YES",1:"NO")

 +2        QUIT 

 +3       ;

H          DO M^LRBLDPA1

           if LR("Q")

               QUIT 

           DO T

           QUIT 

H1         DO H

           if LR("Q")

               QUIT 

           WRITE !,$PIECE(^LAB(60,LRT,0),"^"),?32,LRX(1),?49,LRX(2)

           QUIT 

T          WRITE !,"Workload Entry",?36,"Date",?54,"Tech"

           QUIT