79 lines
4.2 KiB
Mathematica
79 lines
4.2 KiB
Mathematica
|
PSOORFI6 ;BIR/SJA-finish cprs orders cont. ;01/05/07
|
||
|
|
;;7.0;OUTPATIENT PHARMACY;**225**;DEC 1997;Build 29
|
||
|
|
;External reference to ^PSDRUG supported by DBIA 221
|
||
|
|
;External references PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
|
||
|
|
;External reference to ^DPT supported by DBIA 10035
|
||
|
|
;
|
||
|
|
DC N ACTION,LST,PSI,PSODFLG,PSONOORS,PSOOPT
|
||
|
|
N VALMCNT W ! K DIR,DUOUT,DIROUT,DTOUT,PSOELSE
|
||
|
|
I '$G(PSOERR("DEAD")) S PSOELSE=1 D PDATA Q:$D(DUOUT)!$D(DTOUT) D Q:$D(DIRUT)
|
||
|
|
.D NOOR^PSOCAN4 Q:$D(DIRUT)
|
||
|
|
.S DIR("A")="Comments",DIR(0)="F^10:75",DIR("B")="Per Pharmacy Request" D ^DIR K DIR
|
||
|
|
I '$G(PSOELSE) K PSOELSE S PSONOOR="A" D DE^PSOORFI2 I '$G(ACTION)!('$D(PSODFLG)) S VALMBCK="R" Q
|
||
|
|
K PSOELSE I $D(DIRUT) K DIRUT,DUOUT,DTOUT,Y Q
|
||
|
|
S ACOM=Y
|
||
|
|
S INCOM=ACOM,PSONOORS=PSONOOR D DE^PSOORFI2
|
||
|
|
I '$G(ACTION)!('$D(PSODFLG)) Q
|
||
|
|
S PSONOOR=PSONOORS D RTEST D SPEED D ULP^PSOCAN
|
||
|
|
K PSOCAN,ACOM,INCOM,ACTION,LINE,PSONOOR,PSOSDXY,PSONOORS,PSOOPT,RXCNT,REA,RX,PSODA,DRG
|
||
|
|
S Y=-1
|
||
|
|
Q
|
||
|
|
PSPEED S (YY,PSODA)=$P(PSOSD(STA,DRG),"^"),RX=$P($G(^PSRX(PSODA,0)),"^") D SPEED1 Q:PSPOP!($D(PSINV(RX)))
|
||
|
|
Q:$G(SPEED)&(REA="R")
|
||
|
|
SHOW S DRG=+$P(^PSRX(PSODA,0),"^",6),DRG=$S($D(^PSDRUG(DRG,0)):$P(^(0),"^"),1:"")
|
||
|
|
S LC=0 W !,$P(^PSRX(PSODA,0),"^")," ",DRG,?52,$S($D(^DPT(+$P(^PSRX(PSODA,0),"^",2),0)):$P(^(0),"^"),1:"PATIENT UNKNOWN")
|
||
|
|
I REA="C" W !?25,"Rx to be Discontinued",! Q
|
||
|
|
W !?21,"*** Rx to be Reinstated ***",!
|
||
|
|
Q
|
||
|
|
SPEED1 S PSPOP=0 I $G(PSODIV),+$P($G(^PSRX(PSODA,2)),"^",9)'=$G(PSOSITE) D:'$G(SPEED) DIV^PSOCAN
|
||
|
|
K STAT S STAT=+$P(^PSRX(PSODA,"STA"),"^"),REA=$E("C00CCCCCCCCCR000C",STAT+1)
|
||
|
|
Q:$G(SPEED)&(REA="R")
|
||
|
|
I REA="R",$P($G(^PSRX(PSODA,"PKI")),"^") S PKI=1 S PSINV(RX)="" Q
|
||
|
|
I REA=0!(PSPOP)!($P(^PSRX(+YY,"STA"),"^")>12),$P(^("STA"),"^")<16 S PSINV(RX)="" Q
|
||
|
|
S:REA'=0&('PSPOP) PSCAN(RX)=PSODA_"^"_REA,RXCNT=$G(RXCNT)+1
|
||
|
|
Q
|
||
|
|
SPEED N PKI K PSINV,PSCAN S PSODA=IN I $D(^PSRX(PSODA,0)) S YY=PSODA,RX=$P(^(0),"^") S:PSODA<0 PSINV(RX)="" D:PSODA>0 SPEED1
|
||
|
|
G:'$D(PSCAN) INVALD S II="",RXCNT=0 F S II=$O(PSCAN(II)) Q:II="" S PSODA=+PSCAN(II),REA=$P(PSCAN(II),"^",2),RXCNT=RXCNT+1 D SHOW
|
||
|
|
;
|
||
|
|
ASK G:'$D(PSCAN) INVALD W ! S DIR("A")="OK to "_$S($G(RXCNT)>1:"Change Status",REA="C":"Discontinue the active order",1:"Reinstate"),DIR(0)="Y",DIR("B")="N"
|
||
|
|
D ^DIR K DIR I $D(DIRUT) S:$O(PSOSDX(0)) PSOSDXY=1 Q
|
||
|
|
I 'Y S:$O(PSOSDX(0)) PSOSDXY=1 K PSCAN D INVALD Q
|
||
|
|
S RX="" F S RX=$O(PSCAN(RX)) Q:RX="" D PSOL^PSSLOCK(+PSCAN(RX)) I $G(PSOMSG) D ACT D PSOUL^PSSLOCK(+PSCAN(RX))
|
||
|
|
D INVALD
|
||
|
|
Q
|
||
|
|
ACT S DA=+PSCAN(RX),REA=$P(PSCAN(RX),"^",2),II=RX,PSODFN=$P(^PSRX(DA,0),"^",2) I REA="R" D REINS^PSOCAN2 Q
|
||
|
|
S PSOOPT=-1 D CAN^PSOCAN
|
||
|
|
Q
|
||
|
|
INVALD K PSCAN Q:'$D(PSINV) W !! F I=1:1:80 W "="
|
||
|
|
W $C(7),!!,"The Following Rx Number(s) Are Invalid Choices, Expired, "_$S($G(PKI):"Digitally Signed",1:""),!,"Discontinued by Provider, or Marked As Deleted:" S II="" F S II=$O(PSINV(II)) Q:II="" W !?10,II
|
||
|
|
K PSINV I $G(PSOERR)!($G(SPEED)) K DIR,DUOUT,DTOUT,DIRUT S DIR(0)="E",DIR("A")="Press Return to Continue"
|
||
|
|
D ^DIR K DIR,DTOUT,DIRUT,DUOUT
|
||
|
|
KILL D KILL^PSOCAN2
|
||
|
|
K PSOMSG,PSOPLCK,PSOWUN,PSOULRX
|
||
|
|
Q
|
||
|
|
RTEST ;
|
||
|
|
Q:'$G(LINE)
|
||
|
|
N PCIN,PCINFLAG,PCINX
|
||
|
|
S PCINFLAG=0 F PCIN=1:1 S PCINX=$P(LINE,",",PCIN) Q:$P(LINE,",",PCIN)']"" D
|
||
|
|
.Q:'$G(PCINX)
|
||
|
|
.Q:'$G(PSOCAN(PCINX))
|
||
|
|
.I $P($G(^PSRX(+$G(PSOCAN(PCINX)),"STA")),"^")'=12,'$G(PCINFLAG) S PSOCANRD=+$P($G(^PSRX($G(PSOCAN(PCINX)),0)),"^",4) S PCINFLAG=1
|
||
|
|
I '$G(PCINFLAG) S PSOCANRZ=1
|
||
|
|
Q
|
||
|
|
RTESTA ;
|
||
|
|
N PFIN,PFINZ,PFINFLAG
|
||
|
|
S PFINFLAG=0 S PFIN="" F S PFIN=$O(PSOSD(PFIN)) Q:PFIN="" S PFINZ="" F S PFINZ=$O(PSOSD(PFIN,PFINZ)) Q:PFINZ="" D
|
||
|
|
.I $G(PFIN)'="PENDING" I $P($G(^PSRX(+$P($G(PSOSD(PFIN,PFINZ)),"^"),"STA")),"^")'=12,'$G(PFINFLAG) S PSOCANRD=+$P($G(^(0)),"^",4),PFINFLAG=1
|
||
|
|
I '$G(PFINFLAG) S PSOCANRZ=1
|
||
|
|
Q
|
||
|
|
PDATA Q:$P(^PS(52.41,ORD,0),"^",3)'="RNW"!('$P(^PS(52.41,ORD,0),"^",21))
|
||
|
|
S PSI=0,IN=0 F S PSI=$O(PSOLST(PSI)) Q:'PSI!(IN) I $P(PSOLST(PSI),"^",2)=$P(^PS(52.41,ORD,0),"^",21) S LINE=PSI,(PSOCAN(PSI),IN)=$P(PSOLST(PSI),"^",2)
|
||
|
|
Q:'$G(LINE)
|
||
|
|
S:(+$G(^PSRX($P(^PS(52.41,ORD,0),"^",21),"STA"))<9) PSODFLG=1 Q:'$G(PSODFLG)
|
||
|
|
D ASKDC S ACTION=Y
|
||
|
|
Q
|
||
|
|
ASKDC W ! K DIR,DUOUT,DIRUT,DTOUT
|
||
|
|
S DIR("A")="There is an active Rx for this pending order, Discontinue both (Y/N)",DIR("B")="NO",DIR(0)="Y"
|
||
|
|
S DIR("?",1)="Y - Discontinue both pending and active Rx",DIR("?",2)="N - Discontinue pending order only"
|
||
|
|
S DIR("?")="'^' - Quit (no action taken)" D ^DIR K DIR Q
|