source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRBLDTA.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1LRBLDTA ;AVAMC/REG/CYM - ABNORMAL DONOR TESTS ;6/28/96 09:04 ;
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 !!?20,"Blood donor- Abnormal Test List"
6A R !!,"Start with DONOR UNIT ID: ",X:DTIME G:X=""!(X[U) END D C G:'$D(X) A
7 S A=$A(X,$L(X))-1,A=$C(A),LRA=$E(X,1,$L(X)-1)_A
8B R !,"Go to DONOR UNIT ID: ",X:DTIME G:X=""!(X[U) END D C G:'$D(X) B
9 S LRB=X,ZTRTN="QUE^LRBLDTA" D BEG^LRUTL G:POP!($D(ZTSK)) END
10 ;
11QUE U IO F A=12:1:20 D FIELD^DID(65.54,A,"","LABEL","LRA") S LRA(A)=LRA("LABEL")
12 D L^LRU,S^LRU,H S A=LRA,LR("F")=1 F B=0:0 S A=$O(^LRE("C",A)) Q:A=""!(A]LRB)!(LR("Q")) D F
13 D END^LRUTL,END Q
14F S I=$O(^LRE("C",A,0)),LRIDT=+$O(^(I,0)) Q:'$D(^LRE(I,5,LRIDT,0)) S Y=$P(+^(0),".",1) D D^LRU S LRT=Y
15 S F=0 F E=0:0 S E=$O(LRA(E)) Q:'E I $D(^LRE(I,5,LRIDT,E)),+^(E) S F=F+1,Z=^(E) D G
16 I F W !,LR("%")
17 Q
18G D:$Y>(IOSL-5) H Q:LR("Q") W:F=1 !,LRT,?14,A,?26,I W:F>1 ! W ?36,LRA(E)," ",$P(Z,"^",3)
19 Q
20 ;
21H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
22 D F^LRU W !,"LABORATORY SERVICE",?23,"ABNORMAL TEST RESULTS FOR DONORS"
23 W !,"Donation Date",?14,"Unit ID",?26,"DONOR",?36,"TEST",!,LR("%") Q
24 ;
25C I X'?.UN!($L(X)<6)!($L(X)>11) W $C(7)," Entry must be 6-11 digits &/or UPPER CASE letters" K X
26 Q
27 ;
28END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.