PSOORDRG ;BIR/SAB - order entry drug selection ;11/13/97
;;7.0;OUTPATIENT PHARMACY;**3,29,49,46,81,105,134,144,132,188,207,148,243,251,379**;DEC 1997;Build 28
;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
;
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)
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
S DRG=0
F S DRG=$O(^TMP($J,"ORDERS",DRG)) Q:'DRG S NDF=$P(^TMP($J,"ORDERS",DRG),"^",2) D
.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)
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
..Q:'$P(^PS(52.41,EN,0),"^",8)
..S PSOOI=^PS(52.41,EN,0)
..I $P(PSOOI,"^",3)'="DC"&($P(PSOOI,"^",3)'="DE") D
...I '$P(^PS(52.41,EN,0),"^",9) D BLDOI Q
...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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORDRG 7547 printed Sep 23, 2025@20:08:15 Page 2
PSOORDRG ;BIR/SAB - order entry drug selection ;11/13/97
+1 ;;7.0;OUTPATIENT PHARMACY;**3,29,49,46,81,105,134,144,132,188,207,148,243,251,379**;DEC 1997;Build 28
+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 ;
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^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 KILL PSOX1,PSOY
if $GET(POERR)
QUIT
+11 ;dup drug/class check
+12 SET DNM=0
FOR
SET DNM=$ORDER(^TMP($JOB,"ORDERS",DNM))
if 'DNM
QUIT
Begin DoDot:1
+13 SET DRNM=$PIECE(^TMP($JOB,"ORDERS",DNM),"^",3)
+14 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
+15 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
+16 IF $EXTRACT(PSODRUG("VA CLASS"),1,2)="HA"
IF $EXTRACT($PIECE(^TMP($JOB,"ORDERS",DNM),"^"),1,2)="HA"
QUIT
+17 SET PSODC=$ORDER(^PS(50.605,"B",PSODRUG("VA CLASS"),0))
if 'PSODC
QUIT
+18 SET DC=$GET(DC)+1
SET ^TMP($JOB,"DC",DC,0)=PSODRUG("VA CLASS")
+19 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
+20 ;drug interaction check
+21 SET DRG=0
+22 FOR
SET DRG=$ORDER(^TMP($JOB,"ORDERS",DRG))
if 'DRG
QUIT
SET NDF=$PIECE(^TMP($JOB,"ORDERS",DRG),"^",2)
Begin DoDot:1
+23 SET IT=0
SET PSOICT=""
+24 FOR
SET IT=$ORDER(^PS(56,"APD",NDF,PSODRUG("NDF"),IT))
if 'IT
QUIT
Begin DoDot:2
+25 if $$DDIEX^PSNAPIS($PIECE(NDF,"A"),$PIECE(NDF,"A",2))
QUIT
+26 if $$DDIEX^PSNAPIS($PIECE(PSODRUG("NDF"),"A"),$PIECE(PSODRUG("NDF"),"A",2))
QUIT
+27 if $PIECE(^PS(56,IT,0),"^",7)&($PIECE(^PS(56,IT,0),"^",7)<DT)
QUIT
+28 IF 'PSOICT
SET PSOICT=IT
QUIT
+29 IF $PIECE($GET(^PS(56,IT,0)),"^",4)=1
SET PSOICT=IT
QUIT
+30 QUIT
End DoDot:2
+31 IF 'PSOICT
QUIT
+32 SET IT=PSOICT
+33 SET DRNM=$PIECE(^TMP($JOB,"ORDERS",DRG),"^",3)
SET ORN=$PIECE(^(DRG),"^",4)
SET RXN=$PIECE(^(DRG),"^",5)
+34 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")_"^"
+35 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
End DoDot:1
+36 DO REMOTE
+37 if $GET(PSOPHI)
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 if '$PIECE(^PS(52.41,EN,0),"^",8)
QUIT
+7 SET PSOOI=^PS(52.41,EN,0)
+8 IF $PIECE(PSOOI,"^",3)'="DC"&($PIECE(PSOOI,"^",3)'="DE")
Begin DoDot:3
+9 IF '$PIECE(^PS(52.41,EN,0),"^",9)
DO BLDOI
QUIT
+10 SET PSODD=+$PIECE(PSOOI,"^",9)
DO SETTMP
End DoDot:3
End DoDot:2
End DoDot:1
+11 DO BUILDX
+12 QUIT
+13 ;
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 ;
