| 1 | PSDEN ;BIR/JPW-Enter NAOUs ; 6 July 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
|
|---|
| 4 | I '$D(^XUSEC("PSD PARAM",DUZ)) W $C(7),!!,?9,"** Please contact your Pharmacy Coordinator for access to enter/edit",!,?12,"NAOUs. PSD PARAM security key required.",! Q
|
|---|
| 5 | S SITEN=$P($G(^PS(59.4,+PSDSITE,0)),"^"),MULTI=$S($P(PSDSITE,"^",2)="M":1,1:0)
|
|---|
| 6 | NAOU ;entry for NAOUs into file 58.8
|
|---|
| 7 | K DIC,DLAYGO W ! S (DIC,DLAYGO)=58.8,DIC(0)="QEAL",DIC("A")="Select NAOU: ",DIC("DR")="2////"_+PSDSITE,DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$P(^(0),""^"",2)'=""P"""
|
|---|
| 8 | D ^DIC K DIC,DLAYGO G:Y<0 END S PSDA=+Y,NEW=+$P(Y,"^",3) D TYPE
|
|---|
| 9 | G NAOU
|
|---|
| 10 | END K ANS,DA,DIC,DIE,DIR,DIROUT,DIRUT,DLAYGO,DR,DTOUT,DUOUT,MULTI,NEW,PSDA,SITEN,X,Y
|
|---|
| 11 | Q
|
|---|
| 12 | TYPE ;selects location type
|
|---|
| 13 | W !!,"CONTROLLED SUBSTANCES SITE : "_SITEN
|
|---|
| 14 | I $P(^PSD(58.8,PSDA,0),"^",2)]"",+$O(^PSD(58.8,PSDA,1,0)) S ANS=$P(^PSD(58.8,PSDA,0),"^",2) G DIE
|
|---|
| 15 | K ANS,DIR,DIRUT S DIR(0)="S^M:MASTER VAULT;S:SATELLITE VAULT;N:NARCOTIC LOCATION",DIR("A")="LOCATION TYPE"
|
|---|
| 16 | S DIR("?")="'S' for Satellite Vault or 'N' for Narcotic location.",DIR("?",1)="Enter this NAOU's type. Select 'M' for Master Vault,"
|
|---|
| 17 | S:$P(^PSD(58.8,PSDA,0),"^",2)]"" DIR("B")=$P(^(0),"^",2) D ^DIR K DIR
|
|---|
| 18 | I $D(DIRUT),NEW K DIK S DIK="^PSD(58.8,",DA=+PSDA D ^DIK K DIK W $C(7),!!,"No location type entered. Entry has been deleted!",!! Q
|
|---|
| 19 | Q:$D(DIRUT) S ANS=Y
|
|---|
| 20 | DIE ;edit
|
|---|
| 21 | S PSDJLP=1
|
|---|
| 22 | K DA,DIE,DR S DIE=58.8,DA=PSDA
|
|---|
| 23 | S:ANS="M" DR=".01T;1////"_ANS_";Q;5;3///@;14;I 'X S Y=19;15;Q;16;Q;17;Q;19;19.5;23;24;25;26;29;28;30;12;S:'$P(^(0),U,8) Y=0;13"
|
|---|
| 24 | S:ANS="S" DR=".01T;1////"_ANS_";Q;3;5;14;I 'X S Y=19;15;Q;16;Q;17;Q;19;19.5;23;24;25;26;29;28;30"
|
|---|
| 25 | S:ANS="N" DR=".01T;1////"_ANS_";Q;3;18;6T;32;33"
|
|---|
| 26 | D ^DIE K DIE,DR,DA,PSDJLP
|
|---|
| 27 | ;link ward for dispensing equipment interface
|
|---|
| 28 | D:$O(^HL(770,"B","PSD-NDES",0))&(ANS="N")
|
|---|
| 29 | WARD .I $O(^PSD(58.8,+PSDA,3,0)) W !!,"Current Ward(s): " S PSDA(1)=0 F S PSDA(1)=$O(^PSD(58.8,+PSDA,3,PSDA(1))) Q:'PSDA(1) W ?20,$P($G(^DIC(42,+PSDA(1),0)),U),!
|
|---|
| 30 | .S DIR(0)="PO^42:AEMQ"
|
|---|
| 31 | .S DIR("A")="Select Ward for dispensing equipment interface"
|
|---|
| 32 | .S DIR("?")="When doses are dispensed the ward will be used as a path to this NAOU."
|
|---|
| 33 | .W ! D ^DIR K DIR Q:Y<1 S PSDA(1)=0,PSDA(2)=+Y,PSDA(3)=$P(Y,U,2)
|
|---|
| 34 | .I $D(^PSD(58.8,"AB",PSDA(2),PSDA)) D Q:$D(DIRUT) G WARD
|
|---|
| 35 | ..S DIR(0)="Y",DIR("A")="Remove "_PSDA(3)_"'s link to "_$P($G(^PSD(58.8,+PSDA,0)),U) D ^DIR K DIR
|
|---|
| 36 | ..I Y=1 W !!,PSDA(3)," removed.",! S DIK="^PSD(58.8,+PSDA,3,",DA(1)=PSDA,DA=PSDA(2) D ^DIK K DIK,DA
|
|---|
| 37 | .F S PSDA(1)=$O(^PSD(58.8,"AB",PSDA(2),PSDA(1))) Q:'PSDA(1) S:$P($G(^PSD(58.8,PSDA(1),0)),U,2)="N"&(PSDA'=PSDA(1)) PSDA(4)=$P($G(^(0)),U)
|
|---|
| 38 | .I $G(PSDA(4))]"" W !!,PSDA(3)," is already linked to ",PSDA(4),"." K PSDA(4) G WARD
|
|---|
| 39 | .S DIC="^PSD(58.8,"_+PSDA_",3,",DIC(0)="LM",DLAYGO=58.8,DA(1)=PSDA
|
|---|
| 40 | .S X=PSDA(3),DA=PSDA(2),DIC("P")=$P(^DD(58.8,21,0),U,2),DINUM=PSDA(2)
|
|---|
| 41 | .D ^DIC K DIC,DA,DLAYGO G WARD
|
|---|
| 42 | ;Set up Default Dispensing Site
|
|---|
| 43 | I "MS"[ANS S $P(PSDSITE,U,3)=PSDA,$P(PSDSITE,U,4)=$P($G(^PSD(58.8,+PSDA,0)),U),$P(PSDSITE,U,5)=0 D EN^PSDSP S:$G(PSDS) $P(PSDSITE,U,5)=1
|
|---|
| 44 | K PSDA,PSDS,PSDSN Q
|
|---|
