LRBLPR ; IHS/DIR/FJE - BLOOD BANK PT RECORD 2/18/93 09:46 ;
;;5.2;LR;;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
D END S X="BLOOD BANK" D ^LRUTL G:Y=-1 END
W !!?20,"PRINT CURRENT PATIENT BLOOD BANK RECORDS",!!,"The dates asked will be from the BLOOD BANK ACCESSION LIST:"
D B^LRU G:Y<0 END
W !!,"Print only patients with antibodies/special instructions " S %=1,LR(7)=0 D YN^LRU G:%<1 END I %=1 S LR(7)=1
ASK W !!,"Enter the maximum number of specimens to display",!,"in reverse chronological order for each patient: " R LR(8):DTIME Q:LR(8)[U
I LR(8)'?1N.N W $C(7),!,"ENTER A WHOLE NUMBER FROM 0-99" G ASK
I $S(+LR(8)<0:1,+LR(8)>99:1,1:0) W $C(7),!,"ENTER A WHOLE NUMBER FROM 0-99" G ASK
S LR(8)=+LR(8),ZTRTN="QUE^LRBLPR" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO W @IOF K ^TMP("LRBL",$J) D L^LRU,S^LRU S S=LRSDT-1
F A=S:0 S A=$O(^LRO(68,LRAA,1,A)) Q:'A!(A>LRLDT) F B=0:0 S B=$O(^LRO(68,LRAA,1,A,1,B)) Q:'B I $D(^(B,0)) S ^TMP("LRBL",$J,+^(0))=""
F A=0:0 S A=$O(^TMP("LRBL",$J,A)) Q:'A D S
D H S LR("F")=1
F LR=0:0 S LR=$O(^TMP("LRBL",$J,"B",LR)) Q:'LR!(LR("Q")) S LRP=0 F LR(1)=0:0 S LRP=$O(^TMP("LRBL",$J,"B",LR,LRP)) Q:LRP=""!(LR("Q")) D B
OUT K ^TMP("LRBL",$J),^TMP($J) W:IOST'?1"C".E @IOF D END^LRUTL,END Q
S ;Q:'$D(^LR(A,0)) S W=^(0),Y=$P(W,"^",3),(LRDPF,P)=$P(W,"^",2),X=^DIC(P,0,"GL"),X=@(X_Y_",0)"),SSN=$P(X,"^",9) D SSN^LRU S ^TMP("LRBL",$J,"B",P,$P(X,"^"),A)=$P(X,"^",3)_"^"_SSN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6) Q
Q:'$D(^LR(A,0)) S W=^(0),(DFN,Y)=$P(W,"^",3),(LRDPF,P)=$P(W,"^",2),X=^DIC(P,0,"GL"),X=@(X_Y_",0)"),SSN=$P(X,"^",9) D SSN^LRU S ^TMP("LRBL",$J,"B",P,$P(X,"^"),A)=$P(X,"^",3)_"^"_HRCN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6) Q ;IHS/ANMC/CLS 11/1/95
;
B F LRDFN=0:0 S LRDFN=$O(^TMP("LRBL",$J,"B",LR,LRP,LRDFN)) Q:'LRDFN!(LR("Q")) S LR(4)=^(LRDFN) D W
Q
W I LR(7),'$O(^LR(LRDFN,1.7,0)),'$O(^LR(LRDFN,3,0)) Q
D:$Y>(IOSL-6) H Q:LR("Q") S Y=+LR(4) D DT^LRU W !,LRP,?31,$P(LR(4),"^",2),?46,Y,?56,$J($P(LR(4),"^",3),2),?59,$P(LR(4),"^",4) D ^LRBLPR1 Q
;
H ;from LRBLPR1, LRBLPRA
I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,"BLOOD BANK PATIENTS" I $D(LRSTR),$D(LRLST) W " from ",LRSTR," to ",LRLST
;W !?10,"Patient",?34,"SSN",?49,"DOB",?55,"ABO",?59,"Rh",!,LR("%") Q
W !?10,"Patient",?34,"HRCN",?49,"DOB",?55,"ABO",?59,"Rh",!,LR("%") Q ;IHS/ANMC/CLS 11/1/95
;
END D V^LRU Q
LRBLPR ; IHS/DIR/FJE - BLOOD BANK PT RECORD 2/18/93 09:46 ;
+1 ;;5.2;LR;;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
+4 DO END
SET X="BLOOD BANK"
DO ^LRUTL
IF Y=-1
GOTO END
+5 WRITE !!?20,"PRINT CURRENT PATIENT BLOOD BANK RECORDS",!!,"The dates asked will be from the BLOOD BANK ACCESSION LIST:"
+6 DO B^LRU
IF Y<0
GOTO END
+7 WRITE !!,"Print only patients with antibodies/special instructions "
SET %=1
SET LR(7)=0
DO YN^LRU
IF %<1
GOTO END
IF %=1
SET LR(7)=1
ASK WRITE !!,"Enter the maximum number of specimens to display",!,"in reverse chronological order for each patient: "
READ LR(8):DTIME
IF LR(8)[U
QUIT
+1 IF LR(8)'?1N.N
WRITE $CHAR(7),!,"ENTER A WHOLE NUMBER FROM 0-99"
GOTO ASK
+2 IF $SELECT(+LR(8)<0:1,+LR(8)>99:1,1:0)
WRITE $CHAR(7),!,"ENTER A WHOLE NUMBER FROM 0-99"
GOTO ASK
+3 SET LR(8)=+LR(8)
SET ZTRTN="QUE^LRBLPR"
DO BEG^LRUTL
IF POP!($DATA(ZTSK))
GOTO END
QUE USE IO
WRITE @IOF
KILL ^TMP("LRBL",$JOB)
DO L^LRU
DO S^LRU
SET S=LRSDT-1
+1 FOR A=S:0
SET A=$ORDER(^LRO(68,LRAA,1,A))
IF 'A!(A>LRLDT)
QUIT
FOR B=0:0
SET B=$ORDER(^LRO(68,LRAA,1,A,1,B))
IF 'B
QUIT
IF $DATA(^(B,0))
SET ^TMP("LRBL",$JOB,+^(0))=""
+2 FOR A=0:0
SET A=$ORDER(^TMP("LRBL",$JOB,A))
IF 'A
QUIT
DO S
+3 DO H
SET LR("F")=1
+4 FOR LR=0:0
SET LR=$ORDER(^TMP("LRBL",$JOB,"B",LR))
IF 'LR!(LR("Q"))
QUIT
SET LRP=0
FOR LR(1)=0:0
SET LRP=$ORDER(^TMP("LRBL",$JOB,"B",LR,LRP))
IF LRP=""!(LR("Q"))
QUIT
DO B
OUT KILL ^TMP("LRBL",$JOB),^TMP($JOB)
IF IOST'?1"C".E
WRITE @IOF
DO END^LRUTL
DO END
QUIT
S ;Q:'$D(^LR(A,0)) S W=^(0),Y=$P(W,"^",3),(LRDPF,P)=$P(W,"^",2),X=^DIC(P,0,"GL"),X=@(X_Y_",0)"),SSN=$P(X,"^",9) D SSN^LRU S ^TMP("LRBL",$J,"B",P,$P(X,"^"),A)=$P(X,"^",3)_"^"_SSN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6) Q
+1 ;IHS/ANMC/CLS 11/1/95
IF '$DATA(^LR(A,0))
QUIT
SET W=^(0)
SET (DFN,Y)=$PIECE(W,"^",3)
SET (LRDPF,P)=$PIECE(W,"^",2)
SET X=^DIC(P,0,"GL")
SET X=@(X_Y_",0)")
SET SSN=$PIECE(X,"^",9)
DO SSN^LRU
SET ^TMP("LRBL",$JOB,"B",P,$PIECE(X,"^"),A)=$PIECE(X,"^",3)_"^"_HRCN_"^"_$PIECE(W,"^",5)_"^"_$PIECE(W,"^",6)
QUIT
+2 ;
B FOR LRDFN=0:0
SET LRDFN=$ORDER(^TMP("LRBL",$JOB,"B",LR,LRP,LRDFN))
IF 'LRDFN!(LR("Q"))
QUIT
SET LR(4)=^(LRDFN)
DO W
+1 QUIT
W IF LR(7)
IF '$ORDER(^LR(LRDFN,1.7,0))
IF '$ORDER(^LR(LRDFN,3,0))
QUIT
+1 IF $Y>(IOSL-6)
DO H
IF LR("Q")
QUIT
SET Y=+LR(4)
DO DT^LRU
WRITE !,LRP,?31,$PIECE(LR(4),"^",2),?46,Y,?56,$JUSTIFY($PIECE(LR(4),"^",3),2),?59,$PIECE(LR(4),"^",4)
DO ^LRBLPR1
QUIT
+2 ;
H ;from LRBLPR1, LRBLPRA
+1 IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
IF LR("Q")
QUIT
+2 DO F^LRU
WRITE !,"BLOOD BANK PATIENTS"
IF $DATA(LRSTR)
IF $DATA(LRLST)
WRITE " from ",LRSTR," to ",LRLST
+3 ;W !?10,"Patient",?34,"SSN",?49,"DOB",?55,"ABO",?59,"Rh",!,LR("%") Q
+4 ;IHS/ANMC/CLS 11/1/95
WRITE !?10,"Patient",?34,"HRCN",?49,"DOB",?55,"ABO",?59,"Rh",!,LR("%")
QUIT
+5 ;
END DO V^LRU
QUIT
