LRBLPTR1 ; IHS/DIR/FJE - TRANSFUSIONS/HEM RESULTS 3/5/91 09:20 ;
;;5.2;LR;;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
S LRS=$O(^LAB(61,"B","BLOOD",0)) I 'LRS W $C(7),!,"BLOOD must be an entry in TOPOGRAPHY file (#61)",! Q
S X="BLOOD BANK" D ^LRUTL Q:Y=-1 S B=0 F A=0:0 S A=$O(^LRO(69.2,LRAA,61,LRS,2,A)) Q:'A S Y=^(A,0),W=$P(Y,"^",2),Y=+Y D S
S LRT(0)=B I 'B W $C(7),!!,"Must have tests to print entered in the",!,"'Tests for inclusion in transfusion report option' in",!,"Blood bank supervisor menu",! Q
K ^TMP($J) I IOST?1"C".E W !!,"Please hold while I sort transfusions with hematology results..."
S LRP=0 F LRA=0:0 S LRP=$O(^TMP("LRBL",$J,LRP)) Q:LRP="" F LRDFN=0:0 S LRDFN=$O(^TMP("LRBL",$J,LRP,LRDFN)) Q:'LRDFN S X=^(LRDFN),LRLDT=9999998-$P(X,"^",2),LRSDT=9999999-$P(X,"^") D A
D WRT Q
A S ^TMP($J,LRDFN)="" F A=LRLDT:0 S A=$O(^LR(LRDFN,1.6,A)) Q:'A!(A>LRSDT) S X=^(A,0),^TMP($J,LRDFN,A,0)=+X,^(.1)=$P(X,"^",2,99)
F A=LRLDT:0 S A=$O(^LR(LRDFN,"CH",A)) Q:'A!(A>LRSDT) S X=^(A,0) F B=1:1:LRT(0) S Z=$S($D(^LR(LRDFN,"CH",A,LRV(B))):$P(^(LRV(B)),"^"),1:"") I Z]"",$P(X,"^",5)=LRS(B) S ^TMP($J,LRDFN,A,0)=+X,^(B)=Z
Q
WRT S N=0 F A=0:0 S N=$O(^TMP("LRBL",$J,N)) Q:N=""!(LR("Q")) F LRDFN=0:0 S LRDFN=$O(^TMP("LRBL",$J,N,LRDFN)) Q:'LRDFN!(LR("Q")) D W
Q
W D G S LRQ=0 D H Q:LR("Q")
F A=0:0 S A=$O(^TMP($J,LRDFN,A)) Q:'A!(LR("Q")) S T=+^(A,0) D T,P
Q:LR("Q") D:DFN ^LRBLPC1 Q
P D:$Y>(IOSL-6) H Q:LR("Q") W !,T S Q=$S($D(^TMP($J,LRDFN,A,.1)):^(.1),1:"") W:Q ?12,$E($P(^LAB(66,+Q,0),"^"),1,28),$S($P(Q,"^",6):"("_$P(Q,"^",6)_")",1:"")
Q:'$O(^TMP($J,LRDFN,A,.1))
S X(1)=0 F B=1:1:LRT(0) S X(1)=X(1)+1 S:$X>(IOM-9) X(1)=1 W:$X>(IOM-9) !?32 W ?32+(8*X(1)) I $D(^TMP($J,LRDFN,A,B)) W $J(^(B),5)
Q
S S X=^LAB(60,Y,0),X(1)=$S($D(^(.1)):$P(^(.1),"^"),1:"??"),Z=$S($D(^(1,W,0)):$P(^(0),"^",7),1:"")
S B=B+1,LRT(B)=$P($P(X,"^",5),";",2,3)_"^"_W_"^"_$P(X,"^")_"^"_Z_"^"_$P(^LAB(61,W,0),"^")_"^"_Y_"^"_X(1),LRV(B)=+LRT(B),LRS(B)=W Q
T S T=T_"000",T=$E(T,4,5)_"/"_$E(T,6,7)_$S(T[".":" "_$E(T,9,10)_":"_$E(T,11,12),1:"") Q
;
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,W(2),?31,W(10),?45,"DOB: ",W(4),!,"Location:",?12,W(5),!,"Mo/Da TIME",?12,"Blood component"
S X(1)=0 F X=1:1:LRT(0) S X(1)=X(1)+1 S:$X>(IOM-8) X(1)=1 W:$X>(IOM-8) !?32 W ?32+(8*X(1)),$P(LRT(X),"^",7)
W !,LR("%") Q
G ;S X=^LR(LRDFN,0),(LRDPF,LRPF)=$P(X,"^",2),Y=$P(X,"^",3),X=^DIC(LRPF,0,"GL"),X=@(X_Y_",0)"),W(2)=$P(X,"^"),DFN=$S(LRPF=2:Y,1:""),Y=$P(X,"^",3),SSN=$P(X,"^",9),W(5)=$S($D(^(.1)):^(.1),1:"") D SSN^LRU,D^LRU S W(4)=Y,W(10)=SSN Q
S X=^LR(LRDFN,0),(LRDPF,LRPF)=$P(X,"^",2),(DFN,Y)=$P(X,"^",3),X=^DIC(LRPF,0,"GL"),X=@(X_Y_",0)"),W(2)=$P(X,"^"),Y=$P(X,"^",3),SSN=$P(X,"^",9),W(5)=$S($D(^(.1)):^(.1),1:"") D SSN^LRU,D^LRU S W(4)=Y,W(10)=HRCN Q ;IHS/ANMC/CLS 11/1/95
;
LRBLPTR1 ; IHS/DIR/FJE - TRANSFUSIONS/HEM RESULTS 3/5/91 09:20 ;
+1 ;;5.2;LR;;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
+4 SET LRS=$ORDER(^LAB(61,"B","BLOOD",0))
IF 'LRS
WRITE $CHAR(7),!,"BLOOD must be an entry in TOPOGRAPHY file (#61)",!
QUIT
+5 SET X="BLOOD BANK"
DO ^LRUTL
IF Y=-1
QUIT
SET B=0
FOR A=0:0
SET A=$ORDER(^LRO(69.2,LRAA,61,LRS,2,A))
IF 'A
QUIT
SET Y=^(A,0)
SET W=$PIECE(Y,"^",2)
SET Y=+Y
DO S
+6 SET LRT(0)=B
IF 'B
WRITE $CHAR(7),!!,"Must have tests to print entered in the",!,"'Tests for inclusion in transfusion report option' in",!,"Blood bank supervisor menu",!
QUIT
+7 KILL ^TMP($JOB)
IF IOST?1"C".E
WRITE !!,"Please hold while I sort transfusions with hematology results..."
+8 SET LRP=0
FOR LRA=0:0
SET LRP=$ORDER(^TMP("LRBL",$JOB,LRP))
IF LRP=""
QUIT
FOR LRDFN=0:0
SET LRDFN=$ORDER(^TMP("LRBL",$JOB,LRP,LRDFN))
IF 'LRDFN
QUIT
SET X=^(LRDFN)
SET LRLDT=9999998-$PIECE(X,"^",2)
SET LRSDT=9999999-$PIECE(X,"^")
DO A
+9 DO WRT
QUIT
A SET ^TMP($JOB,LRDFN)=""
FOR A=LRLDT:0
SET A=$ORDER(^LR(LRDFN,1.6,A))
IF 'A!(A>LRSDT)
QUIT
SET X=^(A,0)
SET ^TMP($JOB,LRDFN,A,0)=+X
SET ^(.1)=$PIECE(X,"^",2,99)
+1 FOR A=LRLDT:0
SET A=$ORDER(^LR(LRDFN,"CH",A))
IF 'A!(A>LRSDT)
QUIT
SET X=^(A,0)
FOR B=1:1:LRT(0)
SET Z=$SELECT($DATA(^LR(LRDFN,"CH",A,LRV(B))):$PIECE(^(LRV(B)),"^"),1:"")
IF Z]""
IF $PIECE(X,"^",5)=LRS(B)
SET ^TMP($JOB,LRDFN,A,0)=+X
SET ^(B)=Z
+2 QUIT
WRT SET N=0
FOR A=0:0
SET N=$ORDER(^TMP("LRBL",$JOB,N))
IF N=""!(LR("Q"))
QUIT
FOR LRDFN=0:0
SET LRDFN=$ORDER(^TMP("LRBL",$JOB,N,LRDFN))
IF 'LRDFN!(LR("Q"))
QUIT
DO W
+1 QUIT
W DO G
SET LRQ=0
DO H
IF LR("Q")
QUIT
+1 FOR A=0:0
SET A=$ORDER(^TMP($JOB,LRDFN,A))
IF 'A!(LR("Q"))
QUIT
SET T=+^(A,0)
DO T
DO P
+2 IF LR("Q")
QUIT
IF DFN
DO ^LRBLPC1
QUIT
P IF $Y>(IOSL-6)
DO H
IF LR("Q")
QUIT
WRITE !,T
SET Q=$SELECT($DATA(^TMP($JOB,LRDFN,A,.1)):^(.1),1:"")
IF Q
WRITE ?12,$EXTRACT($PIECE(^LAB(66,+Q,0),"^"),1,28),$SELECT($PIECE(Q,"^",6):"("_$PIECE(Q,"^",6)_")",1:"")
+1 IF '$ORDER(^TMP($JOB,LRDFN,A,.1))
QUIT
+2 SET X(1)=0
FOR B=1:1:LRT(0)
SET X(1)=X(1)+1
IF $X>(IOM-9)
SET X(1)=1
IF $X>(IOM-9)
WRITE !?32
WRITE ?32+(8*X(1))
IF $DATA(^TMP($JOB,LRDFN,A,B))
WRITE $JUSTIFY(^(B),5)
+3 QUIT
S SET X=^LAB(60,Y,0)
SET X(1)=$SELECT($DATA(^(.1)):$PIECE(^(.1),"^"),1:"??")
SET Z=$SELECT($DATA(^(1,W,0)):$PIECE(^(0),"^",7),1:"")
+1 SET B=B+1
SET LRT(B)=$PIECE($PIECE(X,"^",5),";",2,3)_"^"_W_"^"_$PIECE(X,"^")_"^"_Z_"^"_$PIECE(^LAB(61,W,0),"^")_"^"_Y_"^"_X(1)
SET LRV(B)=+LRT(B)
SET LRS(B)=W
QUIT
T SET T=T_"000"
SET T=$EXTRACT(T,4,5)_"/"_$EXTRACT(T,6,7)_$SELECT(T[".":" "_$EXTRACT(T,9,10)_":"_$EXTRACT(T,11,12),1:"")
QUIT
+1 ;
H IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
IF LR("Q")
QUIT
+1 DO F^LRU
WRITE !,W(2),?31,W(10),?45,"DOB: ",W(4),!,"Location:",?12,W(5),!,"Mo/Da TIME",?12,"Blood component"
+2 SET X(1)=0
FOR X=1:1:LRT(0)
SET X(1)=X(1)+1
IF $X>(IOM-8)
SET X(1)=1
IF $X>(IOM-8)
WRITE !?32
WRITE ?32+(8*X(1)),$PIECE(LRT(X),"^",7)
+3 WRITE !,LR("%")
QUIT
G ;PTR1_source.html#xP">PTR1_source.html#xS">S X=^LR(LRDFN,0),(LRDPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PF,LRPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PF)=$PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P(X,"^",2),Y=$PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P(X,"^",3),X=^DIC(LRPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PF,0,"GL"),X=@(X_Y_",0)"),W(2)=$PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P(X,"^"),DFN=$PTR1_source.html#xP">PTR1_source.html#xS">S(LRPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PF=2:Y,1:""),Y=$PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P(X,"^",3),PTR1_source.html#xP">PTR1_source.html#xS">SPTR1_source.html#xP">PTR1_source.html#xS">SN=$PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P">PTR1_source.html#xP">PTR1_source.html#xPTR1_source.html#xP">P">PTR1_source.html#xP">P(X,"^",9),W(5)=$PTR1_source.html#xP">PTR1_source.html#xS">S($D(^(.1)):^(.1),1:"") D PTR1_source.html#xP">PTR1_source.html#xS">SPTR1_source.html#xP">PTR1_source.html#xS">SN^LRU,D^LRU PTR1_source.html#xP">PTR1_source.html#xS">S W(4)=Y,W(10)=PTR1_source.html#xP">PTR1_source.html#xS">SPTR1_source.html#xP">PTR1_source.html#xS">SN Q
+1 ;IHS/ANMC/CLS 11/1/95
SET X=^LR(LRDFN,0)
SET (LRDPF,LRPF)=$PIECE(X,"^",2)
SET (DFN,Y)=$PIECE(X,"^",3)
SET X=^DIC(LRPF,0,"GL")
SET X=@(X_Y_",0)")
SET W(2)=$PIECE(X,"^")
SET Y=$PIECE(X,"^",3)
SET SSN=$PIECE(X,"^",9)
SET W(5)=$SELECT($DATA(^(.1)):^(.1),1:"")
DO SSN^LRU
DO D^LRU
SET W(4)=Y
SET W(10)=HRCN
QUIT
+2 ;
