source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSODGDG2.m@ 1501

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1PSODGDG2 ;BIR/RTR-drug drug interaction continued ;8/8/96
2 ;;7.0;OUTPATIENT PHARMACY;**27,130**;DEC 1997
3 ;External reference to ^DPT supported by DBIA 10035
4 ;External references to U, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
5EN ;Activate or process an Rx
6 Q:'$G(DA)
7 K ^PS(52.4,"ADI",DA,1),^PSRX(DA,"DRI") F ZZZ=8,9,10 S $P(^PS(52.4,DA,0),"^",ZZZ)=""
8 K ZZZ Q
9PROC I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) W $C(7),$C(7),!!,"SITE PARAMETERS MUST BE DEFINED !",! G EX
10 I '$D(^XUSEC("PSORPH",DUZ)) W $C(7),$C(7),!,"YOU MUST BE A PHARMACIST TO COMPLETE THIS PROCEDURE !",!! Q
11 I $P($G(^VA(200,DUZ,20)),"^",4)']"" W $C(7),$C(7),!,"YOU DO NOT HAVE AN ELECTRONIC SIGNATURE CODE !",!! Q
12BEG S DIC="^PS(52.4,",DIC(0)="AQXEZ",DIC("A")="Select RX with Drug Interaction: ",DIC("S")="I $D(^PS(52.4,""ADI"",+Y))"
13 S DIC("W")="W ?$X+5,$P(^DPT($P(^PS(52.4,+Y,0),""^"",2),0),""^"")_"" "",?40,$E($P(^(0),""^"",9),1,3)_""-""_$E($P(^(0),""^"",9),4,5)_""-""_$E($P(^(0),""^"",9),6,9)"
14 D ^DIC K DIC G:"^"[$E(X)!($D(DTOUT)) EX
15ENT S (PSODFN,PSOVRDFN,DFN,PSDFN)=$P(Y(0),"^",2),PPL="",PSONAM=$P(^DPT(PSDFN,0),"^"),(PSONV,PSONVXX,IFN,DGDG)=+Y D STAT G:FLAGST BEG D ^PSOBUILD
16 S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY K PSOPLCK G BEG
17 K PSOPLCK D PSOL^PSSLOCK(PSONV) I '$G(PSOMSG) D UL^PSSLOCK(PSODFN) D K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,PSOMSG G BEG
18 .I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2),! Q
19 .W !!,"Another person is editing this order.",!
20 D PID^VADPT
21 D DGDGI^PSOVER I $G(VERLFLAG) D UL^PSSLOCK(PSOVRDFN) D PSOUL^PSSLOCK(PSONVXX) K VERLFLAG G BEG
22 D PACK^PSOVER
23 D UL^PSSLOCK(PSOVRDFN),PSOUL^PSSLOCK(PSONVXX)
24 W !! G BEG
25EX D END^PSOVER K PSORX,PSOVRDFN,PSONVXX Q
26 ;
27STAT ;
28 S FLAGST=0
29 S ST00=$P($G(^PSRX(PSONV,"STA")),"^")
30 I $P($G(^PSRX(PSONV,2)),"^",6),+$P($G(^PSRX(PSONV,2)),"^",6)<DT,ST00<12 S $P(^PSRX(PSONV,"STA"),"^")=11,ST00=11
31 I ST00=1!(ST00=4) Q
32 S FLAGST=1
33 K DIK S DA=PSONV,DIK="^PS(52.4," D ^DIK K DIK
34 I ST00>10,ST00<16,$O(^PS(52.5,"B",PSONV,0)) S DA=$O(^PS(52.5,"B",PSONV,0)),DIK="^PS(52.5," D ^DIK K DIK
35 I ST00>10,ST00<16,$G(^PSRX(PSONV,"H"))]"" K:$P(^PSRX(PSONV,"H"),"^") ^PSRX("AH",$P(^PSRX(PSONV,"H"),"^"),PSONV) S ^PSRX(PSONV,"H")=""
36 S STEXT=$S(ST00=0:"Active",ST00=2:"Refill",ST00=3:"Hold",ST00=5:"Suspended",ST00=11:"Expired",ST00=12:"Canceled",ST00=13:"Deleted",ST00=14:"Discontinued",ST00=15:"Discontinued (Edit)",ST00=16:"Provider Hold",1:"Unknown")
37 I '$G(CLFLAG) W !!?3,"Rx # ",$P($G(^PSRX(PSONV,0)),"^")," has a status of ",STEXT_".",! K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR W ! K DIR
38 Q
Note: See TracBrowser for help on using the repository browser.