Routine: PSALOC1

PSALOC1 ;BIR/MNT,DB-Set Up/Edit a Pharmacy Location ;7/23/97

 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97

 W !,"This option lets you change the location type. For example: Inpatient and",!,"Outpatient locations can be changed to a Combined (IP/OP) location."

 W !,"Combined (IP/OP) locations, can be changed to either an Inpatient Location",!,"an Outpatient location, or BOTH.",! Q

PSAHLP2 ;

PSAHLP3 ;

 W !,"An Inpatient site is required to allow linking of IV rooms to the location."

PSAHLP4 ;

 W !,^DD(58.8,20,3),! F X=1,2 W !,^DD(58.8,20,21,X,0)

PSAHLP5 ;

 W !,^DD(58.831,.01,3) W ! F X=1:1:4 W !,^DD(58.831,.01,21,X,0)

PSAHLP6 ;

 W !,^DD(58.842,.01,3) W ! F X=1,2 W !,^DD(58.842,.01,21,X,0)

PSAHLP7 ;

 W !,"This option allows editting of a location's inactivation date.",! Q

PSAHLP8 ;

 W !,"The Enter/Edit a Drug option adds a new drug to the pharmacy location.",!,"It also displays the balance of an existing drug." Q

PSAHLP9 ;

 W !,"This option sets up a flag on a pharmacy location or master vault to maintain",!,"the stock and reorder levels or removes the flag.",! Q

PSAHLP10 ;

 W !,"This option allows the re-activation of an inactive pharmacy location.",!

PSASETUP ;Setup mail message recipients

 S X="PSA REORDER LEVEL",DIC="^XMB(3.8," D ^DIC S PSAREORD=+Y,PSAREORD(1)=X

 S X="PSA UPDATE NDC",DIC="^XMB(3.8," D ^DIC S PSAUPDT=+Y,PSAUPDT(1)=X

 K XMY

 W !,"Currently, any user who holds the 'PSA ORDERS' key, receives the mail message",!,"'Drug Balances Below Reorder Level' & 'NDC/PRICE change messages'."

 W !,"Two mail groups have been established to determine who receives the message.",!

 W !,"Members added to the mail group must first possess the 'PSA ORDERS' key.",!

1 S PSAGRP="PSA REORDER LEVEL" D MEMBER

 S PSAGRP="PSA NDC UPDATES"

MEMBER W !,"Do you want to edit the users for the "_PSAGRP_" mail group? YES//" R AN:DTIME Q:AN["^"  S:AN="" AN="Y" S AN=$E(AN)

 I "yYNn"'[AN W !,"Answer 'Y'es and you will be able to edit the members of this mailgroup." K AN G MEMBER

 I "nN"[AN Q

MEMASK S DIC(0)="AEQMZ",DIC="^VA(200,",DIC("S")="I $D(^XUSEC(""PSA ORDERS"",+Y))" D ^DIC I +Y'>0 Q

 K XMY S XMY(+Y)=""

ACTION R !,"Select 'A' to Add the user or 'D' to delete the user. ADD//",AN:DTIME S:AN="" AN="A" I "AadD"'[AN W !,"Enter a 'D' and if the user is already a member of the group, they'll be deleted." K AN G ACTION

 I "Aa"[AN S X5=$$MG^XMBGRP(PSAGRP,0,DUZ,1,.XMY,,0)

 I "dD"[AN S X5=$$DM^XMBGRP(PSAGRP,.XMY,0)

 I X5'>0 W !,"Sorry, couldn't perform action." G MEMASK

 W !,"task completed." G MEMASK

Q Q

PSALOC1   ;BIR/MNT,DB-Set Up/Edit a Pharmacy Location ;7/23/97

 +1       ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97

 +2        WRITE !,"This option lets you change the location type. For example: Inpatient and",!,"Outpatient locations can be changed to a Combined (IP/OP) location."

 +3        WRITE !,"Combined (IP/OP) locations, can be changed to either an Inpatient Location",!,"an Outpatient location, or BOTH.",!

           QUIT

PSAHLP2   ;

PSAHLP3   ;

 +1        WRITE !,"An Inpatient site is required to allow linking of IV rooms to the location."

 +2        QUIT

PSAHLP4   ;

 +1        WRITE !,^DD(58.8,20,3),!

           FOR X=1,2

               WRITE !,^DD(58.8,20,21,X,0)

 +2        QUIT

PSAHLP5   ;

 +1        WRITE !,^DD(58.831,.01,3)

           WRITE !

           FOR X=1:1:4

               WRITE !,^DD(58.831,.01,21,X,0)

 +2        QUIT

PSAHLP6   ;

 +1        WRITE !,^DD(58.842,.01,3)

           WRITE !

           FOR X=1,2

               WRITE !,^DD(58.842,.01,21,X,0)

 +2        QUIT

PSAHLP7   ;

 +1        WRITE !,"This option allows editting of a location's inactivation date.",!

           QUIT

PSAHLP8   ;

 +1        WRITE !,"The Enter/Edit a Drug option adds a new drug to the pharmacy location.",!,"It also displays the balance of an existing drug."

           QUIT

PSAHLP9   ;

 +1        WRITE !,"This option sets up a flag on a pharmacy location or master vault to maintain",!,"the stock and reorder levels or removes the flag.",!

           QUIT

PSAHLP10  ;

 +1        WRITE !,"This option allows the re-activation of an inactive pharmacy location.",!

 +2        QUIT

PSASETUP  ;Setup mail message recipients

 +1        SET X="PSA REORDER LEVEL"

           SET DIC="^XMB(3.8,"

           DO ^DIC

           SET PSAREORD=+Y

           SET PSAREORD(1)=X

 +2        SET X="PSA UPDATE NDC"

           SET DIC="^XMB(3.8,"

           DO ^DIC

           SET PSAUPDT=+Y

           SET PSAUPDT(1)=X

 +3        KILL XMY

 +4        WRITE !,"Currently, any user who holds the 'PSA ORDERS' key, receives the mail message",!,"'Drug Balances Below Reorder Level' & 'NDC/PRICE change messages'."

 +5        WRITE !,"Two mail groups have been established to determine who receives the message.",!

 +6        WRITE !,"Members added to the mail group must first possess the 'PSA ORDERS' key.",!

 +7       ;

1          SET PSAGRP="PSA REORDER LEVEL"

           DO MEMBER

 +1        SET PSAGRP="PSA NDC UPDATES"

MEMBER     WRITE !,"Do you want to edit the users for the "_PSAGRP_" mail group? YES//"

           READ AN:DTIME

           IF AN["^"

               QUIT

           IF AN=""

               SET AN="Y"

           SET AN=$EXTRACT(AN)

 +1        IF "yYNn"'[AN

               WRITE !,"Answer 'Y'es and you will be able to edit the members of this mailgroup."

               KILL AN

               GOTO MEMBER

 +2        IF "nN"[AN

               QUIT

 +3       ;

MEMASK     SET DIC(0)="AEQMZ"

           SET DIC="^VA(200,"

           SET DIC("S")="I $D(^XUSEC(""PSA ORDERS"",+Y))"

           DO ^DIC

           IF +Y'>0

               QUIT

 +1        KILL XMY

           SET XMY(+Y)=""

ACTION     READ !,"Select 'A' to Add the user or 'D' to delete the user. ADD//",AN:DTIME

           IF AN=""

               SET AN="A"

           IF "AadD"'[AN

               WRITE !,"Enter a 'D' and if the user is already a member of the group, they'll be deleted."

               KILL AN

               GOTO ACTION

 +1        IF "Aa"[AN

               SET X5=$$MG^XMBGRP(PSAGRP,0,DUZ,1,.XMY,,0)

 +2        IF "dD"[AN

               SET X5=$$DM^XMBGRP(PSAGRP,.XMY,0)

 +3        IF X5'>0

               WRITE !,"Sorry, couldn't perform action."

               GOTO MEMASK

 +4        WRITE !,"task completed."

           GOTO MEMASK

Q          QUIT

PSALOC1.m