- 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 Jan 18, 2025@03:27:39 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