LRBLPIT ; IHS/DIR/FJE - PROLONGED TRANSFUSION TIMES 2/18/93 09:45 ;
;;5.2;LR;;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
D END W !?20,"Prolonged transfusion times"
D B^LRU G:Y<0 END S LRSDT=LRSDT-.0001,LRLDT=LRLDT+.99
S ZTRTN="QUE^LRBLPIT" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO K ^TMP($J) D L^LRU,S^LRU,H S LR("F")=1
F LRD=LRSDT:0 S LRD=$O(^LRD(65,"AB",LRD)) Q:'LRD!(LRD>LRLDT) F LRI=0:0 S LRI=$O(^LRD(65,"AB",LRD,LRI)) Q:'LRI I $D(^LRD(65,LRI,6)),$P(^(6),"^") S W(6)=^(6),W(4)=^(4),T=$P(W(4),"^",2),W(0)=^(0),C=$P(W(0),"^",4) D CK
S L=0 F A=0:0 S L=$O(^TMP($J,L)) Q:L=""!(LR("Q")) D:$Y>(IOSL-6) H Q:LR("Q") W !!!,"LOCATION: ",L F P=0:0 S P=$O(^TMP($J,L,P)) Q:'P D W
D END,END^LRUTL Q
W ;D:$Y>(IOSL-6) H1 Q:LR("Q") S X=^LR(P,0),LRDPF=$P(X,U,2),Y=$P(X,"^",3),X=^DIC(LRDPF,0,"GL"),Y=@(X_Y_",0)"),LRP=$P(Y,"^"),SSN=$P(Y,"^",9) D SSN^LRU
D:$Y>(IOSL-6) H1 Q:LR("Q") S X=^LR(P,0),LRDPF=$P(X,U,2),(DFN,Y)=$P(X,"^",3),X=^DIC(LRDPF,0,"GL"),Y=@(X_Y_",0)"),LRP=$P(Y,"^"),SSN=$P(Y,"^",9) D SSN^LRU ;IHS/ANMC/CLS 11/1/95
;W !!,"Patient: ",LRP,?41,"SSN: ",SSN F C=0:0 S C=$O(^TMP($J,L,P,C)) Q:'C!(LR("Q")) S C(1)=$E($P(^LAB(66,C,0),"^"),1,30) F LRI=0:0 S LRI=$O(^TMP($J,L,P,C,LRI)) Q:'LRI!(LR("Q")) S W=^(LRI) D P
W !!,"Patient: ",LRP,?41,"HRCN: ",HRCN F C=0:0 S C=$O(^TMP($J,L,P,C)) Q:'C!(LR("Q")) S C(1)=$E($P(^LAB(66,C,0),"^"),1,30) F LRI=0:0 S LRI=$O(^TMP($J,L,P,C,LRI)) Q:'LRI!(LR("Q")) S W=^(LRI) D P ;IHS/ANMC/CLS 11/1/95
Q
P D:$Y>(IOSL-6) H2 Q:LR("Q") W !,$P(W,"^"),?13,C(1),?44,$P(W,"^",2),?56,$P(W,"^",3),?68,$P(W,"^",5),?74,$J($P(W,"^",4),5) Q
CK S M=$P(^LAB(66,C,0),"^",24) Q:'M S R=$O(^LRD(65,LRI,3,0)) Q:'R S W(3)=^(R,0),R=+W(3),Z=LRD D H^LRUT S J=%H,J(0)=Z(3),Z=R D H^LRUT S X=J-%H*1440,Y=J(0)-Z(3),J=X+Y
Q:J'>M S L=$S($P(W(3),"^",4)]"":$P(W(3),"^",4),1:"??"),Y=+W(3) D D S Y(1)=Y,Y=LRD D D S Y(2)=Y,Y=$P(W(4),"^",3) I Y,$D(^VA(200,Y,0)) S Y=$P(^(0),"^",2)
S ^TMP($J,L,+W(6),C,LRI)=$P(W(0),"^")_"^"_Y(1)_"^"_Y(2)_"^"_J_"^"_Y Q
;
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,"LABORATORY SERVICE",!?9,"PROLONGED TRANSFUSION TIMES FROM ",LRSTR," TO ",LRLST
W !,"Unit ID",?13,"Blood Component",?44,"Relocated",?56,"Transfused",?67,"DspBy",?73,"Minutes"
W !,LR("%") Q
H1 D H Q:LR("Q") W !!!,"LOCATION: ",L Q
H2 ;D H1 Q:LR("Q") W !!,"Patient: ",LRP,?41,"SSN: ",SSN Q
D H1 Q:LR("Q") W !!,"Patient: ",LRP,?41,"HRCN: ",HRCN Q ;IHS/ANMC/CLS 11/1/95
;
D S Y=Y_"000",Y=$E(Y,4,5)_"/"_$E(Y,6,7)_$S(Y[".":" "_$E(Y,9,10)_":"_$E(Y,11,12),1:"") Q
END D V^LRU Q
LRBLPIT ; IHS/DIR/FJE - PROLONGED TRANSFUSION TIMES 2/18/93 09:45 ;
+1 ;;5.2;LR;;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
+4 DO END
WRITE !?20,"Prolonged transfusion times"
+5 DO B^LRU
IF Y<0
GOTO END
SET LRSDT=LRSDT-.0001
SET LRLDT=LRLDT+.99
+6 SET ZTRTN="QUE^LRBLPIT"
DO BEG^LRUTL
IF POP!($DATA(ZTSK))
GOTO END
QUE USE IO
KILL ^TMP($JOB)
DO L^LRU
DO S^LRU
DO H
SET LR("F")=1
+1 FOR LRD=LRSDT:0
SET LRD=$ORDER(^LRD(65,"AB",LRD))
IF 'LRD!(LRD>LRLDT)
QUIT
FOR LRI=0:0
SET LRI=$ORDER(^LRD(65,"AB",LRD,LRI))
IF 'LRI
QUIT
IF $DATA(^LRD(65,LRI,6))
IF $PIECE(^(6),"^")
SET W(6)=^(6)
SET W(4)=^(4)
SET T=$PIECE(W(4),"^",2)
SET W(0)=^(0)
SET C=$PIECE(W(0),"^",4)
DO CK
+2 SET L=0
FOR A=0:0
SET L=$ORDER(^TMP($JOB,L))
IF L=""!(LR("Q"))
QUIT
IF $Y>(IOSL-6)
DO H
IF LR("Q")
QUIT
WRITE !!!,"LOCATION: ",L
FOR P=0:0
SET P=$ORDER(^TMP($JOB,L,P))
IF 'P
QUIT
DO W
+3 DO END
DO END^LRUTL
QUIT
W ;D:$Y>(IOSL-6) H1 Q:LR("Q") S X=^LR(PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P,0),LRDPIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">PF=$PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P(X,U,2),Y=$PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P(X,"^",3),X=^DIC(LRDPIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">PF,0,"GL"),Y=@(X_Y_",0)"),LRPIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P=$PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P(Y,"^"),SSN=$PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P">PIT_source.html#xP">PIT_source.html#xPIT_source.html#xP">P">PIT_source.html#xP">P(Y,"^",9) D SSN^LRU
+1 ;IHS/ANMC/CLS 11/1/95
IF $Y>(IOSL-6)
DO H1
IF LR("Q")
QUIT
SET X=^LR(P,0)
SET LRDPF=$PIECE(X,U,2)
SET (DFN,Y)=$PIECE(X,"^",3)
SET X=^DIC(LRDPF,0,"GL")
SET Y=@(X_Y_",0)")
SET LRP=$PIECE(Y,"^")
SET SSN=$PIECE(Y,"^",9)
DO SSN^LRU
+2 ;W !!,"Patient: ",LRP,?41,"SSN: ",SSN F C=0:0 S C=$O(^TMP($J,L,P,C)) Q:'C!(LR("Q")) S C(1)=$E($P(^LAB(66,C,0),"^"),1,30) F LRI=0:0 S LRI=$O(^TMP($J,L,P,C,LRI)) Q:'LRI!(LR("Q")) S W=^(LRI) D P
+3 ;IHS/ANMC/CLS 11/1/95
WRITE !!,"Patient: ",LRP,?41,"HRCN: ",HRCN
FOR C=0:0
SET C=$ORDER(^TMP($JOB,L,P,C))
IF 'C!(LR("Q"))
QUIT
SET C(1)=$EXTRACT($PIECE(^LAB(66,C,0),"^"),1,30)
FOR LRI=0:0
SET LRI=$ORDER(^TMP($JOB,L,P,C,LRI))
IF 'LRI!(LR("Q"))
QUIT
SET W=^(LRI)
DO P
+4 QUIT
P IF $Y>(IOSL-6)
DO H2
IF LR("Q")
QUIT
WRITE !,$PIECE(W,"^"),?13,C(1),?44,$PIECE(W,"^",2),?56,$PIECE(W,"^",3),?68,$PIECE(W,"^",5),?74,$JUSTIFY($PIECE(W,"^",4),5)
QUIT
CK SET M=$PIECE(^LAB(66,C,0),"^",24)
IF 'M
QUIT
SET R=$ORDER(^LRD(65,LRI,3,0))
IF 'R
QUIT
SET W(3)=^(R,0)
SET R=+W(3)
SET Z=LRD
DO H^LRUT
SET J=%H
SET J(0)=Z(3)
SET Z=R
DO H^LRUT
SET X=J-%H*1440
SET Y=J(0)-Z(3)
SET J=X+Y
+1 IF J'>M
QUIT
SET L=$SELECT($PIECE(W(3),"^",4)]"":$PIECE(W(3),"^",4),1:"??")
SET Y=+W(3)
DO D
SET Y(1)=Y
SET Y=LRD
DO D
SET Y(2)=Y
SET Y=$PIECE(W(4),"^",3)
IF Y
IF $DATA(^VA(200,Y,0))
SET Y=$PIECE(^(0),"^",2)
+2 SET ^TMP($JOB,L,+W(6),C,LRI)=$PIECE(W(0),"^")_"^"_Y(1)_"^"_Y(2)_"^"_J_"^"_Y
QUIT
+3 ;
H IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
IF LR("Q")
QUIT
+1 DO F^LRU
WRITE !,"LABORATORY SERVICE",!?9,"PROLONGED TRANSFUSION TIMES FROM ",LRSTR," TO ",LRLST
+2 WRITE !,"Unit ID",?13,"Blood Component",?44,"Relocated",?56,"Transfused",?67,"DspBy",?73,"Minutes"
+3 WRITE !,LR("%")
QUIT
H1 DO H
IF LR("Q")
QUIT
WRITE !!!,"LOCATION: ",L
QUIT
H2 ;D H1 Q:LR("Q") W !!,"Patient: ",LRP,?41,"SSN: ",SSN Q
+1 ;IHS/ANMC/CLS 11/1/95
DO H1
IF LR("Q")
QUIT
WRITE !!,"Patient: ",LRP,?41,"HRCN: ",HRCN
QUIT
+2 ;
D SET Y=Y_"000"
SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_$SELECT(Y[".":" "_$EXTRACT(Y,9,10)_":"_$EXTRACT(Y,11,12),1:"")
QUIT
END DO V^LRU
QUIT
