LRBLA1 ; IHS/DIR/AAB - BB ADM DATA 07:45 ; [ 6/21/96 ]
;;5.2;LR;**1002**;JUN 01, 1998
;;5.2;LAB SERVICE;**72**;Sep 27, 1994
K LRB D W S LRF=1 D H Q:LR("Q") D ^LRBLA2
Q:$O(^TMP("LR",$J,"N","T",0))=""&($O(^TMP("LR",$J,"N","P",0))="") D H Q:LR("Q") W !!,"COUNT",?7,"TEMPORARY DEFERRAL REASON"
F A=0:0 S A=$O(^TMP("LR",$J,"N","T",A)) Q:'A S Y=^(A),X=9999999-Y,^TMP("LR",$J,"Z",X,A)=Y
F LRX=0:0 S LRX=$O(^TMP("LR",$J,"Z",LRX)) Q:'LRX!(LR("Q")) D A Q:LR("Q")
Q:LR("Q") D:$Y>(IOSL-6) H Q:LR("Q") W !!,"PERMANENT DEFERRALS:",!,"--------------------" S LRP=0
F LRA=0:0 S LRP=$O(^TMP("LR",$J,"N","P",LRP)) Q:LRP=""!(LR("Q")) F LRB=0:0 S LRB=$O(^TMP("LR",$J,"N","P",LRP,LRB)) Q:'LRB!(LR("Q")) F LRD=0:0 S LRD=$O(^TMP("LR",$J,"N","P",LRP,LRB,LRD)) Q:'LRD!(LR("Q")) D D
Q
D D:$Y>(IOSL-6) H3 Q:LR("Q") S Y=9999999-LRD D D^LRU S LRY=Y W !!,LRP,?32,"Deferral Date: ",Y K ^TMP($J)
S LRE=0 F LRG=0:1 S LRE=$O(^LRE(LRB,99,LRE)) Q:'LRE!(LR("Q")) S LRX=^(LRE,0) D:$Y>(IOSL-6) H4 Q:LR("Q") S X=LRX D ^DIWP
D:LRG ^DIWW Q
;
A F LRA=0:0 S LRA=$O(^TMP("LR",$J,"Z",LRX,LRA)) Q:'LRA!(LR("Q")) S LRB=^(LRA),X=$S($D(^LAB(65.4,LRA,0)):^(0),1:""),LRD=$S($P(X,"^",3)]"":$P(X,"^",3),1:$P(X,"^")) D:$Y>(IOSL-6) H1 Q:LR("Q") W !,$J(LRB,4),?7,LRD
Q
;
S S X=" UNITS",LRF=0,LRB("S")="TOTAL"_X,LRB("H")="HOMOLOGOUS"_X,LRB("A")="AUTOLOGOUS"_X,LRB("T")="THERAPEUTIC"_X,LRB("D")="DIRECTED"_X D S^LRU
S Y=$P(^DD(66,.26,0),"^",3) F T="T","H","A","D","S" F A=1:1 S X=$P(Y,";",A) Q:X="" S Z=$P(X,":"),LRA(Z)=$P(X,":",2) F B="A","B","C","D","E","F" S ^TMP("LR",$J,T,B,Z)=0
F T=12:1:20 F E="WA","WD","WH","WT","PA","PD","PH","PT","CA","CD","CH","CT" S ^TMP("LR",$J,"Y",T,E)=0
F E="WA","WD","WH","WT","PA","PD","PH","PT","CA","CD","CH","CT" S ^TMP("LR",$J,"Y",E)=0
F T="WH","WA","WT","WD","PH","PA","PT","PD","CH","CA","CT","CD" S ^TMP("LR",$J,T)=0,^(T,"D")=0
S ^TMP("LR",$J,"N")=0,^("N","P")=0,^("T")=0 Q
W S X="WHOLE BLOOD",LRB("WH")=X_" HOMOLOGOUS",LRB("WA")=X_" AUTOLOGOUS",LRB("WD")=X_" DIRECTED",LRB("WT")=X_" THERAPEUTIC"
S X="PLASMAPHERESIS",LRB("PH")=X_" HOMOLOGOUS",LRB("PA")=X_" AUTOLOGOUS",LRB("PT")=X_" THERAPEUTIC",LRB("PD")=X_" DIRECTED"
S X="CYTAPHERESIS" S LRB("CH")=X_" HOMOLOGOUS",LRB("CA")=X_" AUTOLOGOUS",LRB("CT")=X_" THERAPEUTIC",LRB("CD")=X_" DIRECTED"
S LRB("N")="NO DONATION" Q
;
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,"Blood Bank Administrative Data from: ",LRSTR," to ",LRLST W:LRC !,"DIVISION: ",LRC(2) W !,LR("%") Q:LRF
W !,"| ",LRB(LRB),?20,"|",?30,"SOURCE",?40,"|",?50,"INVENTORY DISPOSITION",?79,"|"
W !,LR("%"),!,"|",?5,"COMPONENT",?20,"|Prepared",?30,"|Received",?40,"|Transfused",?51,"|Shipped",?59,"|Outdated",?69,"|Discarded",?79,"|",!,LR("%")
Q
H1 D H Q:LR("Q") W !,"COUNT",?7,"TEMPORARY DEFERRAL REASON" Q
H3 D H Q:LR("Q") W !,"PERMANENT DEFERRALS:" Q
H4 D H3 Q:LR("Q") W !,LRP,?31,"Deferral Date: ",LRY Q
LRBLA1 ; IHS/DIR/AAB - BB ADM DATA 07:45 ; [ 6/21/96 ]
+1 ;;5.2;LR;**1002**;JUN 01, 1998
+2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
+3 KILL LRB
DO W
SET LRF=1
DO H
IF LR("Q")
QUIT
DO ^LRBLA2
+4 IF $ORDER(^TMP("LR",$JOB,"N","T",0))=""&($ORDER(^TMP("LR",$JOB,"N","P",0))="")
QUIT
DO H
IF LR("Q")
QUIT
WRITE !!,"COUNT",?7,"TEMPORARY DEFERRAL REASON"
+5 FOR A=0:0
SET A=$ORDER(^TMP("LR",$JOB,"N","T",A))
IF 'A
QUIT
SET Y=^(A)
SET X=9999999-Y
SET ^TMP("LR",$JOB,"Z",X,A)=Y
+6 FOR LRX=0:0
SET LRX=$ORDER(^TMP("LR",$JOB,"Z",LRX))
IF 'LRX!(LR("Q"))
QUIT
DO A
IF LR("Q")
QUIT
+7 IF LR("Q")
QUIT
IF $Y>(IOSL-6)
DO H
IF LR("Q")
QUIT
WRITE !!,"PERMANENT DEFERRALS:",!,"--------------------"
SET LRP=0
+8 FOR LRA=0:0
SET LRP=$ORDER(^TMP("LR",$JOB,"N","P",LRP))
IF LRP=""!(LR("Q"))
QUIT
FOR LRB=0:0
SET LRB=$ORDER(^TMP("LR",$JOB,"N","P",LRP,LRB))
IF 'LRB!(LR("Q"))
QUIT
FOR LRD=0:0
SET LRD=$ORDER(^TMP("LR",$JOB,"N","P",LRP,LRB,LRD))
IF 'LRD!(LR("Q"))
QUIT
DO D
+9 QUIT
D IF $Y>(IOSL-6)
DO H3
IF LR("Q")
QUIT
SET Y=9999999-LRD
DO D^LRU
SET LRY=Y
WRITE !!,LRP,?32,"Deferral Date: ",Y
KILL ^TMP($JOB)
+1 SET LRE=0
FOR LRG=0:1
SET LRE=$ORDER(^LRE(LRB,99,LRE))
IF 'LRE!(LR("Q"))
QUIT
SET LRX=^(LRE,0)
IF $Y>(IOSL-6)
DO H4
IF LR("Q")
QUIT
SET X=LRX
DO ^DIWP
+2 IF LRG
DO ^DIWW
QUIT
+3 ;
A FOR LRA=0:0
SET LRA=$ORDER(^TMP("LR",$JOB,"Z",LRX,LRA))
IF 'LRA!(LR("Q"))
QUIT
SET LRB=^(LRA)
SET X=$SELECT($DATA(^LAB(65.4,LRA,0)):^(0),1:"")
SET LRD=$SELECT($PIECE(X,"^",3)]"":$PIECE(X,"^",3),1:$PIECE(X,"^"))
IF $Y>(IOSL-6)
DO H1
IF LR("Q")
QUIT
WRITE !,$JUSTIFY(LRB,4),?7,LRD
+1 QUIT
+2 ;
S SET X=" UNITS"
SET LRF=0
SET LRB("S")="TOTAL"_X
SET LRB("H")="HOMOLOGOUS"_X
SET LRB("A")="AUTOLOGOUS"_X
SET LRB("T")="THERAPEUTIC"_X
SET LRB("D")="DIRECTED"_X
DO S^LRU
+1 SET Y=$PIECE(^DD(66,.26,0),"^",3)
FOR T="T","H","A","D","S"
FOR A=1:1
SET X=$PIECE(Y,";",A)
IF X=""
QUIT
SET Z=$PIECE(X,":")
SET LRA(Z)=$PIECE(X,":",2)
FOR B="A","B","C","D","E","F"
SET ^TMP("LR",$JOB,T,B,Z)=0
+2 FOR T=12:1:20
FOR E="WA","WD","WH","WT","PA","PD","PH","PT","CA","CD","CH","CT"
SET ^TMP("LR",$JOB,"Y",T,E)=0
+3 FOR E="WA","WD","WH","WT","PA","PD","PH","PT","CA","CD","CH","CT"
SET ^TMP("LR",$JOB,"Y",E)=0
+4 FOR T="WH","WA","WT","WD","PH","PA","PT","PD","CH","CA","CT","CD"
SET ^TMP("LR",$JOB,T)=0
SET ^(T,"D")=0
+5 SET ^TMP("LR",$JOB,"N")=0
SET ^("N","P")=0
SET ^("T")=0
QUIT
W SET X="WHOLE BLOOD"
SET LRB("WH")=X_" HOMOLOGOUS"
SET LRB("WA")=X_" AUTOLOGOUS"
SET LRB("WD")=X_" DIRECTED"
SET LRB("WT")=X_" THERAPEUTIC"
+1 SET X="PLASMAPHERESIS"
SET LRB("PH")=X_" HOMOLOGOUS"
SET LRB("PA")=X_" AUTOLOGOUS"
SET LRB("PT")=X_" THERAPEUTIC"
SET LRB("PD")=X_" DIRECTED"
+2 SET X="CYTAPHERESIS"
SET LRB("CH")=X_" HOMOLOGOUS"
SET LRB("CA")=X_" AUTOLOGOUS"
SET LRB("CT")=X_" THERAPEUTIC"
SET LRB("CD")=X_" DIRECTED"
+3 SET LRB("N")="NO DONATION"
QUIT
+4 ;
H IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
IF LR("Q")
QUIT
+1 DO F^LRU
WRITE !,"Blood Bank Administrative Data from: ",LRSTR," to ",LRLST
IF LRC
WRITE !,"DIVISION: ",LRC(2)
WRITE !,LR("%")
IF LRF
QUIT
+2 WRITE !,"| ",LRB(LRB),?20,"|",?30,"SOURCE",?40,"|",?50,"INVENTORY DISPOSITION",?79,"|"
+3 WRITE !,LR("%"),!,"|",?5,"COMPONENT",?20,"|Prepared",?30,"|Received",?40,"|Transfused",?51,"|Shipped",?59,"|Outdated",?69,"|Discarded",?79,"|",!,LR("%")
+4 QUIT
H1 DO H
IF LR("Q")
QUIT
WRITE !,"COUNT",?7,"TEMPORARY DEFERRAL REASON"
QUIT
H3 DO H
IF LR("Q")
QUIT
WRITE !,"PERMANENT DEFERRALS:"
QUIT
H4 DO H3
IF LR("Q")
QUIT
WRITE !,LRP,?31,"Deferral Date: ",LRY
QUIT
