| [613] | 1 | LRBLJU ;AVAMC/REG - FIND UNITS NO DISPOSITION ;10/6/95 10:10 ;
|
|---|
| 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 | S %DT="T",X="N" D ^%DT S N=Y,E(1)=$S($D(E(1)):E(1),1:DT-.0001) S:'$D(LROPT) LROPT=""
|
|---|
| 5 | S IOP="HOME" D ^%ZIS W !!?20,$S($D(A)#2:A,1:""),!!
|
|---|
| 6 | ASK R !,"Select: (A)ll blood components or (S)pecific component: ",S:DTIME G:S=""!(S[U) END G:S?1"A".E T I S'?1"S" W !!,"Enter A to list all components or S for a specific component",! G ASK
|
|---|
| 7 | S DIC=66,DIC(0)="AEQMZ",DIC("A")="Select BLOOD COMPONENT: ",DIC("S")="I $P(^(0),U,4)=""BB""" D ^DIC K DIC G:X=""!(X[U) END S C=+Y,C(1)=$P(Y(0),"^",3)
|
|---|
| 8 | T R !,"Select: (A)ll units or (S)pecific ABO/Rh: ",X:DTIME G:X=""!(X[U) END G DEV:X?1"A".E I X'?1"S".E W !!,"Select A for all units or S for specific T & Rh",! G T
|
|---|
| 9 | AB R !,"ABO GROUP: ",X:DTIME G:X=""!(X[U) END S T=$S(X="A":"A",X="O":"O",X="B":"B",X="AB":"AB",1:"") I T="" W $C(7),!!,"Enter A, O, B, or AB",! G AB
|
|---|
| 10 | R R !,"Rh TYPE: ",X:DTIME G:X=""!(X[U) END S R=$S(X?1"P".E:"POS",X?1"N".E:"NEG",1:"") I R="" W $C(7),!!,"Enter P or N",! G R
|
|---|
| 11 | DEV S ZTRTN="QUE^LRBLJU" D BEG^LRUTL G:POP!($D(ZTSK)) END
|
|---|
| 12 | QUE U IO K ^TMP($J) D L^LRU,S^LRU
|
|---|
| 13 | G:S?1"A".E ALL
|
|---|
| 14 | L S E=E(1) F E=E:0 S E=$O(^LRD(65,"AE",C,E)) Q:'E D I
|
|---|
| 15 | Q:S?1"A".E
|
|---|
| 16 | OUT D ^LRBLJU1 W:IOST'?1"C".E @IOF K ^TMP($J) D END^LRUTL,END Q
|
|---|
| 17 | I I LROPT="" Q:E<N&(E[".") I E'[".",E<$P(N,".") Q
|
|---|
| 18 | F I=0:0 S I=$O(^LRD(65,"AE",C,E,I)) Q:'I D S
|
|---|
| 19 | Q
|
|---|
| 20 | S Q:'$D(^LRD(65,I,0)) I $D(^(4)),$P(^(4),"^")]"" K ^LRD(65,"AE",C,E,I) Q
|
|---|
| 21 | S W=^LRD(65,I,0) Q:$P(W,"^",16)'=DUZ(2)
|
|---|
| 22 | S LRB=$P(W,"^",7),R(1)=$S($P(W,"^",8)]"":$P(W,"^",8),1:"?"),LRLLOC=$O(^LRD(65,I,3,0)),LRLLOC=$S(LRLLOC="":"Bld Bank",1:$P(^(LRLLOC,0),"^",4))
|
|---|
| 23 | I $D(T)#2,$D(R) Q:T'=LRB!(R'=R(1))
|
|---|
| 24 | S ^TMP($J,C,LRB,R(1),$P(W,"^",6),$P(W,"^"))=I_"^"_LRLLOC Q
|
|---|
| 25 | ALL F C=0:0 S C=$O(^LRD(65,"AE",C)) Q:'C D L
|
|---|
| 26 | G OUT
|
|---|
| 27 | EN D END,SET G:Y=-1 END S LROPT="" G LRBLJU
|
|---|
| 28 | EN1 D END,SET G:Y=-1 END S E(1)=0,LROPT="EN1" G LRBLJU
|
|---|
| 29 | ;
|
|---|
| 30 | SET S X="BLOOD BANK" D ^LRUTL Q
|
|---|
| 31 | ;
|
|---|
| 32 | END D V^LRU Q
|
|---|
