| 1 | LRBLDUC ;AVAMC/REG/CYM - DONOR ABO/RH RECHECK ;7/5/96 22:39 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | D V^LRU S X="BLOOD BANK" D ^LRUTL G:Y=-1 END
|
|---|
| 5 | W !!?30,"Donor ABO/Rh Recheck",! I LRCAPA S X="DONOR ABO/RH RECHECK" D X^LRUWK G:'$D(X) END S Y="UC" D S^LRBLWD
|
|---|
| 6 | S LRB="",LRC=1 W !!,"Enter TEST COMMENT(s) " S %=2 D YN^LRU K:%=1 LRC
|
|---|
| 7 | DNR W ! K DA,LR,LRR S DIC="^LRE(",DIC(0)="AFQM",D="C^B",DIC("B")=LRB,DIC("A")="Select DONOR ID: " D MIX^DIC1 K DIC G:X=""!(X[U) END
|
|---|
| 8 | I Y<1 W $C(7),!!,"Complete DONOR ID must be entered (ex. If ID=H12345 then H123 unacceptable)." G DNR
|
|---|
| 9 | I X["," D ASK G:Y<1 DNR D CKRL,REST G DNR
|
|---|
| 10 | S LRQ=+Y,LRI=$O(^LRE("C",X,LRQ,0)) I 'LRI W $C(7)," ",X," does not exist. Try again" G DNR
|
|---|
| 11 | L +^LRE(LRQ,5,LRI,0):5 I '$T W !!,$C(7),"Sorry, someone else is editing this record" G DNR
|
|---|
| 12 | S LRQ(1)=$P(^LRE(LRQ,5,LRI,0),"^",4) D CKRL,REST L -^LRE(LRQ,5,LRI,0) G DNR
|
|---|
| 13 | ;
|
|---|
| 14 | REST S X(1)=$E(X,3,$L(X)),X(2)=X(1)+1,X(3)=$L(X(1))-$L(X(2)) I X(3) S X(2)=$E("00000",1,X(3))_X(2)
|
|---|
| 15 | S LRB=$E(X,1,2)_X(2),LRB=$S($D(^LRE("C",LRB)):LRB,1:"")
|
|---|
| 16 | S X=^LRE(LRQ,0),W(5)=$P(X,U,5),W(6)=$P(X,U,6)
|
|---|
| 17 | S Y=+^LRE(LRQ,5,LRI,0) D D^LRU W !!,"UNIT#:",LRQ(1)," Donation date:",Y I LRQ(1)="" W $C(7),!?35,"Must have UNIT # to proceed." Q
|
|---|
| 18 | W ! S DR="[LRBLDUC]",DIE="^LRE(",DA=LRQ D ^DIE K DIE,DR
|
|---|
| 19 | I $D(LRR) F A=0:0 S A=$O(LRA(A)) Q:'A I $D(^LRE(LRQ,5,LRI,A)),$P(^(A),"^") S LR=1
|
|---|
| 20 | I $D(LRR),'$D(^XUSEC("LRBLSUPER",DUZ)) W !,"One or more components were released. You may not edit existing test results."
|
|---|
| 21 | S Y="UC" D:LRCAPA SET^LRBLWD Q
|
|---|
| 22 | S ;from LRBLDUC input template only supervisor can edit data after release of components
|
|---|
| 23 | I $D(LRR),$P(LRM,U,4)]"",'$D(^XUSEC("LRBLSUPER",DUZ)) S Y=Z
|
|---|
| 24 | I $P(LRM,U)="" W $C(7),!,"ABO/Rh testing not completed." S Y=0
|
|---|
| 25 | Q
|
|---|
| 26 | ASK S LRQ=+Y,DIC="^LRE(LRQ,5,",DIC(0)="FAEQM",DIC("A")="Select DONATION DATE: " D ^DIC K DIC Q:Y<1
|
|---|
| 27 | S LRI=+Y,LRQ(1)=$P(^LRE(LRQ,5,LRI,0),U,4) Q
|
|---|
| 28 | ;
|
|---|
| 29 | CKRL F A=0:0 S A=$O(^LRE(LRQ,5,LRI,66,A)) Q:'A I $P(^(A,0),"^",8)=0 S LRR=1 Q
|
|---|
| 30 | Q
|
|---|
| 31 | END D V^LRU Q
|
|---|
