| [613] | 1 | PSOSUDEL ;BIR/JMB-Delete printed Rx's or Rx's for deceased patients from suspense ;3/17/93
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**36**;DEC 1997
|
|---|
| 3 | ;External reference to ^PS(59.7 supported by DBIA 694
|
|---|
| 4 | 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)
|
|---|
| 5 | 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
|
|---|
| 6 | 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
|
|---|
| 7 | Q
|
|---|
| 8 | CHK I $P($G(^PSRX(RXREC,2)),"^",6),$P($G(^(2)),"^",6)<DT D EX^PSOSUTL S $P(^PSRX(RXREC,"STA"),"^")=11 G DEL
|
|---|
| 9 | 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
|
|---|
| 10 | I +$G(^PS(52.5,SFN,"P"))=1,OKAY=1 G DEL
|
|---|
| 11 | S DFN=$P($G(^PS(52.5,SFN,0)),"^",3) D DEM^VADPT Q:VADM(6)=""
|
|---|
| 12 | 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
|
|---|
| 13 | DEL S DA=SFN,DIK="^PS(52.5," D ^DIK K DIK
|
|---|
| 14 | Q
|
|---|
| 15 | AUTO K %DT,DIC S DIC(0)="XZM",DIC="^DIC(19.2,",X="PSO PNDEL1" D ^DIC
|
|---|
| 16 | I +Y>0 D EDIT^XUTMOPT("PSO PNDEL1") G EX
|
|---|
| 17 | D RESCH^XUTMOPT("PSO PNDEL1","","","7D","L"),EDIT^XUTMOPT("PSO PNDEL1")
|
|---|
| 18 | EX K Y,C,D,D0,DI,DQ,DA,DIE,DR,DIC,Y,X,PSOTM,PSOOPTN,%DT
|
|---|
| 19 | Q
|
|---|
