source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDESTF.m@ 1714

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1PSDESTF ;BIR/BJW-Add Non-CS Drug to Holding file ; 26 Feb 98
2 ;;3.0; CONTROLLED SUBSTANCES ;**8,66**;13 Feb 97;Build 3
3 ;**Y2K compliance**;display 4 digit year on va forms
4 I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
5 I '$D(^XUSEC("PSJ RPHARM",DUZ)) W !!,"Please contact your Pharmacy Coordinator for access to",!,"destroy Controlled Substances.",!!,"PSJ RPHARM security key required.",! G END
6 S PSDUZ=DUZ,PSDOUT=0 D NOW^%DTC S PSDT=+$E(%,1,12)
7 W !!,?5,"NOTE: This Holding for Destruction transaction WILL NOT update your",!,?5,"Controlled Substances inventory balance.",!!
8ASKD ;ask disp location
9 S PSDS=$P(PSDSITE,U,3),PSDSN=$P(PSDSITE,U,4) G:$P(PSDSITE,U,5) DEST
10 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)"
11 S DIC("A")="Select Primary Dispensing Site: ",DIC("B")=PSDSN
12 D ^DIC K DIC G:Y<0 END
13 S PSDS=+Y,PSDSN=$P(Y,"^",2),$P(PSDSITE,U,3)=+Y,$P(PSDSITE,U,4)=PSDSN
14DEST ;set up file 58.86
15 S PSDOUT=0,PSDCT=1
16 S (MFG,LOT,EXP)=""
17DIR ;ask free-text drug name
18 W !!,"You may create a free-text CS drug to place on hold for destruction.",!,"Your Dispensing Site inventory balance WILL NOT be updated.",!!
19 K DA,DIR,DIRUT S DIR(0)="58.86,13" D ^DIR K DA,DIR
20 I $D(DIRUT) D MSG G END
21 I Y']"" D MSG G END
22 S PSDRN=Y
23DIR2 K DA,DIR,DIRUT,DTOUT,DUOUT F PSDANS=2,4,11,12,18 S DIR(0)="58.86,"_PSDANS D ^DIR K DA,DIR D I PSDOUT D MSG G END
24 .I $D(DTOUT)!($D(DUOUT)) S PSDOUT=1 Q
25 .I PSDANS'=4,PSDANS'=18,Y']"" S PSDOUT=1 Q
26 .S PSD(PSDANS)=Y
27 .K DIRUT,DTOUT,DUOUT
28 ;DIR3 added 5/7/95 to add comments field
29DIR3 ;enter free-text information(comments)
30 W !!,"You may enter free-text info regarding drug placed on hold for destruction."
31 K DA,DIR,DIRUT S DIR(0)="58.86,14" D ^DIR K DA,DIR
32 I $D(DTOUT)!($D(DUOUT)) D MSG G END
33 S PSDCOMS=Y
34ASKY ;ask ok to continue
35 W !!,PSDRN," has been selected.",!
36 K DA,DIR,DIRUT S DIR(0)="YA",DIR("B")="NO",DIR("A")="Is this OK to create Holding for Destructions number? "
37 S DIR("?",1)="Answer 'YES' to create a Holding for Destruction number for this drug,",DIR("?")="answer 'NO' to create a different free-text CS drug, or '^' to quit."
38 D ^DIR K DIR I $D(DIRUT) D MSG G END
39 I 'Y G DIR
40 W !!,"Creating an entry in the Destructions file..."
41 F L +^PSD(58.86,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
42 ;5/7/95 Fld 14 added, 7/28/95 Fld 18 added
43FIND S PSDHLD=$P(^PSD(58.86,0),"^",3)+1 I $D(^PSD(58.86,PSDHLD)) S $P(^PSD(58.86,0),"^",3)=PSDHLD G FIND
44 K DA,DIC,DLAYGO S (DIC,DLAYGO)=58.86,DIC(0)="L",(X,DINUM)=PSDHLD D ^DIC K DIC,DINUM,DLAYGO
45 L -^PSD(58.86,0)
46 W !!,"Your Destructions Holding number is ",PSDHLD
47 K DA,DIE,DR S DIE=58.86,DA=PSDHLD,DR="13////"_PSDRN_";2////"_PSD(2)_";3////"_PSDUZ_";5////"_PSDT_";6////"_PSDS_";4////"_$S(+PSD(4):+PSD(4),1:"")_";11////"_+PSD(11)_";12////"_PSD(12)_";14////"_PSDCOMS_";18////"_+PSD(18)
48 D ^DIE K DIE,DA,DR
49 S RQTY=$P($G(^PSD(58.86,PSDHLD,0)),"^",3),PSDRN=$P($G(^(1)),"^")
50 S PSDOK=1
51PRINT ;print 2321
52 W !!,"Number of copies of VA FORM 10-2321? " R NUM:DTIME I '$T!(NUM="^")!(NUM="") W !!,"No copies printed!!",!! Q
53 I NUM'?1N!(NUM=0) W !!,"Enter a whole number between 1 and 9",! G PRINT
54 S Y=PSDT X ^DD("DD") S PSDYR=$P(Y,",",2),PSDYR=$E(PSDYR,1,4)
55 S PG=0,RECDT=$E(PSDT,4,5)_"/"_$E(PSDT,6,7)_"/"_PSDYR I EXP S (EXP1,EXPD)=$$FMTE^XLFDT(EXP,"5D") S:'$P(EXP1,"/",2) EXPD=$P(EXP1,"/")_"/"_$P(EXP1,"/",3)
56 D ^PSDGSRV2
57END ;kill variables
58 K %,%DT,%H,%I,ALL,CNT,DA,DIC,DIE,DINUM,DIR,DIROUT,DIRUT,DLAYGO,DR,DTOUT,DUOUT,EXP,EXP1,EXPD,LN,LOT,MFG,NUM
59 K PG,PSD,PSDANS,PSDCT,PSDCOMS,PSDHLD,PSDOK,PSDOUT,PSDRN,PSDS,PSDSN,PSDT,PSDUZ,PSDYR,RECDT,RPDT,RQTY,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
60 Q
61MSG W $C(7),!!,"WARNING: Holding for Destructions entry HAS NOT been created.",!!
62 Q
Note: See TracBrowser for help on using the repository browser.