PSOORDRG ;BIR/SAB - order entry drug selection ;08-Apr-2013 14:53;DU
;;7.0;OUTPATIENT PHARMACY;**3,29,49,46,81,105,134,144,132,1005,188,1007,207,148,243,1015**;DEC 1997;Build 62
;External references to ^PSJORUT2 supported by DBIA 2376
;External reference to ^PS(50.7 supported by DBIA 2223
;External reference to ^PS(50.605 supported by DBIA 696
;External reference to ^PSDRUG supported by DBIA 221
;External reference to ^PS(55 supported by DBIA 2228
;External reference to ^PS(56 supported by DBIA 2229
;External reference to ^PS(50.416 supported by DBIA 692
;External reference to DDIEX^PSNAPIS supported by DBIA 2574
;External references to ^ORRDI1 supported by DBIA 4659
;Reference to $$GETNDC^PSSNDCUT supported by IA 4707
; Modified - IHS/CIA/PLS - 08/12/04 - Line DRG+8
; 01/05/07 - Line DRG+8
; IHS/MSC/PLS - 07/14/08 - Included VistA patch 188
; IHS/MSC/MGH - 04/08/13 - Changed for compound meds
; Added DOIT and PROCESS entry points
EN(PSODFN,DREN) ;
K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"_PSODFN),PSOPHI S INDX=0
;build patient's drug profile outpat/inpat/non-va
D BLD,ENCHK^PSJORUT2(PSODFN,.INDX),NVA
;collect drug info
DRG ;S X=DREN,DIC="^PSDRUG(",DIC(0)="MQNZO" D ^DIC K DIC,PSOY Q:Y<1 S PSOY=Y,PSOY(0)=Y(0) K X,Y
N PSOICT S PSOICT=""
S PSOY=DREN_"^"_$P($G(^PSDRUG(DREN,0)),"^"),PSOY(0)=$G(^PSDRUG(DREN,0)) K X,Y
S PSODRUG("IEN")=+PSOY,PSODRUG("VA CLASS")=$P(PSOY(0),"^",2),PSODRUG("NAME")=$P(PSOY(0),"^")
S:+$G(^PSDRUG(+PSOY,2)) PSODRUG("OI")=+$G(^(2)),PSODRUG("OIN")=$P(^PS(50.7,+$G(^(2)),0),"^")
S PSODRUG("NDF")=$S($G(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
S PSODRUG("MAXDOSE")=$P(PSOY(0),"^",4),PSODRUG("DEA")=$P(PSOY(0),"^",3),PSODRUG("CLN")=$S($D(^PSDRUG(+PSOY,"ND")):+$P(^("ND"),"^",6),1:0)
S PSODRUG("SIG")=$P(PSOY(0),"^",5),PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSOY,$G(PSOSITE))
S PSODRUG("DAW")=$$GET1^DIQ(50,+PSOY,81)
S PSOX1=$G(^PSDRUG(+PSOY,660)),PSODRUG("COST")=$P($G(PSOX1),"^",6),PSODRUG("UNIT")=$P($G(PSOX1),"^",8),PSODRUG("EXPIRATION DATE")=$P($G(PSOX1),"^",9)
; IHS/CIA/PLS - 08/12/04 - Calculate NDC, AWP and COST
; 01/05/07 - Add check for PSOSITE to prevent the PSONEW array from getting set for inpatient meds
I $G(PSOSITE) D
.S PSONEW("NDC")=$G(PSODRUG("NDC"))
.S:('$G(PSONEW("DFLG")))&('$G(PSONEW("QFLG"))) PSONEW("AWP")=$$AWP^APSQDAWP($S($D(PSONEW("NDC")):PSONEW("NDC"),1:PSODRUG("NDC")),PSODRUG("IEN"),.TALK)
.S:('$G(PSONEW("DFLG")))&('$G(PSONEW("QFLG"))) PSONEW("COST")=$$COST^APSQDAWP($S($D(PSONEW("NDC")):PSONEW("NDC"),1:PSODRUG("NDC")),PSODRUG("IEN"),.TALK)
K PSOX1,PSOY Q:$G(POERR)
;dup drug/class check
S DNM=0 F S DNM=$O(^TMP($J,"ORDERS",DNM)) Q:'DNM D
.S DRNM=$P(^TMP($J,"ORDERS",DNM),"^",3)
.I PSODRUG("NAME")=DRNM S DD=$G(DD)+1,^TMP($J,"DD",DD,0)=PSODRUG("IEN")_"^"_PSODRUG("NAME")_"^"_$P(^TMP($J,"ORDERS",DNM),"^",4)_"^"_$P(^(DNM),"^",5) Q:'$G(PSOPHI)
.I PSODRUG("VA CLASS")]"",$E(PSODRUG("VA CLASS"),1,4)=$E($P(^TMP($J,"ORDERS",DNM),"^"),1,4),DRNM'=PSODRUG("NAME") D
..I $E(PSODRUG("VA CLASS"),1,2)="HA",$E($P(^TMP($J,"ORDERS",DNM),"^"),1,2)="HA" Q
..S PSODC=$O(^PS(50.605,"B",PSODRUG("VA CLASS"),0)) Q:'PSODC
..S DC=$G(DC)+1,^TMP($J,"DC",DC,0)=PSODRUG("VA CLASS")
..S PSODC=$P(^PS(50.605,PSODC,0),"^",2),^TMP($J,"DC",DC,0)=^TMP($J,"DC",DC,0)_"^"_PSODC_"^"_$O(^PSDRUG("B",DRNM,0))_"^"_DRNM_"^"_$P(^TMP($J,"ORDERS",DNM),"^",4)_"^"_$P(^(DNM),"^",5)
;drug interaction check
N CMP,CMPDR,CDRG,TDRG,CNDF
S DRG=0
;IHS/MSC/MGH changed to allow for compound drugs
;DOIT entry point created to allow for looping
F S DRG=$O(^TMP($J,"ORDERS",DRG)) Q:'DRG D
.S DRNM=$P(^TMP($J,"ORDERS",DRG),"^",3)
.S TDRG=$O(^PSDRUG("B",DRNM,""))
.Q:TDRG=""
.S CMP=$P($G(^PSDRUG(TDRG,999999935)),U,1)
.I CMP=1 D
..S CMPDR=0
..F S CMPDR=$O(^PSDRUG(TDRG,999999936,CMPDR)) Q:'+CMPDR D
...S CDRG=$P($G(^PSDRUG(TDRG,999999936,CMPDR,0)),U,1)
...S CNDF=$S($G(^PSDRUG(CDRG,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
...D DOIT(DRG,CNDF)
.E D
..S NDF=$P(^TMP($J,"ORDERS",DRG),"^",2)
..D DOIT(DRG,NDF)
D EXIT
Q
DOIT(DRG,NDF) ;Process the drug IHS/MSC/MGH 04/08/2013
S IT=0,PSOICT=""
F S IT=$O(^PS(56,"APD",NDF,PSODRUG("NDF"),IT)) Q:'IT D
.Q:$$DDIEX^PSNAPIS($P(NDF,"A"),$P(NDF,"A",2))
.Q:$$DDIEX^PSNAPIS($P(PSODRUG("NDF"),"A"),$P(PSODRUG("NDF"),"A",2))
.Q:$P(^PS(56,IT,0),"^",7)&($P(^PS(56,IT,0),"^",7)<DT)
.I 'PSOICT S PSOICT=IT Q
.I $P($G(^PS(56,IT,0)),"^",4)=1 S PSOICT=IT Q
.Q
I 'PSOICT Q
S IT=PSOICT
S DRNM=$P(^TMP($J,"ORDERS",DRG),"^",3),ORN=$P(^(DRG),"^",4),RXN=$P(^(DRG),"^",5)
S DI=$G(DI)+1,^TMP($J,"DI",DI,0)=$O(^PSDRUG("B",DRNM,0))_"^"_DRNM_"^"_IT_"^"_$S($P(^PS(56,IT,0),"^",4)=1:"CRITICAL",1:"SIGNIFICANT")_"^"
S ^TMP($J,"DI",DI,0)=^TMP($J,"DI",DI,0)_$P(^PS(50.416,$P(^PS(56,IT,0),"^",2),0),"^")_"^"_$P(^PS(50.416,$P(^PS(56,IT,0),"^",3),0),"^")_"^"_ORN_"^"_RXN
D REMOTE
Q:$G(PSOPHI)
Q
EXIT K ^TMP($J,"ORDERS"),DFN,DA,DNM,DUPRX0,RX,Y,ZZ,PSOCLOZ,PSOY,DRG,DNM,DD,DI,DC,IT,PSODRUG,PSOY,ORN,DRNM
K PSOX,EXPDT,PSODRUG0,PSORX0,PSORX2,PSORX3,PSOST0,PSOVACL,X,Y,X1,X2,RXN
Q
BLD K ^TMP($J,"ORDERS") I '$D(PSODFN)!('$D(DT)) G EXIT
S X1=DT,X2=-120 D C^%DTC S PSODTCUT=X D BUILD G GETX
Q
BUILD ;build profiles
S EXPDT=PSODTCUT-1,RX=0
F S EXPDT=$O(^PS(55,PSODFN,"P","A",EXPDT)) Q:'EXPDT F S RX=$O(^PS(55,PSODFN,"P","A",EXPDT,RX)) Q:'RX I $D(^PSRX(RX,0)) D GET
S EN=0
F PSOEN=0:0 S PSOEN=$O(^PS(52.41,"AOR",PSODFN,PSOEN)) Q:'PSOEN D
.F S EN=$O(^PS(52.41,"AOR",PSODFN,PSOEN,EN)) Q:'EN D
..S PSOOI=^PS(52.41,EN,0) I $P(PSOOI,"^",3)'="DC"&($P(PSOOI,"^",3)'="DE") D:'$P(^PS(52.41,EN,0),"^",9) BLDOI I $P(^PS(52.41,EN,0),"^",9) S PSODD=+$P(PSOOI,"^",9) D SETTMP
D BUILDX
Q
;
BLDOI ;If no DD/non-standard dose, get all drugs for OI
N PSOI S PSOI=$P(PSOOI,"^",8) Q:'PSOOI
S PSODD="" F S PSODD=$O(^PSDRUG("ASP",PSOI,PSODD)) Q:'PSODD D SETTMP
Q
;
SETTMP ;Create ^TMP($J,"ORDERS"
Q:$P(PSOOI,"^",3)="RF"
S DRG=$S(PSODD:$P($G(^PSDRUG(PSODD,0)),"^"),1:"") Q:DRG']""
S INDX=$G(INDX)+1,^TMP($J,"ORDERS",INDX)=$S(PSODD:$P(^PSDRUG(PSODD,0),"^",2),1:"")_"^"_$S($G(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)_"^"_DRG_"^"_$P(^PS(52.41,EN,0),"^")_"^"_EN_"P;O"
Q
;
BUILDX K EN,PSOOI,PSODD,PSOEN Q
;
GET ;data for profiles
S PSORX0=^PSRX(RX,0),PSOST0=+^("STA") Q:PSOST0>5&(PSOST0'=16)
S PSORX2=$G(^PSRX(RX,2)),PSORX3=$G(^(3)),ORN=$P($G(^("OR1")),"^",2) S:PSORX3="" PSORX3=$P(PSORX2,"^",2)
S PSODRUG=+$P(PSORX0,"^",6) Q:'$D(^PSDRUG(PSODRUG,0))
S PSODRUG0=^PSDRUG(PSODRUG,0),PSOVACL=$P(PSODRUG0,"^",2)
;
I EXPDT<DT D
.N DIE,DIC,DR,DA S STAT="SC",DIE=52,DA=RX,DR="100////11" D ^DIE K DIE,DIC,DR,DA
.D ECAN^PSOUTL(RX) S DA=RX
.S COMM="Prescription Expired",PHARMST="ZE" D EN^PSOHLSN1(DA,STAT,PHARMST,COMM)
S INDX=$G(INDX)+1
S ^TMP($J,"ORDERS",INDX)=PSOVACL_"^"_$S($G(^PSDRUG(PSODRUG,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)_"^"_$P(^PSDRUG(PSODRUG,0),"^")_"^"_ORN_"^"_RX_"R;O"
Q
GETX ;
K PSOX,EXPDT,PSODRUG,PSODRUG0,PSORX0,PSORX2,PSORX3,PSOST0,PSOVACL,X,Y,X1,X2,ORN
Q
CLOZ ;
S ANQRTN=$P(^PSDRUG(PSODRUG("IEN"),"CLOZ1"),"^"),ANQX=0,P(5)=PSODRUG("IEN"),DFN=PSODFN,X=ANQRTN
X ^%ZOSF("TEST") I D @("^"_ANQRTN) S:$G(ANQX) PSORX("DFLG")=1
K P(5),ANQRTN,ANQX,X
Q
DRGCHK(PSODFN,DREN,DDRUG) ;Only check DREN against drug in DDRG()
;* PSODFN = Patient's DFN
;* DREN = Dispense drug to be checked against the drug in the array
;* DDRUG = The array of dispense drug in the buffer.
;*
K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")
NEW DDRUG0,DDRUGND,COD,PSJINX S COD="",PSJINX=0
S DDRUG=0 F S DDRUG=$O(DDRUG(DDRUG)) Q:'DDRUG D DDRUG^PSJORUT2
D DRG
Q
OIDRG(PSODFN,PSOI) ;checks every drug tied to orderable item passed by package use
K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC"),DD,DC,DI N DREN S INDX=0,PSOPHI=1
;build patient's drug profile inpat/outpat/non-va
D BLD,ENCHK^PSJORUT2(PSODFN,.INDX),NVA
F DREN=0:0 S DREN=$O(^PSDRUG("ASP",PSOI,DREN)) Q:'DREN I $D(^PSDRUG(DREN,O)) D DRG
K PSOPHI D EXIT
Q
NVA ;checks existing nva
F I=0:0 S I=$O(^PS(55,PSODFN,"NVA",I)) Q:'I D:$D(^PS(55,PSODFN,"NVA",I,0))
.Q:$P(^PS(55,PSODFN,"NVA",I,0),"^",7)
.S PSOI=$P(^PS(55,PSODFN,"NVA",I,0),"^"),DRG=$P(^(0),"^",2),ORN=$P(^(0),"^",8)
.I DRG,$G(^PSDRUG(DRG,0))]"" D NVA1 K DRG Q
.K DRG F DRG=0:0 S DRG=$O(^PSDRUG("ASP",PSOI,DRG)) Q:'DRG D:$D(^PSDRUG(DRG,0)) NVA1
K I,PSOOTC,ORN,PSOI,DRG,DRGN,PSOY,VACL,NDF
Q
NVA1 S PSOY=$G(^PSDRUG(DRG,0)),DRGN=$P(PSOY,"^"),VACL=$P(PSOY,"^",2)
S NDF=$S($G(^PSDRUG(DRG,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
S INDX=$G(INDX)+1,^TMP($J,"ORDERS",INDX)=VACL_"^"_NDF_"^"_DRGN_"^"_ORN_"^"_I_"N;O"
Q
;
REMOTE ;
I $T(HAVEHDR^ORRDI1)']"" Q
I '$$HAVEHDR^ORRDI1 Q
D REMOTE^PSOORRDI(PSODFN,DREN)
K ^TMP($J,"DI"_PSODFN) ;THIS LEVEL ONLY NEEDED FOR BACKDOOR OUTPATIENT PHARMACY CHECKS
Q
;
PSOORDRG ;BIR/SAB - order entry drug selection ;08-Apr-2013 14:53;DU
+1 ;;7.0;OUTPATIENT PHARMACY;**3,29,49,46,81,105,134,144,132,1005,188,1007,207,148,243,1015**;DEC 1997;Build 62
+2 ;External references to ^PSJORUT2 supported by DBIA 2376
+3 ;External reference to ^PS(50.7 supported by DBIA 2223
+4 ;External reference to ^PS(50.605 supported by DBIA 696
+5 ;External reference to ^PSDRUG supported by DBIA 221
+6 ;External reference to ^PS(55 supported by DBIA 2228
+7 ;External reference to ^PS(56 supported by DBIA 2229
+8 ;External reference to ^PS(50.416 supported by DBIA 692
+9 ;External reference to DDIEX^PSNAPIS supported by DBIA 2574
+10 ;External references to ^ORRDI1 supported by DBIA 4659
+11 ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707
+12 ; Modified - IHS/CIA/PLS - 08/12/04 - Line DRG+8
+13 ; 01/05/07 - Line DRG+8
+14 ; IHS/MSC/PLS - 07/14/08 - Included VistA patch 188
+15 ; IHS/MSC/MGH - 04/08/13 - Changed for compound meds
+16 ; Added DOIT and PROCESS entry points
EN(PSODFN,DREN) ;
+1 KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI"_PSODFN),PSOPHI
SET INDX=0
+2 ;build patient's drug profile outpat/inpat/non-va
+3 DO BLD
DO ENCHK^PSJORUT2(PSODFN,.INDX)
DO NVA
+4 ;collect drug info
DRG ;S X=DREN,DIC="^PSDRUG(",DIC(0)="MQNZO" D ^DIC K DIC,PSOY Q:Y<1 S PSOY=Y,PSOY(0)=Y(0) K X,Y
+1 NEW PSOICT
SET PSOICT=""
+2 SET PSOY=DREN_"^"_$PIECE($GET(^PSDRUG(DREN,0)),"^")
SET PSOY(0)=$GET(^PSDRUG(DREN,0))
KILL X,Y
+3 SET PSODRUG("IEN")=+PSOY
SET PSODRUG("VA CLASS")=$PIECE(PSOY(0),"^",2)
SET PSODRUG("NAME")=$PIECE(PSOY(0),"^")
+4 IF +$GET(^PSDRUG(+PSOY,2))
SET PSODRUG("OI")=+$GET(^(2))
SET PSODRUG("OIN")=$PIECE(^PS(50.7,+$GET(^(2)),0),"^")
+5 SET PSODRUG("NDF")=$SELECT($GET(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
+6 SET PSODRUG("MAXDOSE")=$PIECE(PSOY(0),"^",4)
SET PSODRUG("DEA")=$PIECE(PSOY(0),"^",3)
SET PSODRUG("CLN")=$SELECT($DATA(^PSDRUG(+PSOY,"ND")):+$PIECE(^("ND"),"^",6),1:0)
+7 SET PSODRUG("SIG")=$PIECE(PSOY(0),"^",5)
SET PSODRUG("NDC")=$$GETNDC">GETNDC^PSSNDCUT(+PSOY,$GET(PSOSITE))
+8 SET PSODRUG("DAW")=$$GET1^DIQ(50,+PSOY,81)
+9 SET PSOX1=$GET(^PSDRUG(+PSOY,660))
SET PSODRUG("COST")=$PIECE($GET(PSOX1),"^",6)
SET PSODRUG("UNIT")=$PIECE($GET(PSOX1),"^",8)
SET PSODRUG("EXPIRATION DATE")=$PIECE($GET(PSOX1),"^",9)
+10 ; IHS/CIA/PLS - 08/12/04 - Calculate NDC, AWP and COST
+11 ; 01/05/07 - Add check for PSOSITE to prevent the PSONEW array from getting set for inpatient meds
+12 IF $GET(PSOSITE)
Begin DoDot:1
+13 SET PSONEW("NDC")=$GET(PSODRUG("NDC"))
+14 IF ('$GET">GET(PSONEW("DFLG")))&('$GET">GET(PSONEW("QFLG")))
SET PSONEW("AWP")=$$AWP^APSQDAWP($SELECT($DATA(PSONEW("NDC")):PSONEW("NDC"),1:PSODRUG("NDC")),PSODRUG("IEN"),.TALK)
+15 IF ('$GET">GET(PSONEW("DFLG")))&('$GET">GET(PSONEW("QFLG")))
SET PSONEW("COST")=$$COST^APSQDAWP($SELECT($DATA(PSONEW("NDC")):PSONEW("NDC"),1:PSODRUG("NDC")),PSODRUG("IEN"),.TALK)
End DoDot:1
+16 KILL PSOX1,PSOY
IF $GET(POERR)
QUIT
+17 ;dup drug/class check
+18 SET DNM=0
FOR
SET DNM=$ORDER(^TMP($JOB,"ORDERS",DNM))
IF 'DNM
QUIT
Begin DoDot:1
+19 SET DRNM=$PIECE(^TMP($JOB,"ORDERS",DNM),"^",3)
+20 IF PSODRUG("NAME")=DRNM
SET DD=$GET(DD)+1
SET ^TMP($JOB,"DD",DD,0)=PSODRUG("IEN")_"^"_PSODRUG("NAME")_"^"_$PIECE(^TMP($JOB,"ORDERS",DNM),"^",4)_"^"_$PIECE(^(DNM),"^",5)
IF '$GET(PSOPHI)
QUIT
+21 IF PSODRUG("VA CLASS")]""
IF $EXTRACT(PSODRUG("VA CLASS"),1,4)=$EXTRACT($PIECE(^TMP($JOB,"ORDERS",DNM),"^"),1,4)
IF DRNM'=PSODRUG("NAME")
Begin DoDot:2
+22 IF $EXTRACT(PSODRUG("VA CLASS"),1,2)="HA"
IF $EXTRACT($PIECE(^TMP($JOB,"ORDERS",DNM),"^"),1,2)="HA"
QUIT
+23 SET PSODC=$ORDER(^PS(50.605,"B",PSODRUG("VA CLASS"),0))
IF 'PSODC
QUIT
+24 SET DC=$GET(DC)+1
SET ^TMP($JOB,"DC",DC,0)=PSODRUG("VA CLASS")
+25 SET PSODC=$PIECE(^PS(50.605,PSODC,0),"^",2)
SET ^TMP($JOB,"DC",DC,0)=^TMP($JOB,"DC",DC,0)_"^"_PSODC_"^"_$ORDER(^PSDRUG("B",DRNM,0))_"^"_DRNM_"^"_$PIECE(^TMP($JOB,"ORDERS",DNM),"^",4)_"^"_$PIECE(^(DNM),"^",5)
End DoDot:2
End DoDot:1
+26 ;drug interaction check
+27 NEW CMP,CMPDR,CDRG,TDRG,CNDF
+28 SET DRG=0
+29 ;IHS/MSC/MGH changed to allow for compound drugs
+30 ;DOIT entry point created to allow for looping
+31 FOR
SET DRG=$ORDER(^TMP($JOB,"ORDERS",DRG))
IF 'DRG
QUIT
Begin DoDot:1
+32 SET DRNM=$PIECE(^TMP($JOB,"ORDERS",DRG),"^",3)
+33 SET TDRG=$ORDER(^PSDRUG("B",DRNM,""))
+34 IF TDRG=""
QUIT
+35 SET CMP=$PIECE($GET(^PSDRUG(TDRG,999999935)),U,1)
+36 IF CMP=1
Begin DoDot:2
+37 SET CMPDR=0
+38 FOR
SET CMPDR=$ORDER(^PSDRUG(TDRG,999999936,CMPDR))
IF '+CMPDR
QUIT
Begin DoDot:3
+39 SET CDRG=$PIECE($GET(^PSDRUG(TDRG,999999936,CMPDR,0)),U,1)
+40 SET CNDF=$SELECT($GET(^PSDRUG(CDRG,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
+41 DO DOIT(DRG,CNDF)
End DoDot:3
End DoDot:2
+42 IF '$TEST
Begin DoDot:2
+43 SET NDF=$PIECE(^TMP($JOB,"ORDERS",DRG),"^",2)
+44 DO DOIT(DRG,NDF)
End DoDot:2
End DoDot:1
+45 DO EXIT
+46 QUIT
DOIT(DRG,NDF) ;Process the drug IHS/MSC/MGH 04/08/2013
+1 SET IT=0
SET PSOICT=""
+2 FOR
SET IT=$ORDER(^PS(56,"APD",NDF,PSODRUG("NDF"),IT))
IF 'IT
QUIT
Begin DoDot:1
+3 IF $$DDIEX^PSNAPIS($PIECE(NDF,"A"),$PIECE(NDF,"A",2))
QUIT
+4 IF $$DDIEX^PSNAPIS($PIECE(PSODRUG("NDF"),"A"),$PIECE(PSODRUG("NDF"),"A",2))
QUIT
+5 IF $PIECE(^PS(56,IT,0),"^",7)&($PIECE(^PS(56,IT,0),"^",7)<DT)
QUIT
+6 IF 'PSOICT
SET PSOICT=IT
QUIT
+7 IF $PIECE($GET(^PS(56,IT,0)),"^",4)=1
SET PSOICT=IT
QUIT
+8 QUIT
End DoDot:1
+9 IF 'PSOICT
QUIT
+10 SET IT=PSOICT
+11 SET DRNM=$PIECE(^TMP($JOB,"ORDERS",DRG),"^",3)
SET ORN=$PIECE(^(DRG),"^",4)
SET RXN=$PIECE(^(DRG),"^",5)
+12 SET DI=$GET(DI)+1
SET ^TMP($JOB,"DI",DI,0)=$ORDER(^PSDRUG("B",DRNM,0))_"^"_DRNM_"^"_IT_"^"_$SELECT($PIECE(^PS(56,IT,0),"^",4)=1:"CRITICAL",1:"SIGNIFICANT")_"^"
+13 SET ^TMP($JOB,"DI",DI,0)=^TMP($JOB,"DI",DI,0)_$PIECE(^PS(50.416,$PIECE(^PS(56,IT,0),"^",2),0),"^")_"^"_$PIECE(^PS(50.416,$PIECE(^PS(56,IT,0),"^",3),0),"^")_"^"_ORN_"^"_RXN
+14 DO REMOTE
+15 IF $GET(PSOPHI)
QUIT
+16 QUIT
EXIT KILL ^TMP($JOB,"ORDERS"),DFN,DA,DNM,DUPRX0,RX,Y,ZZ,PSOCLOZ,PSOY,DRG,DNM,DD,DI,DC,IT,PSODRUG,PSOY,ORN,DRNM
+1 KILL PSOX,EXPDT,PSODRUG0,PSORX0,PSORX2,PSORX3,PSOST0,PSOVACL,X,Y,X1,X2,RXN
+2 QUIT
BLD KILL ^TMP($JOB,"ORDERS")
IF '$DATA(PSODFN)!('$DATA(DT))
GOTO EXIT
+1 SET X1=DT
SET X2=-120
DO C^%DTC
SET PSODTCUT=X
DO BUILD
GOTO GETX
+2 QUIT
BUILD ;build profiles
+1 SET EXPDT=PSODTCUT-1
SET RX=0
+2 FOR
SET EXPDT=$ORDER(^PS(55,PSODFN,"P","A",EXPDT))
IF 'EXPDT
QUIT
FOR
SET RX=$ORDER(^PS(55,PSODFN,"P","A",EXPDT,RX))
IF 'RX
QUIT
IF $DATA(^PSRX(RX,0))
DO GET
+3 SET EN=0
+4 FOR PSOEN=0:0
SET PSOEN=$ORDER(^PS(52.41,"AOR",PSODFN,PSOEN))
IF 'PSOEN
QUIT
Begin DoDot:1
+5 FOR
SET EN=$ORDER(^PS(52.41,"AOR",PSODFN,PSOEN,EN))
IF 'EN
QUIT
Begin DoDot:2
+6 SET PSOOI=^PS(52.41,EN,0)
IF $PIECE(PSOOI,"^",3)'="DC"&($PIECE(PSOOI,"^",3)'="DE")
IF '$PIECE(^PS(52.41,EN,0),"^",9)
DO BLDOI
IF $PIECE(^PS(52.41,EN,0),"^",9)
SET PSODD=+$PIECE(PSOOI,"^",9)
DO SETTMP
End DoDot:2
End DoDot:1
+7 DO BUILDX
+8 QUIT
+9 ;
BLDOI ;If no DD/non-standard dose, get all drugs for OI
+1 NEW PSOI
SET PSOI=$PIECE(PSOOI,"^",8)
IF 'PSOOI
QUIT
+2 SET PSODD=""
FOR
SET PSODD=$ORDER(^PSDRUG("ASP",PSOI,PSODD))
IF 'PSODD
QUIT
DO SETTMP
+3 QUIT
+4 ;
SETTMP ;Create ^TMP($J,"ORDERS"
+1 IF $PIECE(PSOOI,"^",3)="RF"
QUIT
+2 SET DRG=$SELECT(PSODD:$PIECE($GET(^PSDRUG(PSODD,0)),"^"),1:"")
IF DRG']""
QUIT
+3 SET INDX=$GET(INDX)+1
SET ^TMP($JOB,"ORDERS",INDX)=$SELECT(PSODD:$PIECE(^PSDRUG(PSODD,0),"^",2),1:"")_"^"_$SELECT($GET(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)_"^"_DRG_"^"_$PIECE(^PS(52.41,EN,0),"^")_"^"_EN_"P;O"
+4 QUIT
+5 ;
BUILDX KILL EN,PSOOI,PSODD,PSOEN
QUIT
+1 ;
GET ;data for profiles
+1 SET PSORX0=^PSRX(RX,0)
SET PSOST0=+^("STA")
IF PSOST0>5&(PSOST0'=16)
QUIT
+2 SET PSORX2=$GET(^PSRX(RX,2))
SET PSORX3=$GET(^(3))
SET ORN=$PIECE($GET(^("OR1")),"^",2)
IF PSORX3=""
SET PSORX3=$PIECE(PSORX2,"^",2)
+3 SET PSODRUG=+$PIECE(PSORX0,"^",6)
IF '$DATA(^PSDRUG(PSODRUG,0))
QUIT
+4 SET PSODRUG0=^PSDRUG(PSODRUG,0)
SET PSOVACL=$PIECE(PSODRUG0,"^",2)
+5 ;
+6 IF EXPDT<DT
Begin DoDot:1
+7 NEW DIE,DIC,DR,DA
SET STAT="SC"
SET DIE=52
SET DA=RX
SET DR="100////11"
DO ^DIE
KILL DIE,DIC,DR,DA
+8 DO ECAN^PSOUTL(RX)
SET DA=RX
+9 SET COMM="Prescription Expired"
SET PHARMST="ZE"
DO EN^PSOHLSN1(DA,STAT,PHARMST,COMM)
End DoDot:1
+10 SET INDX=$GET(INDX)+1
+11 SET ^TMP($JOB,"ORDERS",INDX)=PSOVACL_"^"_$SELECT($GET(^PSDRUG(PSODRUG,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)_"^"_$PIECE(^PSDRUG(PSODRUG,0),"^")_"^"_ORN_"^"_RX_"R;O"
+12 QUIT
GETX ;
+1 KILL PSOX,EXPDT,PSODRUG,PSODRUG0,PSORX0,PSORX2,PSORX3,PSOST0,PSOVACL,X,Y,X1,X2,ORN
+2 QUIT
CLOZ ;
+1 SET ANQRTN=$PIECE(^PSDRUG(PSODRUG("IEN"),"CLOZ1"),"^")
SET ANQX=0
SET P(5)=PSODRUG("IEN")
SET DFN=PSODFN
SET X=ANQRTN
+2 XECUTE ^%ZOSF("TEST")
IF $TEST
DO @("^"_ANQRTN)
IF $GET(ANQX)
SET PSORX("DFLG")=1
+3 KILL P(5),ANQRTN,ANQX,X
+4 QUIT
DRGCHK(PSODFN,DREN,DDRUG) ;Only check DREN against drug in DDRG()
+1 ;* PSODFN = Patient's DFN
+2 ;* DREN = Dispense drug to be checked against the drug in the array
+3 ;* DDRUG = The array of dispense drug in the buffer.
+4 ;*
+5 KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC")
+6 NEW DDRUG0,DDRUGND,COD,PSJINX
SET COD=""
SET PSJINX=0
+7 SET DDRUG=0
FOR
SET DDRUG=$ORDER(DDRUG(DDRUG))
IF 'DDRUG
QUIT
DO DDRUG^PSJORUT2
+8 DO DRG
+9 QUIT
OIDRG(PSODFN,PSOI) ;checks every drug tied to orderable item passed by package use
+1 KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC"),DD,DC,DI
NEW DREN
SET INDX=0
SET PSOPHI=1
+2 ;build patient's drug profile inpat/outpat/non-va
+3 DO BLD
DO ENCHK^PSJORUT2(PSODFN,.INDX)
DO NVA
+4 FOR DREN=0:0
SET DREN=$ORDER(^PSDRUG("ASP",PSOI,DREN))
IF 'DREN
QUIT
IF $DATA(^PSDRUG(DREN,O))
DO DRG
+5 KILL PSOPHI
DO EXIT
+6 QUIT
NVA ;checks existing nva
+1 FOR I=0:0
SET I=$ORDER(^PS(55,PSODFN,"NVA",I))
IF 'I
QUIT
IF $DATA(^PS(55,PSODFN,"NVA",I,0))
Begin DoDot:1
+2 IF $PIECE(^PS(55,PSODFN,"NVA",I,0),"^",7)
QUIT
+3 SET PSOI=$PIECE(^PS(55,PSODFN,"NVA",I,0),"^")
SET DRG=$PIECE(^(0),"^",2)
SET ORN=$PIECE(^(0),"^",8)
+4 IF DRG
IF $GET(^PSDRUG(DRG,0))]""
DO NVA1
KILL DRG
QUIT
+5 KILL DRG
FOR DRG=0:0
SET DRG=$ORDER(^PSDRUG("ASP",PSOI,DRG))
IF 'DRG
QUIT
IF $DATA(^PSDRUG(DRG,0))
DO NVA1
End DoDot:1
+6 KILL I,PSOOTC,ORN,PSOI,DRG,DRGN,PSOY,VACL,NDF
+7 QUIT
NVA1 SET PSOY=$GET(^PSDRUG(DRG,0))
SET DRGN=$PIECE(PSOY,"^")
SET VACL=$PIECE(PSOY,"^",2)
+1 SET NDF=$SELECT($GET(^PSDRUG(DRG,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
+2 SET INDX=$GET(INDX)+1
SET ^TMP($JOB,"ORDERS",INDX)=VACL_"^"_NDF_"^"_DRGN_"^"_ORN_"^"_I_"N;O"
+3 QUIT
+4 ;
REMOTE ;
+1 IF $TEXT(HAVEHDR^ORRDI1)']""
QUIT
+2 IF '$$HAVEHDR^ORRDI1
QUIT
+3 DO REMOTE^PSOORRDI(PSODFN,DREN)
+4 ;THIS LEVEL ONLY NEEDED FOR BACKDOOR OUTPATIENT PHARMACY CHECKS
KILL ^TMP($JOB,"DI"_PSODFN)
+5 QUIT
+6 ;
