LRBLPBR ; IHS/DIR/FJE - BB TESTS REPORT 3/28/94 11:59 ;
;;5.2;LR;;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
GETP D:'$D(LRAA) A G:'$D(LRAA) END W ! K DIC D ^LRDPA G:LRDFN<1 END I '$D(^LR(LRDFN,"BB")) W $C(7),!?3,"No blood bank data for ",LRP G GETP
I '$D(^LRO(69.2,LRAA,3,LRDFN,0)) S ^(0)=LRDFN_"^"_LRLLOC,^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)="" L +^LRO(69.2,LRAA,3) S X=^LRO(69.2,LRAA,3,0),^(0)=$P(X,"^",1,2)_"^"_LRDFN_"^"_($P(X,"^",4)+1) L -^LRO(69.2,LRAA,3)
G GETP
;
CH D A G:'$D(LRAA) END D L G:'G END S LRAPX=1 D C W !!,"Save reports for reprinting " S %=2 D YN^LRU G:%<1 END S:%=1 LRSAV=1
DEV W !!,"Print component requests " S %=2 D YN^LRU Q:%<1 S:%=1 LRN(2)=1
W ! S ZTRTN="QUE^LRBLPBR" D BEG^LRUTL G:POP!($D(ZTSK)) END
;
QUE U IO K ^TMP("LRBL",$J) D L^LRU,S^LRU F X=2.91,8,10.3,11.3 S LRN(X)=$P(^DD(63.01,X,0),"^")
I $D(LR("S")) D SET G LST
S LRLLOC=0 F A=0:0 S LRLLOC=$O(^LRO(69.2,LRAA,3,"C",LRLLOC)) Q:LRLLOC="" F LRDFN=0:0 S LRDFN=$O(^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)) Q:'LRDFN D SET
LST S G=0
F S G=$O(^TMP("LRBL",$J,G)) Q:G=""!(LR("Q")) S N=0 F S N=$O(^TMP("LRBL",$J,G,N)) Q:N=""!(LR("Q")) S LRDFN=0 F S LRDFN=$O(^TMP("LRBL",$J,G,N,LRDFN)) Q:'LRDFN!(LR("Q")) S LR=^(LRDFN) D ^LRBLPBR1
I '$D(LRSAV) K ^LRO(69.2,LRAA,3) S ^LRO(69.2,LRAA,3,0)="^69.29A^^"
W:IOST'?1"C".E @IOF K ^TMP("LRBL",$J) D END^LRUTL,END Q
;
SET ;S W=^LR(LRDFN,0),Y=$P(W,"^",3),(LRDPF,P)=$P(W,"^",2),X=^DIC(P,0,"GL"),X=@(X_Y_",0)"),Z=+$G(^(.104)),Z(1)="^"_$P($G(^DD(P,.104,0)),"^",3),SSN=$P(X,"^",9) D SSN^LRU
S W=^LR(LRDFN,0),(DFN,Y)=$P(W,"^",3),(LRDPF,P)=$P(W,"^",2),X=^DIC(P,0,"GL"),X=@(X_Y_",0)"),Z=+$G(^(.104)),Z(1)="^"_$P($G(^DD(P,.104,0)),"^",3),SSN=$P(X,"^",9) D SSN^LRU ;IHS/ANMC/CLS 11/1/95
I Z,$D(@(Z(1)_Z_",0)")) S LRMD=$P(^(0),"^")
I 'Z S Z=$S($D(^LR(LRDFN,.2)):+^(.2),1:"") I Z,$D(^VA(200,Z,0)) S LRMD=$P(^(0),"^")
;S ^TMP("LRBL",$J,LRLLOC,$P(X,"^"),LRDFN)=$P(X,"^",3)_"^"_SSN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6)_"^"_LRMD Q
S ^TMP("LRBL",$J,LRLLOC,$P(X,"^"),LRDFN)=$P(X,"^",3)_"^"_HRCN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6)_"^"_LRMD Q ;IHS/ANMC/CLS 11/1/95
;
SGL D:'$D(LRAA) A G:'$D(LRAA) END K DIC S LRDPAF=1 W ! D ^LRDPA G:LRDFN<1 END I '$D(^LR(LRDFN,"BB")) W $C(7),!?3,"No blood bank data for ",LRP G SGL
S:LRLLOC="" LRLLOC="???"
S (LRSAV,LR("S"))=1 G DEV
;
DEL D A G:Y=-1 END D L G:'G END D C W $C(7),!!,"OK TO DELETE THE ",LRAA(1)," TEST REPORT QUEUE LIST" S %=2 D YN^LRU I %=1 K ^LRO(69.2,LRAA,3) S ^LRO(69.2,LRAA,3,0)="^69.29A^0^0" W $C(7),!,"LIST DELETED !" D END Q
W !!,"FINE, LET'S FORGET IT",! Q
C S X=$P(^LRO(69.2,LRAA,3,0),U,4) W !?30,"(",X," patient",$S(X>1:"s",1:""),")" Q
;
L S G=$O(^LRO(69.2,LRAA,3,0)) I 'G W $C(7),!!,"NO BLOOD BANK PATIENTS ON THE TEST REPORT QUEUE",!! Q
Q
;
A D END S X="BLOOD BANK" D ^LRUTL Q
;
END D V^LRU Q
LRBLPBR ; IHS/DIR/FJE - BB TESTS REPORT 3/28/94 11:59 ;
+1 ;;5.2;LR;;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
GETP IF '$DATA(LRAA)
DO A
IF '$DATA(LRAA)
GOTO END
WRITE !
KILL DIC
DO ^LRDPA
IF LRDFN<1
GOTO END
IF '$DATA(^LR(LRDFN,"BB"))
WRITE $CHAR(7),!?3,"No blood bank data for ",LRP
GOTO GETP
+1 IF '$DATA(^LRO(69.2,LRAA,3,LRDFN,0))
SET ^(0)=LRDFN_"^"_LRLLOC
SET ^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)=""
LOCK +^LRO(69.2,LRAA,3)
SET X=^LRO(69.2,LRAA,3,0)
SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRDFN_"^"_($PIECE(X,"^",4)+1)
LOCK -^LRO(69.2,LRAA,3)
+2 GOTO GETP
+3 ;
CH DO A
IF '$DATA(LRAA)
GOTO END
DO L
IF 'G
GOTO END
SET LRAPX=1
DO C
WRITE !!,"Save reports for reprinting "
SET %=2
DO YN^LRU
IF %<1
GOTO END
IF %=1
SET LRSAV=1
DEV WRITE !!,"Print component requests "
SET %=2
DO YN^LRU
IF %<1
QUIT
IF %=1
SET LRN(2)=1
+1 WRITE !
SET ZTRTN="QUE^LRBLPBR"
DO BEG^LRUTL
IF POP!($DATA(ZTSK))
GOTO END
+2 ;
QUE USE IO
KILL ^TMP("LRBL",$JOB)
DO L^LRU
DO S^LRU
FOR X=2.91,8,10.3,11.3
SET LRN(X)=$PIECE(^DD(63.01,X,0),"^")
+1 IF $DATA(LR("S"))
DO SET
GOTO LST
+2 SET LRLLOC=0
FOR A=0:0
SET LRLLOC=$ORDER(^LRO(69.2,LRAA,3,"C",LRLLOC))
IF LRLLOC=""
QUIT
FOR LRDFN=0:0
SET LRDFN=$ORDER(^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN))
IF 'LRDFN
QUIT
DO SET
LST SET G=0
+1 FOR
SET G=$ORDER(^TMP("LRBL",$JOB,G))
IF G=""!(LR("Q"))
QUIT
SET N=0
FOR
SET N=$ORDER(^TMP("LRBL",$JOB,G,N))
IF N=""!(LR("Q"))
QUIT
SET LRDFN=0
FOR
SET LRDFN=$ORDER(^TMP("LRBL",$JOB,G,N,LRDFN))
IF 'LRDFN!(LR("Q"))
QUIT
SET LR=^(LRDFN)
DO ^LRBLPBR1
+2 IF '$DATA(LRSAV)
KILL ^LRO(69.2,LRAA,3)
SET ^LRO(69.2,LRAA,3,0)="^69.29A^^"
+3 IF IOST'?1"C".E
WRITE @IOF
KILL ^TMP("LRBL",$JOB)
DO END^LRUTL
DO END
QUIT
+4 ;
SET ;S W=^LR(LRDFN,0),Y=$P(W,"^",3),(LRDPF,P)=$P(W,"^",2),X=^DIC(P,0,"GL"),X=@(X_Y_",0)"),Z=+$G(^(.104)),Z(1)="^"_$P($G(^DD(P,.104,0)),"^",3),SSN=$P(X,"^",9) D SSN^LRU
+1 ;IHS/ANMC/CLS 11/1/95
SET W=^LR(LRDFN,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 Z=+$GET(^(.104))
SET Z(1)="^"_$PIECE($GET(^DD(P,.104,0)),"^",3)
SET SSN=$PIECE(X,"^",9)
DO SSN^LRU
+2 IF Z
IF $DATA(@(Z(1)_Z_",0)"))
SET LRMD=$PIECE(^(0),"^")
+3 IF 'Z
SET Z=$SELECT($DATA(^LR(LRDFN,.2)):+^(.2),1:"")
IF Z
IF $DATA(^VA(200,Z,0))
SET LRMD=$PIECE(^(0),"^")
+4 ;S ^TMP("LRBL",$J,LRLLOC,$P(X,"^"),LRDFN)=$P(X,"^",3)_"^"_SSN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6)_"^"_LRMD Q
+5 ;IHS/ANMC/CLS 11/1/95
SET ^TMP("LRBL",$JOB,LRLLOC,$PIECE(X,"^"),LRDFN)=$PIECE(X,"^",3)_"^"_HRCN_"^"_$PIECE(W,"^",5)_"^"_$PIECE(W,"^",6)_"^"_LRMD
QUIT
+6 ;
SGL IF '$DATA(LRAA)
DO A
IF '$DATA(LRAA)
GOTO END
KILL DIC
SET LRDPAF=1
WRITE !
DO ^LRDPA
IF LRDFN<1
GOTO END
IF '$DATA(^LR(LRDFN,"BB"))
WRITE $CHAR(7),!?3,"No blood bank data for ",LRP
GOTO SGL
+1 IF LRLLOC=""
SET LRLLOC="???"
+2 SET (LRSAV,LR("S"))=1
GOTO DEV
+3 ;
DEL DO A
IF Y=-1
GOTO END
DO L
IF 'G
GOTO END
DO C
WRITE $CHAR(7),!!,"OK TO DELETE THE ",LRAA(1)," TEST REPORT QUEUE LIST"
SET %=2
DO YN^LRU
IF %=1
KILL ^LRO(69.2,LRAA,3)
SET ^LRO(69.2,LRAA,3,0)="^69.29A^0^0"
WRITE $CHAR(7),!,"LIST DELETED !"
DO END
QUIT
+1 WRITE !!,"FINE, LET'S FORGET IT",!
QUIT
C SET X=$PIECE(^LRO(69.2,LRAA,3,0),U,4)
WRITE !?30,"(",X," patient",$SELECT(X>1:"s",1:""),")"
QUIT
+1 ;
L SET G=$ORDER(^LRO(69.2,LRAA,3,0))
IF 'G
WRITE $CHAR(7),!!,"NO BLOOD BANK PATIENTS ON THE TEST REPORT QUEUE",!!
QUIT
+1 QUIT
+2 ;
A DO END
SET X="BLOOD BANK"
DO ^LRUTL
QUIT
+1 ;
END DO V^LRU
QUIT
