| [613] | 1 | PSOCAN ;BIR/JMB-Rx discontinue and reinstate ; 8/3/06 12:38pm
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**11,21,24,27,32,37,88,117,131,185,253**;DEC 1997
|
|---|
| 3 | ;External reference to File #55 supported by DBIA 2228
|
|---|
| 4 | ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
|
|---|
| 5 | START S WARN=0,(DAYS360,SPCANC)=1 D KCAN1^PSOCAN3 W !! S DIR("A")="Discontinue/Reinstate by Rx# or patient name",DIR(0)="SBO^R:RX NUMBER;P:PATIENT NAME"
|
|---|
| 6 | S DIR("?")="Enter 'R' to discontinue/reinstate by Rx#. Enter 'P' to discontinue/reinstate by patient name." D ^DIR K DIR G:$G(DIRUT) KILL^PSOCAN1 K RP S RP=Y G:RP="P" PAT^PSOCAN1
|
|---|
| 7 | NUM D DCORD^PSONEW2
|
|---|
| 8 | K RXSP,PSINV,PSOWUN,PSOULRX D KCAN1^PSOCAN3 S:'$D(PSOCLC) PSOCLC=DUZ S PS="Discontinue" W ! S DIR("A")="Discontinue/Reinstate Prescription(s)#"
|
|---|
| 9 | S DIR(0)="FO^1:245",DIR("?")="Wand/enter barcode or enter Rx number(s) to discontinued/reinstated. If more than one, separate with commas. Do not exceed 245 characters including commas"
|
|---|
| 10 | D ^DIR K DIR G:$G(DIRUT) START S OUT=0 I Y["-" D PSOINST^PSOSUPAT G:OUT NUM S (IN,X)=$P(^PSRX($P(Y,"-",2),0),"^") G NO
|
|---|
| 11 | S IN=Y G RX:Y[","
|
|---|
| 12 | NO S PSPOP=0,DIC=52,DIC(0)="QEMZ" D ^DIC K DIC Q:$G(POERR)&(Y<0) G:Y<0 NUM S (DA,IFN,PSOULRX)=+Y,RXNUM=Y(0,0),PSODFN=+$P(^PSRX(DA,0),"^",2)
|
|---|
| 13 | S PSOWUN=1 S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY K PSOPLCK G NUM
|
|---|
| 14 | K PSOPLCK D PSOL^PSSLOCK(IFN) I '$G(PSOMSG) W !!,$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order.") K PSOMSG D ULP G NUM
|
|---|
| 15 | I $P($G(^PSRX(+$G(IFN),"STA")),"^")=12,$P($G(^("PKI")),"^") W !!,"Cannot be Reinstated - Digitally Signed" D ULP G NUM
|
|---|
| 16 | I $P($G(^PSRX(+$G(IFN),"STA")),"^")=12 S PSOCANRZ=1
|
|---|
| 17 | E S PSOCANRD=+$P($G(^PSRX(+$G(IFN),0)),"^",4)
|
|---|
| 18 | D:$P($G(^PS(55,PSODFN,0)),"^",6)'=2 EN^PSOHLUP(PSODFN)
|
|---|
| 19 | LMNO D CHK S:'$G(DA)&($G(IFN)) DA=IFN
|
|---|
| 20 | I DEAD!$P(^PSRX(DA,"STA"),"^")'<13,$P(^("STA"),"^")'=16 S PSINV($P(^PSRX(DA,0),"^"))="" D:$G(PSOWUN) ULP,ULRX G EP1
|
|---|
| 21 | I $G(PSODIV),$P($G(^PSRX(DA,2)),"^",9),$P(^(2),"^",9)'=$G(PSOSITE) S RXREC=DA D DIV D:$G(POERR)&(PSPOP) ULP,ULRX Q:$G(POERR)&(PSPOP) D:$G(PSOWUN)&($G(PSPOP)) ULP,ULRX G:PSPOP NUM
|
|---|
| 22 | D ICN^PSODPT(PSODFN)
|
|---|
| 23 | S PS=$S($P(^PSRX(DA,"STA"),"^")=12:"Reinstate",1:"Discontinue")
|
|---|
| 24 | I '$G(POERR) N PKIR D
|
|---|
| 25 | .I $P(^PSRX(DA,"STA"),"^")=1,$P($G(^("PKI")),"^") S PKIR=""
|
|---|
| 26 | .D ^PSORXPR
|
|---|
| 27 | D YN S:PS="Reinstate" PS="Discontinue" Q:$G(POERR)&('%) I '% D ULP,ULRX G NUM
|
|---|
| 28 | D REA D:'$D(REA)&($G(PSOWUN)) ULP,ULRX Q:'$D(REA) D COM^PSOCAN1 Q:$G(POERR)&('$D(INCOM))!($D(DIRUT)) I '$D(INCOM)!($D(DIRUT)) D ULP,ULRX G NUM
|
|---|
| 29 | S RX=$P(^PSRX(DA,0),"^"),PSCAN(RX)=DA_"^"_REA
|
|---|
| 30 | D:REA="R" REINS^PSOCAN2 D:REA="R"&('$G(PSORX("DFLG"))) DCORD^PSONEW2 D:$G(PSORX("DFLG")) ULP,ULRX Q:$G(POERR)&($G(PSORX("DFLG"))) G NUM:$G(PSORX("DFLG")) D:REA="C" CAN Q:$G(POERR) D ULP,ULRX G NUM
|
|---|
| 31 | YN D EN^PSOCMOPA I $G(XFLAG)]"" S %=0 K XFLAG Q
|
|---|
| 32 | S DIR("A")="Are you sure you want to "_PS,DIR(0)="Y",DIR("B")="NO" D ^DIR S %=Y K DIR,DUOUT,DTOUT I 'Y!$D(DIRUT) S VALMBCK="R"
|
|---|
| 33 | K DIRUT Q
|
|---|
| 34 | REA S REA=+$P(^PSRX(DA,"STA"),"^") I REA=12 S REA="R" Q
|
|---|
| 35 | I REA,REA'=11 W !?5,$C(7) D
|
|---|
| 36 | .W "Rx# "_RXNUM_" was"_$S(REA=1:" Non-Verified",REA=13:" Deleted",REA=11:" Expired",REA=5:" Suspended",REA=4:" Pending Due to Drug Interactions",REA=3:" On Hold",REA=14!(REA=15):"Discontinued",REA=16:" Provider Held",1:" In Fill Status")_"."
|
|---|
| 37 | I REA,REA'=1,REA'=3,REA'=5,REA'=11,REA'<13,REA'=16 K REA W !?10,"Rx Cannot Be Discontinued/Reinstated!" Q
|
|---|
| 38 | S REA="C" Q
|
|---|
| 39 | CAN N PSODRUG D CAN1^PSOCAN3 Q
|
|---|
| 40 | DIV I '$P($G(PSOSYS),"^",2) W !?10,$C(7),"RX# ",$P(^PSRX(DA,0),"^")," is not a valid choice. (Different Division)" S PSPOP=1 Q
|
|---|
| 41 | I $P($G(PSOSYS),"^",3) W !?10,$C(7) S DIR("A")="RX# "_$P(^PSRX(DA,0),"^")_" is from another division. Continue",DIR(0)="Y",DIR("B")="Y" D ^DIR K DIR S:$G(DIRUT)!('Y) PSPOP=1
|
|---|
| 42 | Q
|
|---|
| 43 | CHK K VADM,DEAD S DFN=PSODFN D DEM^VADPT I $G(VADM(6))="" S DEAD=0 Q
|
|---|
| 44 | S (PSODEATH,DEAD)=1 W !!,?10,VADM(1)_" DIED "_$P($G(VADM(6)),"^",2) D CAN^PSOCAN3 K PSODEATH
|
|---|
| 45 | Q
|
|---|
| 46 | RX N PKI S RXCNT=0,RXSP=1 D TESTRP D COM^PSOCAN1 G:'$D(INCOM)!($D(DIRUT)) NUM K PSINV,PSCAN F II=1:1 S (EN,X)=$P(IN,",",II) Q:$P(IN,",",II)']"" S DIC=52,DIC(0)="QMZ" D ^DIC K DIC S:Y'>0 PSINV(X)="" D:Y>0
|
|---|
| 47 | .S YY=Y,YY(0,0)=Y(0,0),(PSODFN,DFN)=$P(Y(0),"^",2) D:$P($G(^PS(55,PSODFN,0)),"^",6)'=2 EN^PSOHLUP(PSODFN)
|
|---|
| 48 | .D:$G(DFN)>0 CHK I DEAD!($P(^PSRX(+YY,"STA"),"^")=13)!($P(^("STA"),"^")=14) S PSINV(EN)="" Q
|
|---|
| 49 | .I $P(^PSRX(+YY,"STA"),"^")=12,$P($G(^("PKI")),"^") S PKI=1,PSINV(EN)="" Q
|
|---|
| 50 | .S DA=+YY I $P($G(^PSRX(DA,"STA")),"^")=11!($P($G(^(2)),"^",6)<DT) D EXP
|
|---|
| 51 | .S RX=YY(0,0) D:$D(^PSRX(DA,0)) SPEED1^PSOCAN1
|
|---|
| 52 | .;S DA=+YY I $P($G(^PSRX(DA,"STA")),"^")=11!($P($G(^(2)),"^",6)<DT) D EXP Q
|
|---|
| 53 | .;E S RX=YY(0,0) D:$D(^PSRX(DA,0)) SPEED1^PSOCAN1
|
|---|
| 54 | K YY G:'$D(PSCAN) INVALD^PSOCAN1 S RX="",RXCNT=0 F S RX=$O(PSCAN(RX)) Q:RX="" S DA=+PSCAN(RX),REA=$P(PSCAN(RX),"^",2),RXCNT=RXCNT+1 D SHOW^PSOCAN1
|
|---|
| 55 | ASK Q:'$D(PSCAN) W ! S DIR("A")="OK to "_$S($G(RXCNT)>1:"Change Status",REA="C":"Discontinued",1:"Reinstate"),DIR(0)="Y",DIR("B")="N"
|
|---|
| 56 | N PSOCNRXV S PSOCNRXV=0
|
|---|
| 57 | D ^DIR K DIR Q:$G(DIRUT) I 'Y K PSCAN D INVALD^PSOCAN1 G NUM
|
|---|
| 58 | K PSOPLCKZ S RX="" F S RX=$O(PSCAN(RX)) Q:'RX D
|
|---|
| 59 | .S PSODFN=+$P($G(^PSRX(+PSCAN(RX),0)),"^",2)
|
|---|
| 60 | .S PSOPLCK=$$L^PSSLOCK(+$G(PSODFN),0) D:'$G(PSOPLCK)&('$D(PSOPLCKZ(PSODFN))) LOCK^PSOORCPY I '$G(PSOPLCK) S PSOPLCKZ(PSODFN)=PSODFN Q
|
|---|
| 61 | .D PSOL^PSSLOCK(+PSCAN(RX)) I '$G(PSOMSG) D D UL^PSSLOCK(PSODFN) Q
|
|---|
| 62 | ..I $P($G(PSOMSG),"^",2)'="" W !,$P($G(PSOMSG),"^",2),!,"Order "_$P($G(^PSRX(+PSCAN(RX),0)),"^")_"." Q
|
|---|
| 63 | ..W !,"Another person is editing order "_$P($G(^PSRX(+PSCAN(RX),0)),"^")_"."
|
|---|
| 64 | .D ACT D PSOUL^PSSLOCK(+PSCAN(RX)),UL^PSSLOCK(PSODFN)
|
|---|
| 65 | .S PSOCNRXV=1
|
|---|
| 66 | K PSOPLCKZ W:$G(PSOCNRXV) !,$S($G(RXCNT)>1:"Statuses Changed",REA="C":"Prescription Discontinued",1:"Prescription Reinstated") D INVALD^PSOCAN1 G NUM
|
|---|
| 67 | 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
|
|---|
| 68 | D CAN Q
|
|---|
| 69 | EXP ;S PSINV($P(^PSRX(DA,0),"^"))=""
|
|---|
| 70 | Q:$P(^PSRX(DA,"STA"),"^")=12
|
|---|
| 71 | S $P(^PSRX(DA,"STA"),"^")=11 D ECAN^PSOUTL(DA)
|
|---|
| 72 | S STAT="SC",PHARMST="ZE",COMM="Medication Expired on "_$E($P(^PSRX(DA,2),"^",6),4,5)_"/"_$E($P(^(2),"^",6),6,7)_"/"_$E($P(^(2),"^",6),2,3) D EN^PSOHLSN1(DA,STAT,PHARMST,COMM) K COMM,STAT,PHARMST
|
|---|
| 73 | EP1 I '$G(RXSP) D INVALD^PSOCAN1 Q:$G(POERR) G NUM
|
|---|
| 74 | Q
|
|---|
| 75 | PSD ;Called from Controlled Subs, PSDRX is internal Rx number
|
|---|
| 76 | S PSDRFDEL=0
|
|---|
| 77 | I '$G(PSDRX)!('$D(^PSRX(+$G(PSDRX),0))) Q
|
|---|
| 78 | I $P($G(^PSRX(PSDRX,"STA")),"^")<12 Q
|
|---|
| 79 | N DA,NODE,RF,PSOPSDAL,PSODRX,PSODTE,PSODL,SFN,RIFN,PSOSXP,PSOFILDL
|
|---|
| 80 | S PSODRX=0 F PSODLP=0:0 S PSODLP=$O(^PSRX(PSDRX,1,PSODLP)) Q:'PSODLP S:$D(^PSRX(PSDRX,1,PSODLP,0)) PSODRX=PSODLP
|
|---|
| 81 | I 'PSODRX Q
|
|---|
| 82 | I $P($G(^PSRX(PSDRX,1,PSODRX,0)),"^",18) Q
|
|---|
| 83 | D PSDREF I $G(PSOFILDL) K PSOFILDL Q
|
|---|
| 84 | K PSOFILDL,DIE S NODE=0,PSOPSDAL=1,DA(1)=PSDRX,DA=PSODRX,DIE="^PSRX("_DA(1)_",1,",DR=".01///@" D ^DIE K DIE
|
|---|
| 85 | S PSDRFDEL=1
|
|---|
| 86 | Q
|
|---|
| 87 | PSDREF ;
|
|---|
| 88 | N PRDL,PSOCNODE
|
|---|
| 89 | S PSOFILDL=0
|
|---|
| 90 | F PRDL=0:0 S PRDL=$O(^PSRX(PSDRX,4,PRDL)) Q:'PRDL I $G(PSODRX)=$P($G(^PSRX(PSDRX,4,PRDL,0)),"^",3) S PSOCNODE=$G(^(0))
|
|---|
| 91 | I $G(PSOCNODE)="" Q
|
|---|
| 92 | I +$P(PSOCNODE,"^",4)<3 S PSOFILDL=1
|
|---|
| 93 | Q
|
|---|
| 94 | TESTRP ;
|
|---|
| 95 | N PIIN,PIINFLAG S PIINFLAG=0 F PIIN=1:1 S X=$P(IN,",",PIIN) Q:$P(IN,",",PIIN)']"" K DIC S DIC=52,DIC(0)="QMZ" D ^DIC K DIC I +$G(Y) D
|
|---|
| 96 | .I $P($G(^PSRX(+Y,"STA")),"^")'=12,'$G(PIINFLAG) S PSOCANRD=+$P($G(^PSRX(+Y,0)),"^",4) S PIINFLAG=1
|
|---|
| 97 | I '$G(PIINFLAG) S PSOCANRZ=1
|
|---|
| 98 | Q
|
|---|
| 99 | ULP ;
|
|---|
| 100 | D UL^PSSLOCK(+$G(PSODFN))
|
|---|
| 101 | Q
|
|---|
| 102 | ULRX ;
|
|---|
| 103 | I $G(PSOULRX) D PSOUL^PSSLOCK(PSOULRX)
|
|---|
| 104 | Q
|
|---|
