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