source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAWARD.m@ 1093

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1PSAWARD ;BIR/LTL,JMB-Set Up/Edit a Pharmacy Location ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
3 ;This routine links wards to the pharmacy location.
4 ;
5 N DIC,DIE,D0,D1,DLAYGO,DR,DIR,DIRUT,DTOUT,DUOUT,DA,PSAW,PSADR,X,Y,PSAOUT
6 W @IOF,!?5,"For the purpose of collecting Unit Dose and IV dispensing data,",!,"any ward at which such dispensing might ever occur should be added."
7 W !,"The ONLY reason to NOT add a ward would be if the dispensing at that ward",!,"should NOT update ",$G(PSALOCN),"."
8 W !!,"There is NO harm in adding inactive wards."
9 I '$D(^PSD(58.8,+PSALOC,3,0)) S ^(0)="^58.842P^^"
10ALL I $G(PSA(2))=1 S PSA(3)=0,DIC="^PSD(58.8,+PSALOC,3,",DA(1)=PSALOC,DIC(0)="LNX" W !!,PSALOCN," is linked to " F S (DA,DINUM,X,PSA(3))=$O(^DIC(42,PSA(3))) Q:'PSA(3) K DD,DO D:'$G(^PSD(58.8,+PSALOC,3,+PSA(3),0)) FILE^DICN D
11 .W $P($G(^DIC(42,+PSA(3),0)),U) W:$O(^DIC(42,PSA(3))) ", "
12 .I '$O(^DIC(42,PSA(3))) W ".",!
13 .W:$X+10>IOM !!
14 K DINUM
15 G:$G(PSA(2))=1 QUIT
16MUL I $O(^PSD(58.8,+PSALOC,3,0)) D G:$G(PSAOUT) QUIT
17 .S PSA(3)=0
18 .W !!,"The following wards are currently connected to ",PSALOCN,":",!!
19 .F S PSA(3)=$O(^PSD(58.8,+PSALOC,3,+PSA(3))) Q:'PSA(3) W:$X+10>IOM !! W $P($G(^DIC(42,+PSA(3),0)),U),$S($O(^PSD(58.8,+PSALOC,3,+PSA(3))):", ",1:".")
20 .S DIR(0)="Y",DIR("A")="Do you wish to change this",DIR("B")="No",DIR("?")="Any dispensing to these wards by the UD or IV modules will update this location"
21 .W ! D ^DIR K DIR I Y'=1 S PSAOUT=1 Q
22 .S DIR(0)="SBOA^A:ADD;D:DELETE",DIR("A")="Do you wish to ADD or DELETE WARDS? (A/D): "
23 .S DIR("?",1)="Enter 'A' to ADD a Ward, 'D' to DELETE a Ward"
24 .S DIR("?")="or '^' to quit" D ^DIR K DIR S PSAOUT(1)=Y I $D(DIRUT) S PSAOUT=1 Q
25 .I Y="D" S DIC="^PSD(58.8,+PSALOC,3,",DIC(0)="AEMQ",DA(1)=PSALOC,DIC("A")="Select "_$G(PSALOCN)_" WARD: " F D ^DIC Q:Y<0!(Y="") S PSAW=+Y,PSAW(1)=$P($G(^DIC(42,+PSAW,0)),U) D I $D(DIRUT) S PSAOUT=1 Q
26 ..S DIR(0)="Y",DIR("A")="OK to delete "_$G(PSAW(1))
27 ..S DIR("B")="No",DIR("?")="If yes, I'll remove it from "_$G(PSALOCN)
28 ..D ^DIR I Y'=1 S PSAOUT=1 Q
29 ..S DIK=DIC,DA(1)=PSALOC,DA=PSAW D ^DIK W !,$G(PSAW(1))," deleted."
30 .K DIC,DIK,DA,PSAW S:PSAOUT(1)'="A" PSAOUT=1
31 S DIR(0)="SBOA^A:ALL;R:RANGE",DIR("A")="Do you wish to add ALL wards or select a RANGE of wards? (A/R): "
32 S DIR("?",1)="Enter 'A' to add ALL wards, 'R' to select a range"
33 S DIR("?")="or '^' to quit" D ^DIR K DIR I $D(DIRUT) S PSAOUT=1 Q
34 I Y="A" S PSA(2)=1 G ALL
35 S PSAW=0,(PSA,PSA(3))=1,PSA(2)=20
36LOOP F PSA=PSA:1:PSA(2) S PSAW=$O(^DIC(42,PSAW)) Q:'PSAW S PSA=PSA-1 I '$O(^PSD(58.8,"AB",+PSAW,0)) S PSA=PSA+1 W !,PSA,?10,$P($G(^DIC(42,PSAW,0)),U) S PSADR(PSA)=PSAW W:$D(^DIC(42,+PSAW,"I")) ?40,"***INACTIVE***"
37 I PSA=1 W !!,"Sorry, you've already added all the wards that you can." G QUIT
38 S:$O(PSADR(PSA)) PSA=$O(PSADR(PSA))
39 I $G(PSAW) F PSAW(1)=PSAW:0 S PSAW(1)=$O(^DIC(42,PSAW(1))) Q:'PSAW(1)!($G(PSAW(2))>19) I '$O(^PSD(58.8,"AB",+PSAW(1),0)) S PSAW(2)=$G(PSAW(2))+1
40 I $G(PSA)'>$G(PSA(3)) G QUIT
41 S PSA(2)=$G(PSA(2))+$G(PSAW(2))
42 S DIR("?")="You can only select wards that are not yet linked to a location"
43 S DIR(0)="LA^"_PSA(3)_":"_$S($O(PSADR((PSA-1))):PSA,1:PSA-1),DIR("A",1)="Select the ward(s) or range of wards from which you want "_PSALOCN,DIR("A")="to collect dispensing data: " D ^DIR K DIR G:$D(DIRUT) QUIT S PSAC=Y
44 S DIC="^PSD(58.8,"_+PSALOC_",3,",DIC(0)="LNX",DA(1)=PSALOC
45 F PSAB=1:1:PSA I $P($G(PSAC),",",PSAB) K DD,DO S (DA,DINUM,X)=$G(PSADR($P(PSAC,",",PSAB))) D FILE^DICN W "." K DINUM,PSA(1) Q:$G(PSAOUT)
46 K PSAB I $G(PSAW(2)) W @IOF S (PSA,PSA(3))=$G(PSA)+1 G LOOP
47 K DIC,PSA,PSADR G MUL
48QUIT I '$D(DIRUT) W ! S DIE="^PS(59.7,",DA=$O(^PS(59.7,0)),DR="72Inpatient Dispensing Update?" D ^DIE K DIE,DA S:$D(Y) PSAOUT=1
49 Q
Note: See TracBrowser for help on using the repository browser.