LRBLPP ;AVAMC/REG - BB PATIENT PRINT OPTS ; 7/18/88 07:0 ;
;;5.2;LAB SERVICE;**247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
S X="BLOOD BANK" D ^LRUTL Q:Y=-1
W @IOF W ?31,"Blood Bank Patient Print Options"
OPTS ;
R !!,"Select Blood Bank Patient Print Option: ",X:DTIME Q:X=""!(X[U)
F A=1:1 S Y=$P($T(OPT+A),";",3) Q:Y="" G:$E(X,1)=$P(Y,U,2) DO
W !!,"Select from:" G LST
DO W " ",$E($P(Y,U,1),7,$L($P(Y,U,1))),! S LROPT=$P(Y,U,3,4) D @LROPT G OPTS
LST F A=1:1 W !,?15,$P($P($T(OPT+A),";",3),U,1) Q:$T(OPT+A)=""
G OPTS
T S (BY,FLDS)="[LRBL TRANSFUSION REACTIONS]" G SET
SET D V^LRU S L=0,DIC="^LRD(65," K IOP G EN1^DIP
OPT ;;OPTION LIST
;;D ==> Display Blood bank record^D^^LRBLPD
;;T ==> Transfusion reactions report^T^T
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLPP 812 printed Oct 16, 2024@18:12:42 Page 2
LRBLPP ;AVAMC/REG - BB PATIENT PRINT OPTS ; 7/18/88 07:0 ;
+1 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
+2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
+3 SET X="BLOOD BANK"
DO ^LRUTL
if Y=-1
QUIT
+4 WRITE @IOF
WRITE ?31,"Blood Bank Patient Print Options"
OPTS ;
+1 READ !!,"Select Blood Bank Patient Print Option: ",X:DTIME
if X=""!(X[U)
QUIT
+2 FOR A=1:1
SET Y=$PIECE($TEXT(OPT+A),";",3)
if Y=""
QUIT
if $EXTRACT(X,1)=$PIECE(Y,U,2)
GOTO DO
+3 WRITE !!,"Select from:"
GOTO LST
DO WRITE " ",$EXTRACT($PIECE(Y,U,1),7,$LENGTH($PIECE(Y,U,1))),!
SET LROPT=$PIECE(Y,U,3,4)
DO @LROPT
GOTO OPTS
LST FOR A=1:1
WRITE !,?15,$PIECE($PIECE($TEXT(OPT+A),";",3),U,1)
if $TEXT(OPT+A)=""
QUIT
+1 GOTO OPTS
T SET (BY,FLDS)="[LRBL TRANSFUSION REACTIONS]"
GOTO SET
SET DO V^LRU
SET L=0
SET DIC="^LRD(65,"
KILL IOP
GOTO EN1^DIP
OPT ;;OPTION LIST
+1 ;;D ==> Display Blood bank record^D^^LRBLPD
+2 ;;T ==> Transfusion reactions report^T^T
