source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSALOC2.m@ 1742

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1PSALOC2 ;BIR/MNT,DB-Set Up/Edit a Pharmacy Location ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97
3 ;
4 ;This routine is for taking a Combined IP/OP & making it
5 ;an Inpatient Site & Outpatient Site
6 K PSAISIT,PSAERR,PSAOSIT,PSACNTR
7 I $E(PSALOCN)'="C" G CMBSETUP
8 W !,"You will be prompted for an existing Inpatient & Outpatient location.",!,"Both types can be selected, or just one.",!!
9INPAT S PSATYPE="INPATIENT" D SETDIC S DIC("S")="I $E($P(^(0),U,1),1,5)=""INPAT""" D ^DIC S PSAISIT=+Y,PSAISIT(1)=$P(Y,"^",2) I $D(DIRUT) G Q
10OUTPA S PSATYPE="OUTPATIENT" D SETDIC S DIC("S")="I $E($P(^(0),U,1),1,5)=""OUTPA""" D ^DIC S PSAOSIT=+Y,PSAOSIT(1)=$P(Y,"^",2) I $D(DIRUT) G Q
11 G STRDATA
12 ;
13 ;
14STRDATA ;store data
15 I $G(PSAISIT(1))'="" W !,"Inpatient Site : "_PSAISIT(1) S PSACNTR=$G(PSACNTR)+1
16 I $G(PSAOSIT(1))'="" W !,"Outpatient Site : "_PSAOSIT(1) S PSACNTR=$G(PSACNTR)+1
17 I $G(PSAISIT)'>0,$G(PSAOSIT)'>0 W !,"No changes made" G Q
18 I $G(PSACNTR)>1 G FINISH
19 S PSANEWL=$S($G(PSAISIT)>0:PSAISIT,1:PSAOSIT)
20 I $O(^PSD(58.8,PSANEWL,1,0))>0 G FINISH
21 D DRUGS G Q:$G(PSAERR)=1
22 ;
23 ;
24FINISH ;done setting up location
25 I $G(PSAISIT)>0,$G(PSAISIT(1))'="",$P(^PSD(58.8,PSAISIT,0),"^",3)="",$P(^PSD(58.8,PSALOC,0),"^",3)'="" D SETUPIP G Q:$G(PSAERR)'=""
26 I $G(PSAOSIT)>0,$G(PSAOSIT(1))'="",$O(^PSD(58.8,PSALOC,7,0))'="",$O(^PSD(58.8,PSAOSIT,7,0))'>0 D SETUPOP G Q:$G(PSAERR)'=""
27 ;
28DONEI W !,"Do you want to Inactivate "_PSALOCN_" now ? YES// " R AN:DTIME G Q:AN["^" S:AN="" AN="Y" S AN=$E(AN)
29 I "YyNn"'[AN W !,"Since your setting up a new location, there is no point in keeping this one in",!,"an active state. Answer 'Y'es to inactivate this location.",! K AN G DONEI
30 ;
31 ;Inactivate original location
32 I "yY"[AN W !,PSALOCN," is now inactive." S $P(^PSD(58.8,PSALOC,"I"),"^",1)=DT
33 G Q
34 ;
35 ;
36SETUPIP W !,"Do you want to setup "_PSAISIT(1)_" with the same inpatient site",!,"already identified in "_PSALOCN
37 W " ? YES // " R AN:DTIME I AN["^" S PSAERR=1 Q
38 S AN=$E(AN) I "yYnN"'[AN W !,"Answer Yes, and the inpatient site currently assigned to the Combined location",!,"will be assigned to the inpatient site." K AN G SETUPIP
39 I "nN"[AN Q
40 S DIE="^PSD(58.8,",DA=PSAISIT,DR="2////^S X=$P(^PSD(58.8,PSALOC,0),U,2)" D ^DIE
41 Q
42 ;
43 ;
44SETUPOP W !,"Do you want to setup "_PSAOSIT(1)_" with the same Outpatient location(s), ",!,"already defined for "_PSALOCN
45 W " ? YES // " R AN:DTIME I AN["^" S PSAERR=1 Q
46 S AN=$E(AN) I "yYnN"'[AN W !,"Answer Yes, and the outpatient site(s) assigned to the Combined location",!,"will be assigned to the Outpatient location." K AN G SETUPOP
47 I "Nn"[AN Q
48 S DIE="^PSD(58.8,",DA=PSAOSIT,DR="10////^S X=$P(^PSD(58.8,PSALOC,0),U,10)" D ^DIE
49 S %X="^PSD(58.8,PSALOC,7,",%Y="^PSD(58.8,PSAOSIT,7," D XY^%RCR(%X,%Y)
50 Q
51 ;
52 ;
53CMBSETUP ;Setup combined location
54 S DIC("A")="Select Combined location: ",DIC(0)="AEQMZ",DIC="^PSD(58.8,",DIC("S")="I $E($P(^(0),U,1),1,5)=""COMBI""" D ^DIC
55 G Q:+Y'>0 I $P($G(^PSD(58.8,+Y,"I")),"^")'="" W !,"Sorry, this is an inactive pharmacy location.",! K Y G CMBSETUP
56 I $O(^PSD(58.8,+Y,1,0))="" S PSANEWL=+Y D DRUGS
57 G FINISH
58 ;
59 ;
60DRUGS I $O(^PSD(58.8,PSALOC,1,0))="" Q
61 I '$D(^PSD(58.8,PSALOC,1,0)) Q
62 W !,"Do you want to transfer the drugs from "_PSALOCN_" to "_$P(^PSD(58.8,PSANEWL,0),"^")_" YES // " R AN:DTIME S:AN["^" PSAERR=1 Q:$G(PSAERR)=1 I AN="" S AN="Y"
63 S AN=$E(AN) I "yYnN"'[AN W !!,"Since "_PSALOCN_" will be made inactive after setup is complete, you can",!,"transfer each drug and its balance information to the new location.",! G DRUGS
64 I "Nn"[AN Q
65 I "Yy"[AN S X1=0,^PSD(58.8,PSANEWL,1,0)=^PSD(58.8,PSALOC,1,0) F S X1=$O(^PSD(58.8,PSALOC,1,X1)) Q:X1'>0 S ^PSD(58.8,PSANEWL,1,X1,0)=^PSD(58.8,PSALOC,1,X1,0),^PSD(58.8,PSALOC,1,"B",X1,X1)="" W "."
66 W !,"Drug transfer complete."
67 Q
68 ;
69 ;
70SETDIC K DIC S DIC("A")="Select "_PSATYPE_" Pharmacy Location: ",DIC="^PSD(58.8,",DIC(0)="AEBQ"
71Q Q
Note: See TracBrowser for help on using the repository browser.