source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRBLTXA.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1LRBLTXA ;AVAMC/REG - TRANSFUSION FOLLOW-UP ;2/18/93 09:55 ;
2 ;;5.2;LAB SERVICE;**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 W !!,"Search for possible transfusion related disorders"
5 D B^LRU G:Y<0 END S X1=LRSDT,X2=-185 D C^%DTC S LRT=9999999-X,J=LRSDT-1,LRSDT=9999999-LRSDT,LRJ=9999998-LRLDT
6 S ZTRTN="QUE^LRBLTXA" D BEG^LRUTL G:POP!($D(ZTSK)) END
7QUE U IO K ^TMP($J) S LR("D")=0,Z(2)=$O(^LAB(61,"B","SERUM",0)),Z(3)=$O(^LAB(61,"B","BLOOD",0)),Z(5)=$O(^LAB(61,"B","PLASMA",0)) D L^LRU,S^LRU,H S LR("F")=1
8 F A=0:0 S A=$O(^LRO(69.2,LRAA,60,A)) Q:'A F B=0:0 S B=$O(^LRO(69.2,LRAA,60,A,1,B)) Q:'B S C=^(B,0),N(A,B)=$P(^LAB(60,+C,.1),"^"),L(A,B)=$P($P(^(0),"^",5),";",2)_"^"_$P(C,"^",2,3)
9 F A=J:0 S A=$O(^LRO(69,A)) Q:'A!(A>LRLDT) F B=0:0 S B=$O(^LRO(69,A,1,"AA",B)) Q:'B S T=$O(^LR(B,1.6,0)) I T,T<LRT D P
10 S LRP=0 F A=0:0 S LRP=$O(^TMP($J,LRP)) Q:LRP=""!(LR("Q")) F LRDFN=0:0 S LRDFN=$O(^TMP($J,LRP,LRDFN)) Q:'LRDFN!(LR("Q")) S LRP(1)=^(LRDFN),SSN=$P(LRP(1),"^"),LRDPF=$P(^LR(LRDFN,0),U,2) D SSN^LRU,T
11 W !,LR("%") S A=0 F B=0:0 S A=$O(LR("D",A)) Q:A="" D:$Y>(IOSL-6) H Q:LR("Q") W !,A,?5,"= ",LR("D",A)
12 D END^LRUTL,END Q
13T S W(1)=0 F LRI=LRJ:0 S LRI=$O(^LR(LRDFN,"CH",LRI)) Q:'LRI!(LRI>LRSDT)!(LR("Q")) S X=^(LRI,0),Y=+X_"000",T=$P(X,"^",5),T(1)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_" "_$S(Y[".":$E(Y,9,10)_":"_$E(Y,11,12),1:"") D W
14 I W(1),DFN S W(2)=LRP,W(10)=$P(LRP(1),"^"),W(5)=$P(LRP(1),"^",2),W(4)=$P(LRP(1),"^",4) D ^LRBLPC1
15 W:W(1) !,LR("%") Q
16W F LR=0:0 S LR=$O(L(LR)) Q:'LR!(LR("Q")) S J(2)=0 F B=0:0 S B=$O(L(LR,B)) Q:'B!(LR("Q")) D B Q:LR("Q")
17 Q
18B S J=$P(L(LR,B),"^",3),X=$S($D(^LR(LRDFN,"CH",LRI,+L(LR,B))):$P(^(+L(LR,B)),"^"),1:"") S:"<>"[$E(X) X=$E(X,2,99) I X]"",T=$P(L(LR,B),"^",2) D L Q:J(2)
19 Q
20L I $E(J)="[" Q:X'[$E(J,2,99) G M
21 I $E(J)="=" Q:X'=$E(J,2,99) G M
22 I X=+X,@(X_J) G M
23 Q
24M S J(2)=1,W(1)=W(1)+1,DFN=$P(LRP(1),"^",3),W(4)=$P(LRP(1),"^",4) D:$Y>(IOSL-6) H1 Q:LR("Q")
25 W:W(1)=1 !,LRP," SSN:",SSN," Loc: ",$P(LRP(1),"^",2) D:W(1)=1 A,C W !,T(1) W:T'=Z(2)&(T'=Z(3))&(T'=Z(5)) ?13,$E($P(^LAB(61,T,0),"^"),1,7)
26 F X=0:0 S X=$O(L(LR,X)) Q:'X I $D(^LR(LRDFN,"CH",LRI,+L(LR,X))) W ?(16+(X*8)),$J($P(^(+L(LR,X)),"^"),7)
27 S B=99 Q
28A F E=0:0 S E=$O(^LR(LRDFN,1.6,E)) Q:'E!(E>LRT)!(LR("Q")) S X=^(E,0),F=$E(X,1,5),G=$P(X,"^",2) S:'$D(E(F,G)) E(F,G)=0 S E(F,G)=E(F,G)+1
29 F F=0:0 S F=$O(E(F)) Q:'F!(LR("Q")) D:$Y>(IOSL-6) H2 Q:LR("Q") W !,$E(F,4,5)_"/"_$E(F,2,3) F G=0:0 S G=$O(E(F,G)) Q:'G S X=^LAB(66,G,0),Y=$P(X,"^",2) S:Y="" Y="?" W " ",Y,":",E(F,G) S LR("D",Y)=$P(X,"^")
30 K E Q
31C I LR W ! F X=0:0 S X=$O(N(LR,X)) Q:'X W ?(16+(X*8)),$J(N(LR,X),7)
32 Q
33P S X=^LR(B,0),Y=$P(X,"^",3),X=$P(X,"^",2),DFN=$S(X=2:Y,1:""),L=^DIC(X,0,"GL"),X=@(L_Y_",0)"),L=$S($D(@(L_Y_",.1)")):^(.1),$D(^LR(B,.1)):^(.1),1:"UNKNOWN"),Y=$P(X,"^",3) D:Y D^LRU S W(4)=Y
34 S ^TMP($J,$P(X,"^"),B)=$P(X,"^",9)_"^"_L_"^"_DFN_"^"_W(4) Q
35 ;
36END D V^LRU Q
37 ;
38H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
39 D F^LRU W !,"BLOOD BANK SEARCH FOR TRANSFUSION RELATED DISORDERS",!?24,"FROM ",LRSTR," TO ",LRLST,!,LR("%") Q
40H1 D H Q:LR("Q") W:W(1)>1 !,LRP," SSN:",SSN," Loc: ",$P(LRP(1),"^",2) D:W(1)>1 C Q
41H2 D H Q:LR("Q") W !,LRP," SSN:",SSN," Loc: ",$P(LRP(1),"^",2) Q
Note: See TracBrowser for help on using the repository browser.