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 ---[H[J[2J[HLRBLC 905 printed Nov 22, 2024@17:20:22 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
