- LRBLPQA ; IHS/DIR/FJE - TRANSFUSION REQUEST DATA 2/18/93 09:45 ;
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- W !!?20 D END,I,Z G:Y=-1 END
- A R !!?3,"(A)ll components or (S)ingle component: ",X:DTIME Q:X["^"!(X="") I $A(X)'=65,$A(X)'=83 W $C(7),!,"Enter 'A' for all blood components or 'S' for a single component" G A
- G:$A(X)=65 D
- B S DIC=66,DIC(0)="AEQM",DIC("S")="I $P(^(0),U,4)=""BB""" D ^DIC K DIC G:Y<1 END S LRC=+Y,LRC(1)=$P(Y,"^",2) I '$D(^LRO(69.2,LRAA,8,66,1,LRC)) W $C(7),!,"There are no entries to print",!! G B
- D D B^LRU G:Y<0 END S LRLDT=LRLDT+.99,LRSDT=LRSDT-.0001
- S ZTRTN="QUE^LRBLPQA" D BEG^LRUTL G:POP!($D(ZTSK)) END
- QUE U IO D L^LRU,S^LRU,H S LR("F")=1 I $D(LRC) D W G OUT
- S LRC(1)=0 F LRA=0:0 S LRC(1)=$O(^LRO(69.2,LRAA,8,66,1,"B",LRC(1))) Q:LRC(1)=""!(LR("Q")) F LRC=0:0 S LRC=$O(^LRO(69.2,LRAA,8,66,1,"B",LRC(1),LRC)) Q:'LRC!(LR("Q")) D W
- OUT W:IOST'?1"C".E @IOF D END,END^LRUTL Q
- W D:$Y>(IOSL-10) H Q:LR("Q") W !!?20,LRC(1)
- ;F LRD=0:0 S LRD=$O(^LRO(69.2,LRAA,8,66,1,LRC,1,LRD)) Q:'LRD!(LR("Q")) S LRB=^(LRD,0) I +LRB<LRLDT&(+LRB>LRSDT) S $P(^(0),"^",4)=1,SSN=$P(LRB,"^",3) D:$Y>(IOSL-10) H1 Q:LR("Q") S Y=+LRB D D^LRU D W1
- F LRD=0:0 S LRD=$O(^LRO(69.2,LRAA,8,66,1,LRC,1,LRD)) Q:'LRD!(LR("Q")) S LRB=^(LRD,0) I +LRB<LRLDT&(+LRB>LRSDT) S $P(^(0),"^",4)=1,HRCN=$P(LRB,"^",3) D:$Y>(IOSL-10) H1 Q:LR("Q") S Y=+LRB D D^LRU D W1 ;IHS/ANMC/CLS 11/1/95
- Q
- W1 ;W !!,Y," ",$P(LRB,"^",2)," SSN:",SSN
- W !!,Y," ",$P(LRB,"^",2)," HRCN:",HRCN ;IHS/ANMC/CLS 11/1/95
- F A=0:0 S A=$O(^LRO(69.2,LRAA,8,66,1,LRC,1,LRD,1,A)) Q:'A!(LR("Q")) S LR=^(A,0) D:$Y>(IOSL-10) H2 Q:LR("Q") W !,LR
- Q
- EN ;
- D Z G:Y=-1 END W !!,"This option deletes inappropriate transfusion requests",!,"that have been previously printed. OK " S %=2 D YN^LRU G:%'=1 END
- W ! F A=0:0 S A=$O(^LRO(69.2,LRAA,8,66,1,A)) Q:'A S C=0 D K
- W !,"DONE",! G END
- K F B=0:0 S B=$O(^LRO(69.2,LRAA,8,66,1,A,1,B)) Q:'B I $P(^(B,0),"^",4) K ^LRO(69.2,LRAA,8,66,1,A,1,B) S C=C+1 W "."
- Q:'C
- S X=^LRO(69.2,LRAA,8,66,1,A,1,0),Y=$P(X,"^",4)-C
- I Y<1 S V=^LRO(69.2,LRAA,8,66,1,A,0) K ^LRO(69.2,LRAA,8,66,1,A),^LRO(69.2,LRAA,8,66,1,"B",V,A) S Y=$O(^LRO(69.2,LRAA,8,66,1,0)) S:'Y Y=0 S X=^LRO(69.2,LRAA,8,66,1,0),^(0)=$P(X,"^",1,2)_"^"_Y_"^"_($P(X,"^",4)-1) Q
- S X(1)=$O(^LRO(69.2,LRAA,8,66,1,A,1,0)) S:'X(1) X(1)=0 S ^LRO(69.2,LRAA,8,66,1,A,1,0)=$P(X,"^",1,2)_"^"_X(1)_"^"_Y Q
- ;
- H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
- D F^LRU W !,"BLOOD BANK",!?20 D I W !,LR("%") Q
- H1 D H Q:LR("Q") W !!?20,LRC(1) Q
- H2 ;D H1 Q:LR("Q") W ! S Y=+LRB D D^LRU W Y," ",$P(LRB,"^",2)," ",SSN Q
- D H1 Q:LR("Q") W ! S Y=+LRB D D^LRU W Y," ",$P(LRB,"^",2)," ",HRCN Q ;IHS/ANMC/CLS 11/1/95
- I W "Inappropriate transfusion requests report" Q
- Z S X="BLOOD BANK" D ^LRUTL Q
- END D V^LRU Q
- LRBLPQA ; IHS/DIR/FJE - TRANSFUSION REQUEST DATA 2/18/93 09:45 ;
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 WRITE !!?20
- DO END
- DO I
- DO Z
- IF Y=-1
- GOTO END
- A READ !!?3,"(A)ll components or (S)ingle component: ",X:DTIME
- IF X["^"!(X="")
- QUIT
- IF $ASCII(X)'=65
- IF $ASCII(X)'=83
- WRITE $CHAR(7),!,"Enter 'A' for all blood components or 'S' for a single component"
- GOTO A
- +1 IF $ASCII(X)=65
- GOTO D
- B SET DIC=66
- SET DIC(0)="AEQM"
- SET DIC("S")="I $P(^(0),U,4)=""BB"""
- DO ^DIC
- KILL DIC
- IF Y<1
- GOTO END
- SET LRC=+Y
- SET LRC(1)=$PIECE(Y,"^",2)
- IF '$DATA(^LRO(69.2,LRAA,8,66,1,LRC))
- WRITE $CHAR(7),!,"There are no entries to print",!!
- GOTO B
- D DO B^LRU
- IF Y<0
- GOTO END
- SET LRLDT=LRLDT+.99
- SET LRSDT=LRSDT-.0001
- +1 SET ZTRTN="QUE^LRBLPQA"
- DO BEG^LRUTL
- IF POP!($DATA(ZTSK))
- GOTO END
- QUE USE IO
- DO L^LRU
- DO S^LRU
- DO H
- SET LR("F")=1
- IF $DATA(LRC)
- DO W
- GOTO OUT
- +1 SET LRC(1)=0
- FOR LRA=0:0
- SET LRC(1)=$ORDER(^LRO(69.2,LRAA,8,66,1,"B",LRC(1)))
- IF LRC(1)=""!(LR("Q"))
- QUIT
- FOR LRC=0:0
- SET LRC=$ORDER(^LRO(69.2,LRAA,8,66,1,"B",LRC(1),LRC))
- IF 'LRC!(LR("Q"))
- QUIT
- DO W
- OUT IF IOST'?1"C".E
- WRITE @IOF
- DO END
- DO END^LRUTL
- QUIT
- W IF $Y>(IOSL-10)
- DO H
- IF LR("Q")
- QUIT
- WRITE !!?20,LRC(1)
- +1 ;F LRD=0:0 S LRD=$O(^LRO(69.2,LRAA,8,66,1,LRC,1,LRD)) Q:'LRD!(LR("Q")) S LRB=^(LRD,0) I +LRB<LRLDT&(+LRB>LRSDT) S $P(^(0),"^",4)=1,SSN=$P(LRB,"^",3) D:$Y>(IOSL-10) H1 Q:LR("Q") S Y=+LRB D D^LRU D W1
- +2 ;IHS/ANMC/CLS 11/1/95
- FOR LRD=0:0
- SET LRD=$ORDER(^LRO(69.2,LRAA,8,66,1,LRC,1,LRD))
- IF 'LRD!(LR("Q"))
- QUIT
- SET LRB=^(LRD,0)
- IF +LRB<LRLDT&(+LRB>LRSDT)
- SET $PIECE(^(0),"^",4)=1
- SET HRCN=$PIECE(LRB,"^",3)
- IF $Y>(IOSL-10)
- DO H1
- IF LR("Q")
- QUIT
- SET Y=+LRB
- DO D^LRU
- DO W1
- +3 QUIT
- W1 ;W !!,Y," ",$P(LRB,"^",2)," SSN:",SSN
- +1 ;IHS/ANMC/CLS 11/1/95
- WRITE !!,Y," ",$PIECE(LRB,"^",2)," HRCN:",HRCN
- +2 FOR A=0:0
- SET A=$ORDER(^LRO(69.2,LRAA,8,66,1,LRC,1,LRD,1,A))
- IF 'A!(LR("Q"))
- QUIT
- SET LR=^(A,0)
- IF $Y>(IOSL-10)
- DO H2
- IF LR("Q")
- QUIT
- WRITE !,LR
- +3 QUIT
- EN ;
- +1 DO Z
- IF Y=-1
- GOTO END
- WRITE !!,"This option deletes inappropriate transfusion requests",!,"that have been previously printed. OK "
- SET %=2
- DO YN^LRU
- IF %'=1
- GOTO END
- +2 WRITE !
- FOR A=0:0
- SET A=$ORDER(^LRO(69.2,LRAA,8,66,1,A))
- IF 'A
- QUIT
- SET C=0
- DO K
- +3 WRITE !,"DONE",!
- GOTO END
- K FOR B=0:0
- SET B=$ORDER(^LRO(69.2,LRAA,8,66,1,A,1,B))
- IF 'B
- QUIT
- IF $PIECE(^(B,0),"^",4)
- KILL ^LRO(69.2,LRAA,8,66,1,A,1,B)
- SET C=C+1
- WRITE "."
- +1 IF 'C
- QUIT
- +2 SET X=^LRO(69.2,LRAA,8,66,1,A,1,0)
- SET Y=$PIECE(X,"^",4)-C
- +3 IF Y<1
- SET V=^LRO(69.2,LRAA,8,66,1,A,0)
- KILL ^LRO(69.2,LRAA,8,66,1,A),^LRO(69.2,LRAA,8,66,1,"B",V,A)
- SET Y=$ORDER(^LRO(69.2,LRAA,8,66,1,0))
- IF 'Y
- SET Y=0
- SET X=^LRO(69.2,LRAA,8,66,1,0)
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_Y_"^"_($PIECE(X,"^",4)-1)
- QUIT
- +4 SET X(1)=$ORDER(^LRO(69.2,LRAA,8,66,1,A,1,0))
- IF 'X(1)
- SET X(1)=0
- SET ^LRO(69.2,LRAA,8,66,1,A,1,0)=$PIECE(X,"^",1,2)_"^"_X(1)_"^"_Y
- QUIT
- +5 ;
- H IF $DATA(LR("F"))
- IF IOST?1"C".E
- DO M^LRU
- IF LR("Q")
- QUIT
- +1 DO F^LRU
- WRITE !,"BLOOD BANK",!?20
- DO I
- WRITE !,LR("%")
- QUIT
- H1 DO H
- IF LR("Q")
- QUIT
- WRITE !!?20,LRC(1)
- QUIT
- H2 ;D H1 Q:LR("Q") W ! S Y=+LRB D D^LRU W Y," ",$P(LRB,"^",2)," ",SSN Q
- +1 ;IHS/ANMC/CLS 11/1/95
- DO H1
- IF LR("Q")
- QUIT
- WRITE !
- SET Y=+LRB
- DO D^LRU
- WRITE Y," ",$PIECE(LRB,"^",2)," ",HRCN
- QUIT
- I WRITE "Inappropriate transfusion requests report"
- QUIT
- Z SET X="BLOOD BANK"
- DO ^LRUTL
- QUIT
- END DO V^LRU
- QUIT
