- LRBLC ; IHS/DIR/FJE - ABO/RH COUNT 2/18/93 08:37 ;
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- 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
- LRBLC ; IHS/DIR/FJE - ABO/RH COUNT 2/18/93 08:37 ;
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 DO END
- WRITE !!?20,"ABO/Rh recheck counts"
- +5 DO B^LRU
- IF Y=-1
- GOTO END
- +6 SET LRSDT=LRSDT-.01
- SET LRLDT=LRLDT+.99
- SET (LRABO,LRRH)=0
- +7 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
