- PSOVER1 ;BHAM ISC/SAB - verify one rx ;3/9/05 12:53pm
- ;;7.0;OUTPATIENT PHARMACY;**32,46,90,131,202,207,148,243,268,281,324,358,251,375,387,379,390,372,416,411,422,402,500,562,747**;DEC 1997;Build 7
- ; Reference to ^PSDRUG( in ICR #221
- ; Reference to PSOUL^PSSLOCK in ICR #2789
- ; Reference to ^PS(55 in ICR #2228
- ; Reference to DOSE^PSSORPH is in ICR #3234
- ; Reference to ^ORRDI1 in ICR #4659
- ; Reference to ^XTMP("ORRDI" in ICR #4660
- ; Reference to $$DS^PSSDSAPI in ICR #5425
- ; Reference to $$GETNDC^PSSNDCUT in ICR #4707
- ; Reference to ^DPT( in ICR #3097
- ; Reference to ^PS(50.606 in ICR #2174
- ; Reference to ^PS(50.7 in ICR #2223
- ; Reference to ^PS(56 in ICR #2229
- REDO ;
- I '$G(PSOCLK) Q:$G(PSVERFLG)
- S (DRG,PSODRUG("NAME"))=$P(^PSDRUG(+$P(^PSRX(PSONV,0),"^",6),0),"^"),PSODRUG("VA CLASS")=$P(^(0),"^",2)
- S PSOVQUIT=0,PSODRUG("IEN")=$P(^PSRX(PSONV,0),"^",6)
- S PSOY(0)=^PSDRUG(PSODRUG("IEN"),0),PSOY=PSODRUG("IEN")_"^"_$P(PSOY(0),"^")
- D SET^PSODRG
- I '$D(PSODFN) S PSODFN=$P(^PSRX(PSONV,0),"^",2)
- ;
- EDIT ;
- N PSDNEW,PSDOLD
- S (PSDNEW,PSDOLD)="",PSDOLD=$P(^PSDRUG($P(^PSRX(PSONV,0),"^",6),0),"^")_"^"_PSONV
- S DA=PSONV D ^PSORXPR
- I $G(PSORX("DFLG")) G OUT ;*422
- I $G(PKI1)=2 D DCV1^PSOPKIV1 G OUT
- K PSDTSTOP S DIR("A")="EDIT",DIR("B")="N",DIR(0)="SB^Y:YES;N:NO;P:PROFILE",DIR("?")="Enter Y to change this RX, P to see a profile, or N to proceed with verification and order checks."
- D ^DIR K DIR W ! I $G(DIRUT)!($G(DTOUT)) S PSOVBCK=1 G OUT
- ;PSOPOCK=1 called from Process Order Check option; PSOCLK=1 means initiated from Rx verify by clerk.
- I Y="Y",($G(PSOCLK)!($G(PSOPOCK))) D FULLEDT S VALMBCK="R" G KILL:$$CHECK(PSONV) G EDIT
- I Y="Y",$G(PSOACT)]"" S VALMBCK="R",PSVERFLG=1 G OUT ;this pops the user back to the med profile screen when verify is called from Patient Prescription Processing
- I $D(DIRUT),$G(PSOCLK) S PSOCQ=1 G OUT
- I $D(DIRUT),$G(PSOACT)]"" S VALMBCK="R" G OUT
- G ORDCHK:Y="N",PROF:Y="P",OUT:"YNP"'[$E(Y)
- ;
- D EXPIRE K DIE,DR,DEA1,DEA2,P(5),PSRX1,PSRX2
- K PSD(PSDOLD) S PSDNEW="",PSDNEW=$P(^PSDRUG($P(^PSRX(PSONV,0),"^",6),0),"^")_"^"_PSONV,PSD(PSDNEW)=PSONV_"^*^1^"_$P(^PSDRUG($P(^PSRX(PSONV,0),"^",6),0),"^",2)
- ;
- S DA=$S($D(PSORXED("IRXN")):PSORXED("IRXN"),1:PSONV) D ^PSORXPR G OUT:$G(DIRUT)
- G OUT:$D(DIRUT)!($D(DTOUT))
- I '$G(PSOCLK) S DA=$S($D(PSORXED("IRXN")):PSORXED("IRXN"),1:PSONV) W !,"CHANGE",! D ^PSORXPR G OUT:$D(DIRUT)!($D(DTOUT)) G EDIT
- G EDIT:PSDNEW=PSDOLD,REDO
- PROF I '$D(PSOSD) W !,$C(7),"This patient has no other prescriptions on file",!! G EDIT Q
- W !!,$P(^DPT(DFN,0),"^"),?40,"ID#:"_VA("PID") W:$D(INT)!$D(PSONV) " RX#: "_$S($D(INT):$P(INT,"^"),$D(^PSRX(PSONV)):$P(^PSRX(PSONV,0),"^"),1:"")
- D HD^PSODDPR2() D ^PSODSPL D SHOW2^PSOVER G EDIT Q
- ;
- EXPIRE S RX0=^PSRX(DA,0),X1=$P($P(RX0,"^",13),"."),X2=$P(RX0,"^",9)+1*$P(RX0,"^",8),X2=$S($P(RX0,"^",8)=X2:X2,X2<181:184,X2=360:366,1:X2),X=X1 D:X1&X2 C^%DTC
- K ^PS(55,PSDFN,"P","A",+$P(^PSRX(DA,2),"^",6),DA) S ^PS(55,PSDFN,"P","A",X,DA)="",$P(^PSRX(DA,2),"^",6)=X,$P(^PS(52.4,DA,0),"^",7)=X K X1,X2 Q
- ;
- ORDCHK ;
- S PSOVER1=1
- S RX0=^PSRX(PSONV,0)
- D ORDCK
- I $G(PSOQUIT) S:$G(PSOCLK) PSOQUIT=0 S:'$G(PSOCLK) PSORX("DFLG")=1 ;if verify by clerk continue on with the next Rx; if not exit
- I $G(PSOVQUIT)!$G(PSORX("DFLG")) G OUT
- ;------
- VERIFY ;
- D FULL^VALM1 G:'$P(PSOPAR,"^",2) VERY
- W !,$P(^DPT(DFN,0),"^"),?40,"ID#:"_VA("PID") W:$D(INT)!$D(PSONV) " RX#: "_$S($D(INT):$P(INT,"^"),$D(^PSRX(PSONV)):$P(^PSRX(PSONV,0),"^"),1:"") W:$D(PSODRUG("NAME")) !,PSODRUG("NAME"),!
- I $G(PSONAM)="" S PSONAM=$P(^DPT(PSDFN,0),"^")
- S DIR("A")="VERIFY FOR "_PSONAM_"? (Y/N/Delete/Quit): ",DIR("B")="Y",DIR(0)="SA^Y:YES;N:NO;D:DELETE;Q:QUIT"
- S DIR("?",1)="Enter Y (or return) to verify this prescription",DIR("?",2)="N to leave this prescription non-verified and to end this session of verification",DIR("?")="D to delete this prescription"
- D ^DIR K DIR
- I Y="N"!("Q^"[$E(Y)) D G OUT
- .S (PSVERFLG,PSOVBCK)=1,PSORX("DFLG")=1
- .S:$D(PSOOVNOD) ^PS(52.4,PSONV,0)=PSOOVNOD S:$G(PSOOVSTA) $P(^PSRX(PSONV,"STA"),"^")=PSOOVSTA
- .S:PSOOVSTA=4 ^PS(52.4,"ADI",PSONV,1)=""
- G DELETE:Y="D"
- VERY I $G(PKI1)=1 D REA^PSOPKIV1 G:'$D(PKIR) VERIFY
- K ^PSRX(PSONV,"DAI") S $P(^PSRX(PSONV,3),"^",6)=""
- K ^PSRX(PSONV,"DRI"),SPFL1
- I '$O(^PSRX(PSONV,6,0)) D I $D(DUOUT)!($D(DTOUT)) W !!,"Rx: "_$P(^PSRX(DA,0),"^")_" not Verified!!",! H 2 G OUT
- .W !!,"Dosing Instructions Missing. Please add!",!
- .I $P($G(^PSRX(PSONV,"SIG")),"^")]"",'$P($G(^("SIG")),"^",2) W "SIG: "_$P(^PSRX(PSONV,"SIG"),"^"),!
- .I $P($G(^PSRX(PSONV,"SIG")),"^",2),$O(^PSRX(PSONV,"SIG1",0)) D K I
- ..W "SIG: " F I=0:0 S I=$O(^PSRX(PSONV,"SIG1",I)) Q:'I W ^PSRX(PSONV,"SIG1",I,0),!
- .S DA=PSONV,PSOVER=1 K DIR,DIRUT,DUOUT,DTOUT
- .S PSODRUG("IEN")=$P(^PSRX(DA,0),"^",6),PSODFN=$P(^(0),"^",2),PSORXED("IRXN")=DA,PSODRUG("OI")=$P(^PSRX(DA,"OR1"),"^")
- .D DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN),^PSOORED3
- .K PSODFN,PSODRUG("IEN"),DOSE,PSOVER
- .I '$G(ENT) S DUOUT=1
- .Q:$D(DUOUT)!($D(DTOUT))
- .K DIR,DIRUT,DUOUT,DTOUT S DIE=52,DR=114 D ^DIE K DIE,DR,DTOUT
- .I X'="" D SIG^PSOHELP D:$G(INS1)]"" EN^DDIOL($E(INS1,2,9999999)) S PSORXED("SIG",1)=$E(INS1,2,9999999)
- .D EN^PSOFSIG(.PSORXED,1),UDSIG^PSOORED3 H 2
- S DA=PSONV,$P(^PSRX(DA,2),"^",10)=DUZ,DRG=$P(^PSDRUG($P(^PSRX(DA,0),"^",6),0),"^")
- I $P(^PSRX(DA,2),"^",2)>DT,$P(PSOPAR,"^",6) D G KILL
- .S (SPFL1,PSOVER)="",PSORX("FILL DATE")=$P(^PSRX(DA,2),"^",2),RXF=0
- .D UPSUS S PSTRIVER=1 D SUS^PSORXL
- .K PSORX("FILL DATE"),PSTRIVER
- .I $D(^TMP("PSODAOC",$J)) D ^PSONEWOC K ^TMP("PSODAOC",$J)
- S PSOVER(PSONV)="" S $P(^PSRX(PSONV,"STA"),"^")=0,DRG=$P(^PSDRUG($P(^PSRX(DA,0),"^",6),0),"^")
- S $P(PSOSD("NON-VERIFIED",DRG),"^",2)=0,PSOSD("ACTIVE",DRG)=PSOSD("NON-VERIFIED",DRG)
- I $D(^TMP("PSODAOC",$J)) D ^PSONEWOC K ^TMP("PSODAOC",$J)
- I $G(PKI1)=1,$G(PKIR)]"" D ACT^PSOPKIV1(DA)
- K PSOSD("NON-VERIFIED",DRG) D EN^PSOHLSN1(PSONV,"SC","CM","") ;S VALMBCK=""
- ;saves drug allergy order chks pso*7*390
- I +$G(^TMP("PSODAOC",$J,1,0)) D
- .I $G(PSORX("DFLG")) K ^TMP("PSODAOC",$J) Q
- .N RXN,PSODAOC S RXN=PSONV,PSODAOC="Rx Backdoor VERIFIED NEW Order Acceptance_OP"
- .D DAOC^PSONEW
- .K ^TMP("PSODAOC",$J),RET
- ;
- ; - Calling ECME for claims generation and transmission / REJECT handling
- N ACTION
- I $$SUBMIT^PSOBPSUT(PSONV) D I ACTION="Q"!(ACTION="^") Q
- . S ACTION="" D ECMESND^PSOBPSU1(PSONV,,,$S($O(^PSRX(PSONV,1,0)):"RF",1:"OF"))
- . ; Quit if there is an unresolved Tricare non-billable reject code, PSO*7*358
- . I $$PSOET^PSOREJP3(PSONV) S ACTION="Q" Q
- . I $$FIND^PSOREJUT(PSONV) D
- . . S ACTION=$$HDLG^PSOREJU1(PSONV,0,"79,88,943","OF","IOQ","Q")
- ;
- KILL S DA=PSONV,DIK="^PS(52.4," D ^DIK K DA,DIK D DCORD^PSONEW2
- OUT ;
- K PSOVER1
- I '$G(PSOCLK) S:$G(DIRUT)!($G(DTOUT)) PSORX("DFLG")=1 K DIRUT,DTOUT,DUOUT,UPFLAGX D CLEAN S VALMBCK="Q" Q
- I $G(PSOCLK) S PSORX("DFLG")=0 K UPFLAGX D CLEAN Q
- DELETE K UPFLAGX D DELETE^PSOVER2 G:$G(UPFLAGX) OUT K PSOSD("NON-VERIFIED",$G(DRG)) Q
- QUIT S PSOQUIT="" D CLEAN K PSOVER1 Q
- UPSUS S $P(PSOSD("NON-VERIFIED",DRG),"^",2)=5,PSOSD("ACTIVE",DRG)=PSOSD("NON-VERIFIED",DRG) K PSOSD("NON-VERIFIED",DRG) D EN^PSOHLSN1(PSONV,"SC","CM","")
- Q
- CLEAN ;cleans up tmp("psorxdc") global
- I $G(PSODOSEX) K PSODOSEX Q
- N PSOWRITE
- I $O(^TMP("PSORXDC",$J,0)) F RORD=0:0 S RORD=$O(^TMP("PSORXDC",$J,RORD)) Q:'RORD D
- .D PSOUL^PSSLOCK(RORD_$S($P(^TMP("PSORXDC",$J,RORD,0),"^")="P":"S",1:""))
- .I $P(^TMP("PSORXDC",$J,RORD,0),"^")="P" D Q
- ..S PSOR=^PS(52.41,RORD,0)
- ..S DNM=$S($P(PSOR,"^",9):$P($G(^PSDRUG($P(PSOR,"^",9),0)),"^"),1:$P(^PS(50.7,$P(PSOR,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(PSOR,"^",8),0),"^",2),0),"^"))
- ..W $C(7),!," Duplicate "_$S($P(^TMP("PSORXDC",$J,RORD,0),"^",10):"Therapy",1:"Drug")_" Pending Order "_DNM_" NOT Discontinued." S PSOWRITE=1
- .W !," Duplicate "_$S($P(^TMP("PSORXDC",$J,RORD,0),"^",10):"Therapy",1:"Drug")_" Rx #"_$P(^PSRX(RORD,0),"^")_" "_$P(^TMP("PSORXDC",$J,RORD,0),"^",7)_" NOT Discontinued." S PSOWRITE=1
- I $G(PSOWRITE)&('$G(PSOWRIT)) W ! 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 K DIR,X,Y I ($Y+5)>IOSL W @IOF
- K ^TMP("PSORXDC",$J),RORD,PRNXZ,ORNZZ,PSOR
- Q
- KV1 ;
- K PSOANSQD,DRET,LST,PSOQUIT,PSODRUG,PSONEW,SIG,PSODIR,PHI,PRC,ORCHK,ORDRG,PSOSIGFL,PSORX("ISSUE DATE"),PSORX("FILL DATE"),CLOZPAT
- KV K DIR,DIRUT,DTOUT,DUOUT
- Q
- NVA ;
- I $P(PSOSD(STA,DNM),"^",11) D NVA^PSODRDU1 Q
- N PSOOI,CLASS,FLG,X,Y,RXREC,IFN
- S (Y,FLG)=""
- S RXREC=$P(PSOSD(STA,DNM),"^",10),PSOOI=+$G(^PS(55,DFN,"NVA",RXREC,0)),IFN=RXREC N DNM
- F S Y=$O(^PSDRUG("ASP",PSOOI,Y)) Q:Y=""!(FLG) S DNM=$P(^PSDRUG(Y,0),"^"),CLASS=$P(^PSDRUG(Y,0),"^",2) I PSODRUG("NAME")=DNM!(CLASS=PSODRUG("VA CLASS")) D DSP^PSODRDU1 S FLG=1 Q
- Q
- REMOTE ;
- K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),^TMP($J,"DI"_PSODFN) D
- .I $T(HAVEHDR^ORRDI1)']"" Q
- .I '$$HAVEHDR^ORRDI1 Q
- .D HD^PSODDPR2():(($Y+5)'>IOSL)
- .I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D Q
- ..I $T(REMOTE^PSORX1)]"" Q
- ..W !!,"Remote data not available - Only local order checks processed.",! D HD^PSODDPR2():(($Y+5)>IOSL)
- .W !!,"Now doing remote order checks. Please wait..."
- .D REMOTE^PSOORRDI(PSODFN,+$P($G(^PSRX(PSONV,0)),"^",6))
- .I $P($G(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0 W !!,"Remote data not available - Only local order checks processed.",! D HD^PSODDPR2():(($Y+5)>IOSL) ;D PAUSE^PSOORRD2 Q
- .I $D(^TMP($J,"DD")) D DUP^PSOORRD2
- .I $D(^TMP($J,"DC")) D CLS^PSOORRD2
- .I $D(^TMP($J,"DI"_PSODFN)) K ^TMP($J,"DI") M ^TMP($J,"DI")=^TMP($J,"DI"_PSODFN) D DRGINT^PSOORRD2
- K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),^TMP($J,"DI"_PSODFN)
- Q
- NOALRGY ;
- N PSODFN,PSODRUG
- S PSODFN=$P(^PSRX(PSONV,0),"^",2),PSODRUG("IEN")=$P(^PSRX(PSONV,0),"^",6)
- D NOALRGY^PSODRG
- Q
- ;
- ORDCK ;
- N ORN,ORNZZ,PSOLST,Y,PSOODFN S ORN=PSONV,PSOLST(PSONV)=PSONV_"^"_PSONV,PSOVORD=1
- N DRG,ON,CT,DRGI,PDRG,SEV,STX,INT,CLI,PSONULN,PSONULN1,LST,LSI,DGI,SER,SERS,DUPT,SV
- S ORNZZ=ORN,PRNXZ(ORN)=PSOLST(ORN),PSORENW("OIRXN")=PSONV,PSOODFN=DFN
- I '$D(PSODFN) S PSODFN=$P(^PSRX(PSONV,0),"^",2)
- D SHOW^PSOVER D HD^PSODDPR2():(($Y+5)>IOSL)
- S (PSODRUG("IEN"),PSDRUG("IEN"))=$P(^PSRX(PSONV,0),"^",6)
- N PSOVINF S PSOVINF=^PSDRUG(PSDRUG("IEN"),0),PSODRUG("VA CLASS")=$P(^(0),"^",2)
- S PSODRUG("VA CLASS")=$P(PSOVINF,"^",2),(DRG,PSODRUG("NAME"))=$P(^PSDRUG(PSDRUG("IEN"),0),"^")
- S PSODRUG("NDF")=$S($G(^PSDRUG(PSDRUG("IEN"),"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
- S PSODRUG("MAXDOSE")=$P(PSOVINF,"^",4),PSODRUG("DEA")=$P(PSOVINF,"^",3),PSODRUG("CLN")=$S($D(^PSDRUG(PSDRUG("IEN"),"ND")):+$P(^("ND"),"^",6),1:0)
- S PSODRUG("SIG")=$P(PSOVINF,"^",5),PSODRUG("NDC")=$$GETNDC^PSSNDCUT(PSDRUG("IEN"),$G(PSOSITE)),PSODRUG("STKLVL")=$G(^PSDRUG(PSDRUG("IEN"),660.1))
- S PSODRUG("DAW")=$$GET1^DIQ(50,PSONV,81)
- I PSODRUG("DAW")="" S PSODRUG("DAW")=0
- K PSOVINF
- D POST^PSODRG S DFN=PSOODFN
- I $$GET1^DIQ(52,PSONV,100,"I")=13 S PSORX("DFLG")=1 Q
- I $G(PSVERFLG),$G(PSOCLK) S PSVERFLG=0
- I $G(PSOCLK),$G(PSORX("DFLG")) S PSOVQUIT=1 K PSORX("DFLG"),DIRUT,DTOUT Q
- Q:PSORX("DFLG")
- D:'$G(PSORX("DFLG")) DOSCK^PSODOSUT("V")
- I $$GET1^DIQ(52,PSONV,100,"I")=13 S PSORX("DFLG")=1 Q
- I $G(PSOCLK),$G(PSORX("DFLG")) S PSOVQUIT=1 K PSORX("DFLG"),DIRUT,DTOUT Q
- Q:PSORX("DFLG")!($G(PSOQUIT))
- S PSOLST(ORNZZ)=PRNXZ(ORNZZ),ORN=ORNZZ K PSORENW("OIRXN")
- Q
- ;
- FULLEDT ;
- D FULL^VALM1
- N RX,FILL,OPSOLST,OPSLST,OLDDA,PSODRUG,REJ
- S (RX,PSORXED("IRXN"))=PSONV
- M OPSOLST=PSOLST,OPSLST=PSLST,ODA=DA
- N PSOSITE,ORN,PSOPAR,PSOLIST,PSOSD
- S PSOSITE=$$RXSITE^PSOBPSUT(RX,""),ORN=RX
- S PSOPAR=$G(^PS(59,PSOSITE,1)),PSOLIST(1)=ORN_","
- D EPH^PSORXEDT
- M PSOLST=OPSOLST,PSLST=OPSLST S VALMBCK="R" S:$D(OLDDA) DA=OLDDA
- Q
- ;
- DRIDOSE(DA,RX0) ;where DA is RXIEN and RX0 is zero node of file 52 for the RXIEN
- N T,RXN,RXX,SCRIPT,SEV,X,SER,PSOSERV,PSOSCPT,PSODOSF,RX
- S RX=RX0
- S RXN=$P(RX0,"^")
- I $D(^PS(52.4,RX,0))!($D(^PSRX(RX,"DRI"))) D
- . Q:'$P($G(^PS(52.4,RX,0)),"^",8)&('$D(^PSRX(RX,"DRI")))
- .W !!,"*** During order, there were DRUG-DRUG INTERACTION for the following RX(s):"
- I $P($G(^PS(52.4,RX,0)),"^",8) S SCRIPT=$P(^PS(52.4,RX,0),"^",10),SEV=$P(^PS(52.4,RX,0),"^",9) F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D
- . S SER=$P(^PS(56,SEV(X),0),"^",4) S:$G(SER)=1 PSOSERV=1
- . S PSOSCPT(RXX(X))=" "_$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^")
- I $D(^PSRX(RX,"DRI")) S SCRIPT=$P(^PSRX(RX,"DRI"),"^",2),SEV=$P(^PSRX(RX,"DRI"),"^") F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D
- .S SER=$P(^PS(56,SEV(X),0),"^",4)
- .S PSOSCPT(RXX(X))=" "_$P($G(^PSRX(RXX(X),0)),"^")_" "_$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^")
- S SCRIPT="" F S SCRIPT=$O(PSOSCPT(SCRIPT)) Q:SCRIPT="" W !,PSOSCPT(SCRIPT)
- I $$DS^PSSDSAPI,$D(^PS(52.4,RX,1)) S T=$P(^PS(52.4,RX,1),"^") D W:PSODOSF'="" !,"*** Dose Warning: ",PSODOSF
- . S PSODOSF="",PSODOSF=$S(T=4:"DOSAGE EXCEEDS MAX SINGLE DOSE AND/OR MAX DAILY DOSE",T=3:"MAX SINGLE DOSE & DAILY DOSE RANGE",T=2:"MAX SINGLE DOSE",T=1:"DAILY DOSE RANGE",1:"")
- W !
- Q
- CHECK(PSONV) ;
- N PSOSTAT S PSOSTAT=$$GET1^DIQ(52,PSONV,100,"I")
- I ",11,12,13,14,15,"[(","_PSOSTAT_",") Q 1
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOVER1 13404 printed Jan 18, 2025@03:37:28 Page 2
- PSOVER1 ;BHAM ISC/SAB - verify one rx ;3/9/05 12:53pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**32,46,90,131,202,207,148,243,268,281,324,358,251,375,387,379,390,372,416,411,422,402,500,562,747**;DEC 1997;Build 7
- +2 ; Reference to ^PSDRUG( in ICR #221
- +3 ; Reference to PSOUL^PSSLOCK in ICR #2789
- +4 ; Reference to ^PS(55 in ICR #2228
- +5 ; Reference to DOSE^PSSORPH is in ICR #3234
- +6 ; Reference to ^ORRDI1 in ICR #4659
- +7 ; Reference to ^XTMP("ORRDI" in ICR #4660
- +8 ; Reference to $$DS^PSSDSAPI in ICR #5425
- +9 ; Reference to $$GETNDC^PSSNDCUT in ICR #4707
- +10 ; Reference to ^DPT( in ICR #3097
- +11 ; Reference to ^PS(50.606 in ICR #2174
- +12 ; Reference to ^PS(50.7 in ICR #2223
- +13 ; Reference to ^PS(56 in ICR #2229
- REDO ;
- +1 IF '$GET(PSOCLK)
- if $GET(PSVERFLG)
- QUIT
- +2 SET (DRG,PSODRUG("NAME"))=$PIECE(^PSDRUG(+$PIECE(^PSRX(PSONV,0),"^",6),0),"^")
- SET PSODRUG("VA CLASS")=$PIECE(^(0),"^",2)
- +3 SET PSOVQUIT=0
- SET PSODRUG("IEN")=$PIECE(^PSRX(PSONV,0),"^",6)
- +4 SET PSOY(0)=^PSDRUG(PSODRUG("IEN"),0)
- SET PSOY=PSODRUG("IEN")_"^"_$PIECE(PSOY(0),"^")
- +5 DO SET^PSODRG
- +6 IF '$DATA(PSODFN)
- SET PSODFN=$PIECE(^PSRX(PSONV,0),"^",2)
- +7 ;
- EDIT ;
- +1 NEW PSDNEW,PSDOLD
- +2 SET (PSDNEW,PSDOLD)=""
- SET PSDOLD=$PIECE(^PSDRUG($PIECE(^PSRX(PSONV,0),"^",6),0),"^")_"^"_PSONV
- +3 SET DA=PSONV
- DO ^PSORXPR
- +4 ;*422
- IF $GET(PSORX("DFLG"))
- GOTO OUT
- +5 IF $GET(PKI1)=2
- DO DCV1^PSOPKIV1
- GOTO OUT
- +6 KILL PSDTSTOP
- SET DIR("A")="EDIT"
- SET DIR("B")="N"
- SET DIR(0)="SB^Y:YES;N:NO;P:PROFILE"
- SET DIR("?")="Enter Y to change this RX, P to see a profile, or N to proceed with verification and order checks."
- +7 DO ^DIR
- KILL DIR
- WRITE !
- IF $GET(DIRUT)!($GET(DTOUT))
- SET PSOVBCK=1
- GOTO OUT
- +8 ;PSOPOCK=1 called from Process Order Check option; PSOCLK=1 means initiated from Rx verify by clerk.
- +9 IF Y="Y"
- IF ($GET(PSOCLK)!($GET(PSOPOCK)))
- DO FULLEDT
- SET VALMBCK="R"
- if $$CHECK(PSONV)
- GOTO KILL
- GOTO EDIT
- +10 ;this pops the user back to the med profile screen when verify is called from Patient Prescription Processing
- IF Y="Y"
- IF $GET(PSOACT)]""
- SET VALMBCK="R"
- SET PSVERFLG=1
- GOTO OUT
- +11 IF $DATA(DIRUT)
- IF $GET(PSOCLK)
- SET PSOCQ=1
- GOTO OUT
- +12 IF $DATA(DIRUT)
- IF $GET(PSOACT)]""
- SET VALMBCK="R"
- GOTO OUT
- +13 if Y="N"
- GOTO ORDCHK
- if Y="P"
- GOTO PROF
- if "YNP"'[$EXTRACT(Y)
- GOTO OUT
- +14 ;
- +15 DO EXPIRE
- KILL DIE,DR,DEA1,DEA2,P(5),PSRX1,PSRX2
- +16 KILL PSD(PSDOLD)
- SET PSDNEW=""
- SET PSDNEW=$PIECE(^PSDRUG($PIECE(^PSRX(PSONV,0),"^",6),0),"^")_"^"_PSONV
- SET PSD(PSDNEW)=PSONV_"^*^1^"_$PIECE(^PSDRUG($PIECE(^PSRX(PSONV,0),"^",6),0),"^",2)
- +17 ;
- +18 SET DA=$SELECT($DATA(PSORXED("IRXN")):PSORXED("IRXN"),1:PSONV)
- DO ^PSORXPR
- if $GET(DIRUT)
- GOTO OUT
- +19 if $DATA(DIRUT)!($DATA(DTOUT))
- GOTO OUT
- +20 IF '$GET(PSOCLK)
- SET DA=$SELECT($DATA(PSORXED("IRXN")):PSORXED("IRXN"),1:PSONV)
- WRITE !,"CHANGE",!
- DO ^PSORXPR
- if $DATA(DIRUT)!($DATA(DTOUT))
- GOTO OUT
- GOTO EDIT
- +21 if PSDNEW=PSDOLD
- GOTO EDIT
- GOTO REDO
- PROF IF '$DATA(PSOSD)
- WRITE !,$CHAR(7),"This patient has no other prescriptions on file",!!
- GOTO EDIT
- QUIT
- +1 WRITE !!,$PIECE(^DPT(DFN,0),"^"),?40,"ID#:"_VA("PID")
- if $DATA(INT)!$DATA(PSONV)
- WRITE " RX#: "_$SELECT($DATA(INT):$PIECE(INT,"^"),$DATA(^PSRX(PSONV)):$PIECE(^PSRX(PSONV,0),"^"),1:"")
- +2 DO HD^PSODDPR2()
- DO ^PSODSPL
- DO SHOW2^PSOVER
- GOTO EDIT
- QUIT
- +3 ;
- EXPIRE SET RX0=^PSRX(DA,0)
- SET X1=$PIECE($PIECE(RX0,"^",13),".")
- SET X2=$PIECE(RX0,"^",9)+1*$PIECE(RX0,"^",8)
- SET X2=$SELECT($PIECE(RX0,"^",8)=X2:X2,X2<181:184,X2=360:366,1:X2)
- SET X=X1
- if X1&X2
- DO C^%DTC
- +1 KILL ^PS(55,PSDFN,"P","A",+$PIECE(^PSRX(DA,2),"^",6),DA)
- SET ^PS(55,PSDFN,"P","A",X,DA)=""
- SET $PIECE(^PSRX(DA,2),"^",6)=X
- SET $PIECE(^PS(52.4,DA,0),"^",7)=X
- KILL X1,X2
- QUIT
- +2 ;
- ORDCHK ;
- +1 SET PSOVER1=1
- +2 SET RX0=^PSRX(PSONV,0)
- +3 DO ORDCK
- +4 ;if verify by clerk continue on with the next Rx; if not exit
- IF $GET(PSOQUIT)
- if $GET(PSOCLK)
- SET PSOQUIT=0
- if '$GET(PSOCLK)
- SET PSORX("DFLG")=1
- +5 IF $GET(PSOVQUIT)!$GET(PSORX("DFLG"))
- GOTO OUT
- +6 ;------
- VERIFY ;
- +1 DO FULL^VALM1
- if '$PIECE(PSOPAR,"^",2)
- GOTO VERY
- +2 WRITE !,$PIECE(^DPT(DFN,0),"^"),?40,"ID#:"_VA("PID")
- if $DATA(INT)!$DATA(PSONV)
- WRITE " RX#: "_$SELECT($DATA(INT):$PIECE(INT,"^"),$DATA(^PSRX(PSONV)):$PIECE(^PSRX(PSONV,0),"^"),1:"")
- if $DATA(PSODRUG("NAME"))
- WRITE !,PSODRUG("NAME"),!
- +3 IF $GET(PSONAM)=""
- SET PSONAM=$PIECE(^DPT(PSDFN,0),"^")
- +4 SET DIR("A")="VERIFY FOR "_PSONAM_"? (Y/N/Delete/Quit): "
- SET DIR("B")="Y"
- SET DIR(0)="SA^Y:YES;N:NO;D:DELETE;Q:QUIT"
- +5 SET DIR("?",1)="Enter Y (or return) to verify this prescription"
- SET DIR("?",2)="N to leave this prescription non-verified and to end this session of verification"
- SET DIR("?")="D to delete this prescription"
- +6 DO ^DIR
- KILL DIR
- +7 IF Y="N"!("Q^"[$EXTRACT(Y))
- Begin DoDot:1
- +8 SET (PSVERFLG,PSOVBCK)=1
- SET PSORX("DFLG")=1
- +9 if $DATA(PSOOVNOD)
- SET ^PS(52.4,PSONV,0)=PSOOVNOD
- if $GET(PSOOVSTA)
- SET $PIECE(^PSRX(PSONV,"STA"),"^")=PSOOVSTA
- +10 if PSOOVSTA=4
- SET ^PS(52.4,"ADI",PSONV,1)=""
- End DoDot:1
- GOTO OUT
- +11 if Y="D"
- GOTO DELETE
- VERY IF $GET(PKI1)=1
- DO REA^PSOPKIV1
- if '$DATA(PKIR)
- GOTO VERIFY
- +1 KILL ^PSRX(PSONV,"DAI")
- SET $PIECE(^PSRX(PSONV,3),"^",6)=""
- +2 KILL ^PSRX(PSONV,"DRI"),SPFL1
- +3 IF '$ORDER(^PSRX(PSONV,6,0))
- Begin DoDot:1
- +4 WRITE !!,"Dosing Instructions Missing. Please add!",!
- +5 IF $PIECE($GET(^PSRX(PSONV,"SIG")),"^")]""
- IF '$PIECE($GET(^("SIG")),"^",2)
- WRITE "SIG: "_$PIECE(^PSRX(PSONV,"SIG"),"^"),!
- +6 IF $PIECE($GET(^PSRX(PSONV,"SIG")),"^",2)
- IF $ORDER(^PSRX(PSONV,"SIG1",0))
- Begin DoDot:2
- +7 WRITE "SIG: "
- FOR I=0:0
- SET I=$ORDER(^PSRX(PSONV,"SIG1",I))
- if 'I
- QUIT
- WRITE ^PSRX(PSONV,"SIG1",I,0),!
- End DoDot:2
- KILL I
- +8 SET DA=PSONV
- SET PSOVER=1
- KILL DIR,DIRUT,DUOUT,DTOUT
- +9 SET PSODRUG("IEN")=$PIECE(^PSRX(DA,0),"^",6)
- SET PSODFN=$PIECE(^(0),"^",2)
- SET PSORXED("IRXN")=DA
- SET PSODRUG("OI")=$PIECE(^PSRX(DA,"OR1"),"^")
- +10 DO DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN)
- DO ^PSOORED3
- +11 KILL PSODFN,PSODRUG("IEN"),DOSE,PSOVER
- +12 IF '$GET(ENT)
- SET DUOUT=1
- +13 if $DATA(DUOUT)!($DATA(DTOUT))
- QUIT
- +14 KILL DIR,DIRUT,DUOUT,DTOUT
- SET DIE=52
- SET DR=114
- DO ^DIE
- KILL DIE,DR,DTOUT
- +15 IF X'=""
- DO SIG^PSOHELP
- if $GET(INS1)]""
- DO EN^DDIOL($EXTRACT(INS1,2,9999999))
- SET PSORXED("SIG",1)=$EXTRACT(INS1,2,9999999)
- +16 DO EN^PSOFSIG(.PSORXED,1)
- DO UDSIG^PSOORED3
- HANG 2
- End DoDot:1
- IF $DATA(DUOUT)!($DATA(DTOUT))
- WRITE !!,"Rx: "_$PIECE(^PSRX(DA,0),"^")_" not Verified!!",!
- HANG 2
- GOTO OUT
- +17 SET DA=PSONV
- SET $PIECE(^PSRX(DA,2),"^",10)=DUZ
- SET DRG=$PIECE(^PSDRUG($PIECE(^PSRX(DA,0),"^",6),0),"^")
- +18 IF $PIECE(^PSRX(DA,2),"^",2)>DT
- IF $PIECE(PSOPAR,"^",6)
- Begin DoDot:1
- +19 SET (SPFL1,PSOVER)=""
- SET PSORX("FILL DATE")=$PIECE(^PSRX(DA,2),"^",2)
- SET RXF=0
- +20 DO UPSUS
- SET PSTRIVER=1
- DO SUS^PSORXL
- +21 KILL PSORX("FILL DATE"),PSTRIVER
- +22 IF $DATA(^TMP("PSODAOC",$JOB))
- DO ^PSONEWOC
- KILL ^TMP("PSODAOC",$JOB)
- End DoDot:1
- GOTO KILL
- +23 SET PSOVER(PSONV)=""
- SET $PIECE(^PSRX(PSONV,"STA"),"^")=0
- SET DRG=$PIECE(^PSDRUG($PIECE(^PSRX(DA,0),"^",6),0),"^")
- +24 SET $PIECE(PSOSD("NON-VERIFIED",DRG),"^",2)=0
- SET PSOSD("ACTIVE",DRG)=PSOSD("NON-VERIFIED",DRG)
- +25 IF $DATA(^TMP("PSODAOC",$JOB))
- DO ^PSONEWOC
- KILL ^TMP("PSODAOC",$JOB)
- +26 IF $GET(PKI1)=1
- IF $GET(PKIR)]""
- DO ACT^PSOPKIV1(DA)
- +27 ;S VALMBCK=""
- KILL PSOSD("NON-VERIFIED",DRG)
- DO EN^PSOHLSN1(PSONV,"SC","CM","")
- +28 ;saves drug allergy order chks pso*7*390
- +29 IF +$GET(^TMP("PSODAOC",$JOB,1,0))
- Begin DoDot:1
- +30 IF $GET(PSORX("DFLG"))
- KILL ^TMP("PSODAOC",$JOB)
- QUIT
- +31 NEW RXN,PSODAOC
- SET RXN=PSONV
- SET PSODAOC="Rx Backdoor VERIFIED NEW Order Acceptance_OP"
- +32 DO DAOC^PSONEW
- +33 KILL ^TMP("PSODAOC",$JOB),RET
- End DoDot:1
- +34 ;
- +35 ; - Calling ECME for claims generation and transmission / REJECT handling
- +36 NEW ACTION
- +37 IF $$SUBMIT^PSOBPSUT(PSONV)
- Begin DoDot:1
- +38 SET ACTION=""
- DO ECMESND^PSOBPSU1(PSONV,,,$SELECT($ORDER(^PSRX(PSONV,1,0)):"RF",1:"OF"))
- +39 ; Quit if there is an unresolved Tricare non-billable reject code, PSO*7*358
- +40 IF $$PSOET^PSOREJP3(PSONV)
- SET ACTION="Q"
- QUIT
- +41 IF $$FIND^PSOREJUT(PSONV)
- Begin DoDot:2
- +42 SET ACTION=$$HDLG^PSOREJU1(PSONV,0,"79,88,943","OF","IOQ","Q")
- End DoDot:2
- End DoDot:1
- IF ACTION="Q"!(ACTION="^")
- QUIT
- +43 ;
- KILL SET DA=PSONV
- SET DIK="^PS(52.4,"
- DO ^DIK
- KILL DA,DIK
- DO DCORD^PSONEW2
- OUT ;
- +1 KILL PSOVER1
- +2 IF '$GET(PSOCLK)
- if $GET(DIRUT)!($GET(DTOUT))
- SET PSORX("DFLG")=1
- KILL DIRUT,DTOUT,DUOUT,UPFLAGX
- DO CLEAN
- SET VALMBCK="Q"
- QUIT
- +3 IF $GET(PSOCLK)
- SET PSORX("DFLG")=0
- KILL UPFLAGX
- DO CLEAN
- QUIT
- DELETE KILL UPFLAGX
- DO DELETE^PSOVER2
- if $GET(UPFLAGX)
- GOTO OUT
- KILL PSOSD("NON-VERIFIED",$GET(DRG))
- QUIT
- QUIT SET PSOQUIT=""
- DO CLEAN
- KILL PSOVER1
- QUIT
- UPSUS SET $PIECE(PSOSD("NON-VERIFIED",DRG),"^",2)=5
- SET PSOSD("ACTIVE",DRG)=PSOSD("NON-VERIFIED",DRG)
- KILL PSOSD("NON-VERIFIED",DRG)
- DO EN^PSOHLSN1(PSONV,"SC","CM","")
- +1 QUIT
- CLEAN ;cleans up tmp("psorxdc") global
- +1 IF $GET(PSODOSEX)
- KILL PSODOSEX
- QUIT
- +2 NEW PSOWRITE
- +3 IF $ORDER(^TMP("PSORXDC",$JOB,0))
- FOR RORD=0:0
- SET RORD=$ORDER(^TMP("PSORXDC",$JOB,RORD))
- if 'RORD
- QUIT
- Begin DoDot:1
- +4 DO PSOUL^PSSLOCK(RORD_$SELECT($PIECE(^TMP("PSORXDC",$JOB,RORD,0),"^")="P":"S",1:""))
- +5 IF $PIECE(^TMP("PSORXDC",$JOB,RORD,0),"^")="P"
- Begin DoDot:2
- +6 SET PSOR=^PS(52.41,RORD,0)
- +7 SET DNM=$SELECT($PIECE(PSOR,"^",9):$PIECE($GET(^PSDRUG($PIECE(PSOR,"^",9),0)),"^"),1:$PIECE(^PS(50.7,$PIECE(PSOR,"^",8),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^PS(50.7,$PIECE(PSOR,"^",8),0),"^",2),0),"^"))
- +8 WRITE $CHAR(7),!," Duplicate "_$SELECT($PIECE(^TMP("PSORXDC",$JOB,RORD,0),"^",10):"Therapy",1:"Drug")_" Pending Order "_DNM_" NOT Discontinued."
- SET PSOWRITE=1
- End DoDot:2
- QUIT
- +9 WRITE !," Duplicate "_$SELECT($PIECE(^TMP("PSORXDC",$JOB,RORD,0),"^",10):"Therapy",1:"Drug")_" Rx #"_$PIECE(^PSRX(RORD,0),"^")_" "_$PIECE(^TMP("PSORXDC",$JOB,RORD,0),"^",7)_" NOT Discontinued."
- SET PSOWRITE=1
- End DoDot:1
- +10 IF $GET(PSOWRITE)&('$GET(PSOWRIT))
- WRITE !
- 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
- KILL DIR,X,Y
- IF ($Y+5)>IOSL
- WRITE @IOF
- +11 KILL ^TMP("PSORXDC",$JOB),RORD,PRNXZ,ORNZZ,PSOR
- +12 QUIT
- KV1 ;
- +1 KILL PSOANSQD,DRET,LST,PSOQUIT,PSODRUG,PSONEW,SIG,PSODIR,PHI,PRC,ORCHK,ORDRG,PSOSIGFL,PSORX("ISSUE DATE"),PSORX("FILL DATE"),CLOZPAT
- KV KILL DIR,DIRUT,DTOUT,DUOUT
- +1 QUIT
- NVA ;
- +1 IF $PIECE(PSOSD(STA,DNM),"^",11)
- DO NVA^PSODRDU1
- QUIT
- +2 NEW PSOOI,CLASS,FLG,X,Y,RXREC,IFN
- +3 SET (Y,FLG)=""
- +4 SET RXREC=$PIECE(PSOSD(STA,DNM),"^",10)
- SET PSOOI=+$GET(^PS(55,DFN,"NVA",RXREC,0))
- SET IFN=RXREC
- NEW DNM
- +5 FOR
- SET Y=$ORDER(^PSDRUG("ASP",PSOOI,Y))
- if Y=""!(FLG)
- QUIT
- SET DNM=$PIECE(^PSDRUG(Y,0),"^")
- SET CLASS=$PIECE(^PSDRUG(Y,0),"^",2)
- IF PSODRUG("NAME")=DNM!(CLASS=PSODRUG("VA CLASS"))
- DO DSP^PSODRDU1
- SET FLG=1
- QUIT
- +6 QUIT
- REMOTE ;
- +1 KILL ^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI"),^TMP($JOB,"DI"_PSODFN)
- Begin DoDot:1
- +2 IF $TEXT(HAVEHDR^ORRDI1)']""
- QUIT
- +3 IF '$$HAVEHDR^ORRDI1
- QUIT
- +4 if (($Y+5)'>IOSL)
- DO HD^PSODDPR2()
- +5 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
- Begin DoDot:2
- +6 IF $TEXT(REMOTE^PSORX1)]""
- QUIT
- +7 WRITE !!,"Remote data not available - Only local order checks processed.",!
- if (($Y+5)>IOSL)
- DO HD^PSODDPR2()
- End DoDot:2
- QUIT
- +8 WRITE !!,"Now doing remote order checks. Please wait..."
- +9 DO REMOTE^PSOORRDI(PSODFN,+$PIECE($GET(^PSRX(PSONV,0)),"^",6))
- +10 ;D PAUSE^PSOORRD2 Q
- IF $PIECE($GET(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0
- WRITE !!,"Remote data not available - Only local order checks processed.",!
- if (($Y+5)>IOSL)
- DO HD^PSODDPR2()
- +11 IF $DATA(^TMP($JOB,"DD"))
- DO DUP^PSOORRD2
- +12 IF $DATA(^TMP($JOB,"DC"))
- DO CLS^PSOORRD2
- +13 IF $DATA(^TMP($JOB,"DI"_PSODFN))
- KILL ^TMP($JOB,"DI")
- MERGE ^TMP($JOB,"DI")=^TMP($JOB,"DI"_PSODFN)
- DO DRGINT^PSOORRD2
- End DoDot:1
- +14 KILL ^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI"),^TMP($JOB,"DI"_PSODFN)
- +15 QUIT
- NOALRGY ;
- +1 NEW PSODFN,PSODRUG
- +2 SET PSODFN=$PIECE(^PSRX(PSONV,0),"^",2)
- SET PSODRUG("IEN")=$PIECE(^PSRX(PSONV,0),"^",6)
- +3 DO NOALRGY^PSODRG
- +4 QUIT
- +5 ;
- ORDCK ;
- +1 NEW ORN,ORNZZ,PSOLST,Y,PSOODFN
- SET ORN=PSONV
- SET PSOLST(PSONV)=PSONV_"^"_PSONV
- SET PSOVORD=1
- +2 NEW DRG,ON,CT,DRGI,PDRG,SEV,STX,INT,CLI,PSONULN,PSONULN1,LST,LSI,DGI,SER,SERS,DUPT,SV
- +3 SET ORNZZ=ORN
- SET PRNXZ(ORN)=PSOLST(ORN)
- SET PSORENW("OIRXN")=PSONV
- SET PSOODFN=DFN
- +4 IF '$DATA(PSODFN)
- SET PSODFN=$PIECE(^PSRX(PSONV,0),"^",2)
- +5 DO SHOW^PSOVER
- if (($Y+5)>IOSL)
- DO HD^PSODDPR2()
- +6 SET (PSODRUG("IEN"),PSDRUG("IEN"))=$PIECE(^PSRX(PSONV,0),"^",6)
- +7 NEW PSOVINF
- SET PSOVINF=^PSDRUG(PSDRUG("IEN"),0)
- SET PSODRUG("VA CLASS")=$PIECE(^(0),"^",2)
- +8 SET PSODRUG("VA CLASS")=$PIECE(PSOVINF,"^",2)
- SET (DRG,PSODRUG("NAME"))=$PIECE(^PSDRUG(PSDRUG("IEN"),0),"^")
- +9 SET PSODRUG("NDF")=$SELECT($GET(^PSDRUG(PSDRUG("IEN"),"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
- +10 SET PSODRUG("MAXDOSE")=$PIECE(PSOVINF,"^",4)
- SET PSODRUG("DEA")=$PIECE(PSOVINF,"^",3)
- SET PSODRUG("CLN")=$SELECT($DATA(^PSDRUG(PSDRUG("IEN"),"ND")):+$PIECE(^("ND"),"^",6),1:0)
- +11 SET PSODRUG("SIG")=$PIECE(PSOVINF,"^",5)
- SET PSODRUG("NDC")=$$GETNDC^PSSNDCUT(PSDRUG("IEN"),$GET(PSOSITE))
- SET PSODRUG("STKLVL")=$GET(^PSDRUG(PSDRUG("IEN"),660.1))
- +12 SET PSODRUG("DAW")=$$GET1^DIQ(50,PSONV,81)
- +13 IF PSODRUG("DAW")=""
- SET PSODRUG("DAW")=0
- +14 KILL PSOVINF
- +15 DO POST^PSODRG
- SET DFN=PSOODFN
- +16 IF $$GET1^DIQ(52,PSONV,100,"I")=13
- SET PSORX("DFLG")=1
- QUIT
- +17 IF $GET(PSVERFLG)
- IF $GET(PSOCLK)
- SET PSVERFLG=0
- +18 IF $GET(PSOCLK)
- IF $GET(PSORX("DFLG"))
- SET PSOVQUIT=1
- KILL PSORX("DFLG"),DIRUT,DTOUT
- QUIT
- +19 if PSORX("DFLG")
- QUIT
- +20 if '$GET(PSORX("DFLG"))
- DO DOSCK^PSODOSUT("V")
- +21 IF $$GET1^DIQ(52,PSONV,100,"I")=13
- SET PSORX("DFLG")=1
- QUIT
- +22 IF $GET(PSOCLK)
- IF $GET(PSORX("DFLG"))
- SET PSOVQUIT=1
- KILL PSORX("DFLG"),DIRUT,DTOUT
- QUIT
- +23 if PSORX("DFLG")!($GET(PSOQUIT))
- QUIT
- +24 SET PSOLST(ORNZZ)=PRNXZ(ORNZZ)
- SET ORN=ORNZZ
- KILL PSORENW("OIRXN")
- +25 QUIT
- +26 ;
- FULLEDT ;
- +1 DO FULL^VALM1
- +2 NEW RX,FILL,OPSOLST,OPSLST,OLDDA,PSODRUG,REJ
- +3 SET (RX,PSORXED("IRXN"))=PSONV
- +4 MERGE OPSOLST=PSOLST,OPSLST=PSLST,ODA=DA
- +5 NEW PSOSITE,ORN,PSOPAR,PSOLIST,PSOSD
- +6 SET PSOSITE=$$RXSITE^PSOBPSUT(RX,"")
- SET ORN=RX
- +7 SET PSOPAR=$GET(^PS(59,PSOSITE,1))
- SET PSOLIST(1)=ORN_","
- +8 DO EPH^PSORXEDT
- +9 MERGE PSOLST=OPSOLST,PSLST=OPSLST
- SET VALMBCK="R"
- if $DATA(OLDDA)
- SET DA=OLDDA
- +10 QUIT
- +11 ;
- DRIDOSE(DA,RX0) ;where DA is RXIEN and RX0 is zero node of file 52 for the RXIEN
- +1 NEW T,RXN,RXX,SCRIPT,SEV,X,SER,PSOSERV,PSOSCPT,PSODOSF,RX
- +2 SET RX=RX0
- +3 SET RXN=$PIECE(RX0,"^")
- +4 IF $DATA(^PS(52.4,RX,0))!($DATA(^PSRX(RX,"DRI")))
- Begin DoDot:1
- +5 if '$PIECE($GET(^PS(52.4,RX,0)),"^",8)&('$DATA(^PSRX(RX,"DRI")))
- QUIT
- +6 WRITE !!,"*** During order, there were DRUG-DRUG INTERACTION for the following RX(s):"
- End DoDot:1
- +7 IF $PIECE($GET(^PS(52.4,RX,0)),"^",8)
- SET SCRIPT=$PIECE(^PS(52.4,RX,0),"^",10)
- SET SEV=$PIECE(^PS(52.4,RX,0),"^",9)
- FOR X=1:1
- SET RXX(X)=$PIECE(SCRIPT,",",X)
- SET SEV(X)=$PIECE(SEV,",",X)
- if RXX(X)=""
- QUIT
- Begin DoDot:1
- +8 SET SER=$PIECE(^PS(56,SEV(X),0),"^",4)
- if $GET(SER)=1
- SET PSOSERV=1
- +9 SET PSOSCPT(RXX(X))=" "_$SELECT(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$PIECE(^PSDRUG($PIECE(^PSRX(RXX(X),0),"^",6),0),"^")
- End DoDot:1
- +10 IF $DATA(^PSRX(RX,"DRI"))
- SET SCRIPT=$PIECE(^PSRX(RX,"DRI"),"^",2)
- SET SEV=$PIECE(^PSRX(RX,"DRI"),"^")
- FOR X=1:1
- SET RXX(X)=$PIECE(SCRIPT,",",X)
- SET SEV(X)=$PIECE(SEV,",",X)
- if RXX(X)=""
- QUIT
- Begin DoDot:1
- +11 SET SER=$PIECE(^PS(56,SEV(X),0),"^",4)
- +12 SET PSOSCPT(RXX(X))=" "_$PIECE($GET(^PSRX(RXX(X),0)),"^")_" "_$SELECT(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$PIECE(^PSDRUG($PIECE(^PSRX(RXX(X),0),"^",6),0),"^")
- End DoDot:1
- +13 SET SCRIPT=""
- FOR
- SET SCRIPT=$ORDER(PSOSCPT(SCRIPT))
- if SCRIPT=""
- QUIT
- WRITE !,PSOSCPT(SCRIPT)
- +14 IF $$DS^PSSDSAPI
- IF $DATA(^PS(52.4,RX,1))
- SET T=$PIECE(^PS(52.4,RX,1),"^")
- Begin DoDot:1
- +15 SET PSODOSF=""
- SET PSODOSF=$SELECT(T=4:"DOSAGE EXCEEDS MAX SINGLE DOSE AND/OR MAX DAILY DOSE",T=3:"MAX SINGLE DOSE & DAILY DOSE RANGE",T=2:"MAX SINGLE DOSE",T=1:"DAILY DOSE RANGE",1:"")
- End DoDot:1
- if PSODOSF'=""
- WRITE !,"*** Dose Warning: ",PSODOSF
- +16 WRITE !
- +17 QUIT
- CHECK(PSONV) ;
- +1 NEW PSOSTAT
- SET PSOSTAT=$$GET1^DIQ(52,PSONV,100,"I")
- +2 IF ",11,12,13,14,15,"[(","_PSOSTAT_",")
- QUIT 1
- +3 QUIT 0