| 1 | LRBLJM ;AVAMC/REG/CYM - EDIT POOLED UNIT ;9/26/97 13:01 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**90,247,267**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | D END S X="BLOOD BANK" D ^LRUTL G:Y=-1 END D BAR^LRBLB
|
|---|
| 5 | ASK W !! S X=$$READ^LRBLB("Select POOLED UNIT: ") G:X=""!(X[U) END
|
|---|
| 6 | I X'["?",LR,$E(X,1,$L(LR(2)))=LR(2) D ^LRBLBU G:'$D(X) ASK
|
|---|
| 7 | W:'LR $$STRIP^LRBLB(.X) ; Strip off the data identifiers just in case
|
|---|
| 8 | I '$O(^LRD(65,"B",X,0)) W $C(7)," Must enter a specific unit" G ASK
|
|---|
| 9 | D REST,K^LRU
|
|---|
| 10 | I $D(LRLOCK) L -^LRD(65,LRLOCK)
|
|---|
| 11 | K ^TMP($J),LRV,LRP,DA,LRLOCK G ASK
|
|---|
| 12 | REST S LR("Q")=0,DIC="^LRD(65,",DIC(0)="EFQMZ",DIC("S")="I $P($G(^LAB(66,+$P(^(0),U,4),0)),U,27)"
|
|---|
| 13 | D ^DIC K DIC Q:Y<1 S LRP=+Y,LRW=Y(0),LRA=$P(^LAB(66,$P(Y(0),U,4),0),U,26) D L Q:LRL
|
|---|
| 14 | I $P(^LRD(65,LRP,0),U,16)'=DUZ(2) W $C(7),!!,"You can only edit Pooled Units from your own division.",! G ASK
|
|---|
| 15 | I '$O(^LRD(65,LRP,9,0)) W $C(7),!,"No units in pool." Q
|
|---|
| 16 | W !?5,"Units in pool: " S E=0 F LRB=0:0 S LRB=$O(^LRD(65,LRP,9,LRB)) Q:'LRB!(LR("Q")) S X=^(LRB,0),Y=$P(X,"^",2),LRZ=+X D:Y]"" W
|
|---|
| 17 | Q:'$D(^TMP($J))!(LR("Q"))
|
|---|
| 18 | S S DIR(0)="S^A:Add unit to pool;R:Remove unit from pool;D:Delete the pool" D ^DIR
|
|---|
| 19 | G:$D(DIRUT) END
|
|---|
| 20 | D @(Y_"^LRBLJM1")
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | W S LRV=0 F B=0:0 S B=$O(^LRD(65,"B",Y,B)) Q:'B S W=^LRD(65,B,0),W(4)=$P(^LAB(66,LRZ,0),U) I $P(W,U,4)=LRZ S LRV=1,E=E+1,^TMP($J,E)=LRB_U_B_U_$P(W,U)_U_W(4) W !?7,$P(W,U),?25,W(4) D:E#21=0 M^LRU Q:LR("Q")
|
|---|
| 24 | I 'LRV S LR("Q")=1 D F
|
|---|
| 25 | Q
|
|---|
| 26 | F W $C(7),!!?7,Y,?25,$P(^LAB(66,LRZ,0),U)," not correct" S DIC="^LAB(66,",DIC(0)="AEQM",DIC("S")="I $P(^(0),U,26)=LRA",DIC("A")="Select CORRECT COMPONENT: " D ^DIC K DIC Q:Y<1 S $P(^LRD(65,LRP,9,LRB,0),U)=+Y
|
|---|
| 27 | S DA(1)=LRP,DA=LRB,X=+Y,O=LRZ,Z="65.091,.01" D EN^LRUD
|
|---|
| 28 | Q
|
|---|
| 29 | L ;
|
|---|
| 30 | S LRL=0
|
|---|
| 31 | I $D(LRLOCK)#2 L -^LRD(65,LRLOCK)
|
|---|
| 32 | S LRLOCK=LRP L +^LRD(65,LRP):1
|
|---|
| 33 | I '$T W !,$C(7),"ANOTHER TERMINAL IS EDITING ",$P(^LRD(65,LRP,0),U) S LRL=1
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | END D V^LRU Q
|
|---|
