LRBLDRR2.m

LRBLDRR2 ;AVAMC/REG/CYM - DO NOT RELEASE BLOOD COMPONENT ;6/26/96  12:06 ;

 ;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994

 ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021

A R !?5,"COMPONENT DISPOSITION: ",X:DTIME Q:X=""!(X[U)  I X["?" D C G A

 S Y=$S(X=1:"QUARANTINE",X=2:"DISCARD",$E("DISCARD",1,$L(X))=X:"DISCARD",$E("QUARANTINE",1,$L(X))=X:"QUARANTINE",1:"") W:X " ",Y W:'X $E(Y,$L(X)+1,$L(Y))

 I Y="" W $C(7) D C G A

 S Z=Y,DIE="^LRE(LRQ,5,LRI,66,",DA(2)=LRQ,DA(1)=LRI,DA=C,DR=".08///^S X=Z;.07////^S X=DUZ;.02//^S X=""NOW"";1" D ^DIE

 Q

EN ;from LRBLDRR1

 W !,"COMPONENT DISPOSITION & COMPONENT DISPOSITION COMMENT DELETED"

 S X=^LRE(LRQ,5,LRI,66,C,0),^(0)=+X_"^^"_$P(X,U,3)_U_$P(X,U,4)_U_$P(X,U,5)_U_$P(X,U,6) K ^LRE(LRQ,5,LRI,66,C,1) Q

C W !,"CHOOSE FROM:",!?7,1,?16,"QUARANTINE",!?7,2,?16,"DISCARD" Q

EN1 ;from LRBLDRR

 I LRJ(10.4)=""!("ABO"'[LRJ(10.4))!(LRJ(11.4)="")!("POSNEG"'[LRJ(11.4)) W $C(7),!!,"Must perform ABO/Rh recheck !!",! S A=1 Q

 I LRJ(10.4)'=LRJ(10) W $C(7),!!,"ABO Interpretation Recheck not same as ABO Interpretation " S A=1

 I LRJ(11)'[LRJ(11.4) W $C(7),!!,"Rh Interpretation Recheck not same as Rh Interpretation" S A=1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRBLDRR2   1208     printed  Apr 09, 2024@21:25:33                                                                                                                                                                                                    Page 2

LRBLDRR2  ;AVAMC/REG/CYM - DO NOT RELEASE BLOOD COMPONENT ;6/26/96  12:06 ;

 +1       ;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994

 +2       ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021

A          READ !?5,"COMPONENT DISPOSITION: ",X:DTIME

           if X=""!(X[U)

               QUIT 

           IF X["?"

               DO C

               GOTO A

 +1        SET Y=$SELECT(X=1:"QUARANTINE",X=2:"DISCARD",$EXTRACT("DISCARD",1,$LENGTH(X))=X:"DISCARD",$EXTRACT("QUARANTINE",1,$LENGTH(X))=X:"QUARANTINE",1:"")

           if X

               WRITE " ",Y

           if 'X

               WRITE $EXTRACT(Y,$LENGTH(X)+1,$LENGTH(Y))

 +2        IF Y=""

               WRITE $CHAR(7)

               DO C

               GOTO A

 +3        SET Z=Y

           SET DIE="^LRE(LRQ,5,LRI,66,"

           SET DA(2)=LRQ

           SET DA(1)=LRI

           SET DA=C

           SET DR=".08///^S X=Z;.07////^S X=DUZ;.02//^S X=""NOW"";1"

           DO ^DIE

 +4        QUIT 

EN        ;from LRBLDRR1

 +1        WRITE !,"COMPONENT DISPOSITION & COMPONENT DISPOSITION COMMENT DELETED"

 +2        SET X=^LRE(LRQ,5,LRI,66,C,0)

           SET ^(0)=+X_"^^"_$PIECE(X,U,3)_U_$PIECE(X,U,4)_U_$PIECE(X,U,5)_U_$PIECE(X,U,6)

           KILL ^LRE(LRQ,5,LRI,66,C,1)

           QUIT 

C          WRITE !,"CHOOSE FROM:",!?7,1,?16,"QUARANTINE",!?7,2,?16,"DISCARD"

           QUIT 

EN1       ;from LRBLDRR

 +1        IF LRJ(10.4)=""!("ABO"'[LRJ(10.4))!(LRJ(11.4)="")!("POSNEG"'[LRJ(11.4))

               WRITE $CHAR(7),!!,"Must perform ABO/Rh recheck !!",!

               SET A=1

               QUIT 

 +2        IF LRJ(10.4)'=LRJ(10)

               WRITE $CHAR(7),!!,"ABO Interpretation Recheck not same as ABO Interpretation "

               SET A=1

 +3        IF LRJ(11)'[LRJ(11.4)

               WRITE $CHAR(7),!!,"Rh Interpretation Recheck not same as Rh Interpretation"

               SET A=1

 +4        QUIT