LRBLPBR ;AVAMC/REG - BB TESTS REPORT ;3/28/94 11:59 ;
;;5.2;LAB SERVICE;**247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
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)) D
. S ^LRO(69.2,LRAA,3,LRDFN,0)=LRDFN_"^"_LRLLOC,^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)=""
. L +^LRO(69.2,LRAA,3):5 I '$T G GETP
. 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 D FIELD^DID(63.01,X,"","LABEL","LRN") S LRN(X)=LRN("LABEL") K LRN("LABEL")
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
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),"^")
I 'Z S LRMD="UNKNOWN"
S ^TMP("LRBL",$J,LRLLOC,$P(X,"^"),LRDFN)=$P(X,"^",3)_"^"_SSN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6)_"^"_LRMD Q
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLPBR 2714 printed Dec 13, 2024@02:11:40 Page 2
LRBLPBR ;AVAMC/REG - BB TESTS REPORT ;3/28/94 11:59 ;
+1 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
+2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
GETP if '$DATA(LRAA)
DO A
+1 if '$DATA(LRAA)
GOTO END
+2 WRITE !
KILL DIC
DO ^LRDPA
if LRDFN<1
GOTO END
+3 IF '$DATA(^LR(LRDFN,"BB"))
WRITE $CHAR(7),!?3,"No blood bank data for ",LRP
GOTO GETP
+4 IF '$DATA(^LRO(69.2,LRAA,3,LRDFN,0))
Begin DoDot:1
+5 SET ^LRO(69.2,LRAA,3,LRDFN,0)=LRDFN_"^"_LRLLOC
SET ^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)=""
+6 LOCK +^LRO(69.2,LRAA,3):5
IF '$TEST
GOTO GETP
+7 SET X=^LRO(69.2,LRAA,3,0)
SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRDFN_"^"_($PIECE(X,"^",4)+1)
+8 LOCK -^LRO(69.2,LRAA,3)
End DoDot:1
+9 GOTO GETP
+10 ;
CH DO A
if '$DATA(LRAA)
GOTO END
+1 DO L
if 'G
GOTO END
+2 SET LRAPX=1
DO C
+3 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)
+1 DO L^LRU
DO S^LRU
+2 FOR X=2.91,8,10.3,11.3
DO FIELD^DID(63.01,X,"","LABEL","LRN")
SET LRN(X)=LRN("LABEL")
KILL LRN("LABEL")
+3 IF $DATA(LR("S"))
DO SET
GOTO LST
+4 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 SET W=^LR(LRDFN,0)
SET 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)
+1 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 IF 'Z
SET LRMD="UNKNOWN"
+5 SET ^TMP("LRBL",$JOB,LRLLOC,$PIECE(X,"^"),LRDFN)=$PIECE(X,"^",3)_"^"_SSN_"^"_$PIECE(W,"^",5)_"^"_$PIECE(W,"^",6)_"^"_LRMD
QUIT
+6 ;
SGL if '$DATA(LRAA)
DO A
+1 if '$DATA(LRAA)
GOTO END
+2 KILL DIC
SET LRDPAF=1
WRITE !
DO ^LRDPA
if LRDFN<1
GOTO END
+3 IF '$DATA(^LR(LRDFN,"BB"))
WRITE $CHAR(7),!?3,"No blood bank data for ",LRP
GOTO SGL
+4 if LRLLOC=""
SET LRLLOC="???"
+5 SET (LRSAV,LR("S"))=1
GOTO DEV
+6 ;
DEL DO A
if Y=-1
GOTO END
+1 DO L
if 'G
GOTO END
+2 DO C
WRITE $CHAR(7),!!,"OK TO DELETE THE ",LRAA(1)," TEST REPORT QUEUE LIST"
+3 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
+4 WRITE !!,"FINE, LET'S FORGET IT",!
QUIT
C SET X=$PIECE(^LRO(69.2,LRAA,3,0),U,4)
+1 WRITE !?30,"(",X," patient",$SELECT(X>1:"s",1:""),")"
QUIT
+2 ;
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
