| [613] | 1 | LRBLPT ;AVAMC/REG - TRANSFUSION RESULTS ;9/7/95 08:59 ;
|
|---|
| 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 END S X="BLOOD BANK" D ^LRUTL G:Y=-1 END
|
|---|
| 5 | W !!?28,"Enter transfusion results"
|
|---|
| 6 | ASK W ! K ^TMP($J),LRZ,LRA,DIC,DIE,DR D ^LRDPA G:LRDFN=-1 END D R G ASK
|
|---|
| 7 | ;
|
|---|
| 8 | R I '$D(^LRD(65,"AP",LRDFN)) W $C(7),!!,"No units currently assigned/xmatched.",! Q
|
|---|
| 9 | W ! S DIC("B")=LRMD,DIC="^VA(200,",DIC(0)="AEQ",D="AK.PROVIDER",DIC("A")="Select PROVIDER: " D IX^DIC Q:Y<1 S X=+Y,LRMD=$P(Y,U,2),LRMD(1)=+Y K DIC
|
|---|
| 10 | T W !!,"Select TREATING SPECIALTY: ",LRS,$S(LRS]"":"// ",1:"") R X:DTIME Q:X[U!'$T I X="",LRS="" Q
|
|---|
| 11 | S:X="" X=LRS I X["?" S DIC=45.7,DIC(0)="EM" D ^DIC K DIC W !,"You may select a specialty not in the treating specialty file." G T
|
|---|
| 12 | X $P(^DD(65,6.3,0),"^",5,99) I '$D(X) W $C(7),! W:$D(^(3)) ^(3) X:$D(^(4)) ^(4) G T
|
|---|
| 13 | S DIC="^DIC(45.7,",DIC(0)="EM" D ^DIC K DIC
|
|---|
| 14 | I Y<1 W $C(7),!,"Not an entry in the TREATING SPECIALTY file.",!,"Still want to accept it " S %=2 D YN^LRU I %'=1 S LRS="" G T
|
|---|
| 15 | S LRS=$S(Y>0:$P(Y,"^",2),1:X),LRS(1)=$S(Y>0:+Y,1:"")
|
|---|
| 16 | W ! S (LRA,LRZ)=0,LRG=1 F LRB=1:1 S LRA=$O(^LRD(65,"AP",LRDFN,LRA)) Q:'LRA D:LRB#20=0 M D N
|
|---|
| 17 | K LRG I LRZ=1 S LRV=1 G ^LRBLPT1
|
|---|
| 18 | SEL W !!,"Select units (1-",LRZ,") to enter TRANSFUSION results: " R X:DTIME Q:X=""!(X[U) I X["?" W !,"Enter numbers from 1 to ",LRZ,!,"For 2 or more selections separate each with a ',' (ex. 1,3,4)",!,"Enter 'ALL' for all units." G SEL
|
|---|
| 19 | G:X="ALL" ALL
|
|---|
| 20 | I X?.E1CA.E!($L(X)>200) W $C(7),!,"No CONTROL CHARACTERS, LETTERS or more than 200 characters allowed." G SEL
|
|---|
| 21 | I '+X W $C(7),!,"START with a NUMBER !!",! G SEL
|
|---|
| 22 | S LRQ=X F LRB=0:0 S LRV=+LRQ,LRQ=$E(LRQ,$L(LRV)+2,$L(LRQ)) D:$D(^TMP($J,LRV)) ^LRBLPT1 Q:'$L(LRQ)
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | N W:LRB=1 !?6,"Unit assigned/xmatched:",?48,"Exp date",?64,"Loc"
|
|---|
| 26 | I '$D(^LRD(65,LRA,0)) K ^LRD(65,"AP",LRDFN,LRA) Q
|
|---|
| 27 | Q:$P(^LRD(65,LRA,0),"^",16)'=DUZ(2) I '$P(^LRD(65,LRA,2,LRDFN,0),"^",3) S X=$O(^LRD(65,LRA,2,LRDFN,1,0)) S:X X=+^(X,0) S:X $P(^LRD(65,LRA,2,LRDFN,0),"^",3)=X
|
|---|
| 28 | S X=^LRD(65,LRA,0),F=$O(^(3,0)) S:F F=$P(^(F,0),"^",4) S:F="" F="Blood Bank"
|
|---|
| 29 | S M=$P(^LAB(66,$P(X,"^",4),0),"^"),LRZ=LRZ+1,^TMP($J,LRZ)=LRA_"^"_$P(X,"^",4)_"^"_$P(X,"^")_"^"_$P(X,"^",7)_"^"_$P(X,"^",8)_"^"_$P(^LRD(65,LRA,2,LRDFN,0),"^",3)_"^"_F W ! W:$D(LRG) $J(LRZ,2),") "
|
|---|
| 30 | W $P(X,"^"),?17,$E(M,1,22),?40,$J($P(X,"^",7),2),?43,$P(X,"^",8),?48 S Y=$P(X,"^",6) D DT^LRU W Y,?64,F Q
|
|---|
| 31 | ;
|
|---|
| 32 | ALL F LRV=0:0 S LRV=$O(^TMP($J,LRV)) Q:'LRV D ^LRBLPT1
|
|---|
| 33 | Q
|
|---|
| 34 | M R !,"Press RETURN",X:DTIME W $C(13),$J("",15),$C(13) Q
|
|---|
| 35 | END D V^LRU Q
|
|---|
