source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOARCDE.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 525 bytes
Line 
1PSOARCDE ;BHAM ISC/SAB - Purge Rx from ^PSRX & ^PS(55 ; 12/08/94
2 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
3EN ;N DIK,DA
4 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
5 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
6 S DIK="^PS(52.4,",DA=RX D ^DIK K DA,DIK
7SUS S DA=$O(^PS(52.5,"B",RX,"")) Q:DA']"" S DIK="^PS(52.5," D ^DIK K DIK
8 Q
Note: See TracBrowser for help on using the repository browser.