PSODDPR8 ;BIR/SAB - display enhanced order checks ;11 May 2010 9:06 AM
;;7.0;OUTPATIENT PHARMACY;**390,372,416,500,634**;DEC 1997;Build 3
;External reference to ^PS(50.7 supported by DBIA 2223
;External reference to ^PS(50.606 supported by DBIA 2174
;External reference to ^PS(52.41 supported by DBIA 2844
;External reference to ^PSDRUG supported by DBIA 221
;External reference to ENCHK^PSJORUT2 supported by DBIA 2376
;
DUP ;display drug interaction, clinical effects, and call to display monograph
Q:$G(PSODLQT)
S ZZDGDGC=ZZDGDGC+1,ON=$P(ZZDGDG(SV,ZST,ZORS,ZVA,DRG),"^"),CT=$P(ZZDGDG(SV,ZST,ZORS,ZVA,DRG),"^",2),SEV=$G(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"SEV")) K ISTX
S IT=$S(SEV="Critical":1,SEV="Significant":2,1:0),PDRG=$P(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT),"^",4),DRGI=$P(^(CT),"^",2)
D HD() Q:$G(PSODLQT)
I $G(ZHDR) W @IOF,PSONULN,!,"***"_SEV_"*** Drug Interaction with Prospective Drug:",!?20,PDRG_" and",! S ZHDR=0
E W !
I $P(ON,";")["C" D ^PSODDPR7
I $P(ON,";")="N" D ^PSODDPR3 D HD():(($Y+5)>IOSL) Q:$G(PSODLQT)
I $P(ON,";")="P" D PEND D HD():(($Y+5)>IOSL) Q:$G(PSODLQT)
I $P(ON,";")="O" D DDRX D HD():(($Y+5)>IOSL) Q:$G(PSODLQT)
I $P(ON,";")="Z" D DDRX1 D HD():(($Y+5)>IOSL) Q:$G(PSODLQT)
I $P(ON,";")="R" D RDI^PSODDPR3 D HD():(($Y+5)>IOSL) Q:$G(PSODLQT)
I '+$G(PSOINTV),IT=2 S PSOINTV=2_"^"_ON
I IT=1 S PSOINTV=1_"^"_ON
D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) I COUNT=ZZDGDG2(SV,ZVA) S COUNT=0 W ! D CL D HD():(($Y+5)'>IOSL)
Q
;
PEND N DUPRX0,RFLS,ISSD,DNM,RXREC,Y
D HD() Q:$G(PSODLQT) S RXREC=$P(ON,";",2),DNM=$P(^PS(52.41,RXREC,0),"^",9)
S DUPRX0=^PS(52.41,RXREC,0),RFLS=$P(DUPRX0,"^",11),ISSD=$P(DUPRX0,"^",6)
I '$P(DUPRX0,"^",9) D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Pending Order: ",20)_$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
E S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Pending Drug: ",20)_$S($P(DUPRX0,"^",9):$P(^PSDRUG($P(DUPRX0,"^",9),0),"^"),1:"No Dispense Drug Selected")
D FSIG^PSOUTLA("P",RXREC,50)
S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("SIG: ",20) F I=0:0 S I=$O(FSIG(I)) Q:'I W:'$G(PSODUPF) FSIG(I) I $O(FSIG(I)) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J(" ",20)
Q
;
DDRX ;
S RXREC=$P(ON,";",2),DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),RX0=DUPRX0,RX2=^PSRX(RXREC,2),($P(RX0,"^",15),STATUS)=+$G(^PSRX(RXREC,"STA"))
S J=RXREC D STAT^PSOFUNC K RX0,RX2,LSTFD S RXRECLOC=$G(RXREC),DRGNM=$P(^PSDRUG($P(DUPRX0,"^",6),0),"^")
D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Local RX#: ",20)_$P(DUPRX0,"^"),!,$J("Drug: ",20)_DRGNM_" ("_ST_")"
K FSIG,BSIG I $P($G(^PSRX(RXREC,"SIG")),"^",2) D FSIG^PSOUTLA("R",RXREC,50) 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,50)
D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("SIG: ",20),$G(BSIG(1))
I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J(" ",20)_$G(BSIG(PSREV)) D HD()
K BSIG,PSREV
I $G(QTHER) D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("QTY: ",20)_$P(DUPRX0,"^",7),?44,$J("Days Supply: ",20)_$P(DUPRX0,"^",8)
D PRSTAT^PSODDPRE(RXREC) S LSTFD=+^PSRX(RXREC,3) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Last Filled On: ",20)_$E(LSTFD,4,5)_"/"_$E(LSTFD,6,7)_"/"_$E(LSTFD,2,3)
Q
;
DDRX1 ;
W:SV="C" !,$J("Drug: ",21)_$S($D(PSSDIUTL):PDRG,1:DRG)
W:SV="S" !,$J("Drug: ",24)_$S($D(PSSDIUTL):PDRG,1:DRG)
Q
;
CL Q:$G(PSODLQT) N CLI,LT,STX,I,BSIG S ZHDR=1 N CLECNT
D HD():(($Y+5)>IOSL) Q:$G(PSODLQT)
I IT=2 W !?2,"*** Refer to MONOGRAPH for SIGNIFICANT INTERACTION CLINICAL EFFECTS",!
I IT=1 W ! D
.S CLECNT=0 F S CLECNT=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CLECNT)) Q:CLECNT="" I $D(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CLECNT,"CLIN")) D
..S CLI="",CLI=$P($G(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CLECNT,"CLIN")),"CLINICAL EFFECTS: ",2)
..S LT=75,STX=CLI D FT Q:$G(PSODLQT) F I=0:0 S I=$O(BSIG(I)) Q:'I W ?2,BSIG(I),! D HD():(($Y+5)>IOSL) Q:$G(PSODLQT)
..W !
D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) I $O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",0)) D MON^PSODDPR3 K X,Y
D HD():(($Y+5)>IOSL)
Q
;
FT ;format text
D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) K BSIG N BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM S BBSIG=STX S (BVAR,BVAR1)="",III=1
S ZNT=0 F NNN=1:1:$L(BBSIG) I $E(BBSIG,NNN)=" "!($L(BBSIG)=NNN) S ZNT=ZNT+1 D I $L(BVAR)>LT S BSIG(III)=BLIM_" ",III=III+1,BVAR=BVAR1
.S BVAR1=$P(BBSIG," ",(ZNT)),BLIM=BVAR,BVAR=$S(BVAR="":BVAR1,1:BVAR_" "_BVAR1) D HD(6):(($Y+6)>IOSL)
I $G(BVAR)'="" S BSIG(III)=BVAR
I $G(BSIG(1))=""!($G(BSIG(1))=" ") S BSIG(1)=$G(BSIG(2)) K BSIG(2)
K LT D HD():(($Y+5)>IOSL)
Q
;
HD(PSOLINES,OVRRID) ;
Q:$G(PSODUPF) ;P634
S:'$G(PSODLQT) PSODLQT=0 S:'$G(OVRRID) OVRRID=0 S:'$G(PSOLINES) PSOLINES=5
I '$G(OVRRID),$G(PSODLQT)!(($Y+PSOLINES)'>IOSL) Q
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
W ! K DIR,Y S DIR(0)="E",DIR("A")="Press return to continue" D ^DIR K DIR
K PSOLINES,OVRRID
I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODLQT=1,PSORX("DFLG")=1 Q
W:'$G(PSODUPF) @IOF
Q
;
;
CPRS(PSODFN,PSODSULS,PSODSUOI,PSODSUTY,PSODSUAG) ;
;Duplicate supply check for CPRS
;PSODFN - Patient
;PSODSULS - Literal
;PSODSUOI - Orderable Item array in format of PSODSUOI(n)=IEN (#50.7) ^ Orderable Name name
;PSODSUTY - P1;P2 where P1 is dialogue ("I" for IV, U for Unit Dose, "O" for Outpatient, "N" for Non-VA Meds (required)), P2=Pharm order# (optional)
;PSODSUAG - If 1, indicates TMP global from CPRS^PSODDPR4 call still exists, and add to it
I '$G(PSODFN) Q
I '$O(PSODSUOI(0)) Q
I '$D(PSODSULS) Q
N INDX,PSODSUDL,PSODSUPK,PSODSURG,PSODSUA1,PSODSUA2,PSODSUNM,PSODSUAP,PSODSUIN,PSODSUII,PSODSUNN,PSODSUDM,PSODSUDC,PSODSUST,PSODSUCC,PSODSULP,PSODSUBB,PSODSUB4,PSODSONM,PSODSOP2
S PSODSUDL=$P($G(PSODSUTY),";") I PSODSUDL'="I",PSODSUDL'="U",PSODSUDL'="O",PSODSUDL'="N" Q
S PSODSUPK=$S(PSODSUDL="I":1,PSODSUDL="U":1,1:0),PSODSUCC=0
S PSODSUA1="" F S PSODSUA1=$O(PSODSUOI(PSODSUA1)) Q:PSODSUA1="" S PSODSONM=PSODSUOI(PSODSUA1) D
.S PSODSUA2="" F S PSODSUA2=$O(^PSDRUG("ASP",PSODSUA1,PSODSUA2)) Q:PSODSUA2="" D
..S PSODSUNM=$P($G(^PSDRUG(PSODSUA2,0)),"^") Q:PSODSUNM=""
..S PSODSUAP=$P($G(^PSDRUG(PSODSUA2,2)),"^",3)
..I PSODSUPK,PSODSUAP'["I",PSODSUAP'["U" Q
..I PSODSUDL="O",PSODSUAP'["O" Q
..I PSODSUDL="N",PSODSUAP'["X" Q
..I '$$SUP^PSSDSAPI(PSODSUA2) Q
..S PSODSUIN=$P($G(^PSDRUG(PSODSUA2,"I")),"^")
..I PSODSUIN,PSODSUIN<DT Q
..S PSODSURG(PSODSUA2)=PSODSUNM_$S($G(PSODSONM):"^"_PSODSONM,1:"")
I $O(PSODSURG(""))="" Q
S INDX=0 K ^TMP($J,"ORDERS") I '$G(PSODSUAG) K ^TMP($J,"DD"),^TMP($J,PSODSULS)
D BLD^PSOORDRG,ENCHK^PSJORUT2(PSODFN,.INDX),NVA^PSOORDRG I '$D(^TMP($J,"ORDERS")) Q
S PSODSUDC=0,PSODSUII=""
I $G(PSODSUAG) D
.S PSODSULP="" F S PSODSULP=$O(^TMP($J,"DD",PSODSULP)) Q:PSODSULP="" S PSODSUDC=PSODSULP
.S PSODSUBB="" F S PSODSUBB=$O(^TMP($J,PSODSULS,"IN","PROSPECTIVE",PSODSUBB)) Q:PSODSUBB="" I $G(PSODSUTY)=$P(PSODSUBB,";",1,2) S PSODSUB4=$P(PSODSUBB,";",4) I PSODSUB4>PSODSUCC S PSODSUCC=PSODSUB4
F S PSODSUII=$O(PSODSURG(PSODSUII)) Q:PSODSUII="" D
.S PSODSUNN=$P(PSODSURG(PSODSUII),"^"),PSODSOP2=$P(PSODSURG(PSODSUII),"^",2),PSODSUDM=""
.F S PSODSUDM=$O(^TMP($J,"ORDERS",PSODSUDM)) Q:PSODSUDM="" I PSODSUNN=$P(^TMP($J,"ORDERS",PSODSUDM),"^",3) D
..S PSODSUDC=PSODSUDC+1,^TMP($J,"DD",PSODSUDC,0)=PSODSUII_"^"_PSODSUNN_"^"_$P(^TMP($J,"ORDERS",PSODSUDM),"^",4)_"^"_$P(^TMP($J,"ORDERS",PSODSUDM),"^",5) D:'$D(PSODSUST(PSODSUII)) PNODE
K ^TMP($J,"ORDERS")
Q
;
PNODE ;Set prospective node for duplicate supply check for CPRS
N PSOSPRID,PSOSPRQN,PSOSPRNF,PSOSPRN1,PSOSPRN2,PSOSPRXX
S PSOSPRNF=$S($G(^PSDRUG(PSODSUII,"ND"))]"":+^PSDRUG(PSODSUII,"ND")_"A"_$P(^PSDRUG(PSODSUII,"ND"),"^",3),1:0)
S PSOSPRID=$$GETVUID^XTID(50.68,,+$P($G(PSOSPRNF),"A",2)_",")
S PSOSPRN1=$P($G(^PSDRUG(PSODSUII,"ND")),"^"),PSOSPRN2=$P($G(^PSDRUG(PSODSUII,"ND")),"^",3),PSOSPRXX=$$PROD0^PSNAPIS(PSOSPRN1,PSOSPRN2),PSOSPRQN=$P(PSOSPRXX,"^",7)
S PSODSUCC=$G(PSODSUCC)+1,^TMP($J,PSODSULS,"IN","PROSPECTIVE",$P(PSODSUTY,";")_";"_$P(PSODSUTY,";",2)_";PROSPECTIVE;"_PSODSUCC)=PSOSPRQN_"^"_+PSOSPRID_"^"_PSODSUII_"^"_$G(PSODSUNN)_$S($G(PSODSOP2):"^"_PSODSOP2,1:"")
S PSODSUST(PSODSUII)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODDPR8 8604 printed Apr 09, 2024@21:27:20 Page 2
PSODDPR8 ;BIR/SAB - display enhanced order checks ;11 May 2010 9:06 AM
+1 ;;7.0;OUTPATIENT PHARMACY;**390,372,416,500,634**;DEC 1997;Build 3
+2 ;External reference to ^PS(50.7 supported by DBIA 2223
+3 ;External reference to ^PS(50.606 supported by DBIA 2174
+4 ;External reference to ^PS(52.41 supported by DBIA 2844
+5 ;External reference to ^PSDRUG supported by DBIA 221
+6 ;External reference to ENCHK^PSJORUT2 supported by DBIA 2376
+7 ;
DUP ;display drug interaction, clinical effects, and call to display monograph
+1 if $GET(PSODLQT)
QUIT
+2 SET ZZDGDGC=ZZDGDGC+1
SET ON=$PIECE(ZZDGDG(SV,ZST,ZORS,ZVA,DRG),"^")
SET CT=$PIECE(ZZDGDG(SV,ZST,ZORS,ZVA,DRG),"^",2)
SET SEV=$GET(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"SEV"))
KILL ISTX
+3 SET IT=$SELECT(SEV="Critical":1,SEV="Significant":2,1:0)
SET PDRG=$PIECE(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT),"^",4)
SET DRGI=$PIECE(^(CT),"^",2)
+4 DO HD()
if $GET(PSODLQT)
QUIT
+5 IF $GET(ZHDR)
WRITE @IOF,PSONULN,!,"***"_SEV_"*** Drug Interaction with Prospective Drug:",!?20,PDRG_" and",!
SET ZHDR=0
+6 IF '$TEST
WRITE !
+7 IF $PIECE(ON,";")["C"
DO ^PSODDPR7
+8 IF $PIECE(ON,";")="N"
DO ^PSODDPR3
if (($Y+5)>IOSL)
DO HD()
if $GET(PSODLQT)
QUIT
+9 IF $PIECE(ON,";")="P"
DO PEND
if (($Y+5)>IOSL)
DO HD()
if $GET(PSODLQT)
QUIT
+10 IF $PIECE(ON,";")="O"
DO DDRX
if (($Y+5)>IOSL)
DO HD()
if $GET(PSODLQT)
QUIT
+11 IF $PIECE(ON,";")="Z"
DO DDRX1
if (($Y+5)>IOSL)
DO HD()
if $GET(PSODLQT)
QUIT
+12 IF $PIECE(ON,";")="R"
DO RDI^PSODDPR3
if (($Y+5)>IOSL)
DO HD()
if $GET(PSODLQT)
QUIT
+13 IF '+$GET(PSOINTV)
IF IT=2
SET PSOINTV=2_"^"_ON
+14 IF IT=1
SET PSOINTV=1_"^"_ON
+15 if (($Y+5)>IOSL)
DO HD()
if $GET(PSODLQT)
QUIT
IF COUNT=ZZDGDG2(SV,ZVA)
SET COUNT=0
WRITE !
DO CL
if (($Y+5)'>IOSL)
DO HD()
+16 QUIT
+17 ;
PEND NEW DUPRX0,RFLS,ISSD,DNM,RXREC,Y
+1 DO HD()
if $GET(PSODLQT)
QUIT
SET RXREC=$PIECE(ON,";",2)
SET DNM=$PIECE(^PS(52.41,RXREC,0),"^",9)
+2 SET DUPRX0=^PS(52.41,RXREC,0)
SET RFLS=$PIECE(DUPRX0,"^",11)
SET ISSD=$PIECE(DUPRX0,"^",6)
+3 IF '$PIECE(DUPRX0,"^",9)
DO HD()
if $GET(PSODLQT)
QUIT
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Pending Order: ",20)_$PIECE(^PS(50.7,$PIECE(DUPRX0,"^",8),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")
+4 IF '$TEST
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Pending Drug: ",20)_$SELECT($PIECE(DUPRX0,"^",9):$PIECE(^PSDRUG($PIECE(DUPRX0,"^",9),0),"^"),1:"No Dispense Drug Selected")
+5 DO FSIG^PSOUTLA("P",RXREC,50)
+6 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("SIG: ",20)
FOR I=0:0
SET I=$ORDER(FSIG(I))
if 'I
QUIT
if '$GET(PSODUPF)
WRITE FSIG(I)
IF $ORDER(FSIG(I))
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY(" ",20)
+7 QUIT
+8 ;
DDRX ;
+1 SET RXREC=$PIECE(ON,";",2)
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),STATUS)=+$GET(^PSRX(RXREC,"STA"))
+2 SET J=RXREC
DO STAT^PSOFUNC
KILL RX0,RX2,LSTFD
SET RXRECLOC=$GET(RXREC)
SET DRGNM=$PIECE(^PSDRUG($PIECE(DUPRX0,"^",6),0),"^")
+3 DO HD()
if $GET(PSODLQT)
QUIT
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Local RX#: ",20)_$PIECE(DUPRX0,"^"),!,$JUSTIFY("Drug: ",20)_DRGNM_" ("_ST_")"
+4 KILL FSIG,BSIG
IF $PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
DO FSIG^PSOUTLA("R",RXREC,50)
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,50)
+6 DO HD()
if $GET(PSODLQT)
QUIT
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("SIG: ",20),$GET(BSIG(1))
+7 IF $ORDER(BSIG(1))
FOR PSREV=1:0
SET PSREV=$ORDER(BSIG(PSREV))
if 'PSREV
QUIT
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY(" ",20)_$GET(BSIG(PSREV))
DO HD()
+8 KILL BSIG,PSREV
+9 IF $GET(QTHER)
DO HD()
if $GET(PSODLQT)
QUIT
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("QTY: ",20)_$PIECE(DUPRX0,"^",7),?44,$JUSTIFY("Days Supply: ",20)_$PIECE(DUPRX0,"^",8)
+10 DO PRSTAT^PSODDPRE(RXREC)
SET LSTFD=+^PSRX(RXREC,3)
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Last Filled On: ",20)_$EXTRACT(LSTFD,4,5)_"/"_$EXTRACT(LSTFD,6,7)_"/"_$EXTRACT(LSTFD,2,3)
+11 QUIT
+12 ;
DDRX1 ;
+1 if SV="C"
WRITE !,$JUSTIFY("Drug: ",21)_$SELECT($DATA(PSSDIUTL):PDRG,1:DRG)
+2 if SV="S"
WRITE !,$JUSTIFY("Drug: ",24)_$SELECT($DATA(PSSDIUTL):PDRG,1:DRG)
+3 QUIT
+4 ;
CL if $GET(PSODLQT)
QUIT
NEW CLI,LT,STX,I,BSIG
SET ZHDR=1
NEW CLECNT
+1 if (($Y+5)>IOSL)
DO HD()
if $GET(PSODLQT)
QUIT
+2 IF IT=2
WRITE !?2,"*** Refer to MONOGRAPH for SIGNIFICANT INTERACTION CLINICAL EFFECTS",!
+3 IF IT=1
WRITE !
Begin DoDot:1
+4 SET CLECNT=0
FOR
SET CLECNT=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CLECNT))
if CLECNT=""
QUIT
IF $DATA(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CLECNT,"CLIN"))
Begin DoDot:2
+5 SET CLI=""
SET CLI=$PIECE($GET(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CLECNT,"CLIN")),"CLINICAL EFFECTS: ",2)
+6 SET LT=75
SET STX=CLI
DO FT
if $GET(PSODLQT)
QUIT
FOR I=0:0
SET I=$ORDER(BSIG(I))
if 'I
QUIT
WRITE ?2,BSIG(I),!
if (($Y+5)>IOSL)
DO HD()
if $GET(PSODLQT)
QUIT
+7 WRITE !
End DoDot:2
End DoDot:1
+8 if (($Y+5)>IOSL)
DO HD()
if $GET(PSODLQT)
QUIT
IF $ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",0))
DO MON^PSODDPR3
KILL X,Y
+9 if (($Y+5)>IOSL)
DO HD()
+10 QUIT
+11 ;
FT ;format text
+1 if (($Y+5)>IOSL)
DO HD()
if $GET(PSODLQT)
QUIT
KILL BSIG
NEW BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM
SET BBSIG=STX
SET (BVAR,BVAR1)=""
SET III=1
+2 SET ZNT=0
FOR NNN=1:1:$LENGTH(BBSIG)
IF $EXTRACT(BBSIG,NNN)=" "!($LENGTH(BBSIG)=NNN)
SET ZNT=ZNT+1
Begin DoDot:1
+3 SET BVAR1=$PIECE(BBSIG," ",(ZNT))
SET BLIM=BVAR
SET BVAR=$SELECT(BVAR="":BVAR1,1:BVAR_" "_BVAR1)
if (($Y+6)>IOSL)
DO HD(6)
End DoDot:1
IF $LENGTH(BVAR)>LT
SET BSIG(III)=BLIM_" "
SET III=III+1
SET BVAR=BVAR1
+4 IF $GET(BVAR)'=""
SET BSIG(III)=BVAR
+5 IF $GET(BSIG(1))=""!($GET(BSIG(1))=" ")
SET BSIG(1)=$GET(BSIG(2))
KILL BSIG(2)
+6 KILL LT
if (($Y+5)>IOSL)
DO HD()
+7 QUIT
+8 ;
HD(PSOLINES,OVRRID) ;
+1 ;P634
if $GET(PSODUPF)
QUIT
+2 if '$GET(PSODLQT)
SET PSODLQT=0
if '$GET(OVRRID)
SET OVRRID=0
if '$GET(PSOLINES)
SET PSOLINES=5
+3 IF '$GET(OVRRID)
IF $GET(PSODLQT)!(($Y+PSOLINES)'>IOSL)
QUIT
+4 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+5 WRITE !
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press return to continue"
DO ^DIR
KILL DIR
+6 KILL PSOLINES,OVRRID
+7 IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
QUIT
+8 if '$GET(PSODUPF)
WRITE @IOF
+9 QUIT
+10 ;
+11 ;
CPRS(PSODFN,PSODSULS,PSODSUOI,PSODSUTY,PSODSUAG) ;
+1 ;Duplicate supply check for CPRS
+2 ;PSODFN - Patient
+3 ;PSODSULS - Literal
+4 ;PSODSUOI - Orderable Item array in format of PSODSUOI(n)=IEN (#50.7) ^ Orderable Name name
+5 ;PSODSUTY - P1;P2 where P1 is dialogue ("I" for IV, U for Unit Dose, "O" for Outpatient, "N" for Non-VA Meds (required)), P2=Pharm order# (optional)
+6 ;PSODSUAG - If 1, indicates TMP global from CPRS^PSODDPR4 call still exists, and add to it
+7 IF '$GET(PSODFN)
QUIT
+8 IF '$ORDER(PSODSUOI(0))
QUIT
+9 IF '$DATA(PSODSULS)
QUIT
+10 NEW INDX,PSODSUDL,PSODSUPK,PSODSURG,PSODSUA1,PSODSUA2,PSODSUNM,PSODSUAP,PSODSUIN,PSODSUII,PSODSUNN,PSODSUDM,PSODSUDC,PSODSUST,PSODSUCC,PSODSULP,PSODSUBB,PSODSUB4,PSODSONM,PSODSOP2
+11 SET PSODSUDL=$PIECE($GET(PSODSUTY),";")
IF PSODSUDL'="I"
IF PSODSUDL'="U"
IF PSODSUDL'="O"
IF PSODSUDL'="N"
QUIT
+12 SET PSODSUPK=$SELECT(PSODSUDL="I":1,PSODSUDL="U":1,1:0)
SET PSODSUCC=0
+13 SET PSODSUA1=""
FOR
SET PSODSUA1=$ORDER(PSODSUOI(PSODSUA1))
if PSODSUA1=""
QUIT
SET PSODSONM=PSODSUOI(PSODSUA1)
Begin DoDot:1
+14 SET PSODSUA2=""
FOR
SET PSODSUA2=$ORDER(^PSDRUG("ASP",PSODSUA1,PSODSUA2))
if PSODSUA2=""
QUIT
Begin DoDot:2
+15 SET PSODSUNM=$PIECE($GET(^PSDRUG(PSODSUA2,0)),"^")
if PSODSUNM=""
QUIT
+16 SET PSODSUAP=$PIECE($GET(^PSDRUG(PSODSUA2,2)),"^",3)
+17 IF PSODSUPK
IF PSODSUAP'["I"
IF PSODSUAP'["U"
QUIT
+18 IF PSODSUDL="O"
IF PSODSUAP'["O"
QUIT
+19 IF PSODSUDL="N"
IF PSODSUAP'["X"
QUIT
+20 IF '$$SUP^PSSDSAPI(PSODSUA2)
QUIT
+21 SET PSODSUIN=$PIECE($GET(^PSDRUG(PSODSUA2,"I")),"^")
+22 IF PSODSUIN
IF PSODSUIN<DT
QUIT
+23 SET PSODSURG(PSODSUA2)=PSODSUNM_$SELECT($GET(PSODSONM):"^"_PSODSONM,1:"")
End DoDot:2
End DoDot:1
+24 IF $ORDER(PSODSURG(""))=""
QUIT
+25 SET INDX=0
KILL ^TMP($JOB,"ORDERS")
IF '$GET(PSODSUAG)
KILL ^TMP($JOB,"DD"),^TMP($JOB,PSODSULS)
+26 DO BLD^PSOORDRG
DO ENCHK^PSJORUT2(PSODFN,.INDX)
DO NVA^PSOORDRG
IF '$DATA(^TMP($JOB,"ORDERS"))
QUIT
+27 SET PSODSUDC=0
SET PSODSUII=""
+28 IF $GET(PSODSUAG)
Begin DoDot:1
+29 SET PSODSULP=""
FOR
SET PSODSULP=$ORDER(^TMP($JOB,"DD",PSODSULP))
if PSODSULP=""
QUIT
SET PSODSUDC=PSODSULP
+30 SET PSODSUBB=""
FOR
SET PSODSUBB=$ORDER(^TMP($JOB,PSODSULS,"IN","PROSPECTIVE",PSODSUBB))
if PSODSUBB=""
QUIT
IF $GET(PSODSUTY)=$PIECE(PSODSUBB,";",1,2)
SET PSODSUB4=$PIECE(PSODSUBB,";",4)
IF PSODSUB4>PSODSUCC
SET PSODSUCC=PSODSUB4
End DoDot:1
+31 FOR
SET PSODSUII=$ORDER(PSODSURG(PSODSUII))
if PSODSUII=""
QUIT
Begin DoDot:1
+32 SET PSODSUNN=$PIECE(PSODSURG(PSODSUII),"^")
SET PSODSOP2=$PIECE(PSODSURG(PSODSUII),"^",2)
SET PSODSUDM=""
+33 FOR
SET PSODSUDM=$ORDER(^TMP($JOB,"ORDERS",PSODSUDM))
if PSODSUDM=""
QUIT
IF PSODSUNN=$PIECE(^TMP($JOB,"ORDERS",PSODSUDM),"^",3)
Begin DoDot:2
+34 SET PSODSUDC=PSODSUDC+1
SET ^TMP($JOB,"DD",PSODSUDC,0)=PSODSUII_"^"_PSODSUNN_"^"_$PIECE(^TMP($JOB,"ORDERS",PSODSUDM),"^",4)_"^"_$PIECE(^TMP($JOB,"ORDERS",PSODSUDM),"^",5)
if '$DATA(PSODSUST(PSODSUII))
DO PNODE
End DoDot:2
End DoDot:1
+35 KILL ^TMP($JOB,"ORDERS")
+36 QUIT
+37 ;
PNODE ;Set prospective node for duplicate supply check for CPRS
+1 NEW PSOSPRID,PSOSPRQN,PSOSPRNF,PSOSPRN1,PSOSPRN2,PSOSPRXX
+2 SET PSOSPRNF=$SELECT($GET(^PSDRUG(PSODSUII,"ND"))]"":+^PSDRUG(PSODSUII,"ND")_"A"_$PIECE(^PSDRUG(PSODSUII,"ND"),"^",3),1:0)
+3 SET PSOSPRID=$$GETVUID^XTID(50.68,,+$PIECE($GET(PSOSPRNF),"A",2)_",")
+4 SET PSOSPRN1=$PIECE($GET(^PSDRUG(PSODSUII,"ND")),"^")
SET PSOSPRN2=$PIECE($GET(^PSDRUG(PSODSUII,"ND")),"^",3)
SET PSOSPRXX=$$PROD0^PSNAPIS(PSOSPRN1,PSOSPRN2)
SET PSOSPRQN=$PIECE(PSOSPRXX,"^",7)
+5 SET PSODSUCC=$GET(PSODSUCC)+1
SET ^TMP($JOB,PSODSULS,"IN","PROSPECTIVE",$PIECE(PSODSUTY,";")_";"_$PIECE(PSODSUTY,";",2)_";PROSPECTIVE;"_PSODSUCC)=PSOSPRQN_"^"_+PSOSPRID_"^"_PSODSUII_"^"_$GET(PSODSUNN)_$SELECT($GET(PSODSOP2):"^"_PSODSOP2,1:"")
+6 SET PSODSUST(PSODSUII)=""
+7 QUIT
