PSODRDUP ;BIR/SAB - Dup drug class checker ;4/30/09 12:32pm
;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,39,56,130,132,192,207,222,243,305,324**;DEC 1997;Build 6
;
;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
S $P(PSONULN,"-",79)="-",(STA,DNM)="" K CLS
F S STA=$O(PSOSD(STA)) Q:STA="" F S DNM=$O(PSOSD(STA,DNM)) Q:DNM=""!$G(PSORX("DFLG")) I $P(PSOSD(STA,DNM),"^")'=$G(PSORENW("OIRXN")) D Q:$G(PSORX("DFLG"))
.I STA="PENDING" D ^PSODRDU1 Q
.I STA="ZNONVA" D NVA^PSODRDU1 Q
.D:PSODRUG("NAME")=$P(DNM,"^")&('$D(^XUSEC("PSORPH",DUZ))) Q:$G(PSORX("DFLG"))
..I $P($G(PSOPAR),"^",16) D DUP Q:$G(PSORX("DFLG"))
..I $P(PSOPAR,"^",2),'$P($G(PSOPAR),"^",16) D DUP Q:$G(PSORX("DFLG"))
..I '$P(PSOPAR,"^",2),'$P($G(PSOPAR),"^",16) D DUP Q:$G(PSORX("DFLG"))
.D:PSODRUG("NAME")=$P(DNM,"^")&($D(^XUSEC("PSORPH",DUZ))) DUP Q:$G(PSORX("DFLG"))
.I PSODRUG("VA CLASS")]"",$E(PSODRUG("VA CLASS"),1,4)=$E($P(PSOSD(STA,DNM),"^",5),1,4),PSODRUG("NAME")'=$P(DNM,"^") D CLS
K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI")
D REMOTE^PSOCPDUP
EXIT D ^PSOBUILD K CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXN,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
Q
DUP S:$P(PSOSD(STA,DNM),"^",2)<10!($P(PSOSD(STA,DNM),"^",2)=16) DUP=1 W !,PSONULN,!,$C(7),"Duplicate Drug "_$P(DNM,"^")_" in Prescription: ",$P(^PSRX(+PSOSD(STA,DNM),0),"^")
S RXREC=+PSOSD(STA,DNM),MSG="Discontinued During "_$S('$G(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Drug"
DATA S DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),RX0=DUPRX0,RX2=^PSRX(RXREC,2),$P(RX0,"^",15)=+$G(^PSRX(RXREC,"STA"))
S RXRECLOC=$G(RXREC)
W !!,$J("Status: ",24) S J=RXREC D STAT^PSOFUNC W ST K RX0,RX2 W ?40,$J("Issued: ",24),$E(ISSD,4,5)_"/"_$E(ISSD,6,7)_"/"_$E(ISSD,2,3)
S DA=RXREC D PRSTAT(DA)
K FSIG,BSIG I $P($G(^PSRX(RXREC,"SIG")),"^",2) D FSIG^PSOUTLA("R",RXREC,54) F PSREV=1:1 Q:'$D(FSIG(PSREV)) S BSIG(PSREV)=FSIG(PSREV)
K FSIG,PSREV I '$P($G(^PSRX(RXREC,"SIG")),"^",2) D EN2^PSOUTLA1(RXREC,54)
W !,$J("SIG: ",24) W $G(BSIG(1))
I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV W !?24,$G(BSIG(PSREV))
K BSIG,PSREV
W !,$J("QTY: ",24)_$P(DUPRX0,"^",7),?40,$J("# of refills: ",24)_RFLS S PHYS=$S($D(^VA(200,+$P(DUPRX0,"^",4),0)):$P(^(0),"^"),1:"UNKNOWN")
W !,$J("Provider: ",24)_PHYS,?40,$J("Refills remaining: ",24),RFLS-$S($D(^PSRX(RXREC,1,0)):$P(^(0),"^",4),1:0)
S LSTFL=+^PSRX(RXREC,3) W !?40,$J("Last filled on: ",24)_$E(LSTFL,4,5)_"/"_$E(LSTFL,6,7)_"/"_$E(LSTFL,2,3),!?40,$J("Days Supply: ",24)_$P(DUPRX0,"^",8)
W !,PSONULN,! I $P($G(^PS(53,+$P($G(PSORX("PATIENT STATUS")),"^"),0)),"^")["AUTH ABS"!($G(PSORX("PATIENT STATUS"))["AUTH ABS")&'$P(PSOPAR,"^",5) W !,"PATIENT ON AUTHORIZED ABSENCE!" K RXRECLOC Q
ASKCAN I $P(PSOSD(STA,DNM),"^",2)>10,$P(PSOSD(STA,DNM),"^",2)'=16 K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,DTOUT,DUOUT,DIRUT,RXRECLOC Q
I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)),'$G(CLS) S PSORX("DFLG")=1 K RXRECLOC Q
I $P(PSOPAR,"^",2),'$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)),'$G(CLS) S PSORX("DFLG")=1 K RXRECLOC Q
I $P(PSOSD(STA,DNM),"^",2)=16,$G(DUP) W !!,"Prescription "_$P($G(^PSRX(+$G(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",! K DUP,RXRECLOC S PSORX("DFLG")=1 Q
D PSOL^PSSLOCK(RXRECLOC) I '$G(PSOMSG) D K PSOMSG,DIR,DUP,RXRECLOC S DIR("A")="Press Return to continue",DIR(0)="E" D ^DIR K DIR S PSORX("DFLG")=1 Q
.I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2),! Q
.W !!,"Another person is editing Rx "_$P($G(^PSRX(RXRECLOC,0)),"^"),!
K PSOMSG S DIR("A")=$S($P(PSOSD(STA,DNM),"^",2)=12:"Reinstate",1:"Discontinue")_" RX # "_$P(^PSRX(+PSOSD(STA,DNM),0),"^"),DIR(0)="Y",DIR("?")="Enter Y to "_$S($P(PSOSD(STA,DNM),"^",2)=12:"reinstate",1:"discontinue")_" this RX."
D ^DIR K DIR S DA=RXREC S ACT=$S($D(SPCANC):"Reinstated during Rx cancel.",1:$S($P(PSOSD(STA,DNM),"^",2)=12:"Reinstated",1:"Discontinued")_" while "_$S('$G(PSONV):"entering",1:"verifying")_" new RX")
D CMOP^PSOUTL I $G(CMOP("S"))="L" W !,"A CMOP Rx cannot be discontinued during transmission!",! S Y=0 K CMOP
I 'Y W $C(7)," -Prescription was not "_$S($P(PSOSD(STA,DNM),"^",2)=12:"reinstated",1:"discontinued")_"..." D Q
.S:'$D(PSOCLC) PSOCLC=DUZ S MSG=ACT,REA=$S($P(PSOSD(STA,DNM),"^",2)=12:"R",1:"C") S:$G(DUP) PSORX("DFLG")=1 K DUP D ULRX K RXRECLOC
.I $D(^TMP("PSORXDC",$J,RXREC,0)) K ^TMP("PSORXDC",$J,RXREC,0)
I $P(PSOSD(STA,DNM),"^",2)=16,$G(CLS) W !!,"Prescription "_$P($G(^PSRX(+$G(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",! D ULRX K CLS,DUP,RXRECLOC S PSORX("DFLG")=1 H 2 Q
S PSOCLC=DUZ,MSG=$S($G(MSG)]"":MSG,1:ACT_" During New RX "_$S('$G(PSONV):"Entry",1:"Verification")_" - Duplicate Rx"),REA=$S($P(PSOSD(STA,DNM),"^",2)=12:"R",1:"C")
W !!,"Duplicate "_$S($G(CLS):"Class",1:"Drug")_" will be discontinued after the acceptance of the new order.",!
S ^TMP("PSORXDC",$J,RXREC,0)="52^"_DA_"^"_MSG_"^"_REA_"^"_ACT_"^"_STA_"^"_DNM,PSONOOR="D"
K RXRECLOC,DUP,CLS,PSONOOR Q
CLS K DUP
I $E($G(PSODRUG("VA CLASS")),1,2)="HA",$E($P($G(PSOSD(STA,DNM)),"^",5),1,2)="HA" K PSOELSE Q
S CLS=1,MSG="Discontinued During "_$S('$G(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Class" W !,PSONULN
W !?5,$C(7),"*** SAME CLASS *** OF DRUG IN RX #"_$P(^PSRX(+PSOSD(STA,DNM),0),"^")_" FOR "_$P(DNM,"^"),!,"CLASS: "_PSODRUG("VA CLASS")
S CAN=$P(PSOSD(STA,DNM),"^",2)'<11!($P(PSOSD(STA,DNM),"^",2)=1) S RXREC=+PSOSD(STA,DNM) I $P($G(PSOPAR),"^",10) D DATA Q
E W !,PSONULN K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,DTOUT,DUOUT,DIRUT
K PSOELSE Q
ULRX ;
I '$G(RXRECLOC) Q
D PSOUL^PSSLOCK(RXRECLOC)
Q
;
PRSTAT(DA) ;Displays the prescription's status
N PSOTRANS,PSOREL,CMOP,RXPSTA,PSOX,RFLZRO,PSOLRD,PSORTS
S RXPSTA="Processing Status: ",PSOLRD=$P($G(^PSRX(RXREC,2)),"^",13)
D ^PSOCMOPA I $G(PSOCMOP)]"" D K CMOP,PSOTRANS,PSOREL
.S PSOTRANS=$E($P(PSOCMOP,"^",2),4,5)_"/"_$E($P(PSOCMOP,"^",2),6,7)_"/"_$E($P(PSOCMOP,"^",2),2,3)
.S PSOREL=$S(CMOP("L")=0:$P($G(^PSRX(DA,2)),"^",13),1:$P(^PSRX(DA,1,CMOP("L"),0),"^",18))
.S PSOREL=$E(PSOREL,4,5)_"/"_$E(PSOREL,6,7)_"/"_$E(PSOREL,2,3)_"@"_$E($P(PSOREL,".",2),1,4)
.I '$D(IOINORM)!('$D(IOINHI)) S X="IORVOFF;IORVON;IOINHI;IOINORM" D ENDR^%ZISS
.W !
.I $P($G(^PSRX(RXREC,"STA")),"^")=0 D
..W:$$TRANCMOP^PSOUTL(RXREC) ?5,IORVON_IOINHI
.W ?5,RXPSTA_$S($P(PSOCMOP,"^")=0!($P(PSOCMOP,"^")=2):"Transmitted to CMOP on "_PSOTRANS,$P(PSOCMOP,"^")=1:"Released by CMOP on "_PSOREL,1:"Not Dispensed"),IOINORM_IORVOFF
I $G(PSOCMOP)']"" D
.F PSOX=0:0 S PSOX=$O(^PSRX(RXREC,1,PSOX)) Q:'PSOX D
..S RFLZRO=$G(^PSRX(RXREC,1,PSOX,0))
..S:$P(RFLZRO,"^",18)'="" PSOLRD=$P(RFLZRO,"^",18) I $P(RFLZRO,"^",16) S PSOLRD=PSOLRD_"^R",PSORTS=$P(RFLZRO,"^",16)
.I '$O(^PSRX(RXREC,1,0)),$P(^PSRX(RXREC,2),"^",15) S PSOLRD=PSOLRD_"^R",PSORTS=$P(^PSRX(RXREC,2),"^",15)
.W !,$J(RXPSTA,24) I +$G(PSORTS) W "Returned to stock on "_$$FMTE^XLFDT(PSORTS,2) Q
.W $S(PSOLRD="":"Not released locally",1:"Released locally on "_$$FMTE^XLFDT($P(PSOLRD,"^"),2)_" "_$P(PSOLRD,"^",2))_$S($P(^PSRX(RXREC,0),"^",11)="W":" (Window)",1:" (Mail)")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODRDUP 7261 printed Dec 13, 2024@02:27:22 Page 2
PSODRDUP ;BIR/SAB - Dup drug class checker ;4/30/09 12:32pm
+1 ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,39,56,130,132,192,207,222,243,305,324**;DEC 1997;Build 6
+2 ;
+3 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
+4 SET $PIECE(PSONULN,"-",79)="-"
SET (STA,DNM)=""
KILL CLS
+5 FOR
SET STA=$ORDER(PSOSD(STA))
if STA=""
QUIT
FOR
SET DNM=$ORDER(PSOSD(STA,DNM))
if DNM=""!$GET(PSORX("DFLG"))
QUIT
IF $PIECE(PSOSD(STA,DNM),"^")'=$GET(PSORENW("OIRXN"))
Begin DoDot:1
+6 IF STA="PENDING"
DO ^PSODRDU1
QUIT
+7 IF STA="ZNONVA"
DO NVA^PSODRDU1
QUIT
+8 if PSODRUG("NAME")=$PIECE(DNM,"^")&('$DATA(^XUSEC("PSORPH",DUZ)))
Begin DoDot:2
+9 IF $PIECE($GET(PSOPAR),"^",16)
DO DUP
if $GET(PSORX("DFLG"))
QUIT
+10 IF $PIECE(PSOPAR,"^",2)
IF '$PIECE($GET(PSOPAR),"^",16)
DO DUP
if $GET(PSORX("DFLG"))
QUIT
+11 IF '$PIECE(PSOPAR,"^",2)
IF '$PIECE($GET(PSOPAR),"^",16)
DO DUP
if $GET(PSORX("DFLG"))
QUIT
End DoDot:2
if $GET(PSORX("DFLG"))
QUIT
+12 if PSODRUG("NAME")=$PIECE(DNM,"^")&($DATA(^XUSEC("PSORPH",DUZ)))
DO DUP
if $GET(PSORX("DFLG"))
QUIT
+13 IF PSODRUG("VA CLASS")]""
IF $EXTRACT(PSODRUG("VA CLASS"),1,4)=$EXTRACT($PIECE(PSOSD(STA,DNM),"^",5),1,4)
IF PSODRUG("NAME")'=$PIECE(DNM,"^")
DO CLS
End DoDot:1
if $GET(PSORX("DFLG"))
QUIT
+14 KILL ^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI")
+15 DO REMOTE^PSOCPDUP
EXIT DO ^PSOBUILD
KILL CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXN,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
+1 QUIT
DUP if $PIECE(PSOSD(STA,DNM),"^",2)<10!($PIECE(PSOSD(STA,DNM),"^",2)=16)
SET DUP=1
WRITE !,PSONULN,!,$CHAR(7),"Duplicate Drug "_$PIECE(DNM,"^")_" in Prescription: ",$PIECE(^PSRX(+PSOSD(STA,DNM),0),"^")
+1 SET RXREC=+PSOSD(STA,DNM)
SET MSG="Discontinued During "_$SELECT('$GET(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Drug"
DATA SET DUPRX0=^PSRX(RXREC,0)
SET RFLS=$PIECE(DUPRX0,"^",9)
SET ISSD=$PIECE(^PSRX(RXREC,0),"^",13)
SET RX0=DUPRX0
SET RX2=^PSRX(RXREC,2)
SET $PIECE(RX0,"^",15)=+$GET(^PSRX(RXREC,"STA"))
+1 SET RXRECLOC=$GET(RXREC)
+2 WRITE !!,$JUSTIFY("Status: ",24)
SET J=RXREC
DO STAT^PSOFUNC
WRITE ST
KILL RX0,RX2
WRITE ?40,$JUSTIFY("Issued: ",24),$EXTRACT(ISSD,4,5)_"/"_$EXTRACT(ISSD,6,7)_"/"_$EXTRACT(ISSD,2,3)
+3 SET DA=RXREC
DO PRSTAT(DA)
+4 KILL FSIG,BSIG
IF $PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
DO FSIG^PSOUTLA("R",RXREC,54)
FOR PSREV=1:1
if '$DATA(FSIG(PSREV))
QUIT
SET BSIG(PSREV)=FSIG(PSREV)
+5 KILL FSIG,PSREV
IF '$PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
DO EN2^PSOUTLA1(RXREC,54)
+6 WRITE !,$JUSTIFY("SIG: ",24)
WRITE $GET(BSIG(1))
+7 IF $ORDER(BSIG(1))
FOR PSREV=1:0
SET PSREV=$ORDER(BSIG(PSREV))
if 'PSREV
QUIT
WRITE !?24,$GET(BSIG(PSREV))
+8 KILL BSIG,PSREV
+9 WRITE !,$JUSTIFY("QTY: ",24)_$PIECE(DUPRX0,"^",7),?40,$JUSTIFY("# of refills: ",24)_RFLS
SET PHYS=$SELECT($DATA(^VA(200,+$PIECE(DUPRX0,"^",4),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+10 WRITE !,$JUSTIFY("Provider: ",24)_PHYS,?40,$JUSTIFY("Refills remaining: ",24),RFLS-$SELECT($DATA(^PSRX(RXREC,1,0)):$PIECE(^(0),"^",4),1:0)
+11 SET LSTFL=+^PSRX(RXREC,3)
WRITE !?40,$JUSTIFY("Last filled on: ",24)_$EXTRACT(LSTFL,4,5)_"/"_$EXTRACT(LSTFL,6,7)_"/"_$EXTRACT(LSTFL,2,3),!?40,$JUSTIFY("Days Supply: ",24)_$PIECE(DUPRX0,"^",8)
+12 WRITE !,PSONULN,!
IF $PIECE($GET(^PS(53,+$PIECE($GET(PSORX("PATIENT STATUS")),"^"),0)),"^")["AUTH ABS"!($GET(PSORX("PATIENT STATUS"))["AUTH ABS")&'$PIECE(PSOPAR,"^",5)
WRITE !,"PATIENT ON AUTHORIZED ABSENCE!"
KILL RXRECLOC
QUIT
ASKCAN IF $PIECE(PSOSD(STA,DNM),"^",2)>10
IF $PIECE(PSOSD(STA,DNM),"^",2)'=16
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR,DTOUT,DUOUT,DIRUT,RXRECLOC
QUIT
+1 IF '$PIECE(PSOPAR,"^",2)
IF '$PIECE(PSOPAR,"^",16)
IF '$DATA(^XUSEC("PSORPH",DUZ))
IF '$GET(CLS)
SET PSORX("DFLG")=1
KILL RXRECLOC
QUIT
+2 IF $PIECE(PSOPAR,"^",2)
IF '$PIECE(PSOPAR,"^",16)
IF '$DATA(^XUSEC("PSORPH",DUZ))
IF '$GET(CLS)
SET PSORX("DFLG")=1
KILL RXRECLOC
QUIT
+3 IF $PIECE(PSOSD(STA,DNM),"^",2)=16
IF $GET(DUP)
WRITE !!,"Prescription "_$PIECE($GET(^PSRX(+$GET(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",!
KILL DUP,RXRECLOC
SET PSORX("DFLG")=1
QUIT
+4 DO PSOL^PSSLOCK(RXRECLOC)
IF '$GET(PSOMSG)
Begin DoDot:1
+5 IF $PIECE($GET(PSOMSG),"^",2)'=""
WRITE !!,$PIECE(PSOMSG,"^",2),!
QUIT
+6 WRITE !!,"Another person is editing Rx "_$PIECE($GET(^PSRX(RXRECLOC,0)),"^"),!
End DoDot:1
KILL PSOMSG,DIR,DUP,RXRECLOC
SET DIR("A")="Press Return to continue"
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET PSORX("DFLG")=1
QUIT
+7 KILL PSOMSG
SET DIR("A")=$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"Reinstate",1:"Discontinue")_" RX # "_$PIECE(^PSRX(+PSOSD(STA,DNM),0),"^")
SET DIR(0)="Y"
SET DIR("?")="Enter Y to "_$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"reinstate",1:"discontinue")_" this RX."
+8 DO ^DIR
KILL DIR
SET DA=RXREC
SET ACT=$SELECT($DATA(SPCANC):"Reinstated during Rx cancel.",1:$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"Reinstated",1:"Discontinued")_" while "_$SELECT('$GET(PSONV):"entering",1:"verifying")_" new RX")
+9 DO CMOP^PSOUTL
IF $GET(CMOP("S"))="L"
WRITE !,"A CMOP Rx cannot be discontinued during transmission!",!
SET Y=0
KILL CMOP
+10 IF 'Y
WRITE $CHAR(7)," -Prescription was not "_$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"reinstated",1:"discontinued")_"..."
Begin DoDot:1
+11 if '$DATA(PSOCLC)
SET PSOCLC=DUZ
SET MSG=ACT
SET REA=$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"R",1:"C")
if $GET(DUP)
SET PSORX("DFLG")=1
KILL DUP
DO ULRX
KILL RXRECLOC
+12 IF $DATA(^TMP("PSORXDC",$JOB,RXREC,0))
KILL ^TMP("PSORXDC",$JOB,RXREC,0)
End DoDot:1
QUIT
+13 IF $PIECE(PSOSD(STA,DNM),"^",2)=16
IF $GET(CLS)
WRITE !!,"Prescription "_$PIECE($GET(^PSRX(+$GET(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",!
DO ULRX
KILL CLS,DUP,RXRECLOC
SET PSORX("DFLG")=1
HANG 2
QUIT
+14 SET PSOCLC=DUZ
SET MSG=$SELECT($GET(MSG)]"":MSG,1:ACT_" During New RX "_$SELECT('$GET(PSONV):"Entry",1:"Verification")_" - Duplicate Rx")
SET REA=$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"R",1:"C")
+15 WRITE !!,"Duplicate "_$SELECT($GET(CLS):"Class",1:"Drug")_" will be discontinued after the acceptance of the new order.",!
+16 SET ^TMP("PSORXDC",$JOB,RXREC,0)="52^"_DA_"^"_MSG_"^"_REA_"^"_ACT_"^"_STA_"^"_DNM
SET PSONOOR="D"
+17 KILL RXRECLOC,DUP,CLS,PSONOOR
QUIT
CLS KILL DUP
+1 IF $EXTRACT($GET(PSODRUG("VA CLASS")),1,2)="HA"
IF $EXTRACT($PIECE($GET(PSOSD(STA,DNM)),"^",5),1,2)="HA"
KILL PSOELSE
QUIT
+2 SET CLS=1
SET MSG="Discontinued During "_$SELECT('$GET(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Class"
WRITE !,PSONULN
+3 WRITE !?5,$CHAR(7),"*** SAME CLASS *** OF DRUG IN RX #"_$PIECE(^PSRX(+PSOSD(STA,DNM),0),"^")_" FOR "_$PIECE(DNM,"^"),!,"CLASS: "_PSODRUG("VA CLASS")
+4 SET CAN=$PIECE(PSOSD(STA,DNM),"^",2)'<11!($PIECE(PSOSD(STA,DNM),"^",2)=1)
SET RXREC=+PSOSD(STA,DNM)
IF $PIECE($GET(PSOPAR),"^",10)
DO DATA
QUIT
+5 IF '$TEST
WRITE !,PSONULN
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR,DTOUT,DUOUT,DIRUT
+6 KILL PSOELSE
QUIT
ULRX ;
+1 IF '$GET(RXRECLOC)
QUIT
+2 DO PSOUL^PSSLOCK(RXRECLOC)
+3 QUIT
+4 ;
PRSTAT(DA) ;Displays the prescription's status
+1 NEW PSOTRANS,PSOREL,CMOP,RXPSTA,PSOX,RFLZRO,PSOLRD,PSORTS
+2 SET RXPSTA="Processing Status: "
SET PSOLRD=$PIECE($GET(^PSRX(RXREC,2)),"^",13)
+3 DO ^PSOCMOPA
IF $GET(PSOCMOP)]""
Begin DoDot:1
+4 SET PSOTRANS=$EXTRACT($PIECE(PSOCMOP,"^",2),4,5)_"/"_$EXTRACT($PIECE(PSOCMOP,"^",2),6,7)_"/"_$EXTRACT($PIECE(PSOCMOP,"^",2),2,3)
+5 SET PSOREL=$SELECT(CMOP("L")=0:$PIECE($GET(^PSRX(DA,2)),"^",13),1:$PIECE(^PSRX(DA,1,CMOP("L"),0),"^",18))
+6 SET PSOREL=$EXTRACT(PSOREL,4,5)_"/"_$EXTRACT(PSOREL,6,7)_"/"_$EXTRACT(PSOREL,2,3)_"@"_$EXTRACT($PIECE(PSOREL,".",2),1,4)
+7 IF '$DATA(IOINORM)!('$DATA(IOINHI))
SET X="IORVOFF;IORVON;IOINHI;IOINORM"
DO ENDR^%ZISS
+8 WRITE !
+9 IF $PIECE($GET(^PSRX(RXREC,"STA")),"^")=0
Begin DoDot:2
+10 if $$TRANCMOP^PSOUTL(RXREC)
WRITE ?5,IORVON_IOINHI
End DoDot:2
+11 WRITE ?5,RXPSTA_$SELECT($PIECE(PSOCMOP,"^")=0!($PIECE(PSOCMOP,"^")=2):"Transmitted to CMOP on "_PSOTRANS,$PIECE(PSOCMOP,"^")=1:"Released by CMOP on "_PSOREL,1:"Not Dispensed"),IOINORM_IORVOFF
End DoDot:1
KILL CMOP,PSOTRANS,PSOREL
+12 IF $GET(PSOCMOP)']""
Begin DoDot:1
+13 FOR PSOX=0:0
SET PSOX=$ORDER(^PSRX(RXREC,1,PSOX))
if 'PSOX
QUIT
Begin DoDot:2
+14 SET RFLZRO=$GET(^PSRX(RXREC,1,PSOX,0))
+15 if $PIECE(RFLZRO,"^",18)'=""
SET PSOLRD=$PIECE(RFLZRO,"^",18)
IF $PIECE(RFLZRO,"^",16)
SET PSOLRD=PSOLRD_"^R"
SET PSORTS=$PIECE(RFLZRO,"^",16)
End DoDot:2
+16 IF '$ORDER(^PSRX(RXREC,1,0))
IF $PIECE(^PSRX(RXREC,2),"^",15)
SET PSOLRD=PSOLRD_"^R"
SET PSORTS=$PIECE(^PSRX(RXREC,2),"^",15)
+17 WRITE !,$JUSTIFY(RXPSTA,24)
IF +$GET(PSORTS)
WRITE "Returned to stock on "_$$FMTE^XLFDT(PSORTS,2)
QUIT
+18 WRITE $SELECT(PSOLRD="":"Not released locally",1:"Released locally on "_$$FMTE^XLFDT($PIECE(PSOLRD,"^"),2)_" "_$PIECE(PSOLRD,"^",2))_$SELECT($PIECE(^PSRX(RXREC,0),"^",11)="W":" (Window)",1:" (Mail)")
End DoDot:1
+19 QUIT
