| 1 | PSALOCO ;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 | ;PSALOC = Internal entry number for location
|
|---|
| 7 | ;References to ^PSDRUG( are covered by IA #2095
|
|---|
| 8 | ;PSALOCN = Location Name
|
|---|
| 9 | ;PSALOCA(PSALOCN,PSALOC)=ip site ^ Op site ^ more op sites
|
|---|
| 10 | ;
|
|---|
| 11 | K PSALOC
|
|---|
| 12 | PSAOPT W @IOF,!!,?20,"<<<< PHARMACY LOCATION OPTION SCREEN >>>>",! F X=1:1:(IOM-2) W "="
|
|---|
| 13 | W !!,"# OPTION NAME",!,"---------------",!,"1. CHANGE LOCATION TYPE",!,"2. CHANGE LOCATION NAME",!,"3. INPATIENT SITE SELECTION (not available for Outpatient locations)"
|
|---|
| 14 | W !,"4. OUTPATIENT SITE SELECTION (not available for Inpatient locations)"
|
|---|
| 15 | W !,"5. IV ROOM SETUP ",!,"6. WARD SETUP"
|
|---|
| 16 | W !,"7. INACTIVATE PHARMACY LOCATION",!,"8. ADD/EDIT DRUGS",!,"9. SET MAINTAIN REORDER LEVELS FLAG"
|
|---|
| 17 | W !,"10. REACTIVATE A PHARMACY LOCATION."
|
|---|
| 18 | W !,"11. CREATE NEW PHARMACY LOCATION"
|
|---|
| 19 | OPTASK W !!,"Select Option Number: " R AN:DTIME G Q:AN["^" G Q:AN="" G HLP:"?"[AN I AN<1!(AN>11) W !,"Please enter a number between 1 & 11." K AN G OPTASK
|
|---|
| 20 | S PSAOPT=AN I AN="10" G 10
|
|---|
| 21 | I PSAOPT="11" G ADD^PSALOC
|
|---|
| 22 | I $G(PSALOC)="" D ^PSALOC G Q:$G(PSALOC)'>0 G @PSAOPT
|
|---|
| 23 | 1 S PSAHDR="CHANGE LOCATION TYPE" D HDR
|
|---|
| 24 | D ^PSALOC2
|
|---|
| 25 | G NXT
|
|---|
| 26 | 2 S PSAHDR="CHANGE LOCATION NAME" D HDR
|
|---|
| 27 | W !,"The new location name must at least contain : " S PSACHKR=$S($E(PSALOCN)="C":"COMBINED (IP/OP)",$E(PSALOCN)="I":"INPATIENT",1:"OUTPATIENT") W PSACHKR
|
|---|
| 28 | ASK2 R !,"Please enter the new name : ",AN:DTIME G NXT:AN["^" I AN="" W " ??? " G ASK2
|
|---|
| 29 | S PSALOCN1=AN I $E(PSALOCN1,1,$L(PSACHKR))'=PSACHKR W !,"Sorry, the new name must start with "_PSACHKR G ASK2
|
|---|
| 30 | I $D(^PSD(58.8,"B",PSALOCN1)) W !,"Sorry, this name is already setup." K PSALOCN1 G ASK2
|
|---|
| 31 | S $P(^PSD(58.8,PSALOC,0),"^")=PSALOCN1
|
|---|
| 32 | K ^PSD(58.8,"B",PSALOCN,PSALOC)
|
|---|
| 33 | S ^PSD(58.8,"B",PSALOCN1,PSALOC)=""
|
|---|
| 34 | S PSALOCA(PSALOCN1,PSALOC)=PSALOCA(PSALOCN,PSALOC)
|
|---|
| 35 | S PSALOCA(PSALOCN1,PSALOC)=PSALOCA(PSALOCN,PSALOC)
|
|---|
| 36 | S PSAMNU(PSANUM,PSALOCN1,PSALOC)=PSAMNU(PSANUM,PSALOCN,PSALOC) K PSAMNU(PSANUM,PSALOCN,PSALOC)
|
|---|
| 37 | S PSALOCN=PSALOCN1 K PSALOCN1
|
|---|
| 38 | G NXT
|
|---|
| 39 | 3 S PSAHDR="INPATIENT SITE SELECTION" D HDR
|
|---|
| 40 | I $E(PSALOCN)="O" W !!,"Sorry, Inpatient Site association is not permitted for an Outpatient Location" G QUIT3
|
|---|
| 41 | I $P($G(PSALOCA(PSALOCN,PSALOC)),"^")="" S (PSA(1),PSA(2))=0 G INP
|
|---|
| 42 | S PSAISIT=$P($G(PSALOCA(PSALOCN,PSALOC)),"^")
|
|---|
| 43 | S PSAISIT(1)=$P($G(^PS(59.4,PSAISIT,0)),"^") ;Inpatient Site Name
|
|---|
| 44 | W !,"Inpatient Site : ",$P($G(^PS(59.4,$P($G(PSALOCA(PSALOCN,PSALOC)),"^"),0)),"^")
|
|---|
| 45 | W !,"Change this site? NO// " R AN:DTIME I AN["^" G QUIT3
|
|---|
| 46 | S:AN="" AN="N" S AN=$E(AN) I "NnyY"'[AN W !,"Answer 'Y' for yes to change which Inpatient Site is associated with this",!,"pharmacy location.",! D EOP G 3
|
|---|
| 47 | I "nN"[AN G QUIT3
|
|---|
| 48 | S PSAIVCHG=1
|
|---|
| 49 | S (PSA(1),PSA(2))=0
|
|---|
| 50 | INP S PSA(1)=$O(^PS(59.4,PSA(1))) G INPQ:PSA(1)'>0 I $P($G(^PS(59.4,PSA(1),0)),"^",26)=1 S PSA(2)=PSA(2)+1,PSAB=PSA(1)
|
|---|
| 51 | G INP
|
|---|
| 52 | INPQ ;End loop through inpatient file
|
|---|
| 53 | I PSA(2)<1 W !,"An Inpatient Site has not been identified for AR/WS.",!,"AR/WS dispensing data cannot be gathered" G QUIT3
|
|---|
| 54 | S:PSA(2)=1 PSAISIT=PSAB
|
|---|
| 55 | I $G(PSAIVCHG)=1,PSA(2)=1 W !,"Sorry, but this is the only inpatient site in the Inpatient Site file ? ",! G QUIT3
|
|---|
| 56 | D:PSA(2)>1 I Y<1 S PSAOU=1 G QUIT3
|
|---|
| 57 | .W !!,"Because there is more than one Inpatient Site at this facility, I need you to",! S DIC="^PS(59.4,",DIC(0)="AEQMZ",DIC("A")="Select an AR/WS Inpatient Site Name : ",DIC("S")="I $P($G(^(0)),U,26)=1" D ^DIC S PSAISIT=+Y
|
|---|
| 58 | .K DIC S:$D(DUOUT)!($D(DTOUT))!(X="") PSAERR=1 Q
|
|---|
| 59 | .I PSAITY=3&(Y<1) S PSAOU=1 S PSAERR=1 Q
|
|---|
| 60 | .S PSAISIT=+Y
|
|---|
| 61 | I $G(PSAERR)=1 G QUIT3
|
|---|
| 62 | S PSALOCI=0 F S PSALOCI=$O(^PSD(58.8,"ASITE",PSAISIT,"P",PSALOCI)) Q:'PSALOCI I '$P($G(^PSD(58.8,PSALOCI,"I")),"^") W !,"Already Assigned to : "_$P($G(^PSD(58.8,PSALOCI,0)),"^") S PSAERR=1
|
|---|
| 63 | I $G(PSAERR)'>0,$G(PSAISIT)>0,$G(PSALOC)>0 S DIE="^PSD(58.8,",DA=PSALOC,DR="2////^S X=PSAISIT" D ^DIE S $P(PSALOCA(PSALOCN,PSALOC),"^")=PSAISIT
|
|---|
| 64 | ;
|
|---|
| 65 | QUIT3 G NXT
|
|---|
| 66 | 4 S PSAHDR="OUTPATIENT SITE SELECTION" D HDR
|
|---|
| 67 | I $E(PSALOCN)="I" W !!,"Sorry, Outpatient Site association is not permitted for an Inpatient Location.",! G QUIT4
|
|---|
| 68 | I $G(PSAITY)=1 G QUIT4
|
|---|
| 69 | S PSAOSIT=$P($G(PSALOCA(PSALOCN,PSALOC)),"^",2)
|
|---|
| 70 | W !!,"Outpatient site selection affects the collection of dispensing data.",!,"When a prescription is released through Outpatient pharmacy, the data is stored "
|
|---|
| 71 | W !,"then retrieved by the Drug Accountability back-ground job that runs each night.",!!
|
|---|
| 72 | ;
|
|---|
| 73 | OPASK ;get Outpatient site(s)
|
|---|
| 74 | I $G(PSAOSIT)'="" S PSAOSIT(1)=$P($G(^PS(59,PSAOSIT,0)),"^")
|
|---|
| 75 | W !,"Primary Outpatient Site : ",$S($G(PSAOSIT)="":"Unknown",1:$G(PSAOSIT(1)))
|
|---|
| 76 | D OPSITES I $O(PSAOSIT(1))'="" W !,"Secondary Site(s) : " F X=2:1 Q:$G(PSAOSIT(X))="" I PSAOSIT(X)'=PSAOSIT W ?34,$P($G(^PS(59,PSAOSIT(X),0)),"^"),!
|
|---|
| 77 | K DIC,DA,DO,DR,DIR,DIE
|
|---|
| 78 | S DIC(0)="AEQMZL",DA(1)=PSALOC,DIC="^PSD(58.8,PSALOC,7,",DIC("A")="Select Outpatient Site: " D ^DIC
|
|---|
| 79 | I +Y'>0 G QUIT4
|
|---|
| 80 | ;Check for existence of op site in PSALOCA(PSALOCN,PSALOC)
|
|---|
| 81 | S DA=+Y
|
|---|
| 82 | S PSAOSIT=+Y,PSAOSIT(1)=Y(0,0),DIE="^PSD(58.8,PSALOC,7,",DR="1" D ^DIE
|
|---|
| 83 | ;
|
|---|
| 84 | I $P($G(PSALOCA(PSALOCN,PSALOC)),"^",2)="" S $P(PSALOCA(PSALOCN,PSALOC),"^",2)=PSAOSIT G QUIT4
|
|---|
| 85 | S NOMATCH=0,CNTR=1 F X=2:1 Q:$G(PSAOSIT(X))="" S CNTR=$G(CNTR)+1 I PSAOSIT(X)=+PSAOSIT S NOMATCH=1
|
|---|
| 86 | I $G(NOMATCH)=0 S $P(PSALOCA(PSALOCN,PSALOC),"^",(CNTR+1))=+PSAOSIT
|
|---|
| 87 | ;
|
|---|
| 88 | QUIT4 G NXT
|
|---|
| 89 | 5 S PSAHDR="IV ROOM SETUP" D HDR
|
|---|
| 90 | D IV^PSAENTO
|
|---|
| 91 | QUIT5 G NXT
|
|---|
| 92 | 6 S PSAHDR="WARD LOCATION SETUP" D HDR
|
|---|
| 93 | I $G(PSAISIT)'>0,$P(PSALOCA(PSALOCN,PSALOC),"^")'="" S PSAISIT=$P(PSALOCA(PSALOCN,PSALOC),"^")
|
|---|
| 94 | I $G(PSAISIT)'>0 W !!,"Sorry, I cannot find an Inpatient Site associated with this location.",! G WARDQ
|
|---|
| 95 | I $O(^PSD(58.8,+PSALOC,3,0))="" W !,"No wards are currently assigned to this location."
|
|---|
| 96 | S PSAWARD=0 I $O(^PSD(58.8,+PSALOC,3,0)) W !,PSALOCN," is set up to gather AR/WS dispensing data for : ",!!,$P($G(^PS(59.4,+PSAISIT,0)),U),"," D
|
|---|
| 97 | .S PSA(3)=0 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:".")
|
|---|
| 98 | EDTWRD ;Edit Wards
|
|---|
| 99 | R !!,"Do you want to add/edit the wards accociated with this location? NO // ",AN:DTIME G WARDQ:AN["^" I AN="" S AN="N"
|
|---|
| 100 | S AN=$E(AN) I "yYnN"'[AN W !,"Answer Yes, and we'll loop through the ward file, and either add new wards,",!,"or delete wards already associated with this location. " G EDTWRD
|
|---|
| 101 | I "Nn"[AN G WARDQ
|
|---|
| 102 | S PSAWARD=0
|
|---|
| 103 | WARDLP S PSAWARD=$O(^DIC(42,PSAWARD)) G WARDQ:PSAWARD'>0 W !,$P($G(^DIC(42,PSAWARD,0)),"^")
|
|---|
| 104 | I '$D(^PSD(58.8,PSALOC,3,PSAWARD,0)) G WARD1
|
|---|
| 105 | WARDASK R ?25,"Remove association with location? NO // ",AN:DTIME I AN["^" S PSAERR=1 G WARDQ
|
|---|
| 106 | I AN="" G WARDLP
|
|---|
| 107 | I "YyNn"'[AN W !
|
|---|
| 108 | I "yY"[AN W ?(IOM-9),"removed" S DIK="^PSD(58.8,+PSALOC,3,",DIC(0)="AEMQ",DA(1)=PSALOC,DA=PSAWARD D ^DIK
|
|---|
| 109 | G WARDLP
|
|---|
| 110 | ;
|
|---|
| 111 | WARD1 ;not currently assigned
|
|---|
| 112 | I $D(^PSD(58.8,"AB",PSAWARD)),$O(^PSD(58.8,"AB",PSAWARD,0))'=PSALOC W ?30,"This ward is already associated with : "_$P($G(^PSD(58.8,$O(^PSD(58.8,"AB",PSAWARD,0)),0)),"^") G WARDLP
|
|---|
| 113 | R ?40,"Add to location ? NO // : ",AN:DTIME G WARDQ:AN["^" I AN="" G WARDLP
|
|---|
| 114 | S AN=$E(AN) I "nNyY"'[AN W !,"Do you want to add this ward to this location?" K AN G WARD1
|
|---|
| 115 | I "Nn"[AN G WARDLP
|
|---|
| 116 | W ?(IOM-7),"Adding" S (DINUM,X)=PSAWARD,DIC="^PSD(58.8,+PSALOC,3,",DA(1)=PSALOC,DIC(0)="LNX" D FILE^DICN
|
|---|
| 117 | G WARDLP
|
|---|
| 118 | WARDQ ;
|
|---|
| 119 | G NXT
|
|---|
| 120 | 7 S PSAHDR="EDIT INACTIVATION DATA" D HDR
|
|---|
| 121 | S DIE="^PSD(58.8,",DA=PSALOC,DR="4" D ^DIE
|
|---|
| 122 | G NXT
|
|---|
| 123 | 8 S PSAHDR="ADD/EDIT DRUGS FOR LOCATION" D HDR
|
|---|
| 124 | I $O(^PSD(58.8,PSALOC,1,0))>0 G 83
|
|---|
| 125 | 81 R !,"Do you want to transfer drugs from another location? NO// ",AN:DTIME G Q:AN["^" S AN=$E(AN) I "nN"[AN G 83
|
|---|
| 126 | I "YyNn"'[AN W !,"Answer 'Y'es to transfer all the drugs from another location to this location.",!,"Please note that the drugs will be inactivated in the old location." G 81
|
|---|
| 127 | 82 R !,"Transfer the drug's balance, stock level, etc., as well? YES // ",AN:DTIME G Q:AN["^" S AN=$E(AN) I "nN"'[AN S PSATFER=0
|
|---|
| 128 | I "YyNn"'[AN W !!,"Answer 'Y'es to transfer all the current information about the drug to the new",!," location.",!! G 82
|
|---|
| 129 | I "Yy"[AN S PSATFER=1
|
|---|
| 130 | 811 S PSALOCB=PSALOC K PSALOC D ^PSALOC G Q:$G(PSALOC)'>0 S PSALOC2=PSALOC,PSALOC=PSALOCB K PSALOCB I PSALOC2=PSALOC W !!,"Sorry, that is the current location." D EOP G 811
|
|---|
| 131 | S X1=0 F S X1=$O(^PSD(58.8,PSALOC2,1,X1)) Q:X1'>0 W !,$P($G(^PSDRUG(X1,0)),"^") D
|
|---|
| 132 | .S ^PSD(58.8,PSALOC,1,X1,0)=X1 I $G(PSATFER)=1 S ^PSD(58.8,PSALOC,1,X1,0)=^PSD(58.8,PSALOC2,1,X1,0)
|
|---|
| 133 | .S ^PSD(58.8,PSALOC,1,"B",X1,X1)="" ;drug xref
|
|---|
| 134 | D EOP G NXT
|
|---|
| 135 | 83 K DIC,DIR S PSAOPT="PSALOC" D GETDRUG^PSADRUGP K PSAOPT
|
|---|
| 136 | G NXT
|
|---|
| 137 | 9 S PSAHDR="SET/DELETE MAINTAIN REORDER LEVELS FLAG"
|
|---|
| 138 | S DIE="^PSD(58.8,",DA=PSALOC,DR=34 D ^DIE K DA,DIE
|
|---|
| 139 | G NXT
|
|---|
| 140 | 10 S DIC(0)="AEQMZ",DIC="^PSD(58.8,",DIC("A")="Select Inactive Pharmacy Location: ",DIC("S")="I $D(^PSD(58.8,+Y,""I""))"
|
|---|
| 141 | D ^DIC G Q:+Y'>0 S DIE="^PSD(58.8,",DA=+Y,DR="4" D ^DIE
|
|---|
| 142 | I $P($G(^PSD(58.8,DA,"I")),"^")="" K ^PSD(58.8,DA,"I") W !,$P(^PSD(58.8,DA,0),"^")," Reactivated."
|
|---|
| 143 | Q
|
|---|
| 144 | PSA10 S PSAHDR="SETUP RECIPIENTS OF MAILMESSAGE" W @IOF,!,PSAHDR_" SCREEN",! F X=1:1:(IOM-1) W "="
|
|---|
| 145 | D PSASETUP^PSALOC1,EOP Q
|
|---|
| 146 | HLP W !!,"Display help for which item # ?" R AN:DTIME G PSALOCO:"^"[AN I AN<1!(AN>10) G OPTASK
|
|---|
| 147 | S X="PSAHLP"_AN_"^PSALOC1" D @X G OPTASK
|
|---|
| 148 | EOP F X=$Y:1:(IOSL-5) W !
|
|---|
| 149 | R !,"Press RETURN/ENTER to continue: ",AN:DTIME
|
|---|
| 150 | Q
|
|---|
| 151 | Q G EXIT^PSALOC
|
|---|
| 152 | HDR S PSAHDR=PSAHDR_" SCREEN" W @IOF,!,PSAHDR_" for : "_PSALOCN,! F X=1:1:(IOM-1) W "="
|
|---|
| 153 | ;
|
|---|
| 154 | W ! Q
|
|---|
| 155 | NXT D EOP G PSALOCO
|
|---|
| 156 | OPSITES ;
|
|---|
| 157 | F X=2:1 Q:'$D(PSAOSIT(X)) K PSAOSIT(X)
|
|---|
| 158 | F X=2:1 Q:$P($G(PSALOCA(PSALOCN,PSALOC)),"^",X)="" S PSAOSIT(X)=$P($G(PSALOCA(PSALOCN,PSALOC)),"^",X)
|
|---|
| 159 | Q
|
|---|
| 160 | ADD S X6=$$MG^XMBGRP(PSAGROUP,0,DUZ,0,.XMY,,0)
|
|---|
| 161 | W !,$S($G(X6)>0:"Ok, addition completed.",1:"error in adding users ? "),!
|
|---|
| 162 | Q
|
|---|
