| 1 | LRCENDE1 ;SLC/CJS-ORDER DELETE ;8/11/97
|
|---|
| 2 | ;;5.2;LAB SERVICE;**100,107,121,201,202,221**;Sep 27, 1994
|
|---|
| 3 | DO 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
|
|---|
| 17 | CEN1 ;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
|
|---|
| 20 | OR ;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
|
|---|
| 27 | SKPLR ;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
|
|---|
| 37 | ZAP 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
|
|---|
| 39 | ZAP1 D:$D(^LRO(68,LRAA,1,LRCWDT,1,LRAN,4,LRTSN,0))#2 ZAP3(LRAA,LRCWDT,LRAN,LRTSN)
|
|---|
| 40 | Q
|
|---|
| 41 | ZAP2 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
|
|---|
| 43 | DC ;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
|
|---|
| 49 | ZAP3(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
|
|---|
