| [613] | 1 | LROR3 ;SLC/DCM - CANCEL,PURGE,SETUP,CLEAN EXECUTES ;11/26/90 10:10 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**100,121,165**;Sep 27, 1994
|
|---|
| 3 | C ;;Cancel execute from OR
|
|---|
| 4 | I ORSTS="",$D(ORPK),$L($P(ORPK,"^",8)) S X=$P(ORPK,"^",2)_","""_$P(ORPK,"^",5)_""","_$P(ORPK,"^",3)_","_$P(ORPK,"^",4)_","_$P(ORPK,"^",8) K:$L(X) @("^XUTL(""OR"",$J,""LROT"","_X_")") S ORSTS="K" D ST^ORX W " Deleted" Q
|
|---|
| 5 | I +ORSTS=11 S ORSTS="K" D ST^ORX W " Deleted" Q
|
|---|
| 6 | I ORGY=0 D C3 Q:LREND
|
|---|
| 7 | I ORGY'=0 S LRODT=+ORPK,LRSN=$P(ORPK,"^",2),I=$P(ORPK,"^",3)
|
|---|
| 8 | I 'LRODT!('LRSN)!('I) S ORSTS=1 D:ORGY=9 ST^ORX Q
|
|---|
| 9 | I '$D(^LRO(69,LRODT,1,LRSN)),ORGY=10 Q
|
|---|
| 10 | I '$D(^LRO(69,LRODT,1,LRSN)),ORGY=9 S ORSTS=1 D ST^ORX Q
|
|---|
| 11 | I '$D(^LRO(69,LRODT,1,LRSN,2,I)),ORGY=10 Q
|
|---|
| 12 | I '$D(^LRO(69,LRODT,1,LRSN,2,I)),ORGY=9 S ORSTS=1 D ST^ORX Q
|
|---|
| 13 | I $D(^LRO(69,LRODT,1,LRSN,3)),$P(^(3),"^",2) W !,"Tests already verified for this portion of the order, cannot delete." G END
|
|---|
| 14 | C1 S LRORD=+^LRO(69,LRODT,1,LRSN,.1),X=^(2,I,0),LRTSN=+X,LRAD=+$P(X,"^",3),LRAA=+$P(X,"^",4),LRAN=+$P(X,"^",5),(LRNOP,LRACC)="",LRONE=""
|
|---|
| 15 | I LRAD,LRAA,LRAN,$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),'$D(^XUSEC("LRLAB",DUZ)) W !!,$C(7),"Already accessioned. Contact lab to cancel.",! G END
|
|---|
| 16 | C2 I ORGY=0 D DC^ORX5 S LREND=1 G END
|
|---|
| 17 | I ORGY=9 D C4
|
|---|
| 18 | END K LRODT,LRSN,LRAD,LRAA,LRAN,LRNOP,LRACC,LRONE,LRC,LRDFN,LRDPF,LRSX,LRTSN,LRUSNM
|
|---|
| 19 | Q
|
|---|
| 20 | C3 I 'ORPK D C2 Q
|
|---|
| 21 | S LRODT=+ORPK,LRSN=$P(ORPK,"^",2),I=$P(ORPK,"^",3) I 'LRODT!('LRSN)!('I) D C2 Q
|
|---|
| 22 | I '$D(^LRO(69,LRODT,1,LRSN,2,I)) K LRODT,LRSN D C2 Q
|
|---|
| 23 | S LREND=0 Q
|
|---|
| 24 | Q
|
|---|
| 25 | C4 I LRAD,LRAA,LRAN,$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D OR^LRCENDE1 I LRNOP G END
|
|---|
| 26 | I 'LRNOP D C5
|
|---|
| 27 | S ORSTS=1 D ST^ORX
|
|---|
| 28 | Q
|
|---|
| 29 | C5 ;
|
|---|
| 30 | S $P(^LRO(69,LRODT,1,LRSN,2,$P(ORPK,"^",3),0),"^",3,6)="^^^",$P(^(0),"^",9,11)="CA^W^"_DUZ
|
|---|
| 31 | ;K ^LRO(69,LRODT,1,LRSN,2,$P(ORPK,"^",3)),^LRO(69,LRODT,1,LRSN,2,"B",LRTSN,$P(ORPK,"^",3)) S LRTSN=$P(^LAB(60,LRTSN,0),"^") S:'$D(^LRO(69,LRODT,1,LRSN,6,0)) ^(0)="^69.04^^"
|
|---|
| 32 | ;S LRUSNM=$P(^VA(200,DUZ,0),"^"),X=1+$P(^LRO(69,LRODT,1,LRSN,6,0),"^",3),$P(^(0),"^",3,4)=X_"^"_X,^(X,0)="Ordered test "_LRTSN_" deleted by "_LRUSNM
|
|---|
| 33 | ;S DIE="^LRO(69,LRODT,1,",DA=LRSN,DR=16 D ^DIE
|
|---|
| 34 | S Y=$P(^LRO(69,LRODT,1,LRSN,0),"^",8) D DD^%DT W !," Ordered test "_$P(^LAB(60,LRTSN,0),"^")_" for "_Y_" cancelled."
|
|---|
| 35 | Q
|
|---|
| 36 | P ;;Purge execute from OR
|
|---|
| 37 | S LREND=0,LRXODT=+ORPK,LRXSN=$P(ORPK,"^",2),LRXTN=$P(ORPK,"^",3)
|
|---|
| 38 | I LRXODT,LRXSN,LRXTN,ORSTS'=1 D PEND
|
|---|
| 39 | I 'LREND S ORSTS="K" D ST^ORX
|
|---|
| 40 | K LRXODT,LRXSN,LRXTN,LREND Q
|
|---|
| 41 | SETUP ;;Setup execute from OR
|
|---|
| 42 | Q
|
|---|
| 43 | CLEAN ;;Clean-up execute from OR
|
|---|
| 44 | D LREND^LROW4
|
|---|
| 45 | K LRASK,LRPREV,LROCK,LRPGM,LRTSNM,LRCK,LRDTX,LROSX,LREK,LROST,LRPRAM,LRA,LRAA,LRABV,LRAD,LRAX,LRC,LRH,LRSF,LRSS,LRSX,LRU,LRWHO,LRECUR,LRNOW,LRSTUB,LRZX,LRSZX
|
|---|
| 46 | K ^XUTL("OR",$J,"LROST"),^("LRZX"),^("LROT"),^("COM")
|
|---|
| 47 | Q
|
|---|
| 48 | PEND I '$D(^LRO(69,LRXODT,1,LRXSN,0)) Q
|
|---|
| 49 | S X=+^LRO(69,LRXODT,1,LRXSN,0) I $D(^LR(X,0)),$P(^(0),"^",2)'=2 G P1
|
|---|
| 50 | I '$D(^LRO(69,LRXODT,1,LRXSN,1)) S LREND=1 Q
|
|---|
| 51 | I ORSTS=5 S LREND=1 Q
|
|---|
| 52 | I $D(^LRO(69,LRXODT,1,LRXSN,3)),'$L($P(^(3),"^",2)) S LREND=1 Q
|
|---|
| 53 | P1 S:$D(^LRO(69,LRXODT,1,LRXSN,2,LRXTN,0)) $P(^(0),"^",7)="" Q
|
|---|
| 54 | Q
|
|---|
