| 1 | PSOORFI6 ;BIR/SJA-finish cprs orders cont. ;01/05/07
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**225**;DEC 1997;Build 29
|
|---|
| 3 | ;External reference to ^PSDRUG supported by DBIA 221
|
|---|
| 4 | ;External references PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
|
|---|
| 5 | ;External reference to ^DPT supported by DBIA 10035
|
|---|
| 6 | ;
|
|---|
| 7 | DC N ACTION,LST,PSI,PSODFLG,PSONOORS,PSOOPT
|
|---|
| 8 | N VALMCNT W ! K DIR,DUOUT,DIROUT,DTOUT,PSOELSE
|
|---|
| 9 | I '$G(PSOERR("DEAD")) S PSOELSE=1 D PDATA Q:$D(DUOUT)!$D(DTOUT) D Q:$D(DIRUT)
|
|---|
| 10 | .D NOOR^PSOCAN4 Q:$D(DIRUT)
|
|---|
| 11 | .S DIR("A")="Comments",DIR(0)="F^10:75",DIR("B")="Per Pharmacy Request" D ^DIR K DIR
|
|---|
| 12 | I '$G(PSOELSE) K PSOELSE S PSONOOR="A" D DE^PSOORFI2 I '$G(ACTION)!('$D(PSODFLG)) S VALMBCK="R" Q
|
|---|
| 13 | K PSOELSE I $D(DIRUT) K DIRUT,DUOUT,DTOUT,Y Q
|
|---|
| 14 | S ACOM=Y
|
|---|
| 15 | S INCOM=ACOM,PSONOORS=PSONOOR D DE^PSOORFI2
|
|---|
| 16 | I '$G(ACTION)!('$D(PSODFLG)) Q
|
|---|
| 17 | S PSONOOR=PSONOORS D RTEST D SPEED D ULP^PSOCAN
|
|---|
| 18 | K PSOCAN,ACOM,INCOM,ACTION,LINE,PSONOOR,PSOSDXY,PSONOORS,PSOOPT,RXCNT,REA,RX,PSODA,DRG
|
|---|
| 19 | S Y=-1
|
|---|
| 20 | Q
|
|---|
| 21 | PSPEED S (YY,PSODA)=$P(PSOSD(STA,DRG),"^"),RX=$P($G(^PSRX(PSODA,0)),"^") D SPEED1 Q:PSPOP!($D(PSINV(RX)))
|
|---|
| 22 | Q:$G(SPEED)&(REA="R")
|
|---|
| 23 | SHOW S DRG=+$P(^PSRX(PSODA,0),"^",6),DRG=$S($D(^PSDRUG(DRG,0)):$P(^(0),"^"),1:"")
|
|---|
| 24 | S LC=0 W !,$P(^PSRX(PSODA,0),"^")," ",DRG,?52,$S($D(^DPT(+$P(^PSRX(PSODA,0),"^",2),0)):$P(^(0),"^"),1:"PATIENT UNKNOWN")
|
|---|
| 25 | I REA="C" W !?25,"Rx to be Discontinued",! Q
|
|---|
| 26 | W !?21,"*** Rx to be Reinstated ***",!
|
|---|
| 27 | Q
|
|---|
| 28 | SPEED1 S PSPOP=0 I $G(PSODIV),+$P($G(^PSRX(PSODA,2)),"^",9)'=$G(PSOSITE) D:'$G(SPEED) DIV^PSOCAN
|
|---|
| 29 | K STAT S STAT=+$P(^PSRX(PSODA,"STA"),"^"),REA=$E("C00CCCCCCCCCR000C",STAT+1)
|
|---|
| 30 | Q:$G(SPEED)&(REA="R")
|
|---|
| 31 | I REA="R",$P($G(^PSRX(PSODA,"PKI")),"^") S PKI=1 S PSINV(RX)="" Q
|
|---|
| 32 | I REA=0!(PSPOP)!($P(^PSRX(+YY,"STA"),"^")>12),$P(^("STA"),"^")<16 S PSINV(RX)="" Q
|
|---|
| 33 | S:REA'=0&('PSPOP) PSCAN(RX)=PSODA_"^"_REA,RXCNT=$G(RXCNT)+1
|
|---|
| 34 | Q
|
|---|
| 35 | 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
|
|---|
| 36 | 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
|
|---|
| 37 | ;
|
|---|
| 38 | 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"
|
|---|
| 39 | D ^DIR K DIR I $D(DIRUT) S:$O(PSOSDX(0)) PSOSDXY=1 Q
|
|---|
| 40 | I 'Y S:$O(PSOSDX(0)) PSOSDXY=1 K PSCAN D INVALD Q
|
|---|
| 41 | 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))
|
|---|
| 42 | D INVALD
|
|---|
| 43 | Q
|
|---|
| 44 | 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
|
|---|
| 45 | S PSOOPT=-1 D CAN^PSOCAN
|
|---|
| 46 | Q
|
|---|
| 47 | INVALD K PSCAN Q:'$D(PSINV) W !! F I=1:1:80 W "="
|
|---|
| 48 | 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
|
|---|
| 49 | K PSINV I $G(PSOERR)!($G(SPEED)) K DIR,DUOUT,DTOUT,DIRUT S DIR(0)="E",DIR("A")="Press Return to Continue"
|
|---|
| 50 | D ^DIR K DIR,DTOUT,DIRUT,DUOUT
|
|---|
| 51 | KILL D KILL^PSOCAN2
|
|---|
| 52 | K PSOMSG,PSOPLCK,PSOWUN,PSOULRX
|
|---|
| 53 | Q
|
|---|
| 54 | RTEST ;
|
|---|
| 55 | Q:'$G(LINE)
|
|---|
| 56 | N PCIN,PCINFLAG,PCINX
|
|---|
| 57 | S PCINFLAG=0 F PCIN=1:1 S PCINX=$P(LINE,",",PCIN) Q:$P(LINE,",",PCIN)']"" D
|
|---|
| 58 | .Q:'$G(PCINX)
|
|---|
| 59 | .Q:'$G(PSOCAN(PCINX))
|
|---|
| 60 | .I $P($G(^PSRX(+$G(PSOCAN(PCINX)),"STA")),"^")'=12,'$G(PCINFLAG) S PSOCANRD=+$P($G(^PSRX($G(PSOCAN(PCINX)),0)),"^",4) S PCINFLAG=1
|
|---|
| 61 | I '$G(PCINFLAG) S PSOCANRZ=1
|
|---|
| 62 | Q
|
|---|
| 63 | RTESTA ;
|
|---|
| 64 | N PFIN,PFINZ,PFINFLAG
|
|---|
| 65 | 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
|
|---|
| 66 | .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
|
|---|
| 67 | I '$G(PFINFLAG) S PSOCANRZ=1
|
|---|
| 68 | Q
|
|---|
| 69 | PDATA Q:$P(^PS(52.41,ORD,0),"^",3)'="RNW"!('$P(^PS(52.41,ORD,0),"^",21))
|
|---|
| 70 | 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)
|
|---|
| 71 | Q:'$G(LINE)
|
|---|
| 72 | S:(+$G(^PSRX($P(^PS(52.41,ORD,0),"^",21),"STA"))<9) PSODFLG=1 Q:'$G(PSODFLG)
|
|---|
| 73 | D ASKDC S ACTION=Y
|
|---|
| 74 | Q
|
|---|
| 75 | ASKDC W ! K DIR,DUOUT,DIRUT,DTOUT
|
|---|
| 76 | S DIR("A")="There is an active Rx for this pending order, Discontinue both (Y/N)",DIR("B")="NO",DIR(0)="Y"
|
|---|
| 77 | S DIR("?",1)="Y - Discontinue both pending and active Rx",DIR("?",2)="N - Discontinue pending order only"
|
|---|
| 78 | S DIR("?")="'^' - Quit (no action taken)" D ^DIR K DIR Q
|
|---|
