source: FOIAVistA/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDDWK1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1PSDDWK1 ;BIR/JPW-Pharm Dispensing Worksheet (cont'd) ;12/14/99 15:01
2 ;;3.0; CONTROLLED SUBSTANCES ;**20**;13 Feb 97
3 ;
4 ; Reference to XUSEC( supported by DBIA # 10076
5 ; Reference to DPT( supported by DBIA # 10035
6 ; Reference to PSD(58.8 supported by DBIA # 2711
7 ;
8START ;entry point for dispensing options
9 S (NEW,PSDNO)=0,NOFLAG=1,ACT="" D DISPLAY Q:(PSDOUT)!(PSDNO)
10 S ORDS=$S(NEW:ORDS,1:+PSDS)
11CHK ;
12 I '$D(^XUSEC("PSJ RPHARM",DUZ)) D TECH Q:PSDOUT G ACT
13 S BAL=+$P(^PSD(58.8,ORDS,1,PSDR,0),"^",4)
14 I QTY>BAL W $C(7),!!,"=> The drug balance is "_BAL_". You cannot dispense "_QTY_" for this drug.",! G PHARM
15 W !!,"Old Balance: ",BAL,?35,"New Balance: ",BAL-QTY,!
16PHARM ;by dispensing pharmacist
17 W ! K DA,DIR,DTOUT,DUOUT S DIR(0)="SOBA^V:VERIFY;DC:CANCEL;E:EDIT;B:BYPASS;S:SHOW",DIR("?",1)="Enter 'V' to verify or dispense this order, 'DC' to cancel this order,"
18 S DIR("?",2)="'E' to edit, 'B' to bypass without verifying,",DIR("?")="'S' to show this order again or '^' to quit.",DIR("A")="ACTION (V DC E B S): "
19 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSDOUT=1 D MSG Q
20 S ACT=$S(Y="":"B",1:Y)
21ACT ;decides disp action
22 I ACT="V" D ^PSDDWK2 Q
23 I ACT="P" D ^PSDDWK2 Q
24 I ACT="DC" D ^PSDDWK4 Q:STAT=9 Q:PSDOUT G CHK
25 I ACT="E" D EDIT^PSDDWKE Q:(PSDOUT)!(PSDNO) G CHK
26 I ACT="S" D DISPLAY G CHK
27 I ACT="B" D MSG
28END Q
29TECH ;by tech or non-disp pharmacist
30 W ! K DA,DIR,DTOUT,DUOUT S DIR("A")="ACTION",DIR(0)="SOBA^P:PROCESS;DC:CANCEL;E:EDIT;B:BYPASS;S:SHOW",DIR("?",1)="Enter 'P' to process this order, 'C' to cancel this order,"
31 S DIR("?",2)="'E' to edit, 'B' to bypass without processing,",DIR("?")="'S' to show this order again or '^' to quit.",DIR("A")="ACTION (P DC E B S): "
32 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSDOUT=1 D MSG Q
33 S ACT=$S(Y="":"B",1:Y)
34 Q
35MSG W !!,"Press <RET> to continue" R X:DTIME W !!
36 I '$T!(X["^") S PSDOUT=1
37 Q
38DISPLAY ;displays order request
39 Q:PSDOUT W @IOF,!,?23,"Controlled Substance Order Request"
40 I $P($G(^PSD(58.85,PSDN,2)),U,2) W !,?27,"*** PRIORITY" W:$G(PAT) " INFUSION" W " ORDER ***"
41 W !! K LN S $P(LN,"-",80)=""
42 W "Pharmacy Dispensing #: ",$S(PSDPN:PSDPN,1:""),!,"Requested by",?16,": ",ORDN,?52,"Request Date: ",REQD,!,LN,!
43 W !,"Drug",?16,": ",PSDRN,?56,"Quantity: ",?66,QTY
44 W:$G(PAT) !,"Patient",?16,": ",$P($G(^DPT(+$G(PAT),0)),U)
45 W !,"Dispensed by",?16,": ",$S(PSDBY:PSDBYN,1:""),?50,"Dispensed Date: ",$S(PSDT:PSDDT,1:""),!,"Disp. Location",?16,": ",$S($D(ORDSN):ORDSN,1:"")
46 W !,"Manufacturer",?16,": ",MFG,!,"Lot #",?16,": ",LOT,!,"Exp. Date",?16,": ",EXPD
47 W !,"Ord. Location",?16,": ",NAOUN,!,"Order Status",?16,": ",$P($G(^PSD(58.82,STAT,0)),"^"),!,"Comments:" S COMM=0
48 I $D(^PSD(58.85,PSDN,1,0)) S COMM=1 K ^UTILITY($J,"W") F TEXT=0:0 S TEXT=$O(^PSD(58.85,PSDN,1,TEXT)) Q:'TEXT S X=$G(^PSD(58.85,PSDN,1,TEXT,0)),DIWL=5,DIWR=75,DIWF="W" D ^DIWP
49 I COMM D ^DIWW S COMM=0
50 Q
Note: See TracBrowser for help on using the repository browser.