PSODDPR1 ;BIR/SAB - enhanced dup drug checker for pending/nva orders ;09/30/06 11:33am
;;7.0;OUTPATIENT PHARMACY;**251,375,379,651**;DEC 1997;Build 30
;External reference to ^PSDRUG supported by DBIA 221
;External reference to ^PS(50.606 supported by DBIA 2174
;External reference to ^PS(51.2 supported by DBIA 2226
;External reference to ^PS(50.7 supported by DBIA 2223
;External reference to ^SC supported by DBIA 10040
;External reference to ^PS(56 supported by DBIA 2229
;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
N DUP,DUPRX0,ISSD,IT,MSG,PSONV,RFLS,TY,Y
S RXREC=$P(PSOSD(STA,DNM),"^",10)
Q:'$D(^PS(52.41,RXREC,0))
Q:$P($G(^PS(52.41,RXREC,0)),"^",3)="RF"
I $G(ORD) D K FSIG Q
.D:ORD'=RXREC&($G(PSODRUG("NAME"))=$P(DNM,"^"))&('$D(^XUSEC("PSORPH",DUZ))) Q:$G(PSORX("DFLG"))
..I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16) D DUP I $G(PSOTECCK) S PSORX("DFLG")=1 Q
..I '$P(PSOPAR,"^",2),$P(PSOPAR,"^",16),$G(PSOTECCK) D DUP Q
..I $P(PSOPAR,"^",2),$G(PSOTECCK) D Q
...S DA=+PSOSD(STA,DNM),PSOCLC=DUZ
...S MSG="Discontinued During Reinstating Prescription Entry",ACT="Discontinued during Rx Reinstate."
...S ^TMP("PSORXDC",$J,RXREC,0)="P^"_RXREC_"^"_MSG_"^^^^"_DNM
..I $P($G(PSOPAR),"^",16) D DUP Q:$G(PSORX("DFLG"))
..I $P($G(PSOPAR),"^",2),'$P(PSOPAR,"^",16) D DUP Q:$G(PSORX("DFLG"))
..I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16) D DUP Q:$G(PSORX("DFLG"))
.I $D(^XUSEC("PSORPH",DUZ)) D:ORD'=RXREC&($G(PSODRUG("NAME"))=$P(DNM,"^")) DUP Q:$G(PSORX("DFLG"))
;backdoor orders
Q:'$P($G(^PS(52.41,RXREC,0)),"^",9)
D:PSODRUG("NAME")=$P(DNM,"^")&('$D(^XUSEC("PSORPH",DUZ))) I $G(PSORX("DFLG")) K FSIG Q
.I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16) D DUP I $G(PSOTECCK) S PSORX("DFLG")=1 Q
.I '$P(PSOPAR,"^",2),$P(PSOPAR,"^",16),$G(PSOTECCK) D DUP Q
.I $P(PSOPAR,"^",2),$G(PSOTECCK) D Q
..S DA=+PSOSD(STA,DNM),PSOCLC=DUZ
..S MSG="Discontinued During Reinstating Prescription Entry",ACT="Discontinued during Rx Reinstate."
..S ^TMP("PSORXDC",$J,RXREC,0)="P^"_RXREC_"^"_MSG_"^^^^"_DNM
.I $P($G(PSOPAR),"^",16) D DUP Q:$G(PSORX("DFLG"))
.I $P($G(PSOPAR),"^",2),'$P(PSOPAR,"^",16) D DUP Q:$G(PSORX("DFLG"))
.I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16) D DUP Q:$G(PSORX("DFLG"))
D:PSODRUG("NAME")=$P(DNM,"^")&($D(^XUSEC("PSORPH",DUZ))) DUP Q:$G(PSORX("DFLG"))
K FSIG Q
DUP S DUP=1 W !,PSONULN,!,$C(7),"DUPLICATE DRUG in a Pending Order for",!
S MSG="Discontinued During "_$S('$G(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Drug."
DATA S DUPRX0=^PS(52.41,RXREC,0),RFLS=$P(DUPRX0,"^",11),ISSD=$P(DUPRX0,"^",6)
S RXRECLOD=RXREC N DNM,ACT
I '$P(DUPRX0,"^",9) W !,$J("Orderable Item: ",20)_$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
E W !,$J("Drug: ",20)_$S($P(DUPRX0,"^",9):$P(^PSDRUG($P(DUPRX0,"^",9),0),"^"),1:"No Dispense Drug Selected")
S DNM=$S($P(DUPRX0,"^",9):$P(^PSDRUG($P(DUPRX0,"^",9),0),"^"),1:$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"))
D FSIG^PSOUTLA("P",RXREC,50)
W !,$J("SIG: ",20) F I=0:0 S I=$O(FSIG(I)) Q:'I W $J(FSIG(I),20) I $O(FSIG(I)) W !?8
W !,$J("Quantity: ",20)_$P(DUPRX0,"^",10),?35,$J("# of Refills: ",20)_$P(DUPRX0,"^",11)
W !,$J("Provider: ",20)_$P(^VA(200,$P(DUPRX0,"^",5),0),"^")
S Y=$P(DUPRX0,"^",6) X ^DD("DD") W ?30,$J("Issue Date: ",20)_Y
S TY=3 D INST
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 RXRECLOD Q
ASKCAN ;
S:'$D(PSODLQT) PSODLQT=0
I '$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)) D Q
.S PSORX("DFLG")=1 K RXRECLOC,DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR
D PSOL^PSSLOCK(RXRECLOD_"S") I '$G(PSOMSG) D K PSOMSG,DIR,DUP,RXRECLOD S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR S PSORX("DFLG")=1 Q
.I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2),! Q
.W !!,"Another person is editing this pending order.",!
K PSOMSG S DIR("A")="Discontinue Pending Order for "_DNM_" Y/N",DIR(0)="Y",DIR("?")="Enter Y to Discontinue this pending order."
D ^DIR K DIR S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 Q:$G(PSODLQT)
I 'Y W !,$C(7)," Pending Order was not discontinued..." S:$G(DUP) PSORX("DFLG")=1 K DUP,CLS D ULPN Q
S ACT="Discontinued while "_$S('$G(PSONV):"entering",1:"verifying")_" new RX"
K ^UTILITY($J,"W") S DIWL=1,DIWR=75,DIWF=""
W ! S X="Pending Order for "_DNM_" will be discontinued after the acceptance of the new order." D ^DIWP
F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W !,^UTILITY($J,"W",1,ZX,0)
K ^UTILITY($J,"W"),X,DIWL,DIWR,DIWF W ! H 2
S ^TMP("PSORXDC",$J,RXREC,0)="P^"_RXREC_"^"_MSG_"^^^^"_DNM
K CLS,DUP,PSOSD(STA,DNM),DNM
Q
INST ;displays instruction and/or comments
S INST=0 F S INST=$O(^PS(52.41,RXREC,TY,INST)) Q:'INST S MIG=^PS(52.41,RXREC,TY,INST,0) D
.W !,$S(TY=2:" "_$S($$ERXIEN^PSOERXUT(RXREC_"P"):"eRx",1:" ")_" Instructions: ",TY=3:" Provider Comments: ",1:"")
.F SG=1:1:$L(MIG," ") W:$X+$L($P(MIG," ",SG)_" ")>IOM @$S(TY=3:"!?14",1:"!?19") W $P(MIG," ",SG)_" "
K INST,TY,MIG,SG
Q
ULPN ;
I '$G(RXRECLOD) Q
D PSOUL^PSSLOCK(RXRECLOD_"S") K RXRECLOD
Q
NVA ;displays duplicate drugs and classes for non-va meds
I $G(IT) D Q
.S SER=$P($G(^PS(56,IT,0)),"^",4)
.W "***"_$S(SER=1:"Critical",1:"Significant")_"*** Drug Interaction with a Non-VA Med Order.",!,"Drug: "_$P(DNM,"^")
.K DIR,DIRUT,DTOUT,DUOUT S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 Q:$G(PSODLQT) K DIR,DIRUT,DTOUT,DUOUT
Q:'$D(^PS(55,PSODFN,"NVA",$P(PSOSD(STA,DNM),"^",10),0))
I '$D(^XUSEC("PSORPH",DUZ)),$P(PSOPAR,"^",2),$G(PSOTECCK) Q
S IFN=$P(PSOSD(STA,DNM),"^",10),RXREC=IFN
I '$G(IT),$G(PSODRUG("NAME"))=$P(DNM,"^") D DSP Q
Q
DSP S $P(PSONULN,"-",79)="-"
W !,PSONULN,!,"Duplicate Drug in a Non-VA Med Order for",!
S DUPRX0=^PS(55,PSODFN,"NVA",RXREC,0)
;W !,$J("Orderable Item: ",20)_$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
W !,$J("Drug: ",20)_$S($P(DUPRX0,"^",2):$P(^PSDRUG($P(DUPRX0,"^",2),0),"^"),1:"No Dispense Drug Selected")
;W !,$J("Drug Class: ",20)_$G(PSODRUG("VA CLASS"))
W !,$J("Dosage: ",20)_$S($P(DUPRX0,"^",3):$P(DUPRX0,"^",3),1:"<NOT ENTERED>")
W !,$J("Schedule: ",20)_$S($P(DUPRX0,"^",5)]"":$P(DUPRX0,"^",5),1:"<NOT ENTERED>"),!,$J("Medication Route: ",20)_$S($P(DUPRX0,"^",4)]"":$P(DUPRX0,"^",4),1:"<NOT ENTERED>")
W !,$J("Start Date: ",20)_$S($P(DUPRX0,"^",9):$$FMTE^XLFDT($P(DUPRX0,"^",9)),1:"<NOT ENTERED>")
W ?40,$J("CPRS Order #: ",20)_$P(DUPRX0,"^",8)
W !,$J("Documented By: ",20)_$P(^VA(200,$P(DUPRX0,"^",11),0),"^")_" on "_$$FMTE^XLFDT($P(DUPRX0,"^",10))
W !,PSONULN,!
S ^TMP($J,"PSONVADD",RXREC,0)=1
K RX3,LSTFL,PSONULN,ISSD,J,LSTFD,PHYS,ST,TRM,DUPRX0,FL,FSIG,I,IFN,RFLS,RXREC,X,Y,IEN,DSC,REA,OCK,ORD1
K DIR,DIRUT,DTOUT,DUOUT S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 Q:$G(PSODLQT) K DIR,DIRUT,DTOUT,DUOUT
Q
F I=0:0 S I=$O(^PS(55,PSODFN,"NVA",IFN,"OCK",I)) Q:'I D W !
.I $Y+3>IOSL D W @IOF
..K DIR,DIRUT,DUOUT S DIR(0)="E",DIR("A")="Press Return to Continue or ""^"" to Stop" D ^DIR S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 Q:$G(PSODLQT)
..I $G(DUOUT) S NVAQ=1
.Q:$G(NVAQ)
.S ORD1=$P(^PS(55,PSODFN,"NVA",IFN,"OCK",I,0),"^"),ORP=$P(^(0),"^",2)
.W !,"Order Check #"_I_": "
.K OCK,LEN I $L(ORD1)>70 S (LEN,IEN)=1 D
..F SG=1:1:$L(ORD1) S:$L($G(OCK(IEN))_" "_$P(ORD1," ",SG))>75&($P(ORD1," ",SG)]"") IEN=IEN+1 S:$P(ORD1," ",SG)'="" OCK(IEN)=$G(OCK(IEN))_" "_$P(ORD1," ",SG)
..F II=0:0 S II=$O(OCK(II)) Q:'II W !?5,OCK(II)
.W:'$G(LEN) ORD1 K LEN,SG,IEN,II,OCK,ORD1
.W !,"Overriding Provider: "_$S($G(ORP):$P(^VA(200,ORP,0),"^"),1:"")
.K ORP,OCK,REA W !,"Reason:" F SS=0:0 S SS=$O(^PS(55,PSODFN,"NVA",IFN,"OCK",I,"OVR",SS)) Q:'SS S REA(SS)=^PS(55,PSODFN,"NVA",IFN,"OCK",I,"OVR",SS,0)
.I '$O(REA(0)) W " <NOT ENTERED>"
.S IEN=1 F II=0:0 S II=$O(REA(II)) Q:'II D
..F SG=1:1:$L(REA(II)) S:$L($G(OCK(IEN))_" "_$P(REA(II)," ",SG))>70&($P(REA(II)," ",SG)]"") IEN=IEN+1 S:$P(REA(II)," ",SG)'="" OCK(IEN)=$G(OCK(IEN))_" "_$P(REA(II)," ",SG)
..K REA,IEN,SG F II=0:0 S II=$O(OCK(II)) Q:'II W OCK(II) I $O(OCK(II)) W !?5
.K OCK W !,"Statement/Explanation/Comments:" F SS=0:0 S SS=$O(^PS(55,PSODFN,"NVA",IFN,"DSC",SS)) Q:'SS S DSC(SS)=^PS(55,PSODFN,"NVA",IFN,"DSC",SS,0)
.S IEN=1 F II=0:0 S II=$O(DSC(II)) Q:'II D
..F SG=1:1:$L(DSC(II)) S:$L($G(OCK(IEN))_" "_$P(DSC(II)," ",SG))>70&($P(DSC(II)," ",SG)]"") IEN=IEN+1 S:$P(DSC(II)," ",SG)'="" OCK(IEN)=$G(OCK(IEN))_" "_$P(DSC(II)," ",SG)
..K IEN,DSC,SG F II=0:0 S II=$O(OCK(II)) Q:'II W !?5,OCK(II)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODDPR1 9000 printed Dec 13, 2024@02:26:24 Page 2
PSODDPR1 ;BIR/SAB - enhanced dup drug checker for pending/nva orders ;09/30/06 11:33am
+1 ;;7.0;OUTPATIENT PHARMACY;**251,375,379,651**;DEC 1997;Build 30
+2 ;External reference to ^PSDRUG supported by DBIA 221
+3 ;External reference to ^PS(50.606 supported by DBIA 2174
+4 ;External reference to ^PS(51.2 supported by DBIA 2226
+5 ;External reference to ^PS(50.7 supported by DBIA 2223
+6 ;External reference to ^SC supported by DBIA 10040
+7 ;External reference to ^PS(56 supported by DBIA 2229
+8 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
+9 NEW DUP,DUPRX0,ISSD,IT,MSG,PSONV,RFLS,TY,Y
+10 SET RXREC=$PIECE(PSOSD(STA,DNM),"^",10)
+11 if '$DATA(^PS(52.41,RXREC,0))
QUIT
+12 if $PIECE($GET(^PS(52.41,RXREC,0)),"^",3)="RF"
QUIT
+13 IF $GET(ORD)
Begin DoDot:1
+14 if ORD'=RXREC&($GET(PSODRUG("NAME"))=$PIECE(DNM,"^"))&('$DATA(^XUSEC("PSORPH",DUZ)))
Begin DoDot:2
+15 IF '$PIECE(PSOPAR,"^",2)
IF '$PIECE(PSOPAR,"^",16)
DO DUP
IF $GET(PSOTECCK)
SET PSORX("DFLG")=1
QUIT
+16 IF '$PIECE(PSOPAR,"^",2)
IF $PIECE(PSOPAR,"^",16)
IF $GET(PSOTECCK)
DO DUP
QUIT
+17 IF $PIECE(PSOPAR,"^",2)
IF $GET(PSOTECCK)
Begin DoDot:3
+18 SET DA=+PSOSD(STA,DNM)
SET PSOCLC=DUZ
+19 SET MSG="Discontinued During Reinstating Prescription Entry"
SET ACT="Discontinued during Rx Reinstate."
+20 SET ^TMP("PSORXDC",$JOB,RXREC,0)="P^"_RXREC_"^"_MSG_"^^^^"_DNM
End DoDot:3
QUIT
+21 IF $PIECE($GET(PSOPAR),"^",16)
DO DUP
if $GET(PSORX("DFLG"))
QUIT
+22 IF $PIECE($GET(PSOPAR),"^",2)
IF '$PIECE(PSOPAR,"^",16)
DO DUP
if $GET(PSORX("DFLG"))
QUIT
+23 IF '$PIECE(PSOPAR,"^",2)
IF '$PIECE(PSOPAR,"^",16)
DO DUP
if $GET(PSORX("DFLG"))
QUIT
End DoDot:2
if $GET(PSORX("DFLG"))
QUIT
+24 IF $DATA(^XUSEC("PSORPH",DUZ))
if ORD'=RXREC&($GET(PSODRUG("NAME"))=$PIECE(DNM,"^"))
DO DUP
if $GET(PSORX("DFLG"))
QUIT
End DoDot:1
KILL FSIG
QUIT
+25 ;backdoor orders
+26 if '$PIECE($GET(^PS(52.41,RXREC,0)),"^",9)
QUIT
+27 if PSODRUG("NAME")=$PIECE(DNM,"^")&('$DATA(^XUSEC("PSORPH",DUZ)))
Begin DoDot:1
+28 IF '$PIECE(PSOPAR,"^",2)
IF '$PIECE(PSOPAR,"^",16)
DO DUP
IF $GET(PSOTECCK)
SET PSORX("DFLG")=1
QUIT
+29 IF '$PIECE(PSOPAR,"^",2)
IF $PIECE(PSOPAR,"^",16)
IF $GET(PSOTECCK)
DO DUP
QUIT
+30 IF $PIECE(PSOPAR,"^",2)
IF $GET(PSOTECCK)
Begin DoDot:2
+31 SET DA=+PSOSD(STA,DNM)
SET PSOCLC=DUZ
+32 SET MSG="Discontinued During Reinstating Prescription Entry"
SET ACT="Discontinued during Rx Reinstate."
+33 SET ^TMP("PSORXDC",$JOB,RXREC,0)="P^"_RXREC_"^"_MSG_"^^^^"_DNM
End DoDot:2
QUIT
+34 IF $PIECE($GET(PSOPAR),"^",16)
DO DUP
if $GET(PSORX("DFLG"))
QUIT
+35 IF $PIECE($GET(PSOPAR),"^",2)
IF '$PIECE(PSOPAR,"^",16)
DO DUP
if $GET(PSORX("DFLG"))
QUIT
+36 IF '$PIECE(PSOPAR,"^",2)
IF '$PIECE(PSOPAR,"^",16)
DO DUP
if $GET(PSORX("DFLG"))
QUIT
End DoDot:1
IF $GET(PSORX("DFLG"))
KILL FSIG
QUIT
+37 if PSODRUG("NAME")=$PIECE(DNM,"^")&($DATA(^XUSEC("PSORPH",DUZ)))
DO DUP
if $GET(PSORX("DFLG"))
QUIT
+38 KILL FSIG
QUIT
DUP SET DUP=1
WRITE !,PSONULN,!,$CHAR(7),"DUPLICATE DRUG in a Pending Order for",!
+1 SET MSG="Discontinued During "_$SELECT('$GET(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Drug."
DATA SET DUPRX0=^PS(52.41,RXREC,0)
SET RFLS=$PIECE(DUPRX0,"^",11)
SET ISSD=$PIECE(DUPRX0,"^",6)
+1 SET RXRECLOD=RXREC
NEW DNM,ACT
+2 IF '$PIECE(DUPRX0,"^",9)
WRITE !,$JUSTIFY("Orderable Item: ",20)_$PIECE(^PS(50.7,$PIECE(DUPRX0,"^",8),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")
+3 IF '$TEST
WRITE !,$JUSTIFY("Drug: ",20)_$SELECT($PIECE(DUPRX0,"^",9):$PIECE(^PSDRUG($PIECE(DUPRX0,"^",9),0),"^"),1:"No Dispense Drug Selected")
+4 SET DNM=$SELECT($PIECE(DUPRX0,"^",9):$PIECE(^PSDRUG($PIECE(DUPRX0,"^",9),0),"^"),1:$PIECE(^PS(50.7,$PIECE(DUPRX0,"^",8),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^"))
+5 DO FSIG^PSOUTLA("P",RXREC,50)
+6 WRITE !,$JUSTIFY("SIG: ",20)
FOR I=0:0
SET I=$ORDER(FSIG(I))
if 'I
QUIT
WRITE $JUSTIFY(FSIG(I),20)
IF $ORDER(FSIG(I))
WRITE !?8
+7 WRITE !,$JUSTIFY("Quantity: ",20)_$PIECE(DUPRX0,"^",10),?35,$JUSTIFY("# of Refills: ",20)_$PIECE(DUPRX0,"^",11)
+8 WRITE !,$JUSTIFY("Provider: ",20)_$PIECE(^VA(200,$PIECE(DUPRX0,"^",5),0),"^")
+9 SET Y=$PIECE(DUPRX0,"^",6)
XECUTE ^DD("DD")
WRITE ?30,$JUSTIFY("Issue Date: ",20)_Y
+10 SET TY=3
DO INST
+11 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 RXRECLOD
QUIT
ASKCAN ;
+1 if '$DATA(PSODLQT)
SET PSODLQT=0
+2 IF '$PIECE(PSOPAR,"^",16)
IF '$DATA(^XUSEC("PSORPH",DUZ))
Begin DoDot:1
+3 SET PSORX("DFLG")=1
KILL RXRECLOC,DIR
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+4 DO PSOL^PSSLOCK(RXRECLOD_"S")
IF '$GET(PSOMSG)
Begin DoDot:1
+5 IF $PIECE($GET(PSOMSG),"^",2)'=""
WRITE !!,$PIECE(PSOMSG,"^",2),!
QUIT
+6 WRITE !!,"Another person is editing this pending order.",!
End DoDot:1
KILL PSOMSG,DIR,DUP,RXRECLOD
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
SET PSORX("DFLG")=1
QUIT
+7 KILL PSOMSG
SET DIR("A")="Discontinue Pending Order for "_DNM_" Y/N"
SET DIR(0)="Y"
SET DIR("?")="Enter Y to Discontinue this pending order."
+8 DO ^DIR
KILL DIR
if ($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
if $GET(PSODLQT)
QUIT
+9 IF 'Y
WRITE !,$CHAR(7)," Pending Order was not discontinued..."
if $GET(DUP)
SET PSORX("DFLG")=1
KILL DUP,CLS
DO ULPN
QUIT
+10 SET ACT="Discontinued while "_$SELECT('$GET(PSONV):"entering",1:"verifying")_" new RX"
+11 KILL ^UTILITY($JOB,"W")
SET DIWL=1
SET DIWR=75
SET DIWF=""
+12 WRITE !
SET X="Pending Order for "_DNM_" will be discontinued after the acceptance of the new order."
DO ^DIWP
+13 FOR ZX=0:0
SET ZX=$ORDER(^UTILITY($JOB,"W",1,ZX))
if 'ZX
QUIT
WRITE !,^UTILITY($JOB,"W",1,ZX,0)
+14 KILL ^UTILITY($JOB,"W"),X,DIWL,DIWR,DIWF
WRITE !
HANG 2
+15 SET ^TMP("PSORXDC",$JOB,RXREC,0)="P^"_RXREC_"^"_MSG_"^^^^"_DNM
+16 KILL CLS,DUP,PSOSD(STA,DNM),DNM
+17 QUIT
INST ;displays instruction and/or comments
+1 SET INST=0
FOR
SET INST=$ORDER(^PS(52.41,RXREC,TY,INST))
if 'INST
QUIT
SET MIG=^PS(52.41,RXREC,TY,INST,0)
Begin DoDot:1
+2 WRITE !,$SELECT(TY=2:" "_$SELECT($$ERXIEN^PSOERXUT(RXREC_"P"):"eRx",1:" ")_" Instructions: ",TY=3:" Provider Comments: ",1:"")
+3 FOR SG=1:1:$LENGTH(MIG," ")
if $X+$LENGTH($PIECE(MIG," ",SG)_" ")>IOM
WRITE @$SELECT(TY=3:"!?14",1:"!?19")
WRITE $PIECE(MIG," ",SG)_" "
End DoDot:1
+4 KILL INST,TY,MIG,SG
+5 QUIT
ULPN ;
+1 IF '$GET(RXRECLOD)
QUIT
+2 DO PSOUL^PSSLOCK(RXRECLOD_"S")
KILL RXRECLOD
+3 QUIT
NVA ;displays duplicate drugs and classes for non-va meds
+1 IF $GET(IT)
Begin DoDot:1
+2 SET SER=$PIECE($GET(^PS(56,IT,0)),"^",4)
+3 WRITE "***"_$SELECT(SER=1:"Critical",1:"Significant")_"*** Drug Interaction with a Non-VA Med Order.",!,"Drug: "_$PIECE(DNM,"^")
+4 KILL DIR,DIRUT,DTOUT,DUOUT
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to continue"
DO ^DIR
if ($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
if $GET(PSODLQT)
QUIT
KILL DIR,DIRUT,DTOUT,DUOUT
End DoDot:1
QUIT
+5 if '$DATA(^PS(55,PSODFN,"NVA",$PIECE(PSOSD(STA,DNM),"^",10),0))
QUIT
+6 IF '$DATA(^XUSEC("PSORPH",DUZ))
IF $PIECE(PSOPAR,"^",2)
IF $GET(PSOTECCK)
QUIT
+7 SET IFN=$PIECE(PSOSD(STA,DNM),"^",10)
SET RXREC=IFN
+8 IF '$GET(IT)
IF $GET(PSODRUG("NAME"))=$PIECE(DNM,"^")
DO DSP
QUIT
+9 QUIT
DSP SET $PIECE(PSONULN,"-",79)="-"
+1 WRITE !,PSONULN,!,"Duplicate Drug in a Non-VA Med Order for",!
+2 SET DUPRX0=^PS(55,PSODFN,"NVA",RXREC,0)
+3 ;W !,$J("Orderable Item: ",20)_$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
+4 WRITE !,$JUSTIFY("Drug: ",20)_$SELECT($PIECE(DUPRX0,"^",2):$PIECE(^PSDRUG($PIECE(DUPRX0,"^",2),0),"^"),1:"No Dispense Drug Selected")
+5 ;W !,$J("Drug Class: ",20)_$G(PSODRUG("VA CLASS"))
+6 WRITE !,$JUSTIFY("Dosage: ",20)_$SELECT($PIECE(DUPRX0,"^",3):$PIECE(DUPRX0,"^",3),1:"<NOT ENTERED>")
+7 WRITE !,$JUSTIFY("Schedule: ",20)_$SELECT($PIECE(DUPRX0,"^",5)]"":$PIECE(DUPRX0,"^",5),1:"<NOT ENTERED>"),!,$JUSTIFY("Medication Route: ",20)_$SELECT($PIECE(DUPRX0,"^",4)]"":$PIECE(DUPRX0,"^",4),1:"<NOT ENTERED>")
+8 WRITE !,$JUSTIFY("Start Date: ",20)_$SELECT($PIECE(DUPRX0,"^",9):$$FMTE^XLFDT($PIECE(DUPRX0,"^",9)),1:"<NOT ENTERED>")
+9 WRITE ?40,$JUSTIFY("CPRS Order #: ",20)_$PIECE(DUPRX0,"^",8)
+10 WRITE !,$JUSTIFY("Documented By: ",20)_$PIECE(^VA(200,$PIECE(DUPRX0,"^",11),0),"^")_" on "_$$FMTE^XLFDT($PIECE(DUPRX0,"^",10))
+11 WRITE !,PSONULN,!
+12 SET ^TMP($JOB,"PSONVADD",RXREC,0)=1
+13 KILL RX3,LSTFL,PSONULN,ISSD,J,LSTFD,PHYS,ST,TRM,DUPRX0,FL,FSIG,I,IFN,RFLS,RXREC,X,Y,IEN,DSC,REA,OCK,ORD1
+14 KILL DIR,DIRUT,DTOUT,DUOUT
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to continue"
DO ^DIR
if ($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
if $GET(PSODLQT)
QUIT
KILL DIR,DIRUT,DTOUT,DUOUT
+15 QUIT
+16 FOR I=0:0
SET I=$ORDER(^PS(55,PSODFN,"NVA",IFN,"OCK",I))
if 'I
QUIT
Begin DoDot:1
+17 IF $Y+3>IOSL
Begin DoDot:2
+18 KILL DIR,DIRUT,DUOUT
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue or ""^"" to Stop"
DO ^DIR
if ($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
if $GET(PSODLQT)
QUIT
+19 IF $GET(DUOUT)
SET NVAQ=1
End DoDot:2
WRITE @IOF
+20 if $GET(NVAQ)
QUIT
+21 SET ORD1=$PIECE(^PS(55,PSODFN,"NVA",IFN,"OCK",I,0),"^")
SET ORP=$PIECE(^(0),"^",2)
+22 WRITE !,"Order Check #"_I_": "
+23 KILL OCK,LEN
IF $LENGTH(ORD1)>70
SET (LEN,IEN)=1
Begin DoDot:2
+24 FOR SG=1:1:$LENGTH(ORD1)
if $LENGTH($GET(OCK(IEN))_" "_$PIECE(ORD1," ",SG))>75&($PIECE(ORD1," ",SG)]"")
SET IEN=IEN+1
if $PIECE(ORD1," ",SG)'=""
SET OCK(IEN)=$GET(OCK(IEN))_" "_$PIECE(ORD1," ",SG)
+25 FOR II=0:0
SET II=$ORDER(OCK(II))
if 'II
QUIT
WRITE !?5,OCK(II)
End DoDot:2
+26 if '$GET(LEN)
WRITE ORD1
KILL LEN,SG,IEN,II,OCK,ORD1
+27 WRITE !,"Overriding Provider: "_$SELECT($GET(ORP):$PIECE(^VA(200,ORP,0),"^"),1:"")
+28 KILL ORP,OCK,REA
WRITE !,"Reason:"
FOR SS=0:0
SET SS=$ORDER(^PS(55,PSODFN,"NVA",IFN,"OCK",I,"OVR",SS))
if 'SS
QUIT
SET REA(SS)=^PS(55,PSODFN,"NVA",IFN,"OCK",I,"OVR",SS,0)
+29 IF '$ORDER(REA(0))
WRITE " <NOT ENTERED>"
+30 SET IEN=1
FOR II=0:0
SET II=$ORDER(REA(II))
if 'II
QUIT
Begin DoDot:2
+31 FOR SG=1:1:$LENGTH(REA(II))
if $LENGTH($GET(OCK(IEN))_" "_$PIECE(REA(II)," ",SG))>70&($PIECE(REA(II)," ",SG)]"")
SET IEN=IEN+1
if $PIECE(REA(II)," ",SG)'=""
SET OCK(IEN)=$GET(OCK(IEN))_" "_$PIECE(REA(II)," ",SG)
+32 KILL REA,IEN,SG
FOR II=0:0
SET II=$ORDER(OCK(II))
if 'II
QUIT
WRITE OCK(II)
IF $ORDER(OCK(II))
WRITE !?5
End DoDot:2
+33 KILL OCK
WRITE !,"Statement/Explanation/Comments:"
FOR SS=0:0
SET SS=$ORDER(^PS(55,PSODFN,"NVA",IFN,"DSC",SS))
if 'SS
QUIT
SET DSC(SS)=^PS(55,PSODFN,"NVA",IFN,"DSC",SS,0)
+34 SET IEN=1
FOR II=0:0
SET II=$ORDER(DSC(II))
if 'II
QUIT
Begin DoDot:2
+35 FOR SG=1:1:$LENGTH(DSC(II))
if $LENGTH($GET(OCK(IEN))_" "_$PIECE(DSC(II)," ",SG))>70&($PIECE(DSC(II)," ",SG)]"")
SET IEN=IEN+1
if $PIECE(DSC(II)," ",SG)'=""
SET OCK(IEN)=$GET(OCK(IEN))_" "_$PIECE(DSC(II)," ",SG)
+36 KILL IEN,DSC,SG
FOR II=0:0
SET II=$ORDER(OCK(II))
if 'II
QUIT
WRITE !?5,OCK(II)
End DoDot:2
End DoDot:1
WRITE !
+37 QUIT
+38 ;
