source: FOIAVistA/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDEST.m@ 1008

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1PSDEST ;BIR/BJW-Destroy a Drug from the Holding file ; 9 Feb 98
2 ;;3.0; CONTROLLED SUBSTANCES ;**8**;13 Feb 97
3 ;**Y2K compliance**, "P" added to date input string
4 I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
5 I '$D(^XUSEC("PSDMGR",DUZ)) W !!,"Please contact your Pharmacy Coordinator for access to",!,"destroy Controlled Substances.",!!,"PSDMGR security key required.",! G END
6 S PSDUZ=DUZ
7 I PSDUZ S PSDUZAN=$P($G(^VA(200,+PSDUZ,0)),"^")
8SETDATE ;7/17/96,inital set to current date
9 S PSDT=DT
10ASKD ;ask disp location
11 S PSDS=$P(PSDSITE,U,3),PSDSN=$P(PSDSITE,U,4)
12 G:$P(PSDSITE,U,5) ASKN
13 K DIC,DA S DIC=58.8,DIC(0)="QEAZ",DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$S($P(^(0),""^"",2)[""M"":1,$P(^(0),""^"",2)[""S"":1,1:0)"
14 S DIC("A")="Select Primary Dispensing Site: ",DIC("B")=PSDSN
15 D ^DIC K DIC G:Y<0 END
16 S PSDS=+Y,PSDSN=$P(Y,"^",2),$P(PSDSITE,U,3)=+Y,$P(PSDSITE,U,4)=PSDSN
17ASKN ;ask holding number
18 W !!,?3,"**Searching for the next available drug awaiting destruction**",!
19 K DIC,DA S DIC=58.86,DIC("A")="Select Destructions #: ",DIC(0)="QEAZ",DIC("S")="I $P(^(0),""^"",7)=PSDS"
20 F PSD=0:0 S PSD=$O(^PSD(58.86,PSD)) Q:'PSD!($D(DIC("B"))) I $D(^PSD(58.86,PSD,0)),'+$P(^(0),"^",10),+$P(^(0),"^",7)=+PSDS S DIC("B")=PSD
21 D ^DIC K DA,DIC G:Y<0 END S PSDA=+Y
22 W !!,?3,"**You Must enter a DATE to destroy or cancel this Holding Num**"
23DISPLAY ;
24 K LN S $P(LN,"-",30)="",PSDR=$P(Y(0),"^",2),PSDRN=$S($P($G(^PSD(58.86,PSDA,1)),"^")]"":$P($G(^PSD(58.86,PSDA,1)),"^"),1:$P($G(^PSDRUG(+PSDR,0)),"^")),NUM=$P(Y(0),"^"),QTY=$P(Y(0),"^",3)
25 S PSDCT=$S($P(Y(0),"^",8)]"":$P(Y(0),"^",8),1:1),NBKU=$S($P(Y(0),"^",12)]"":$P(Y(0),"^",12),1:$P($G(^PSD(58.8,+PSDS,1,+PSDR,0)),"^",8))
26 S PSDCAN=$P($G(^PSD(58.86,PSDA,3)),"^") I PSDCAN S Y=PSDCAN X ^DD("DD") S PSDCAN=Y D MSG2 G ASKN
27 S PSDST=$P(Y(0),"^",11) I PSDST S Y=PSDST X ^DD("DD") S PSDST=Y D MSG1 G ASKN
28 W @IOF,!,"HOLDING FOR DESTRUCTION",!,LN,!!,"Holding Number: ",NUM
29 W !,"Drug: ",PSDRN,!,"Quantity "_$S($D(^PSD(58.8,+PSDR,0)):"("_NBKU_")",1:"")_": ",QTY,!
30OK ;ask ok
31 K DA,DIR,DIRUT S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to destroy this Controlled Substances"
32 S DIR("?",1)="Answer 'YES' if you are destroying this drug,",DIR("?")="answer 'NO' and this drug will remain pending destruction."
33 D ^DIR K DIR I $D(DIRUT) D MSG G END
34 S ANS=Y(0) I ANS="YES" D DATE G:'$D(PSDT) END G DIE
35 I ANS="NO" G OK1 G:'$D(PSDT) END
36DATE ; ask date,7/17/96 added %DT("B")default date or user can enter new date
37 K %DT W !
38 S %DT="AEPTX",%DT(0)="-NOW",%DT("A")="DATE DESTROYED/CANCELLED: ",%DT("B")=$$FMTE^XLFDT(PSDT) D ^%DT G:Y<0 END S PSDT=Y W !
39 Q
40OK1 ;ask if entry error
41 K DA,DIR,DIRUT S DIR(0)="Y",DIR("B")="NO",DIR("A")="Was this a destruction holding number entry error"
42 S DIR("?",1)="Answer 'NO' drug will be destroyed,",DIR("?")="answer 'YES' and this drug will not be destroyed."
43 D ^DIR K DIR I $D(DIRUT) D MSG G END
44OK2 ;ask do you want to cancel holding #,E3R# 4990
45 K DA,DIR,DIRUT S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to cancel this destruction holding number"
46 S DIR("?",1)="Answer 'NO' if you do not want to cancel this destruction holding number,",DIR("?")="answer 'YES' and the destruction holding number will be cancelled."
47 D ^DIR K DIR I $D(DIRUT) D MSG G END
48 I 'Y DO MSG G ASKN
49DIRC ;enter reason,date and pharmacist cancelling holding #,E3R# 4990
50 W !! D DATE G:'$D(PSDT) END
51 K DA,DIR,DIRUT S DIR(0)="58.86,17" D ^DIR K DIR I $D(DIRUT) D MSG G END
52 S PSDCOM3=Y
53 K DIRUT,DTOUT,DUOUT
54 I PSDT S (Y,YYY)=PSDT X ^DD("DD") S PSDT=Y
55 W !,"DATE/TIME CANCELLED: ",PSDT
56 W !,"CANCELLED BY: ",PSDUZAN
57DIE1 ;update 58.86 for cancelling holding #,E3R# 4990
58 ;The AC,AD X-ref's entries are built on the condition that data is in
59 ;Field 10(date/time destroyed),11/29/95 added I $D(Y)
60 K DA,DIE,DR S DA=PSDA,DIE=58.86,DR="9////"_PSDUZ_";10///"_PSDT_";15///"_PSDT_";16////"_PSDUZ_";17////"_PSDCOM3_";11///^S X=PSDCT;12///^S X=NBKU" D ^DIE K DA,DIE,DR I $D(Y) D MSG G END
61 W !!,"Holding Number: ",NUM,?19," flagged as entry error"
62 S PSDT=YYY G ASKN
63DIE ;update 58.86
64 ;10/22/96 added / to fld#11,12 to remove prompt;11/29/95 added I $D(Y)
65 W !,?3,"** Updating the record **",! K DA,DIE,DR S DA=PSDA,DIE=58.86,DR="9////"_PSDUZ_";10///"_PSDT_";11///^S X=PSDCT;12///^S X=NBKU" D ^DIE K DA,DIE,DR
66 I $D(Y) D MSG G END
67 W !!,?3,"=> Holding Number: ",NUM," has been destroyed.",!!
68 G ASKN
69END K %,%DT,%H,%I,ANS,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,LN,NBKU,NUM
70 K PSD,PSDA,PSDCAN,PSDCOM3,PSDR,PSDRN,PSDCT,PSDS,PSDSN,PSDT,PSDST,PSDUZ,PSDUZAN,QTY,X,Y,YYY
71 Q
72MSG W !!,"No action taken",!!
73 Q
74MSG1 ;msg when already destroyed
75 W $C(7),!!,"Drug: ",PSDRN,!,"=> Destruction #: ",NUM," was destroyed on ",PSDST,".",!!
76 Q
77MSG2 ;msg when cancelled,E3R# 4990
78 W $C(7),!!,"Drug: ",PSDRN,!,"=> Destruction #: ",NUM," was cancelled on ",PSDCAN,".",!!
79 Q
Note: See TracBrowser for help on using the repository browser.