source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRBLDCR.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1LRBLDCR ;AVAMC/REG - COMPONENT PREPARATION REPORT ;2/18/93 08:44 ;
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 W !?20,"Blood donor component preparation report"
5 D B^LRU G:Y<0 END S LRSDT=LRSDT-.0001,LRLDT=LRLDT+.99
6 S ZTRTN="QUE^LRBLDCR" D BEG^LRUTL G:POP!($D(ZTSK)) END
7QUE U IO K ^TMP($J) D L^LRU,S^LRU S LRA=$P(^DD(65.54,4.11,0),U,3),LRD=$P(^DD(65.54,6.1,0),U,3),LRB=$P(^DD(65.54,1.1,0),U,3) D H S LR("F")=1
8 F A=LRSDT:0 S A=$O(^LRE("AD",A)) Q:'A!(A>LRLDT) S C=9999999-A F B=0:0 S B=$O(^LRE("AD",A,B)) Q:'B I $D(^LRE(B,5,C,0)),$P(^(0),"^",4)]"" S E=^(0),F=$S($D(^(2)):^(2),1:"") D SET
9 F A=0:0 S A=$O(^TMP($J,A)) Q:'A!(LR("Q")) D:$Y>(IOSL-6) H Q:LR("Q") S Y=A D D^LRU S LRD=Y W !!,"DONATION DATE: ",Y S B=0 D A
10 Q:LR("Q") W !,LR("%") S A=0 F B=0:0 S A=$O(LRT(A)) Q:A=""!(LR("Q")) D:$Y>(IOSL-6) H3 Q:LR("Q") S X=$P($P(LRB,A_":",2),";") W !,$S(X]"":X,1:"?")," DONATION TYPE",?40,"COUNT:",$J(LRT(A),5)
11 Q:LR("Q") W !,LR("%") F A=0:0 S A=$O(LRC(A)) Q:'A!(LR("Q")) D:$Y>(IOSL-6) H3 Q:LR("Q") W !,$S($D(^LAB(66,A,0)):$P(^(0),"^"),1:"??"),?40,"COUNT:",$J(LRC(A),5)
12 D END,END^LRUTL Q
13A F C=1:1 S B=$O(^TMP($J,A,B)) Q:B=""!(LR("Q")) S E=^(B),M=$S($P(E,"^")]"":$P(E,"^"),1:"?") D:$Y>(IOSL-6) H1 Q:LR("Q") D W
14 Q
15W W !,B,?15,M,?19,$P(E,"^",2),?22,$P(E,"^",3),?29,$J($P(E,"^",4),4),?34,$J($P(E,"^",5),4),?39,$P(E,"^",6),?44,$P(E,"^",7) S:'$D(LRT(M)) LRT(M)=0 S LRT(M)=LRT(M)+1
16 S F=0 F G=0:1 S F=$O(^TMP($J,A,B,F)) Q:'F!(LR("Q")) S H=^(F) D:$Y>(IOSL-6) H4 Q:LR("Q") W:G ! W ?49,$P(H,"^"),?66,$J($P(H,"^",2),4),?71,$J($P(H,"^",3),5) S:'$D(LRC(F)) LRC(F)=0 S LRC(F)=LRC(F)+1
17 Q
18SET S G=$P(F,"^",9)_":",G=$P($P(LRA,G,2),";"),H=$P(E,"^",10)_":",H=$E($P($P(LRD,H,2),";"),1,4),I=$P(F,"^",8) I I,$D(^VA(200,I,0)) S I=$P(^(0),"^",2)
19 S Z=$P(F,"^",3) D H^LRUT S J(3)=%H,J(0)=Z(3),(J,Z)=$P(F,"^",2) I Z D H^LRUT S X=J(3)-%H*1440,Y=J(0)-Z(3),J=X+Y
20 S (K,Z)=$P(F,"^",4) I Z D H^LRUT S X=%H-J(3)*1440,Y=Z(3)-J(0),K=X+Y
21 S ^TMP($J,A,$P(E,"^",4))=$P(E,"^",11)_"^"_$P(F,"^")_"^"_G_"^"_J_"^"_K_"^"_H_"^"_I
22 F L=0:0 S L=$O(^LRE(B,5,C,66,L)) Q:'L S X=^(L,0) D C S ^TMP($J,A,$P(E,"^",4),L)=L(1)_"^"_L(2)_"^"_L(3)
23 Q
24C S L(1)=$S($D(^LAB(66,L,0)):$E($P(^(0),"^"),1,16),1:"??"),L(2)=$P(X,"^",5),(Z,L(3))=$P(X,"^",3) I Z D H^LRUT S X=%H-J(3)*1440,Y=Z(3)-J(0),L(3)=X+Y
25 Q
26 ;
27H D H2 Q:LR("Q")
28 W !?22,"Anti",?29,"Coll",?34,"Proc",?39,"Coll",?66,"Vol",?71,"Storage"
29 W !,"Unit ID",?13,"Type",?18,"Bag",?22,"Coag",?30,"Min",?35,"Min",?39,"Disp",?44,"Tech",?49,"Blood component",?66,"(ml)",?71,"Minutes",!,LR("%") Q
30H1 D H Q:LR("Q") W !!,"DONATION DATE: ",LRD Q
31H2 I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
32 D F^LRU W !,"LABORATORY SERVICE",!?9,"BLOOD COMPONENT PREPARATION FROM ",LRSTR," TO ",LRLST Q
33H3 D H2 W !,LR("%") Q
34H4 D H1 W !,B,?15,M,?19,$P(E,"^",2),?22,$P(E,"^",3),?29,$J($P(E,"^",4),4),?34,$J($P(E,"^",5),4),?39,$P(E,"^",6),?44,$P(E,"^",7) Q
35END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.