LRBLPP.m

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 ---LRBLPP   812     printed  Apr 09, 2024@21:09:59                                                                                                                                                                                                       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