LRBLDEX ;AVAMC/REG/CYM - EX-BLOOD DONORS ;6/27/96  08:54 ;
 ;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994
 ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021
 D END S X="BLOOD BANK" D ^LRUTL G:Y=-1 END
 I '$D(^LRO(69.2,LRAA,8,0)) S ^(0)="^69.31A^0^0"
 I '$D(^LRO(69.2,LRAA,8,65.5,0)) S ^(0)=65.5,X=^LRO(69.2,LRAA,8,0),^(0)="^69.31A^65.5^"_($P(X,"^",4)+1)
 W @IOF,!?10,"BLOOD DONORS WHO HAVE NOT DONATED SINCE A SPECIFIED TIME"
 S LR=0,%DT="AEX",%DT(0)="-N",%DT("A")="Date since last donation: " D ^%DT K %DT G:Y<1 END S LRSDT=9999998-Y D D^LRU S LRSTR=Y
 S ZTRTN="QUE^LRBLDEX" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO K ^TMP("LRBL",$J),^LRO(69.2,LRAA,8,65.5) S ^LRO(69.2,LRAA,8,65.5,0)=65.5_U_LRSTR,^(1,0)="^69.32A^0^0" D L^LRU
 F I=0:0 S I=$O(^LRE(I)) Q:'I  I $O(^LRE(I,5,0))>LRSDT D SET
 S ^LRO(69.2,LRAA,8,65.5,1,0)="^69.32A^0^0"_LR D S^LRU
 F X=10:1:20 D
 . D FIELD^DID(65.54,X,"","LABEL","LR") S LR(X)=LR("LABEL")
 G ^LRBLDEX1
 ;
SET S X=$P(^LRE(I,0),"^"),LR=LR+1,^LRO(69.2,LRAA,8,65.5,1,I,0)=X,^LRO(69.2,LRAA,8,65.5,1,"B",X,I)="" Q
 ;
END D V^LRU Q