| [613] | 1 | LRBLDED ;AVAMC/REG/CYM - BLOOD DONOR EDIT ;5/1/97 12:10 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**90,247**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | O D END S LRC="",LRD("U")=1
|
|---|
| 5 | ASK S LRA=0 D G G:Y<1 END D REST G ASK
|
|---|
| 6 | REST I 'LRA W $C(7),!?28,"DONOR PREVIOUSLY ENTERED.",!?3,"THIS OPTION IS FOR ENTERING OLD DATA ON DONORS NOT PREVIOUSLY ENTERED !" Q
|
|---|
| 7 | S DR="[LRBLDOLD]" D ^DIE I $D(Y) W !,$C(7),"Respond to ALL prompts. No '^' allowed ! ENTRY DELETED" S DIK="^LRE(" D ^DIK K DIK Q
|
|---|
| 8 | SH W @IOF S DR="0;1;2;4" D EN^DIQ W !,"EDIT above information: " S %=2 D YN^LRU Q:%<1 I %=1 K DR S DR="[LRBLDEMO]" D ^DIE G SH
|
|---|
| 9 | S:'$D(^LRE(DA,5,0)) ^(0)="^65.54DA^^" S LRQ=DA
|
|---|
| 10 | DD W ! K LRZ S DA(1)=LRQ,DIC="^LRE(LRQ,5,",DIC(0)="AEQLM",DLAYGO=65 D ^DIC K DIC,DLAYGO Q:Y<1
|
|---|
| 11 | S DA=+Y,DIE="^LRE(LRQ,5,",DR=".011////^S X=DUZ;.14///^S X=""YES"";.01;.02//^S X=LRC;S:X LRC=$P(^LAB(65.4,X,0),U);.03;1//^S X=""WHOLE BLOOD"";S:X'=""N"" Y=1.1;2;S LRZ=1,Y=0;1.1//^S X=""HOMOLOGOUS"";3//^S X=""NONE"""
|
|---|
| 12 | D ^DIE G:$D(Y)!($D(LRZ)) DD
|
|---|
| 13 | ID R !,"DONOR UNIT ID: ",X:DTIME G:X=""!(X[U) DD S X(1)=DA D ^LRBLU I '$D(X) W $C(7),! W:$D(^DD(65.54,4,3)) ^(3) X:$D(^(4)) ^(4) G ID
|
|---|
| 14 | S $P(^LRE(LRQ,5,DA,0),"^",4)=X,^LRE("C",X,LRQ,DA)="" G DD
|
|---|
| 15 | ;
|
|---|
| 16 | D D END,G G:Y<1 END G:$D(LR("CK")) D S DR="[LRBLDEMO]" D ^DIE D FRE^LRU W @IOF S DR="0;1;2;4" D:$G(DA) EN^DIQ G D
|
|---|
| 17 | E D END,D^LRBLU G:'$D(X) END D G G:Y<1 END G:$D(LR("CK")) E S DR="[LRBLDCP]" D ^DIE D FRE^LRU G E
|
|---|
| 18 | B D END,G G:Y<1 END G:$D(LR("CK")) B S DR="[LRBLDEDIT]" D ^DIE D FRE^LRU G B
|
|---|
| 19 | C D END,G G:Y<1 END G:$D(LR("CK")) C S DR="[LRBLDON]" D ^DIE D FRE^LRU K LRP G C
|
|---|
| 20 | EN D G G:Y<1 END G:$D(LR("CK")) EN S DR=.085 D ^DIE D FRE^LRU G EN
|
|---|
| 21 | R D ^LRBLDRR Q
|
|---|
| 22 | G K LR("CK"),DA,DQ,DIC,DIE,DR S IOP="HOME" D ^%ZIS
|
|---|
| 23 | I '$D(LRAA) S X="BLOOD BANK" D ^LRUTL K LRDPAF
|
|---|
| 24 | S (DIC,DIE)="^LRE(",DIC(0)="AEQLMZ",DLAYGO=65,D="B^C^"_$S("NAFARMY"[DUZ("AG")&(DUZ("AG")]""):"G4^G",1:"D") W ! D MIX^DIC1 K DIC,DLAYGO,DR Q:Y<1
|
|---|
| 25 | S DA=+Y I $P(Y,U,3) S LRA=1,LRP=$P(Y,U,2) D ^LRBLD G:'$D(DA) G S Y=DA
|
|---|
| 26 | D CK^LRU Q
|
|---|
| 27 | ;
|
|---|
| 28 | END D V^LRU Q
|
|---|
