source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRBLDELT.m@ 1487

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1LRBLDELT ;AVAMC/REG - DELETE FILE 65 ENTRIES ;8/18/89 10:55 ;
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 S X="BLOOD BANK" D ^LRUTL G:Y=-1 END
5 W !!?25,"DELETE INVENTORY FILE ENTRIES",!?28,"WITH FINAL DISPOSITIONS"
6 W !!,$C(7),!!,"Has the tape of the blood inventory file (65) been made ?" S %=2 D YN^LRU G:%'=1 END
7 W !!?20,"Delete units (which have final dispositions)",!?20,"received prior to:"
8 S %DT="AEQM",%DT("A")="Enter Date:" D ^%DT K %DT G:Y<1 END S LR=Y D D^LRU S X1=LR,LR=Y,X2=-1 D C^%DTC S LRLDT=X
9 W !!?20,"Ok to delete units with final disposition",!?20,"received prior to ",LR S %=2 D YN^LRU G:%'=1 END
10 S LR=0 D WAIT^LRU W !,"."
11 F LRA=0:0 S LRA=$O(^LRD(65,"A",LRA)) Q:'LRA!(LRA>LRLDT) F LRI=0:0 S LRI=$O(^LRD(65,"A",LRA,LRI)) Q:'LRI D K
12 L +^LRD(65) S X(1)=$O(^LRD(65,0)) S:'X(1) X(1)=0 S X=^LRD(65,0),^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_($P(X,"^",4)-LR) L -^LRD(65) W $C(7),!!,"Deletion completed.",! Q
13K Q:'$D(^LRD(65,LRI,4)) I $P(^(4),"^")=""&('$D(^(6))) Q
14 S Y=^LRD(65,LRI,0),C=$P(Y,"^",4),R=$P(Y,"^",5),E=$P(Y,"^",6),Z=$P(Y,"^")
15 W:LR#25=0 "." F W=0:0 S W=$O(^LRD(65,LRI,3,W)) Q:'W S V=+^(W,0) K ^LRD(65,"AL",V,LRI)
16 I $D(^LRD(65,LRI,8)) S LRP=+^(8) K:LRP ^LRD(65,"AU",LRP,LRI)
17 F W=0:0 S W=$O(^LRD(65,LRI,2,W)) Q:'W K ^LRD(65,"AP",W,LRI) F V=0:0 S V=$O(^LRD(65,LRI,2,W,1,V)) Q:'V S Y=$P(^(V,0),"^",9) I Y K ^LRD(65,"AN",Y,LRI,W,V)
18 I $L(Z)>2 F X(1)=3:1:4 I '$E(Z,X(1)) K ^LRD(65,"B",$E(Z,X(1),$L(Z)),LRI) Q
19 S X(1)=$S($D(^LRD(65,LRI,4)):$P(^(4),"^",2),1:"") K:X(1) ^LRD(65,"AB",X(1),LRI)
20 K ^LRD(65,LRI),^LRD(65,"A",R,LRI),^LRD(65,"B",Z),^LRD(65,"AT",Z),^LRD(65,"AI",C,Z),^LRD(65,"AE",C,E,LRI),^LRO(69.2,LRAA,8,65,1,LRI),^LRO(69.2,LRAA,8,65,1,"B",Z)
21 S LR=LR+1 Q
22 ;
23END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.