PSODDPR5.m

PSODDPR5 ;BIR/SAB - displays OP/rdi/pending/nva orders ;08/23/17  19:46

 ;;7.0;OUTPATIENT PHARMACY;**251,375,379,390,372,416,438,411,484,441**;DEC 1997;Build 208

 ;External reference to ^PSDRUG( supported by DBIA 4846

 ;External reference to ^PS(50.606 supported by DBIA 2174

 ;External reference to ^PS(50.7 supported by DBIA 2223

 ;External reference to ^PS(55 supported by DBIA 2228

 ;

EXC ;displays order check exceptions

 N Q,CT,ONT,OT,ON,TD,ERRTY,OP,OPP,ZEXC,ZREA,X,DIWL,DIWR,DIWF,PSOWROTE,ZX

 I ($Y+5)'>IOSL D HD^PSODDPR2() Q:$G(PSODLQT)  ;W @IOF

 S (CT,Q)=0,ONT=""

 F  S ONT=$O(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT)) Q:ONT=""  F  S CT=$O(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT)) Q:'CT  D

 .S ZEXC=^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT),ZREA=$P(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT),"^",10)

 .S OT=$P(ONT,";"),ON=$P(ONT,";",2),OP=$P(ONT,";",3),OPP=OT_";"_ON_";"_OP

 .I '$D(PSODGCK),'$D(PSSDGCK),OT="Z",ZREA="Drug not matched to NDF"!($P(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT),"^",7)["manual check") S PSODRUG("BAD",PSODRUG("IEN"))=1

 .Q:$G(^TMP($J,"PSEXC","OUT",OPP))

 .S Q=Q+1,ERRTY=$S(OT="R":"RDI",OT="N":"Non-VA",OT="P":"Pending",OT="O":"Rx",1:"")

 .K ^UTILITY($J,"W") S DIWL=1,DIWR=75,DIWF=""

 .W ! S X=$P(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT),"^",7) D ^DIWP

 .F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX  W !,^UTILITY($J,"W",1,ZX,0) S PSOWROTE=1

 .I $D(PSODGCK)!$D(PSSDGCK) K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." W ! D ^DIR K DIR W @IOF

 .S:OT'="Z" ^TMP($J,"PSEXC","OUT",OPP)=1,PSOWROTE=1

 .Q:ZREA=""

 .K ^UTILITY($J,"W") S DIWL=1,DIWR=75,DIWF=""

 .S X="   Reason(s): "_ZREA D ^DIWP

 .F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX  W !,^UTILITY($J,"W",1,ZX,0) S PSOWROTE=1

 .K ^UTILITY($J,"W"),X,DIWL,DIWR,DIWF

 .D:$O(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT)) HD^PSODDPR2() Q:$G(PSODLQT)

 W !! I $G(PSOWROTE) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR S:($D(DTOUT))!($D(DUOUT)) PSODLQT=1,PSORX("DFLG")=1 W ! K DIR,X,Y I ($Y+5)>IOSL W @IOF

 Q

NOCAN ;shows duplicate therapeutic when cancel duplicate class parameter is et to 'no'

 K ^UTILITY($J,"W"),DDTH,DOCPL S DIWL=1,DIWR=78,DIWF="",(CT,SUB)=0 K TCT,TCTP,TCTL,TCTI,ZZQ,ZHDR

 F  S CT=$O(^TMP($J,LIST,"OUT","THERAPY",CT)) Q:'CT  F  S SUB=$O(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB)) Q:'SUB  D

 .S ON=$P(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^"),PDRG=$P(^(SUB),"^",3),RXREC=$P(ON,";",2)

 .I $G(PSODCTH(ON)) Q

 .I $P(ON,";")="Z" Q

 .I $P(ON,";")="N",$G(^TMP($J,"PSONVADD",RXREC,0)) Q

 .I $P(ON,";")="R",$G(^TMP($J,"PSORMDD",RXREC,0)) Q

 .I $P(ON,";")="O",$G(^TMP("PSORXDC",$J,RXREC,0)) Q

 .I $P(ON,";")="P",$G(^TMP("PSORXDC",$J,RXREC,0)) Q

 .I $P(ON,";")="O",$G(^TMP("PSORXDD",$J,RXREC,0)) Q

 .I '$G(ZHDR) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)  W !,PSONULN,!,"*** THERAPEUTIC DUPLICATION(S) *** "_PSODRUG("NAME")_" with",! S ZHDR=1

 Q:'$G(ZHDR)  Q:$G(PSODLQT)

 N ST,STA,STAT,ORT K DOCPL

 S (SUB,CT)=0 F  S CT=$O(^TMP($J,LIST,"OUT","THERAPY",CT)) Q:'CT  F  S SUB=$O(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB)) Q:'SUB  D DUPCL K DDTH

 D DUPCP

 Q

DUPCL ;

 S ON=$P(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^"),PDRG=$P(^(SUB),"^",3),RXREC=$P(ON,";",2)

 I $P(ON,";")="Z" Q

 I $P(ON,";")="N",$G(^TMP($J,"PSONVADD",RXREC,0)) Q

 I $P(ON,";")="R",$G(^TMP($J,"PSORMDD",RXREC,0)) Q

 I $P(ON,";")="O",$G(^TMP("PSORXDC",$J,RXREC,0)) Q

 I $P(ON,";")="P",$G(^TMP("PSORXDC",$J,RXREC,0)) Q

 I $P(ON,";")="O",$G(^TMP("PSORXDD",$J,RXREC,0)) Q

 S ORT=$S($P(ON,";")="N":4,$P(ON,";")="P":3,$P(ON,";")="R":2,1:1)

 S DOCPL(ORT,ON)=""

 Q

DUPCP D HD^PSODDPR2():(($Y+5)'>IOSL) S ORT=0,ON=""  F  S ORT=$O(DOCPL(ORT)) Q:'ORT!$G(PSODLQT)  F  S ON=$O(DOCPL(ORT,ON)) Q:ON=""!$G(PSODLQT)  D

 .I $P(ON,";")="O" D

 ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)  S ST=$P(^PSRX($P(ON,";",2),"STA"),"^")+1

 ..S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^^EXPIRED^DISCONTINUED^^DISCONTINUED BY PROVIDER^DISCONTINUE EDIT^PROVIDER HOLD"

 ..S STAT=$P(STA,"^",ST) D   ;441 PAPI

 ...I ST=1,$G(^PSRX($P(ON,";",2),"PARK")) S STAT="PARKED"

 ...W !?2,"Local Rx #"_$P(^PSRX($P(ON,";",2),0),"^")_" ("_STAT_") for "_$P(^PSDRUG($P(^PSRX($P(ON,";",2),0),"^",6),0),"^")

 .I $P(ON,";")="P" D

 ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)

 ..N DNM,DUPRX0 S RXREC=$P(ON,";",2),DNM=$P(^PS(52.41,RXREC,0),"^",9)

 ..S DUPRX0=^PS(52.41,RXREC,0)

 ..W !?2,"Pending Order for "

 ..I '$P(DUPRX0,"^",9) W $P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")

 ..E  W $P(^PSDRUG($P(DUPRX0,"^",9),0),"^")

 .I $P(ON,";")="R" N RXDAT D

 ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)

 ..N RDIRX S RXDAT=^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2))

 ..S RDIRX=$P(RXDAT,"^",5) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)  W !?2,"Remote Rx #"_RDIRX_" ("_$P(RXDAT,"^",4)_") for "_$P(RXDAT,"^",3)

 .I $P(ON,";")="N" D

 ..Q:'$D(^PS(55,PSODFN,"NVA",$P(ON,";",2),0))

 ..S DUPRX0=^PS(55,PSODFN,"NVA",$P(ON,";",2),0) N NVAQ

 ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)

 ..W !?2,"Non-VA Med for "

 ..I '$P(DUPRX0,"^",2) W $P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")

 ..E  W $P(^PSDRUG($P(DUPRX0,"^",2),0),"^")

 .S DDTH(ON)=1

 D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)

 D CLASSES^PSODDPR3

 D HD^PSODDPR2(0,1) Q:$G(PSODLQT)

 Q

REMOTE ;backdoor RDI

 Q:$G(PSODLQT)

 N INDD,DO,P3,RDIDNAM,RDIVUID,RDITMP,PSORDI,SEQN,ZI

 S PSORDI=0 F  S PSORDI=$O(^TMP($J,LIST,"OUT","REMOTE",PSORDI)) Q:'PSORDI!$G(PSODLQT)  S RDITMP=^(PSORDI) D  K PSOSEQN

 .I $P(RDITMP,"^",2)="" Q

 .S RDIVUID=$P(RDITMP,"^",2),RDIDNAM=$P(RDITMP,"^",3)

 .I $O(PDRG(0)) F ZI=0:0 S ZI=$O(PDRG(ZI)) Q:'ZI  I $P(^PSDRUG($P(PDRG(ZI),"^"),0),"^")=RDIDNAM S INDD=+$G(INDD)+1,^TMP($J,"DD",INDD,0)=$P(PDRG(ZI),"^")_"^"_RDIDNAM_"^^"_PSORDI_"Z;O"

 .S DO=$G(DO)+1 D GETIREF^XTID(50.68,.01,RDIVUID,"PSOSEQN",1) I 'PSOSEQN S ^TMP($J,LIST,"IN","PROFILE","R;"_PSORDI_";PROFILE;"_DO)=0_"^"_RDIVUID_"^0^"_RDIDNAM_"^^" Q

 .S SEQN="" S SEQN=$O(PSOSEQN(50.68,.01,SEQN)) Q:SEQN=""

 .S P3=+SEQN,SEQN=$P($$PROD0^PSNAPIS(,P3),"^",7)

 .S ^TMP($J,LIST,"IN","PROFILE","R;"_PSORDI_";PROFILE;"_DO)=SEQN_"^"_RDIVUID_"^0^"_RDIDNAM_"^^"

 Q

NSRT ;sort of drug interactions ; called by psoddpr2

 ;Q:$G(PSODLQT)

 N SV,SEV,STOP,TYP,CNT,CHK,DRG,ON,CT,ZOT,PSOVAG,PSODD,COUNT,NSRT,NSRT2,II,ZZDGDG3 S COUNT=0,(SV,DRG,ON,CT,PSOVAG)=""

 F  S SV=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV)) Q:SV=""!$G(PSODLQT)  D  Q:$G(PSORX("DFLG"))

 .F  S DRG=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG)) Q:DRG=""!$G(PSODLQT)  F  S ON=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON)) Q:ON=""!$G(PSODLQT)  F  S CT=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT)) Q:'CT!$G(PSODLQT)  D

 ..I $P(ON,";")'="Z",$P(ON,";")="O",$P(^PSRX($P(ON,";",2),"STA"),"^")>5,$P(^PSRX($P(ON,";",2),"STA"),"^")'=16 Q

 ..I $P(ON,";")'="Z",$P(ON,";")="R" D RVAGEN Q

 ..I $P(ON,";")'="Z",$P(ON,";")="P",'$P($G(^PS(52.41,$P(ON,";",2),0)),"^",9) S PSORDIT=$P($G(^PS(52.41,$P(ON,";",2),0)),"^",8) D:$G(PSORDIT) DVAGEN ;Q  163815

 ..I $P(ON,";")'="Z",$P(ON,";")="N",'$P($G(^PS(55,PSODFN,"NVA",$P(ON,";",2),0)),"^",2) S PSORDIT=$P($G(^PS(55,PSODFN,"NVA",$P(ON,";",2),0)),"^") D:$G(PSORDIT) DVAGEN ;Q  ;*438

 ..S PSODD=$O(^PSDRUG("B",DRG,0)) D:PSODD'="" VAGEN^PSODDPR3(PSODD)

 ..S:PSOVAG="" PSOVAG=DRG

 ..S ZOT=$S($P(ON,";")["C":1,$P(ON,";")="O":2,$P(ON,";")="R":3,$P(ON,";")="P":4,1:5)

 ..S ZDGDG(SV,ZOT,PSOVAG,DRG)=ON_"^"_CT,ZZDGDG3(SV,PSOVAG,DRG)=""

 ..I ZOT=1 S PSOCLNS(SV,PSOVAG,DRG,ON)=CT

 ..I '$D(NSRT(SV,PSOVAG)) S NSRT(SV,PSOVAG)=ZOT

 ..E  S $P(NSRT(SV,PSOVAG),"^",1)=$P(NSRT(SV,PSOVAG),"^",1)_","_ZOT

 ;resort of zdgdg

 K ZZDGDG S (SEV,STOP,PSOVAG,TYP,ON)="",CNT=0

 F J=1:1:5 F  S SEV=$O(NSRT(SEV)) Q:SEV=""  F I=1:1:5 F  S PSOVAG=$O(NSRT(SEV,PSOVAG)) Q:PSOVAG=""  D

 .S TYP="",TYP=","_$P(NSRT(SEV,PSOVAG),"^",1)_","

 .Q:TYP'[(","_J_",")

 .S STOP=0 F CHK=1:1:5 I TYP[(","_CHK_",")&(CHK<J) S STOP=1

 .Q:STOP

 .S CNT=CNT+1 F II=J:1:5 S TYP=I I $D(ZDGDG(SEV,TYP)) D S2(SEV,TYP,PSOVAG,CNT)

 D DGSORT^PSODDPR2

 K NSRT,J,F,I,ZDGDG,COUNT,CNT

 Q

 ;print order sort

S2(SEV,TYP,PSOVAG,CNT) ;

 N PSONAM,COUNT2 S (PSONAM)="",COUNT2=0

 F  S PSONAM=$O(ZDGDG(SEV,TYP,PSOVAG,PSONAM)) Q:PSONAM=""  S COUNT2=COUNT2+1 D

 .S ZZDGDG(SEV,CNT,TYP,PSOVAG,PSONAM)=ZDGDG(SEV,TYP,PSOVAG,PSONAM)

 .S ZZDGCK(SEV,CNT,TYP,PSOVAG,PSONAM)=ZDGDG(SEV,TYP,PSOVAG,PSONAM)

 Q

 ;

NSRT1 ;sort out dc'd drug therapies local and remote rxs

 N RXN,SUB S (SUB,CT)=0 K PSODCTH

 F  S CT=$O(^TMP($J,LIST,"OUT","THERAPY",CT)) Q:'CT  F  S SUB=$O(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB)) Q:'SUB  D

 .S ON=$P(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^")

 .I $P(ON,";")="O",$P($G(^PSRX($P(ON,";",2),3)),"^",5) D  Q

 ..S RXN=$P(ON,";",2),X1=$P($G(^PSRX($P(ON,";",2),3)),"^",5),X2=(+$P(^PSRX($P(ON,";",2),0),"^",8)+7)

 ..D C^%DTC I X<DT S PSODCTH(ON)=1 K X,Y,X1,X2

 .I $P(ON,";")="R",$P($G(^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2))),"^",4)["DISC" D

 ..S RXN=$P(ON,";",2) K X,Y,X1,X2

 ..S X=$P(^TMP($J,LIST,"OUT","REMOTE",RXN),"^",6) D ^%DT S X1=Y,X2=(+$P(^TMP($J,LIST,"OUT","REMOTE",RXN),"^",7)+7)

 ..D C^%DTC I X<DT S PSODCTH(ON)=1 K X,Y,X1,X2

 Q

 ;

RVAGEN ;va generic for remote drugs

 D RVAGEN^PSODDPR4  ;*484 - ROUTINE TOO LARGE

 Q

 ;

DVAGEN ;va generic for non-va/pending meds

 S PSI=0 N PSID,PSODD,PSOVAG

 F  S PSI=$O(^PSDRUG("ASP",PSORDIT,PSI)) Q:'PSI!($G(PSID)'="")  I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["X":0,1:1) S PSID=$P($G(^PSDRUG(PSI,0)),"^")

 I PSI="" S PSI=0 F  S PSI=$O(^PSDRUG("ASP",PSORDIT,PSI)) Q:'PSI!($G(PSID)'="")  I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["O":0,1:1) S PSID=$P($G(^PSDRUG(PSI,0)),"^")

 I PSI="" S PSI=0 F  S PSI=$O(^PSDRUG("ASP",PSORDIT,PSI)) Q:'PSI!($G(PSID)'="")  I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["U":0,1:1) S PSID=$P($G(^PSDRUG(PSI,0)),"^")

 I PSI="" S PSI=0 F  S PSI=$O(^PSDRUG("ASP",PSORDIT,PSI)) Q:'PSI!($G(PSID)'="")  I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["I":0,1:1) S PSID=$P($G(^PSDRUG(PSI,0)),"^")

 I PSI="" S PSI=0 F  S PSI=$O(^PSDRUG("ASP",PSORDIT,PSI)) Q:'PSI!($G(PSID)'="")  I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S('$L($P($G(^PSDRUG(PSI,2)),"^",3)):0,1:1) S PSID=$P($G(^PSDRUG(PSI,0)),"^")

 I PSI="" S PSI=0 F  S PSI=$O(^PSDRUG("ASP",PSORDIT,PSI)) Q:'PSI!($G(PSID)'="")  I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($L($P($G(^PSDRUG(PSI,2)),"^",3)):0,1:1) S PSID=$P($G(^PSDRUG(PSI,0)),"^")

 Q:$G(PSID)']""

 S PSODD=$O(^PSDRUG("B",PSID,0)) D VAGEN^PSODDPR3(PSODD)

 Q:$G(PSOVAG)']""

 S ZOT=$S($P(ON,";")="O":1,$P(ON,";")="R":2,$P(ON,";")="P":3,1:4),ZDGDG(SV,ZOT,PSOVAG,DRG)=ON_"^"_CT,ZZDGDG3(SV,PSOVAG,DRG)="",COUNT=COUNT+1

 K PSI,PSID,PSORDIT,PSODD,PSOVAG

 Q

 ;

INT ;

 I $G(PSOVORD),$P(PSOINTV,"^")=1 D  Q

 .K DIR,DTOUT,DIRUT,DIROUT,DUOUT N DA

 .W ! S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Continue? ",DIR("B")="Y" D ^DIR S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 Q:$G(PSODLQT)

 .K DIR,DTOUT,DIRUT,DIROUT,DUOUT

 .I 'Y S PSODLQT=1,PSORX("DFLG")=1 Q

 .S DA=PSONV,RXREC=DA,RX=$G(^PSRX(RXREC,0)),PSORX("INTERVENE")=1

 .D:'$D(PSODGCK) CRI^PSODGDG1

 .I $G(OLDDA) S DA=OLDDA K OLDDA

 Q:$G(PSODLQT)!($G(PSORX("DFLG")))

 I '$D(PSODGCK),$P(PSOINTV,"^") S IT=$P(PSOINTV,"^"),ON=$P(PSOINTV,"^",2) D ^PSODGDGP K DIR S IT=$P(PSOINTV,"^")

 Q

 ;

DGCK ;CK - Drug check option at patient profile

 I '$D(PSOSD) D FULL^VALM1 D CKMSG G DGCKQ

 N PSODGCKX

 S (PSODGCK,PSONCROC)=1

 D FULL^VALM1

 D PSOCK^PSOUTL

 K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." W ! D ^DIR K DIR W @IOF,!

 D SELECT

 I $G(PSONEW("DFLG"))=1!'$D(PSOSD) W ! G DGCKQ

 D SET^PSODRG

DGCKNP D POST^PSODRG

DGCKQ S VALMBCK="R"

 K PSODGCK,PSODGCKX,MON,PSONEW("DFLG"),PSORX("DFLG"),PSOIENID,PSOGCNPT,PSOGCNID,PSONDFID,DGCKDUPF,PSONCROC

 Q

 ;

GCN(PSOIENID) ;Return 0 for not matched, 1 for matched with no GCNSEQNO, 1^1 for matched with a GCNSEQNO

 N PSONDFID,PSOGCNPT,PSOGCNID

 S PSONDFID=$P($G(^PSDRUG(PSOIENID,"ND")),"^"),PSOGCNPT=$P($G(^PSDRUG(PSOIENID,"ND")),"^",3)

 I 'PSONDFID!('PSOGCNPT) Q 0

 S PSOGCNID=$$PROD0^PSNAPIS(PSONDFID,PSOGCNPT)

 I $P(PSOGCNID,"^",7) Q PSOIENID_";"_PSONDFID_";"_$P(PSOGCNID,"^",7)

 Q PSOIENID_";"_PSONDFID

 ;

PKGFLG(PKF1) ;Return 0 for not in range of acceptable package flags, 1 for within range

 I $S(PKF1["O":1,1:0) Q 1

 I $S(PKF1["X":1,1:0) Q 1

 Q 0

 ;

SELECT ;

 N PSODGCKD S PSODGCKD=0 K:'$G(PSORXED) CLOZPAT

 K IT,DIC,X,Y,PSODRUG("TRADE NAME"),PSODRUG("NDC"),PSODRUG("DAW"),PSODRUG("BAD") S:$G(POERR)&($P($G(OR0),"^",9)) Y=$P(^PSDRUG($P(OR0,"^",9),0),"^")

 I $G(PSODRUG("IEN"))]"",'$D(PSODGCK) S Y=PSODRUG("NAME"),PSONEW("OLD VAL")=PSODRUG("IEN")

 W !,"DRUG: " R X:$S($D(DTIME):DTIME,1:300) I '$T S DTOUT=1

 I PSODGCK,X="",PSOSD<2 D CKMSG S PSONEW("DFLG")=1 G SELECTX

 S:X="" PSODGCKX=1

 I X="",$G(Y)]"" S:Y X=Y S:'X X=$G(PSODRUG("IEN")) S:X X="`"_X

 I X="",$D(PSOSD) S X=$O(PSOSD($O(PSOSD("")),"")),PSODGCKD=1

 I X="",'$D(PSOSD) D  Q

 .W !!,"Now Processing Enhanced Order Checks!  Please wait..." H 1

 .W !!,"No Order Check Warnings Found",! K DIR S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR

 I X?1."?" W !!,"Answer with DRUG NUMBER, or GENERIC NAME, or VA PRODUCT NAME, or",!,"NATIONAL DRUG CLASS, or SYNONYM" G SELECT

 I $G(PSORXED),X["^" S PSORXED("DFLG")=1 G SELECTX

 I X="^"!(X["^^")!($D(DTOUT)) S PSONEW("DFLG")=1 G SELECTX

 I '$G(POERR),X[U,$L(X)>1 S PSODIR("FLD")=PSONEW("FLD") D JUMP^PSODIR1 S:$G(PSODIR("FIELD")) PSONEW("FIELD")=PSODIR("FIELD") K PSODIR S PSODRG("QFLG")=1 G SELECTX

 S DIC=50,DIC(0)="MZV",D="B^C^VAPN^VAC"

 I 'PSODGCKD S DIC=50,DIC(0)="EMQZVT",DIC("T")="",D="B^C^VAPN^VAC"

 I 'PSODGCKD S DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),$$GCN^PSODDPR5(+Y),$$PKGFLG^PSODDPR5($P($G(^PSDRUG(+Y,2)),""^"",3)),$D(^PSDRUG(""ASP"",+$G(^(2)),+Y))"

 D MIX^DIC1 K DIC,PKF1,D

 I $$PSOSUPCK^PSOUTL(+Y) G SELECT

 S (DGCKSTA,DGCKDNM)=""

 I '$G(PSODGCKX),$D(PSOSD) F  S DGCKSTA=$O(PSOSD(DGCKSTA)) Q:DGCKSTA=""!$G(DGCKDUPF)  F  S DGCKDNM=$O(PSOSD(DGCKSTA,DGCKDNM)) Q:DGCKDNM=""!$G(DGCKDUPF)  D

 .I DGCKDNM=$G(Y(0,0)) D

 ..S DGCKDUPF=1 W !!,"Duplicate Drug in Patient profile, please select a different drug:",!

 ..K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF

 I $D(DGCKDUPF) K DGCKDUPF,PSODGCKX G SELECT

 I '$D(PSOSD) D  Q

 .W !!,"Now Processing Enhanced Order Checks!  Please wait..." H 1

 .W !!,"No Order Check Warnings Found",! K DIR S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR

 I $D(DTOUT) S PSONEW("DFLG")=1 G SELECTX

 I $D(DUOUT) K DUOUT G SELECT

 I Y<0 G SELECT

 S:$G(PSONEW("OLD VAL"))=+Y&('$G(PSOEDIT)) PSODRG("QFLG")=1

 K PSOY S PSOY=Y,PSOY(0)=Y(0)

 I $P(PSOY(0),"^")="OTHER DRUG"!($P(PSOY(0),"^")="OUTSIDE DRUG") D TRADE^PSODRG

SELECTX K X,Y,DTOUT,DUOUT,PSONEW("OLD VAL"),PSODGCKD,DGCKDNM,DGCKSTA

 Q

 ;

CKMSG ;

 W !!,"Not enough active profile drugs to perform drug check",! K DIR S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSODDPR5   15333     printed  Mar 13, 2025@21:31:21                                                                                                                                                                                                   Page 2

PSODDPR5  ;BIR/SAB - displays OP/rdi/pending/nva orders ;08/23/17  19:46

 +1       ;;7.0;OUTPATIENT PHARMACY;**251,375,379,390,372,416,438,411,484,441**;DEC 1997;Build 208

 +2       ;External reference to ^PSDRUG( supported by DBIA 4846

 +3       ;External reference to ^PS(50.606 supported by DBIA 2174

 +4       ;External reference to ^PS(50.7 supported by DBIA 2223

 +5       ;External reference to ^PS(55 supported by DBIA 2228

 +6       ;

EXC       ;displays order check exceptions

 +1        NEW Q,CT,ONT,OT,ON,TD,ERRTY,OP,OPP,ZEXC,ZREA,X,DIWL,DIWR,DIWF,PSOWROTE,ZX

 +2       ;W @IOF

           IF ($Y+5)'>IOSL

               DO HD^PSODDPR2()

               if $GET(PSODLQT)

                   QUIT 

 +3        SET (CT,Q)=0

           SET ONT=""

 +4        FOR 

               SET ONT=$ORDER(^TMP($JOB,LIST,"OUT","EXCEPTIONS",ONT))

               if ONT=""

                   QUIT 

               FOR 

                   SET CT=$ORDER(^TMP($JOB,LIST,"OUT","EXCEPTIONS",ONT,CT))

                   if 'CT

                       QUIT 

                   Begin DoDot:1

 +5                    SET ZEXC=^TMP($JOB,LIST,"OUT","EXCEPTIONS",ONT,CT)

                       SET ZREA=$PIECE(^TMP($JOB,LIST,"OUT","EXCEPTIONS",ONT,CT),"^",10)

 +6                    SET OT=$PIECE(ONT,";")

                       SET ON=$PIECE(ONT,";",2)

                       SET OP=$PIECE(ONT,";",3)

                       SET OPP=OT_";"_ON_";"_OP

 +7                    IF '$DATA(PSODGCK)

                           IF '$DATA(PSSDGCK)

                               IF OT="Z"

                                   IF ZREA="Drug not matched to NDF"!($PIECE(^TMP($JOB,LIST,"OUT","EXCEPTIONS",ONT,CT),"^",7)["manual check")

                                       SET PSODRUG("BAD",PSODRUG("IEN"))=1

 +8                    if $GET(^TMP($JOB,"PSEXC","OUT",OPP))

                           QUIT 

 +9                    SET Q=Q+1

                       SET ERRTY=$SELECT(OT="R":"RDI",OT="N":"Non-VA",OT="P":"Pending",OT="O":"Rx",1:"")

 +10                   KILL ^UTILITY($JOB,"W")

                       SET DIWL=1

                       SET DIWR=75

                       SET DIWF=""

 +11                   WRITE !

                       SET X=$PIECE(^TMP($JOB,LIST,"OUT","EXCEPTIONS",ONT,CT),"^",7)

                       DO ^DIWP

 +12                   FOR ZX=0:0

                           SET ZX=$ORDER(^UTILITY($JOB,"W",1,ZX))

                           if 'ZX

                               QUIT 

                           WRITE !,^UTILITY($JOB,"W",1,ZX,0)

                           SET PSOWROTE=1

 +13                   IF $DATA(PSODGCK)!$DATA(PSSDGCK)

                           KILL DIR

                           SET DIR(0)="E"

                           SET DIR("A")="Press Return to Continue..."

                           WRITE !

                           DO ^DIR

                           KILL DIR

                           WRITE @IOF

 +14                   if OT'="Z"

                           SET ^TMP($JOB,"PSEXC","OUT",OPP)=1

                           SET PSOWROTE=1

 +15                   if ZREA=""

                           QUIT 

 +16                   KILL ^UTILITY($JOB,"W")

                       SET DIWL=1

                       SET DIWR=75

                       SET DIWF=""

 +17                   SET X="   Reason(s): "_ZREA

                       DO ^DIWP

 +18                   FOR ZX=0:0

                           SET ZX=$ORDER(^UTILITY($JOB,"W",1,ZX))

                           if 'ZX

                               QUIT 

                           WRITE !,^UTILITY($JOB,"W",1,ZX,0)

                           SET PSOWROTE=1

 +19                   KILL ^UTILITY($JOB,"W"),X,DIWL,DIWR,DIWF

 +20                   if $ORDER(^TMP($JOB,LIST,"OUT","EXCEPTIONS",ONT,CT))

                           DO HD^PSODDPR2()

                       if $GET(PSODLQT)

                           QUIT 

                   End DoDot:1

 +21       WRITE !!

           IF $GET(PSOWROTE)

               KILL DIR

               SET DIR(0)="E"

               SET DIR("?")="Press Return to continue"

               SET DIR("A")="Press Return to Continue"

               DO ^DIR

               if ($DATA(DTOUT))!($DATA(DUOUT))

                   SET PSODLQT=1

                   SET PSORX("DFLG")=1

               WRITE !

               KILL DIR,X,Y

               IF ($Y+5)>IOSL

                   WRITE @IOF

 +22       QUIT 

NOCAN     ;shows duplicate therapeutic when cancel duplicate class parameter is et to 'no'

 +1        KILL ^UTILITY($JOB,"W"),DDTH,DOCPL

           SET DIWL=1

           SET DIWR=78

           SET DIWF=""

           SET (CT,SUB)=0

           KILL TCT,TCTP,TCTL,TCTI,ZZQ,ZHDR

 +2        FOR 

               SET CT=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",CT))

               if 'CT

                   QUIT 

               FOR 

                   SET SUB=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",CT,"DRUGS",SUB))

                   if 'SUB

                       QUIT