source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSALOC.m@ 701

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1PSALOC ;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 ;References to ^PS(59, are covered under IA #212
5 ;References to ^PS(59.4, are covered under IA #2505
6 ;Due to merging facilities, this functionality is being
7 K PSALOC,PSALOCA,PSAMNU
8 S PSALOC=+$O(^PSD(58.8,"ADISP","P",0))
9 I 'PSALOC W !!?5,"No Drug Accountability location has been created yet." G ADD
10 D HDR
11 ;
12ORDER ;If more than one pharmacy location, collect them in alpha order.
13 S (PSACNT,PSALOC)=0 W !
14 F S PSALOC=+$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:'PSALOC D
15 .Q:'$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="")
16 .I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
17 .D SITES^PSAUTL1
18 .K PSAISIT,PSAOSIT
19 .S PSACNT=PSACNT+1,PSAONE=+PSALOC
20 .S PSALOCA($P(^PSD(58.8,PSALOC,0),"^"),PSALOC)=$P(^(0),"^",3)_"^"_$P(^(0),"^",10) I $D(^PSD(58.8,PSALOC,7)) D
21 ..;OP multiple has data
22 ..S X2=0 F S X2=$O(^PSD(58.8,PSALOC,7,X2)) Q:X2'>0 I $P(^PSD(58.8,PSALOC,0),"^",10)'=X2,$P($G(^PSD(58.8,PSALOC,7,X2,0)),"^",2)="" S PSALOCA($P(^PSD(58.8,PSALOC,0),"^"),PSALOC)=PSALOCA($P(^PSD(58.8,PSALOC,0),"^"),PSALOC)_"^"_X2
23 S PSACHK=$O(PSALOCA("")) I PSACHK="" G ADD
24 I $G(PSACNT)=1 G DISP
25 G DISP
26 ;
27ONE ;only one
28 S PSALOC=PSAONE
29 I '$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="") W !,"There are no Drug Accountability pharmacy locations with data." Q
30 S PSALOCN="",PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN="" S PSALOC=0,PSALOC=+$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC
31 G EXIT
32 ;
33DISP ;Displays the available pharmacy locations.
34 S PSACNT=0,PSALOCN=""
35 F S PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN="" D
36 .S PSALOC=0 F S PSALOC=+$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC D
37 ..S PSACNT=PSACNT+1,PSAMNU(PSACNT,PSALOCN,PSALOC)=PSALOCA(PSALOCN,PSALOC)
38 ..W !,$J(PSACNT,2),?5,PSALOCN S DATA=PSAMNU(PSACNT,PSALOCN,PSALOC) W:$P(DATA,"^",1)'="" ?25,$P($G(^PS(59.4,$P(DATA,"^",1),0)),"^") W:$P(DATA,"^",2)'="" ?50,$P($G(^PS(59,$P(DATA,"^",2),0)),"^")
39 ..I $P(DATA,"^",3)'="" F X3=3:1 Q:$P(DATA,"^",X3)="" W:$P(DATA,"^",2)'="" "," W !,?50,$P($G(^PS(59,$P(DATA,"^",X3),0)),"^")
40 ..;I $D(^PSD(58.8,PSALOC,"I")) W !,"***** INACTIVE *****"
41 ;S PSACNT=$G(PSACNT)+1 W !,$J(PSACNT,2),?5,"New Pharmacy Location",! S PSANEW=PSACNT
42 ;
43SELECT S DIR(0)="L^1:"_PSACNT,DIR("A")="Select PHARMACY LOCATION",DIR("??")="^D HELP^PSAUTL3"
44 K PSALOC
45 S DIR("?")="Enter the number of the pharmacy location"
46 D ^DIR K DIR I 'Y S PSAOUT=1 G EXIT
47 S PSANUM=+Y
48 ;I +Y=PSANEW G ADD
49 S PSALOCN=$O(PSAMNU(+Y,"")),PSALOC=+$O(PSAMNU(+Y,PSALOCN,0)),PSAITY=$S($E(PSALOCN)="C":3,$E(PSALOCN)="I":1,$E(PSALOCN)="O":2,1:"")
50 Q
51 ;
52EXIT ;Kills all variables except PSALOC array & PSAOUT
53 K AN,AN1,CNT,CNT1,CNT2,DA,DATA,DIC,DIE,DIR,PSA,PSAB,PSAC,PSACHK,PSACOMB,PSADEL,PSADRUG,PSADT,PSAERR,PSAI,PSAII,PSAINV,PSAIPS,PSAISIT,PSAISITN
54 K PSAIT,PSAITY,PSAIV,PSAIVCHG,PSAIVLOC,PSALEN,PSALOC,PSALOCA,PSALOCI,PSALOCN,PSAMNU,PSANEW,PSANLN,PSANLN1,PSANLN2,PSANOW,PSANUM,PSAO,PSAOC,PSAOK,PSAONE,PSAOP,PSAOSIT,PSAOSITN,PSAOU,PSAOUT,PSAPVMEN
55 K PSAQTY,PSASL,PSASTO,PSAT,PSATYP,PSAWARD,PSAY,X,X2,X3,XX,Y
56 Q
57 Q
58 ;
59ADD ;add locations
60 W !,"New location set-up"
61 S DIR(0)="S^1:INPATIENT;2:OUTPATIENT;3:COMBINED (IP/OP)",DIR("A")="Select Pharmacy type",DIR("?")="You can separate Inpatient and Outpatient or Combine into one location.",DIR("??")="PSA LOCATION EDIT"
62 D ^DIR I $G(DIRUT)=1!($G(DUOUT)=1) W !,"bye" G EXIT
63 S PSAITY=+Y,PSALOCN=Y(0) I $D(^PSD(58.8,"B",PSALOCN)) W !,"There is at least one entry setup with this name. Could we expand the name ?",!,"Something like "_PSALOCN_" (WEST WING) ?" D
64NEWNM .;new Name
65 .R !!,"Please add text for a more descriptive name: ",AN1:DTIME I AN1["^"!('$T)!(AN1="") S PSAOUT=1 Q
66 .S AN=PSALOCN_" "_AN1
67 .I AN=PSALOCN W !,"Sorry that is what I have already" S PSAOUT=1 Q
68 .W !,"New name: "_AN
69 .I AN'=PSALOCN S PSALOCN=AN D
70 ..W !,"Are you sure ? YES// " R AN:DTIME I AN["^" S PSAOUT=1 Q
71 ..I AN="" S AN="Y"
72 ..S AN=$E(AN,1) I "Nn"[AN S PSAOUT=1 Q
73 ..I '$D(^PSD(58.8,"B",AN)) S PSANEW=1 Q
74 ..I $D(^PSD(58.8,"B",AN)) W "sorry, this one exists" S PSAOUT=1 Q
75 I $G(PSAOUT)=1 G EXIT
76 I '$D(^PSD(58.8,"B",PSALOCN)) S PSANEW=1
77 I $G(PSANEW) S X=PSALOCN,DIC(0)="AEQMLZ",DLAYGO="58.8",DIC="^PSD(58.8," D FILE^DICN K DIC,DA S PSALOC=+Y,DIE="^PSD(58.8,",DA=+Y,DR="1////P" D ^DIE K DIE,DR,DA Q
78 Q
79HDR W @IOF,?20,"<<<<< PHARMACY LOCATION SETUP SCREEN >>>>> ",!!,"LOCATION TYPES : INPATIENT, OUTPATIENT & COMBINED (IP/OP)",!!,"#",?5,"LOCATION ",?25,"INPATIENT SITE",?50,"OUTPATIENT SITE(s)",! F X=1:1:(IOM-4) W "="
80 Q
Note: See TracBrowser for help on using the repository browser.