source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRBLDCU.m@ 1742

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1LRBLDCU ;AVAMC/REG/CYM - CUMULATIVE DONATION CALCULATIONS ;6/28/96 08:47 ;
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 S IOP="HOME" D ^%ZIS,END W @IOF,?15,"Cumulative donations and new awards"
5 D S^LRU S LRC=0 D FIELD^DID(65.54,1,"","POINTER","X") S X=X("POINTER") F A=1:1 S B=$P(X,";",A),C=$P(B,":") Q:B="" S LRB(C)=$P(B,":",2)
6 S X=0 F A=0:0 S X=$O(LRB(X)) Q:X="" D Z G:E["^"!(E="") END
7 S I="" W !!,"Print all donors to receive new awards " S %=2 D YN^LRU G:%<1 END I %=1 G DEV
8ASK W ! S LRG(1)=0,DIC="^LRE(",DIC(0)="AEQM" D ^DIC K DIC G:Y<1 END
9 S I=+Y,N=$P(Y,U,2),K=0 D C S:$D(^LRE(I,3)) K=$P(^(3),"^") W:LRG(1)'>LRG!(LRG<1) !,N,!,$S(K:"New award; Not given",1:"No new award"),?33,"Total donations: ",$J(T,3)," Total awards: ",LRG G ASK
10DEV S ZTRTN="QUE^LRBLDCU" D BEG^LRUTL G:POP!($D(ZTSK)) END
11QUE U IO D L^LRU S X="T",%DT="" D ^%DT S LRF=10009999-Y
12 D:IOST?1"C".E WAIT^LRU D H S LR("F")=1,N=0 F A=0:0 S N=$O(^LRE("B",N)) Q:N=""!(LR("Q")) F I=0:0 S I=$O(^LRE("B",N,I)) Q:'I!(LR("Q")) D E
13 W:'LRC !,"No donors found to receive new awards." W:IOST'?1"C".E @IOF D END,END^LRUTL Q
14E Q:$O(^LRE(I,5,0))>LRF
15C S T=0,X=^LRE(I,0),LRG=$P(X,"^",8),Y=$P(X,"^",3) D DT^LRU S N(1)=Y D D
16 Q
17D F V=0:0 S V=$O(^LRE(I,5,V)) Q:'V!(LR("Q")) S C=$P(^(V,0),"^",2) I C]"" S T=T+E(C)
18 Q:LR("Q") I T S LRG(1)=T\8 I LRG(1)>LRG S ^LRE(I,3)=1 D:$Y>(IOSL-6) H Q:LR("Q") W !,N,?31,N(1),?45,$J(LRG,2),?60,$J(T,3) S LRC=LRC+1
19 S $P(^LRE(I,0),"^",7)=T Q
20Z W !,"Enter donation value for ",LRB(X),": " R E:60 Q:E=""!(E[U) I E'?1N.N!(E<0)!(E>99) W !,$C(7),"Enter a whole number from 0 to 99" G Z
21 S E(X)=E Q
22H I $D(^LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
23 D F^LRU W !?20,"BLOOD DONORS TO RECEIVE NEW AWARDS"
24 W !,"Donor",?33,"DOB",?41,"Total Awards",?55,"Cumulative donations",!,LR("%") Q
25END D V^LRU Q
26 ; Line E stops processing any donor not donating in past year
Note: See TracBrowser for help on using the repository browser.