source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRBLPA.m@ 1271

Last change on this file since 1271 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 1.6 KB
Line 
1LRBLPA ;AVAMC/REG/CYM - GET PATIENT INSTR./TESTS ; 7/22/97 19:58 ;
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 S:'$D(LRLLOC) LRLLOC="?" Q:LRLLOC["DIED" S:'$D(LRAA)#2 LRAA=$O(^LRO(68,"B","BLOOD BANK",0))
5 S (S,E,LRBBSPEC)=$O(^LAB(61,"B","BLOOD",0))
6 I 'E S (S,E,LRBBSPEC)=$O(^LAB(61,"B","PERIPHERAL BLOOD",0)) I 'E W $C(7),!,"BLOOD or PERIPHERAL BLOOD must be an entry in TOPOGRAPHY file (#61)",! Q
7 D:'$D(LRBLT) T
8 S X=$S('$D(LRPABO):1,LRPABO="":0,1:1)
9 S:X X=$S('$D(LRPRH):1,LRPRH="":0,1:1)
10 I 'X W $C(7),!!,"No Patient ABO &/or Rh !",! I $D(LRU(2)) S LRDFN=-1 Q
11 K V F A=0:0 S A=$O(LRBLT(A)) Q:'A S V(A)=LRBLT(A)
12 K Q W ! D D I '$D(LRQ) W !!,"OK TO CONTINUE " S %=1 D YN^LRU G:%'=1 END
13 W !! Q
14T S:LRAA="" LRAA=$O(^LRO(68,"B","BLOOD BANK",0))
15 F A=0:0 S A=$O(^LRO(69.2,LRAA,61,S,1,A)) Q:'A S Y=^(A,0),W=$P(Y,"^",2),Y=+Y D S
16 Q
17 ;
18X S W=$$FMTE^XLFDT(+W,"5F"),W=$TR(W," ","0")
19 S W=$TR(W,"@"," ")
20 Q
21 ;
22S S X=^LAB(60,Y,0),Z=$S($D(^(1,W,0)):$P(^(0),"^",7),1:""),LRBLT(A)=W_"^"_$P($P(X,"^",5),";",2,3)_"^"_$P(X,"^")_"^"_Z_"^"_$P(^LAB(61,W,0),"^")_"^"_Y
23 Q
24D F A=0:0 S A=$O(^LR(LRDFN,"CH",A)) Q:'A!('$D(V)) D
25 . S W=^LR(LRDFN,"CH",A,0),S=$P(W,"^",5)
26 . D X
27 . F B=0:0 S B=$O(V(B)) Q:'B D
28 .. I +V(B)=S,$D(^(+$P(V(B),"^",2))) S X=^(+$P(V(B),"^",2)) D W
29 Q
30W S Y=$P($P(V(B),"^",2),";",2),X=$P(X,"^",Y)
31 S S($P(V(B),"^",6),S)=X_"^"_$P(V(B),"^",3)_"^"_W_"^"_$P(V(B),"^",4)_"^"_$P(V(B),"^",5) W !,W,?18,"Last ",$P(V(B),"^",3),": ",X," ",$P(V(B),"^",4)," ",$P(V(B),"^",5) K V(B)
32 Q
33 ;
34END S Q("Q")=1 Q
Note: See TracBrowser for help on using the repository browser.