LRBLC.m

LRBLC ;AVAMC/REG - ABO/RH COUNT ;2/18/93  08:37 ;

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

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

 D END W !!?20,"ABO/Rh recheck counts"

 D B^LRU G:Y=-1 END

 S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99,(LRABO,LRRH)=0

 S ZTRTN="QUE^LRBLC" D BEG^LRUTL G:POP!($D(ZTSK)) END

QUE U IO D L^LRU,S^LRU S A=LRSDT F B=0:0 S A=$O(^LRD(65,"A",A)) Q:'A!(A>LRLDT)  F C=0:0 S C=$O(^LRD(65,"A",A,C)) Q:'C  D C

 D H,END,END^LRUTL Q

C I $D(^LRD(65,C,10)),$P(^(10),"^")]"","ABO"[$P(^(10),"^"),'$P(^(10),"^",4) S LRABO=LRABO+1

 I $D(^LRD(65,C,11)),$P(^(11),"^")]"","POSNEG"[$P(^(11),"^"),'$P(^(11),"^",4) S LRRH=LRRH+1

 Q

H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")

 D F^LRU W !,"BLOOD BANK ABO/Rh counts from: ",LRSTR," to ",LRLST,!,LR("%"),!,"ABO re-check count: ",$J(LRABO,5),!,"Rh  re-check count: ",$J(LRRH,5) Q

 ;

END D V^LRU Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRBLC   905     printed  Apr 09, 2024@21:21:35                                                                                                                                                                                                        Page 2

LRBLC     ;AVAMC/REG - ABO/RH COUNT ;2/18/93  08:37 ;

 +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

           WRITE !!?20,"ABO/Rh recheck counts"

 +4        DO B^LRU

           if Y=-1

               GOTO END

 +5        SET LRSDT=LRSDT-.01

           SET LRLDT=LRLDT+.99

           SET (LRABO,LRRH)=0

 +6        SET ZTRTN="QUE^LRBLC"

           DO BEG^LRUTL

           if POP!($DATA(ZTSK))

               GOTO END

QUE        USE IO

           DO L^LRU

           DO S^LRU

           SET A=LRSDT

           FOR B=0:0

               SET A=$ORDER(^LRD(65,"A",A))

               if 'A!(A>LRLDT)

                   QUIT 

               FOR C=0:0

                   SET C=$ORDER(^LRD(65,"A",A,C))

                   if 'C

                       QUIT 

                   DO C

 +1        DO H

           DO END

           DO END^LRUTL

           QUIT 

C          IF $DATA(^LRD(65,C,10))

               IF $PIECE(^(10),"^")]""

                   IF "ABO"[$PIECE(^(10),"^")

                       IF '$PIECE(^(10),"^",4)

                           SET LRABO=LRABO+1

 +1        IF $DATA(^LRD(65,C,11))

               IF $PIECE(^(11),"^")]""

                   IF "POSNEG"[$PIECE(^(11),"^")

                       IF '$PIECE(^(11),"^",4)

                           SET LRRH=LRRH+1

 +2        QUIT 

H          IF $DATA(LR("F"))

               IF IOST?1"C".E

                   DO M^LRU

                   if LR("Q")

                       QUIT 

 +1        DO F^LRU

           WRITE !,"BLOOD BANK ABO/Rh counts from: ",LRSTR," to ",LRLST,!,LR("%"),!,"ABO re-check count: ",$JUSTIFY(LRABO,5),!,"Rh  re-check count: ",$JUSTIFY(LRRH,5)

           QUIT 

 +2       ;

END        DO V^LRU

           QUIT