| 1 | LRBLDEX ;AVAMC/REG/CYM - EX-BLOOD DONORS ;6/27/96 08:54 ;
|
|---|
| 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 | I '$D(^LRO(69.2,LRAA,8,0)) S ^(0)="^69.31A^0^0"
|
|---|
| 6 | 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)
|
|---|
| 7 | W @IOF,!?10,"BLOOD DONORS WHO HAVE NOT DONATED SINCE A SPECIFIED TIME"
|
|---|
| 8 | 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
|
|---|
| 9 | S ZTRTN="QUE^LRBLDEX" D BEG^LRUTL G:POP!($D(ZTSK)) END
|
|---|
| 10 | 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
|
|---|
| 11 | F I=0:0 S I=$O(^LRE(I)) Q:'I I $O(^LRE(I,5,0))>LRSDT D SET
|
|---|
| 12 | S ^LRO(69.2,LRAA,8,65.5,1,0)="^69.32A^0^0"_LR D S^LRU
|
|---|
| 13 | F X=10:1:20 D
|
|---|
| 14 | . D FIELD^DID(65.54,X,"","LABEL","LR") S LR(X)=LR("LABEL")
|
|---|
| 15 | G ^LRBLDEX1
|
|---|
| 16 | ;
|
|---|
| 17 | 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
|
|---|
| 18 | ;
|
|---|
| 19 | END D V^LRU Q
|
|---|
