- 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 ---[H[J[2J[HLRBLDRR2 1208 printed Jan 18, 2025@03:11:35 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