| 1 | LRBLPUS1 ;AVAMC/REG/CYM - PATIENT UNIT SELECTION ;11/12/96 21:05 ; 11/30/00 4:21pm
|
---|
| 2 | ;;5.2;LAB SERVICE;**72,139,247,267**;Sep 27, 1994
|
---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
---|
| 4 | ;References to ^DIC(4 in this routine are covered by DBIA 2508
|
---|
| 5 | K A,LRB(1),F,Z S Z=0,X="N",%DT="T" D ^%DT S N=Y,H=$P(Y,".") W !! S X=$$READ^LRBLB("Select UNIT: ")
|
---|
| 6 | Q:X=""!(X[U) I X["?"!(X=" ") D H G LRBLPUS1
|
---|
| 7 | I LR,$E(X,1,$L(LR(2)))=LR(2) D
|
---|
| 8 | .D ^LRBLBU
|
---|
| 9 | E W $$STRIP^LRBLB(.X) ; Strip off the data identifiers just in case
|
---|
| 10 | Q:'$D(X)
|
---|
| 11 | S DIC=65,DIC(0)="EQM",DIC("W")="W "" "",$P(^(0),U)",DIC("S")="I $P(^(0),U,16)=DUZ(2),$P(^(0),U,4)=C,$S('$D(^(4)):1,$P(^(4),U)="""":1,1:0)" D ^DIC K DIC S X=$P(Y,U,2)
|
---|
| 12 | I Y<1 W $C(7)," Enter a valid unit",!!,"You can only select units from your division [",LRAA(4),"]",!,"even though units from other divisions may be displayed." G LRBLPUS1
|
---|
| 13 | S Y=+Y L +^LRD(65,Y):2 I '$T W !!,$C(7),"This unit currently unavailable. Please try another ",!! G ^LRBLPUS1
|
---|
| 14 | D ALL G LRBLPUS1
|
---|
| 15 | ALL S LRB(1)=1,Q=$O(^LRD(65,"AI",C,X,0)) I Q S A=X,Q=$O(^LRD(65,"AI",C,A,0)) Q:'Q W !?3 D I G:$D(F) ^LRBLPUS2
|
---|
| 16 | K ^TMP($J) W !?3 S A(2)="",Z(1)=1,A=X D D G ^LRBLPUS2:$D(F) I A(2)?1P W $C(7) Q
|
---|
| 17 | I X'["E",X=+X,+$O(^LRD(65,"AI",X))=X S A=X_"?" D D
|
---|
| 18 | G ^LRBLPUS2:$D(F) W $C(7) Q
|
---|
| 19 | ;
|
---|
| 20 | H I '$D(^LRD(65,"AI",C)) W $C(7),!!,"No units to choose from !",! Q
|
---|
| 21 | I X'["??" W !,"ANSWER WITH UNIT ID",!,"DO YOU WANT THE ENTIRE ",LRAA(4)," ",$P(^LRD(65,0),U)," LIST ? " S %="" D RX^LRU Q:%'=1
|
---|
| 22 | S LR("M")=DUZ(2) I $P($G(^LAB(69.9,1,8.1,DUZ(2),0)),U,6) W !!,"DISPLAY AVAILABLE UNITS FROM OTHER DIVISIONS AS WELL" S %=2 D YN^LRU Q:%<1 S:%=1 LR("M")=""
|
---|
| 23 | S (A,A(2))=0,A(1)=$Y+21 W !?3 F B=0:0 S A=$O(^LRD(65,"AI",C,A)) Q:A="" F Q=0:0 S Q=$O(^LRD(65,"AI",C,A,Q)) Q:'Q D:$Y>A(1)!'$Y MORE Q:A(2)?1P D I
|
---|
| 24 | Q
|
---|
| 25 | ;
|
---|
| 26 | I I Q[".",Q<N K ^LRD(65,"AI",C,A,Q) Q
|
---|
| 27 | I Q<H K ^LRD(65,"AI",C,A,Q) Q
|
---|
| 28 | S V=$O(^LRD(65,"AI",C,A,Q,0)) I $D(^LRD(65,+V,4)),$P(^(4),"^")]"" K ^LRD(65,"AI",C,A,Q,V) Q
|
---|
| 29 | I LR("M") Q:$P($G(^LRD(65,V,0)),"^",16)'=DUZ(2)
|
---|
| 30 | I $D(^LRD(65,V,8)),+^(8) S Y=^(8) Q:+Y&(LRDFN'=+Y) W $S($P(Y,"^",3)="A":"aut",$P(Y,"^",3)="D":"dir",1:"")
|
---|
| 31 | S F=V_"^"_^LRD(65,V,0) I C(19),$P(F,"^",9)="POS",$D(R(LRB)) W:$D(LRB(1)) $C(7),!,$P(F,"^",2)," is Rh positive and the patient has ANTI-D antibodies." K F Q
|
---|
| 32 | I C(7)+C(8) S I(7)=$P(F,"^",8),I(8)=$P(F,"^",9) D OK Q:'$D(F)
|
---|
| 33 | S Z=Z+1 W:$D(Z(1)) $J(Z,2) W ?7,$P(F,"^",2),?20,$J($P(F,"^",8),2)," ",$P(F,"^",9) S Y=$P(F,"^",7) D DT^LRU W ?28,Y S Y=$P(F,"^",12) I Y,Y<LRV W "(",Y,"ml)"
|
---|
| 34 | S Y=+$P(F,"^",17) I Y'=DUZ(2) W ?45,$P($G(^DIC(4,Y,0)),U)
|
---|
| 35 | I C(9)=1,$D(R) S O=0 F O(1)=0:1 S O=$O(^LRD(65,V,70,O)) Q:'O W:'O(1) !?48,"Antigen(s) ABSENT:" W !?48,$P(^LAB(61.3,O,0),"^")
|
---|
| 36 | W !?3 Q
|
---|
| 37 | ;
|
---|
| 38 | D K F F B=0:0 S A=$O(^LRD(65,"AI",C,A)) Q:$E(A,1,$L(X))'=X F Q=0:0 S Q=$O(^LRD(65,"AI",C,A,Q)) Q:'Q!($A(A)>122) D I I $D(F) S ^TMP($J,Z)=F K F I Z#5=0 D C Q:A(2)?1P
|
---|
| 39 | D:Z#5&('$D(F)) C Q
|
---|
| 40 | ;
|
---|
| 41 | OK I C(7)=1,I(7)'=LRPABO K F Q
|
---|
| 42 | I C(8)=1,I(8)'=LRPRH K F Q
|
---|
| 43 | I C(7)=1,C(8)=1 G CK
|
---|
| 44 | I C(7) D @($S(C(9)'=2:LRPABO,1:LRPABO_"P")) Q:'$D(F)
|
---|
| 45 | I C(8),LRPRH="NEG"&(I(8)="POS") K F Q
|
---|
| 46 | CK S O=0 I $D(LRK) F O=0:0 S O=$O(^LRD(65,V,2,O)) Q:'O I $D(^LRD(65,"AP",O,V)) Q
|
---|
| 47 | I O>0 K F Q
|
---|
| 48 | I C(9)=1,$D(R) S O=0 F O(1)=0:1 S O=$O(^LRD(65,V,60,O)) Q:'O I $D(R(O)) K F Q
|
---|
| 49 | Q
|
---|
| 50 | O K:"AB"[I(7) F Q
|
---|
| 51 | A K:I(7)["B" F Q
|
---|
| 52 | B K:I(7)["A" F Q
|
---|
| 53 | AB Q
|
---|
| 54 | OP Q
|
---|
| 55 | AP K:I(7)="B"!(I(7)="O") F Q
|
---|
| 56 | BP K:I(7)="A"!(I(7)="O") F Q
|
---|
| 57 | ABP K:I(7)'="AB" F Q
|
---|
| 58 | ;
|
---|
| 59 | MORE R "'^' TO STOP: ",A(2):DTIME I A(2)?1P S A=$C(126) Q
|
---|
| 60 | S A(1)=A(1)+21 S:$Y<22 A(1)=$Y+21 W $C(13),$J("",15),$C(13),?3 Q
|
---|
| 61 | C I Z=1 S A(2)=1 G F
|
---|
| 62 | W $C(13),"TYPE '^' TO STOP OR",!,"CHOOSE 1-",Z R ": ",A(2):DTIME I A(2)?1P!'$T S A=$C(126) Q
|
---|
| 63 | I A(2)="" W !?3 Q
|
---|
| 64 | F I A(2)>0,A(2)<(Z+1) S F=^TMP($J,A(2))
|
---|
| 65 | S A(2)="^",A=$C(126) Q
|
---|