| [623] | 1 | PSDSITE ;BIR/JPW,LTL-Site Parameters for CS ; 3 May 95
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | SITE ;entry for selecting inpatient sites in file 59.4
|
|---|
| 4 | K DIC,DLAYGO S (DIC,DLAYGO)="^PS(59.4,",DIC(0)="QEAL",D="B",DZ="??"
|
|---|
| 5 | D DQ^DICQ K D,DZ W ! D ^DIC K DIC G:Y<0 END
|
|---|
| 6 | K DA,DIE,DR S DIE=59.4,DA=+Y,DR="31"_"Is "_$P(Y,U,2)_" selectable for Controlled Subs" W ! D ^DIE K DIE
|
|---|
| 7 | END K DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,X,Y
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | LOW ;if auto generate, check low range for numbers
|
|---|
| 11 | I '$D(X) S PSDFLAG=1 Q
|
|---|
| 12 | K PSD,PSDFLAG,PSDL F PSD=0:0 S PSD=$O(^PSD(58.8,PSD)) Q:'PSD I $D(^PSD(58.8,PSD,0)),$D(^(2)),$P(^(2),"^") D
|
|---|
| 13 | .I +$P(^PSD(58.8,PSD,2),"^",2),+$P(^(2),"^",3) S PSDL(+PSD)=""
|
|---|
| 14 | I $O(PSDL(0)) F PSD=0:0 S PSD=+$O(PSDL(PSD)) Q:'PSD D
|
|---|
| 15 | .I X'<$P($G(^PSD(58.8,PSD,2)),"^",2),(X'>$P($G(^(2)),"^",3)),PSD'=DA D MSG S PSDFLAG=1 Q
|
|---|
| 16 | W:$D(PSDFLAG) " Select another range.",! K PSD,PSDL
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | HIGH ;validates high range for dispensing numbers
|
|---|
| 20 | I '$D(X) S PSDFLAG=1 Q
|
|---|
| 21 | K PSD,PSDFLAG,PSDH,PSDL F PSD=0:0 S PSD=$O(^PSD(58.8,PSD)) Q:'PSD I $D(^PSD(58.8,PSD,0)),$D(^(2)),$P(^(2),"^") D
|
|---|
| 22 | .I +$P(^PSD(58.8,PSD,2),"^",2) S PSDL(+$P(^(2),"^",2))=PSD
|
|---|
| 23 | S PSDL=+$P($G(^PSD(58.8,DA,2)),"^",2),PSDH=+$O(PSDL(PSDL)) I PSDH S PSD=+$P(PSDL(PSDH),"^")
|
|---|
| 24 | I X'>PSDL W !!,"High dispensing # must be larger than your low dispensing # "_PSDL_".",!! S PSDFLAG=1 Q
|
|---|
| 25 | I PSDH,X'<PSDH D MSG S PSDFLAG=1
|
|---|
| 26 | W:$D(PSDFLAG) " Select another range.",! K PSD,PSDH,PSDL
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | MSG ;prints message if range already in use
|
|---|
| 30 | W $C(7),!!,?12," => Dispensing Site "_$S($P(^PSD(58.8,PSD,0),"^")]"":$P(^(0),"^"),1:"NAME MISSING")_" <=",!,"has set aside the range "_$P($G(^PSD(58.8,PSD,2)),"^",2)_" through "_$P($G(^(2)),"^",3)_"."
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | LAST ;checks range for 'last dispensed'
|
|---|
| 34 | I '$D(X) S PSDFLAG=1 Q
|
|---|
| 35 | I $D(PSDEN) D LAST1 K LOW,HIGH,PSDCHK Q
|
|---|
| 36 | I X<$P($G(^PSD(58.8,DA,2)),"^",2) D MSG1 S PSDFLAG=1 Q
|
|---|
| 37 | I X>$P($G(^PSD(58.8,DA,2)),"^",3) D MSG1 S PSDFLAG=1
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | MSG1 ;prints message if not in dispensing range
|
|---|
| 41 | W $C(7),!!,"Last number dispensed must be within the range "_$P($G(^PSD(58.8,DA,2)),"^",2)_" to "_$S($P($G(^(2)),"^",3):$P($G(^(2)),"^",3),1:999999999)_".",!
|
|---|
| 42 | Q
|
|---|
| 43 | LAST1 ;checks LOW/HIGH range and LAST dispensed
|
|---|
| 44 | I X<LOW D MSG2 S PSDFLAG=1 Q
|
|---|
| 45 | I X>HIGH D MSG2 S PSDFLAG=1
|
|---|
| 46 | Q
|
|---|
| 47 | MSG2 ;prints msg if not in dispensing range
|
|---|
| 48 | S PSDCHK=1
|
|---|
| 49 | W $C(7),!!,"Last number dispensed must be within the range ",LOW," to ",HIGH,".",!
|
|---|
| 50 | Q
|
|---|
