9 lines
525 B
Mathematica
9 lines
525 B
Mathematica
PSOARCDE ;BHAM ISC/SAB - Purge Rx from ^PSRX & ^PS(55 ; 12/08/94
|
|
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
|
|
EN ;N DIK,DA
|
|
Q:'$D(^PSRX(RX)) S PSOSUSPA=1 D EN^PSOHLSN1(RX,"Z@","","Purge order.","") S PAT=$P(^PSRX(RX,0),"^",2),DIK="^PSRX(",DA=RX D ^DIK K PSOSUSPA
|
|
I $D(^PS(55,PAT,0)) S DA(1)=PAT,DIK="^PS(55,"_DA(1)_",""P""," F X=0:0 S X=$O(^PS(55,PAT,"P",X)) Q:'X I ^PS(55,PAT,"P",X,0)=RX S DA=X D ^DIK K DA,DIK
|
|
S DIK="^PS(52.4,",DA=RX D ^DIK K DA,DIK
|
|
SUS S DA=$O(^PS(52.5,"B",RX,"")) Q:DA']"" S DIK="^PS(52.5," D ^DIK K DIK
|
|
Q
|