source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCENDE1.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1LRCENDE1 ;SLC/CJS-ORDER DELETE ;8/11/97
2 ;;5.2;LAB SERVICE;**100,107,121,201,202,221**;Sep 27, 1994
3DO I $D(^LRO(69,LRODT,1,LRSN,3))&'$D(^XUSEC("LRLAB",DUZ)) W !,"You're not cleared to delete this order." Q
4 Q:'$D(^LRO(69,LRODT,1,LRSN,0))
5 N LRMSTATI
6 I '$L($G(LRNATURE)) D DC^LROR6() I $G(LRNATURE)=-1 W !!,$C(7),"NOTHING CHANGED" Q
7 S LRACC=0 S TT=0
8 F S TT=$O(^LRO(69,LRODT,1,LRSN,2,TT)) Q:TT<1 K TST S X=^(TT,0) I '$P(X,"^",11) S TST(+X)="",LRAD=+$P(X,U,3),LRAA=+$P(X,U,4),LRAN=+$P(X,U,5),ORIFN=$P(X,U,7) D CEN1 I 'LRNOP D
9 . W !,"For test: " S X=^LRO(69,LRODT,1,LRSN,2,TT,0) W !,?5,$P(^LAB(60,+X,0),"^")
10 . S DIE="^LRO(69,LRODT,1,LRSN,2,",DA=TT,DA(1)=LRSN,DA(2)=LRODT,DR="99.1///"_$S($L($P($G(LRNATURE),U,5)):$P(LRNATURE,U,5)_": ",1:"")_":99.1" D ^DIE
11 . D NEW^LR7OB1(LRODT,LRSN,$S($G(LRMSTATI)=""!($G(LRMSTATI)=1):"OC",1:"SC"),$G(LRNATURE),.TST,$G(LRMSTATI))
12 . S:$D(^LRO(69,LRODT,1,LRSN,2,TT,0))#2 $P(^(0),"^",9,11)="CA^L^"_DUZ
13 Q:LRACC&'$D(^XUSEC("LRLAB",DUZ))!LRNOP
14 S LRDFN=+^LRO(69,LRODT,1,LRSN,0),LRLLOC=$P(^(0),U,7)
15 I $P(^LRO(69,LRODT,1,LRSN,0),U,4)="LC" S ION=$P($G(^LAB(69.9,1,3.5,+DUZ(2),0)),U,2) S:ION="" ION=$P(^LAB(69.9,1,3),U,4) I ION]"" D ^LROW2P
16 Q
17CEN1 ;from LRCENDEL
18 D DC
19 N X Q:'$D(^LRO(68,+LRAA,1,+LRAD,1,+LRAN,0)) S LRACC=1 I '$D(^XUSEC("LRLAB",DUZ)) W !,"Already accessioned.",$C(7) Q
20OR ;OE/RR 2.5
21 S LRSS=$P(^LRO(68,LRAA,0),"^",2)
22 S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
23 S LRIDT=$P(+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5) I 'LRIDT G SKPLR
24 I '$D(^LR(LRDFN,LRSS,LRIDT,0))#2 G SKPLR
25 I $P(^LR(LRDFN,LRSS,LRIDT,0),U,3) W !?5,"This accession has already been verified",! S LRNOP=1 Q
26 L +^LR(LRDFN,LRSS,LRIDT):1 I '$T W !!,"This accession is being used by someone else." S LRNOP=1 L -^LR(LRDFN,LRSS,LRIDT) Q
27SKPLR ;from LRTSTJAM,LRTSTOUT
28 S LRNOW=$$NOW^XLFDT
29 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LROSN=$P(X,U,5),LROID=$P(X,U,6),LROCN=$S($D(^(.1)):$P(^(.1),U),1:"")
30 S LRCWDT=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,9)):^(9),1:LRAD),LROWDT=$P(^(0),U,3),LROWDT=$S($D(^LRO(68,LRAA,1,LROWDT,1,LRAN,0)):LROWDT,1:LRAD)
31 D ZAP:'$D(LRONE),ZAP1:$D(LRONE),ZAP:$O(^LRO(68,LRAA,1,LRCWDT,1,LRAN,4,0))'>0&$D(LRONE),ZAP2:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))&$D(LRONE)
32 I LRCWDT'=LROWDT S LRCWDT=LROWDT D ZAP:'$D(LRONE),ZAP1:$D(LRONE)
33 K LRF,LRCWDT,LROWDT,LROSN,LROID,LROCN W "."
34 L -^LR(LRDFN,LRSS,LRIDT)
35 I $D(^LRO(69,+LRODT,1,+LRSN,0)),$P(^(0),U,4)="LC" S ION=$P($G(^LAB(69.9,1,3.5,+DUZ(2),0)),U,2) S:ION="" ION=$P(^LAB(69.9,1,3),U,4) I ION]"" D ^LROW2P
36 Q
37ZAP S LRF=0,I=0 F S I=$O(^LRO(68,LRAA,1,LRCWDT,1,LRAN,4,I)) Q:I<1 I $D(^(I,0)),'$P(^(0),U,5) D ZAP3(LRAA,LRCWDT,LRAN,I)
38 Q
39ZAP1 D:$D(^LRO(68,LRAA,1,LRCWDT,1,LRAN,4,LRTSN,0))#2 ZAP3(LRAA,LRCWDT,LRAN,LRTSN)
40 Q
41ZAP2 Q ;K ^LR(LRDFN,LRSS,LRIDT) I $O(^LRO(69,LRODT,1,LRSN,2,0))'>0 K ^LRO(69,"C",+LRORD,LRODT,LRSN),^LRO(69,LRODT,1,LRSN,2)
42 Q
43DC ;DC orders in OE/RR 2.5
44 I $$VER^LR7OU1>2.5 Q
45 S LRSAVI=ORIFN
46 I $P($G(^ORD(100.99,1,2)),"^",2) S ORNATR=$S($D(LRNATURE):LRNATURE,1:"") D:'$D(LRNATURE) OT^LROR6 S LRNATURE=ORNATR I ORNATR="V"!(ORNATR="P") S ORNAT=ORNATR D DC^ORX7
47 S:$G(LRNATURE)="C" OREASON="S" S ORIFN=LRSAVI,ORSTS=1 D ST^ORX
48 K LRSAVI,ORSTS,ORIFN,OREASON,ORNATR Q
49ZAP3(LRAA,LRCWDT,LRAN,LRTS) ;
50 S:'$G(LRNOW) LRNOW=$$NOW^XLFDT
51 I $D(^LRO(68,LRAA,1,LRCWDT,1,LRAN,4,LRTS,0))#2,'$P(^(0),U,4) S $P(^(0),U,4,6)=DUZ_U_LRNOW_U_$S('$D(LRLABKY):"*Cancel by Floor",1:"*Not Performed")
52 Q
Note: See TracBrowser for help on using the repository browser.