LRBLTA ; IHS/DIR/FJE - TRANSFUSION REACTION COUNTS 7/2/93 07:05 ;
;;5.2;LR;;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
D END,B^LRU G:Y<0 END W !!,"List patients " S %=2,LRF=0 D YN^LRU G:%<1 END S:%=1 LRF=1 W !
S ZTRTN="QUE^LRBLTA" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO K ^TMP($J) S LRSDT=9999998.9-LRSDT,LRLDT=9999997.9-LRLDT
D L^LRU,S^LRU,H S LR("F")=1
F LRDFN=0:0 S LRDFN=$O(^LR("AB",LRDFN)) Q:'LRDFN F LRR=0:0 S LRR=$O(^LR("AB",LRDFN,LRR)) Q:'LRR F LRI=LRLDT:0 S LRI=$O(^LR("AB",LRDFN,LRR,LRI)) Q:'LRI!(LRI>LRSDT) D S
F LRR=0:0 S LRR=$O(^TMP($J,LRR)) Q:'LRR!(LR("Q")) D:$Y>(IOSL-6) H Q:LR("Q") S LRR(1)=$P(^LAB(65.4,LRR,0),U) W !!,LRR(1),?31,$J(^TMP($J,LRR),4) D A
G:LR("Q") OUT W ! S A=0 F S A=$O(^TMP($J,"B",A)) Q:A=""!(LR("Q")) D:$Y>(IOSL-6) H Q:LR("Q") W !,A,?5,"= ",^TMP($J,"B",A)
OUT D:'LR("Q") ^LRBLTA1 D END^LRUTL,END Q
S S X=$G(^LR(LRDFN,1.6,LRI,0)),C=$P(X,"^",2) Q:'C
S:'$D(^TMP($J,LRR)) ^(LRR)=0 S ^(LRR)=^(LRR)+1
S:'$D(^TMP($J,LRR,C)) ^(C)=0 S ^(C)=^(C)+1 S:LRF ^(C,LRDFN,LRI)=+X_"^"_$P(X,"^",3) Q
A F LRC=0:0 S LRC=$O(^TMP($J,LRR,LRC)) Q:'LRC!(LR("Q")) D:$Y>(IOSL-6) H1 Q:LR("Q") S LRE=$P(^LAB(66,LRC,0),U,2) S:LRE]"" ^TMP($J,"B",LRE)=$P(^(0),U) W !?41,LRE,?51,$J(^TMP($J,LRR,LRC),4) D:LRF B
Q
B S LRDFN=0 F S LRDFN=$O(^TMP($J,LRR,LRC,LRDFN)) Q:'LRDFN!(LR("Q")) D N,C
Q
C ;S LRI=0 F S LRI=$O(^TMP($J,LRR,LRC,LRDFN,LRI)) Q:'LRI!(LR("Q")) S LRX=^(LRI) D:$Y>(IOSL-6) H2 Q:LR("Q") W !,SSN,?5,LRP,?36 S Y=+LRX D DT^LRU W Y,?67,$P(LRX,"^",2)
S LRI=0 F S LRI=$O(^TMP($J,LRR,LRC,LRDFN,LRI)) Q:'LRI!(LR("Q")) S LRX=^(LRI) D:$Y>(IOSL-6) H2 Q:LR("Q") W !,HRCN,?5,LRP,?36 S Y=+LRX D DT^LRU W Y,?67,$P(LRX,"^",2) ;IHS/ANMC/CLS 11/1/95
Q
N ;S X=^LR(LRDFN,0),Y=$P(X,"^",3),X=$P(X,"^",2),X=^DIC(X,0,"GL"),X=@(X_Y_",0)"),LRP=$P(X,"^"),SSN=$E($P(X,"^",9),6,9) Q
S X=^LR(LRDFN,0),(DFN,Y)=$P(X,"^",3),X=$P(X,"^",2),X=^DIC(X,0,"GL"),X=@(X_Y_",0)"),LRP=$P(X,"^"),SSN=$P(X,"^",9) D SSN^LRU Q ;IHS/ANMC/CLS 11/1/95
;
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
;D F^LRU W !,"TRANSFUSION REACTION COUNTS FROM ",LRSTR," TO ",LRLST,!,"REACTION",?31,"COUNT",?41,"COMPONENT",?51,"SUBCOUNT" W:LRF !,"SSN",?5,"Patient",?36,"Transfusion Date",?67,"Unit ID" W !,LR("%") Q
D F^LRU W !,"TRANSFUSION REACTION COUNTS FROM ",LRSTR," TO ",LRLST,!,"REACTION",?31,"COUNT",?41,"COMPONENT",?51,"SUBCOUNT" W:LRF !,"HRCN",?10,"Patient",?36,"Transfusion Date",?67,"Unit ID" W !,LR("%") Q ;IHS/ANMC/CLS 11/1/95
H1 D H Q:LR("Q") W !,LRR(1) Q
H2 D H1 Q:LR("Q") W ?41,LRE Q
;
END D V^LRU Q
LRBLTA ; IHS/DIR/FJE - TRANSFUSION REACTION COUNTS 7/2/93 07:05 ;
+1 ;;5.2;LR;;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
+4 DO END
DO B^LRU
IF Y<0
GOTO END
WRITE !!,"List patients "
SET %=2
SET LRF=0
DO YN^LRU
IF %<1
GOTO END
IF %=1
SET LRF=1
WRITE !
+5 SET ZTRTN="QUE^LRBLTA"
DO BEG^LRUTL
IF POP!($DATA(ZTSK))
GOTO END
QUE USE IO
KILL ^TMP($JOB)
SET LRSDT=9999998.9-LRSDT
SET LRLDT=9999997.9-LRLDT
+1 DO L^LRU
DO S^LRU
DO H
SET LR("F")=1
+2 FOR LRDFN=0:0
SET LRDFN=$ORDER(^LR("AB",LRDFN))
IF 'LRDFN
QUIT
FOR LRR=0:0
SET LRR=$ORDER(^LR("AB",LRDFN,LRR))
IF 'LRR
QUIT
FOR LRI=LRLDT:0
SET LRI=$ORDER(^LR("AB",LRDFN,LRR,LRI))
IF 'LRI!(LRI>LRSDT)
QUIT
DO S
+3 FOR LRR=0:0
SET LRR=$ORDER(^TMP($JOB,LRR))
IF 'LRR!(LR("Q"))
QUIT
IF $Y>(IOSL-6)
DO H
IF LR("Q")
QUIT
SET LRR(1)=$PIECE(^LAB(65.4,LRR,0),U)
WRITE !!,LRR(1),?31,$JUSTIFY(^TMP($JOB,LRR),4)
DO A
+4 IF LR("Q")
GOTO OUT
WRITE !
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"B",A))
IF A=""!(LR("Q"))
QUIT
IF $Y>(IOSL-6)
DO H
IF LR("Q")
QUIT
WRITE !,A,?5,"= ",^TMP($JOB,"B",A)
OUT IF 'LR("Q")
DO ^LRBLTA1
DO END^LRUTL
DO END
QUIT
S SET X=$GET(^LR(LRDFN,1.6,LRI,0))
SET C=$PIECE(X,"^",2)
IF 'C
QUIT
+1 IF '$DATA(^TMP($JOB,LRR))
SET ^(LRR)=0
SET ^(LRR)=^(LRR)+1
+2 IF '$DATA(^TMP($JOB,LRR,C))
SET ^(C)=0
SET ^(C)=^(C)+1
IF LRF
SET ^(C,LRDFN,LRI)=+X_"^"_$PIECE(X,"^",3)
QUIT
A FOR LRC=0:0
SET LRC=$ORDER(^TMP($JOB,LRR,LRC))
IF 'LRC!(LR("Q"))
QUIT
IF $Y>(IOSL-6)
DO H1
IF LR("Q")
QUIT
SET LRE=$PIECE(^LAB(66,LRC,0),U,2)
IF LRE]""
SET ^TMP($JOB,"B",LRE)=$PIECE(^(0),U)
WRITE !?41,LRE,?51,$JUSTIFY(^TMP($JOB,LRR,LRC),4)
IF LRF
DO B
+1 QUIT
B SET LRDFN=0
FOR
SET LRDFN=$ORDER(^TMP($JOB,LRR,LRC,LRDFN))
IF 'LRDFN!(LR("Q"))
QUIT
DO N
DO C
+1 QUIT
C ;S LRI=0 F S LRI=$O(^TMP($J,LRR,LRC,LRDFN,LRI)) Q:'LRI!(LR("Q")) S LRX=^(LRI) D:$Y>(IOSL-6) H2 Q:LR("Q") W !,SSN,?5,LRP,?36 S Y=+LRX D DT^LRU W Y,?67,$P(LRX,"^",2)
+1 ;IHS/ANMC/CLS 11/1/95
SET LRI=0
FOR
SET LRI=$ORDER(^TMP($JOB,LRR,LRC,LRDFN,LRI))
IF 'LRI!(LR("Q"))
QUIT
SET LRX=^(LRI)
IF $Y>(IOSL-6)
DO H2
IF LR("Q")
QUIT
WRITE !,HRCN,?5,LRP,?36
SET Y=+LRX
DO DT^LRU
WRITE Y,?67,$PIECE(LRX,"^",2)
+2 QUIT
N ;S X=^LR(LRDFN,0),Y=$P(X,"^",3),X=$P(X,"^",2),X=^DIC(X,0,"GL"),X=@(X_Y_",0)"),LRP=$P(X,"^"),SSN=$E($P(X,"^",9),6,9) Q
+1 ;IHS/ANMC/CLS 11/1/95
SET X=^LR(LRDFN,0)
SET (DFN,Y)=$PIECE(X,"^",3)
SET X=$PIECE(X,"^",2)
SET X=^DIC(X,0,"GL")
SET X=@(X_Y_",0)")
SET LRP=$PIECE(X,"^")
SET SSN=$PIECE(X,"^",9)
DO SSN^LRU
QUIT
+2 ;
H IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
IF LR("Q")
QUIT
+1 ;D F^LRU W !,"TRANSFUSION REACTION COUNTS FROM ",LRSTR," TO ",LRLST,!,"REACTION",?31,"COUNT",?41,"COMPONENT",?51,"SUBCOUNT" W:LRF !,"SSN",?5,"Patient",?36,"Transfusion Date",?67,"Unit ID" W !,LR("%") Q
+2 ;IHS/ANMC/CLS 11/1/95
DO F^LRU
WRITE !,"TRANSFUSION REACTION COUNTS FROM ",LRSTR," TO ",LRLST,!,"REACTION",?31,"COUNT",?41,"COMPONENT",?51,"SUBCOUNT"
IF LRF
WRITE !,"HRCN",?10,"Patient",?36,"Transfusion Date",?67,"Unit ID"
WRITE !,LR("%")
QUIT
H1 DO H
IF LR("Q")
QUIT
WRITE !,LRR(1)
QUIT
H2 DO H1
IF LR("Q")
QUIT
WRITE ?41,LRE
QUIT
+1 ;
END DO V^LRU
QUIT
