source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSALEVEL.m@ 1582

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

initial load of FOIAVistA 6/30/08 version

File size: 6.2 KB
Line 
1PSALEVEL ;BIR/JMB-Enter/Edit Stock and Reorder Levels ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
3 ;This routine allows the user to select a pharmacy location/master vault
4 ;to set the MAINTAIN STOCK LEVELS? field. If yes, the stock and reorder
5 ;levels can be edited.
6 ;
7 I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
8SETUP S PSASLN="",$P(PSASLN,"-",80)=""
9 ;Counts pharmacy locations
10 S (PSALOC,PSANUM)=0
11 F S PSALOC=+$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:'PSALOC D
12 .Q:'$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="")
13 .I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
14 .S PSANUM=PSANUM+1,PSAONE=PSALOC,PSAISIT=+$P(^PSD(58.8,PSALOC,0),"^",3),PSAOSIT=+$P(^(0),"^",10)
15 .D SITES^PSAUTL1 S PSALOCA($P(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=PSAISIT_"^"_PSAOSIT
16 ;Counts master vaults
17 S (PSAMVNUM,PSAMV)=0
18 F S PSAMV=+$O(^PSD(58.8,"ADISP","M",PSAMV)) Q:'PSAMV D
19 .Q:'$D(^PSD(58.8,PSAMV,0))!($P($G(^PSD(58.8,PSAMV,0)),"^")="")!('$P($G(^PSD(58.8,PSAMV,0)),"^",8))
20 .I +$G(^PSD(58.8,PSAMV,"I")),+^PSD(58.8,PSAMV,"I")'>DT Q
21 .S PSAMVNUM=PSAMVNUM+1,PSAONEMV=PSAMV,PSAMV($P(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
22 ;
23BEGIN S (PSABEG,PSALOC,PSAMV,PSAOUT)=0
24 I $D(^XUSEC("PSJ RPHARM",DUZ)) G:'PSAMVNUM&('PSANUM) NONE D PHARMKEY
25 I '$D(^XUSEC("PSJ RPHARM",DUZ)) G:'PSANUM NONE D:PSANUM=1 ONE D:PSANUM>1 MANY
26 G:PSAOUT EXIT G:PSABEG BEGIN
27 ;
28MAINTAIN ;Maintain reorder levels in pharmacy location/master vault?
29 S PSA=$S(PSALOC:PSALOC,1:PSAMV)
30 S DIE="^PSD(58.8,",DA=PSA,DR=34 D ^DIE K DA,DIE
31 G:$G(DTOUT)!($G(DUOUT)) EXIT
32 I '+X G:PSANUM&(PSAMVNUM) BEGIN G EXIT
33 ;
34GETDRUG ;Gets drug levels
35 W ! S DIC(0)="AEMQZ",DIC="^PSD(58.8,"_PSA_",1,",DA(1)=PSA,DIC("S")="I +$P($G(^PSD(58.8,PSA,1,+Y,0)),U,14)'<DT!('$P($G(^PSD(58.8,PSA,1,+Y,0)),U,14))"
36 D ^DIC K DA,DIC G:$G(DTOUT)!($G(DUOUT)) EXIT
37 I Y=-1 G:(PSANUM=1&('PSAMVNUM))!('PSANUM&(PSAMVNUM=1)) EXIT G BEGIN
38 S PSADRG=+Y
39 S DIE="^PSD(58.8,"_PSA_",1,",DA(1)=PSA,DA=PSADRG,DR="2STOCK LEVEL (in Dispense Units);4REORDER LEVEL (in Dispense Units)" D ^DIE K DIE
40 G:$G(DTOUT)!($G(DUOUT)) EXIT
41 G GETDRUG
42 ;
43CHOOSE ;Selects the type of location to have the levels enter/edited.
44 W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>",!,PSASLN
45 S DIR(0)="SO^P:Pharmacy Location;M:Master Vault",DIR("A")="Enter/edit levels for a pharmacy location or master vault",DIR("??")="^D CHO^PSALEVEL"
46 D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
47 S PSACHO=Y
48 I PSACHO="P" D:PSANUM=1 ONE D:PSANUM>1 MANY Q
49 I PSACHO="M" D:PSAMVNUM=1 ONEMV D:PSAMVNUM>1 MANYMV
50 Q
51 ;
52EXIT ;Kills variables
53 K DA,DIC,DIE,DIR,DIRUT,DR,DTOUT,DUOUT,PSA,PSABEG,PSACHO,PSACNT,PSACOMB,PSADRG,PSAISIT,PSAISITN,PSALOC,PSALOCA,PSALOCN
54 K PSAMENU,PSAMV,PSAMVA,PSAMVIEN,PSAMVNUM,PSANUM,PSAONE,PSAONEMV,PSAOSIT,PSAOSITN,PSAOUT,PSASEL,PSASLN,PSAVAULT,X,Y
55 Q
56 ;
57PHARMKEY ;
58 I 'PSAMVNUM D:PSANUM=1 ONE D:PSANUM>1 MANY Q
59 I PSANUM D CHOOSE Q
60 I 'PSANUM D:PSAMVNUM=1 ONEMV D:PSAMVNUM>1 MANYMV
61 Q
62 ;
63ONEMV ;Assigns invoice to Master Vault
64 S PSAMV=PSAONEMV
65 W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
66 W !?31,"<< MASTER VAULT >>",!!,$P(^PSD(58.8,PSAMV,0),"^"),!,PSASLN,!
67 Q
68 ;
69MANYMV ;Displays active master vaults
70 W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>",!,PSASLN,!
71 S PSASEL=0,PSAMVA="" F S PSAMVA=$O(PSAMV(PSAMVA)) Q:PSAMVA="" D
72 .S PSAMVIEN=0 F S PSAMVIEN=$O(PSAMV(PSAMVA,PSAMVIEN)) Q:'PSAMVIEN D
73 ..S PSASEL=PSASEL+1,PSAVAULT(PSASEL,PSAMVA,PSAMVIEN)=""
74 ..W !,$J(PSASEL,2)_".",?4,PSAMVA
75 W ! S DIR(0)="NO^1:"_PSASEL,DIR("A")="Select Master Vault",DIR("?")="Select the Master Vault to be edited",DIR("??")="^D MV^PSALEVEL"
76 D ^DIR K DIR I Y="",PSANUM S PSABEG=1 Q
77 I Y="",'PSANUM S PSAOUT=1 Q
78 I $G(DIRUT) S PSAOUT=1 Q
79 S PSASEL=Y
80 S PSAMVA=$O(PSAVAULT(PSASEL,"")) Q:PSAMVA="" S PSAMVIEN=+$O(PSAVAULT(PSASEL,PSAMVA,0)) Q:'PSAMVIEN S PSAMV=PSAMVIEN
81 W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
82 W !?31,"<< MASTER VAULT >>",!!,$P(^PSD(58.8,PSAMV,0),"^"),!,PSASLN,!
83 Q
84 ;
85NONE ;No DA pharmacy locations
86 Q:PSAMVNUM
87 W !!,"There are no Drug Accountability pharmacy locations.",!!,"Use the Set Up/Edit a Pharmacy Location option on Pharmacy Location menu"
88 W !,"to setup one or more pharmacy locations."
89 G EXIT
90 ;
91ONE ;Only one location
92 S PSACNT=0,PSALOC=PSAONE,PSALOCN=$O(PSALOCA(""))
93 W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
94 W !?31,"PHARMACY LOCATION",!!
95 I $L(PSALOCN)>76 W $P(PSALOCN,":")_" :"_$P($P(PSALOCN,":",2),"(IP)",1)_"(IP)",!?20,$P(PSALOCN,"(IP)",2)
96 W:$L(PSALOCN)<77 PSALOCN W !,PSASLN,!
97 Q
98 ;
99MANY ;If more than one pharmacy location, display invoices.
100 W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>",!,PSASLN,!
101 S PSACNT=0,PSALOCN="" F S PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN="" D
102 .S PSALOC=0 F S PSALOC=$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC D
103 ..S PSACNT=PSACNT+1,PSAMENU(PSACNT,PSALOCN,PSALOC)=PSALOC
104 ..W !,$J(PSACNT,2)_"." W:$L(PSALOCN)>72 ?4,$P(PSALOCN,"(IP)",1)_"(IP)",!?21,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<73 ?4,PSALOCN
105 W !! K DIR S DIR(0)="NO^1:"_PSACNT,DIR("A")="Pharmacy Location",DIR("?")="Select the pharmacy location to be edited",DIR("??")="^D PL^PSALEVEL"
106 D ^DIR K DIR I Y="",PSAMVNUM S PSABEG=1 Q
107 I Y="",'PSAMVNUM S PSAOUT=1 Q
108 I $G(DIRUT) S PSAOUT=1 Q
109 S PSASEL=Y,PSALOCN=$O(PSAMENU(PSASEL,"")) Q:PSALOCN=""
110 S PSALOC=$O(PSAMENU(PSASEL,PSALOCN,0)) Q:'PSALOC
111 W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
112 W !?28,"<< PHARMACY LOCATION >>",!!
113 I $L(PSALOCN)>76 W $P(PSALOCN,"(IP)",1)_"(IP)",!?20,$P(PSALOCN,"(IP)",2)
114 W:$L(PSALOCN)<77 PSALOCN W !,PSASLN,!
115 Q
116 ;
117CHO ;Extended help for "Enter/edit levels for pharmacy location or master vault."
118 W !?5,"Enter P to add or edit stock and reorder levels in a pharmacy location.",!?5,"Enter M to add or edit stock and reorder levels in a master vault."
119 W !!?5,"After making your selection, you will be given a list of active pharmacy",!?5,"locations or master vaults from which to choose."
120 Q
121MV ;Extended help for "Select Master Vault"
122 W !?5,"Enter the numbers of master vaults from the list. Select the ones that",!?5,"contain drugs you want to add or edit stock and reorder levels."
123 Q
124PL ;Extended help for "Select Pharmacy Location"
125 W !?5,"Enter the numbers of pharmacy locations from the list. Select the ones that",!?5,"contain drugs you want to add or edit stock and reorder levels."
126 Q
Note: See TracBrowser for help on using the repository browser.