| 1 | LRUDEL ;AVAMC/REG/CYM - DELETE AN AP ACCESSION NUMBER ;2/18/98 10:04 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**1,72,121,201**;Jul 03, 1997
|
|---|
| 3 | D END,^LRAP G:'$D(Y) END D XR^LRU
|
|---|
| 4 | W !?22,"Delete an Accession Number",!!
|
|---|
| 5 | D S %DT("A")="Accession number date: ",%DT="AQE" D ^%DT K %DT Q:Y<1 S (Y,LRAD)=$E(Y,1,3)_"0000" D DATE S LRH(0)=Y
|
|---|
| 6 | I '$D(^LRO(68,LRAA,1,LRAD,0)) W $C(7),!!,"No accession numbers for ",LRH(0),! G D
|
|---|
| 7 | S H(2)=$E(LRAD,1,3)
|
|---|
| 8 | N1 K LRNO
|
|---|
| 9 | R !!,"Select Accession # : ",LRAN:DTIME Q:LRAN=""!(LRAN["^")
|
|---|
| 10 | D REST L -^LRO(69.2,LRAA) I $D(LRDFN),$L($G(LRSS)) L -^LR(LRDFN,LRSS)
|
|---|
| 11 | G N1
|
|---|
| 12 | REST I LRAN'?1N.N W $C(7),!!,"Enter NUMBERS only" Q
|
|---|
| 13 | I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W $C(7),!!,"Accession number ",LRAN," for ",LRH(0)," not in ACCESSION file",!! Q
|
|---|
| 14 | L +^LRO(68,LRAA,1,LRAD,1,LRAN):1 I '$T W !!?10,$C(7),"Someone else is editing this entry ",! Q
|
|---|
| 15 | L +^LRO(69.2,LRAA):1 I '$T W !!?10,$C(7),"Someone else is editing this entry ",! Q
|
|---|
| 16 | S LRND=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRRC=$P(LRND,U,3)
|
|---|
| 17 | S LRDFN=+LRND G:'$D(^LR(LRDFN,0)) BAD S Y=^(0),LRPFN=$P(Y,U,2),LRFNAM=$P(^DIC(LRPFN,0),U),LRPF=^(0,"GL"),Y=$P(Y,U,3),LRP=@(LRPF_Y_",0)") W !,$P(LRP,U)," ID: ",$P(LRP,U,9) S Y=$P(LRP,U,3) D DATE W:Y'[1700 " DOB: ",Y
|
|---|
| 18 | W !!,"ACC # ",LRAN S Y=LRRC D DATE G:LRSS="AU" DEL^LRAUAW
|
|---|
| 19 | I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN) D T W !,LRAN," Deleted" Q
|
|---|
| 20 | S X=^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRSD=+X,LRI=$P(X,"^",5) Q:'LRI
|
|---|
| 21 | S X=$G(^LR(LRDFN,LRSS,LRI,0)) I $P(X,"^",3)!($P(X,"^",11))!($P(X,"^",15)) W $C(7),!,"Report completed &/or released, deletion not allowed." Q
|
|---|
| 22 | L +^LR(LRDFN,LRSS,LRI):1 I '$T W !!?10,"Someone else is editing this entry ",!,$C(7) Q
|
|---|
| 23 | W " DATE RECEIVED: ",Y," OK to DELETE " S %=2 D YN^LRU I %'=1 W $C(7),!?4,"NOT DELETED",!! Q
|
|---|
| 24 | D ACC^LR7OB1(LRAA,LRAD,LRAN,"OC") ; Cancel order
|
|---|
| 25 | I $D(^LR(LRDFN,LRSS,LRI)) K ^(LRI) I $D(^LR(LRDFN,LRSS,0)) S X=^LR(LRDFN,LRSS,0),X(1)=$O(^(0)),X(2)=$P(X,"^",4)-1,^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_X(2)
|
|---|
| 26 | K:LRRC ^LR(LRXR,LRRC,LRDFN,LRI) K ^LR(LRXREF,H(2),LRABV,LRAN,LRDFN,LRI) D K
|
|---|
| 27 | K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN) K:LRRC ^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)
|
|---|
| 28 | L +^LRO(68,LRAA,1,LRAD,1,0) S X=^LRO(68,LRAA,1,LRAD,1,0),X(1)=$O(^(0)),X(2)=$P(X,"^",4)-1 S:X(2)<1 X(2)=0 S ^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_X(2) L -^LRO(68,LRAA,1,LRAD,1,0)
|
|---|
| 29 | D T Q
|
|---|
| 30 | BAD W $C(7),!!,"Entry not in file",!!
|
|---|
| 31 | Q
|
|---|
| 32 | T ;
|
|---|
| 33 | F A=1,2,3,4 I $D(^LRO(69.2,LRAA,A,LRAN)) K ^(LRAN) S X(1)=$O(^LRO(69.2,LRAA,A,0)) S:'X(1) X(1)=0 I $D(^LRO(69.2,LRAA,A,0)) S X=^(0),^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_$S(X(1)=0:X(1),1:($P(X,"^",4)-1))
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | DATE ; Returns the date in eye-readable month format
|
|---|
| 37 | S Y=$TR($$FMTE^XLFDT(Y,"M"),"@"," ")
|
|---|
| 38 | Q
|
|---|
| 39 | K ; also from LRAPED
|
|---|
| 40 | F A=0:0 S A=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,A)) Q:'A K ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_A)
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | END D V^LRU Q
|
|---|
