PSOSUDEL ;BIR/JMB-Delete printed Rx's or Rx's for deceased patients from suspense ;3/17/93
 ;;7.0;OUTPATIENT PHARMACY;**36**;DEC 1997
 ;External reference to ^PS(59.7 supported by DBIA 694
BEG Q:'$D(^PS(59.7,1,40.1))  S PSOSYS=^PS(59.7,1,40.1),DAYS=$S($P(PSOSYS,"^",5):$P(PSOSYS,"^",5),1:1)
 D NOW^%DTC S X1=X,X2=-DAYS D C^%DTC S DATE=X S DATE=DATE+.01 F ZZZ=0:0 S ZZZ=$O(^PS(52.5,"ADL",ZZZ)) Q:'ZZZ!(ZZZ>DATE)  F SFN=0:0 S SFN=$O(^PS(52.5,"ADL",ZZZ,SFN)) Q:'SFN  S RXREC=$P($G(^PS(52.5,SFN,0)),"^") I RXREC D CHK
EXIT K %,%H,%T,CNT,COM,DA,DATE,DAYS,DFN,DIRUT,JJ,RF,RFCNT,RX,SFN,TM,TSKDT,VADM,X,X1,X2,Y,VADM,RXREC,ZZZ,OKAY
 Q
CHK I $P($G(^PSRX(RXREC,2)),"^",6),$P($G(^(2)),"^",6)<DT D EX^PSOSUTL S $P(^PSRX(RXREC,"STA"),"^")=11 G DEL
 S OKAY=0 I $P($G(^PS(52.5,SFN,0)),U,7)="X"!($P($G(^PS(52.5,SFN,0)),U,7)="P")!($P($G(^PS(52.5,SFN,0)),U,7)="") S OKAY=1
 I +$G(^PS(52.5,SFN,"P"))=1,OKAY=1 G DEL
 S DFN=$P($G(^PS(52.5,SFN,0)),"^",3) D DEM^VADPT Q:VADM(6)=""
DEAD S REA="C",COM="Died ("_$P(VADM(6),"^",2)_")",ACOM="Discontinued while suspended. Died ("_$P(VADM(6),"^",2)_")",DA=+$G(^PS(52.5,SFN,0)),PSCAN($P(^PSRX(DA,0),"^"))=DA_"^"_REA D CAN^PSOCAN K REA,COM,ACOM,PSCAN Q
DEL S DA=SFN,DIK="^PS(52.5," D ^DIK K DIK
 Q
AUTO K %DT,DIC S DIC(0)="XZM",DIC="^DIC(19.2,",X="PSO PNDEL1" D ^DIC
 I +Y>0 D EDIT^XUTMOPT("PSO PNDEL1") G EX
 D RESCH^XUTMOPT("PSO PNDEL1","","","7D","L"),EDIT^XUTMOPT("PSO PNDEL1")
EX K Y,C,D,D0,DI,DQ,DA,DIE,DR,DIC,Y,X,PSOTM,PSOOPTN,%DT
 Q