APSPCDI ; IHS/MSC/PLS - CRITICAL DRUG INTERACTION REPORT ;12-Jan-2012 12:00;PLS
;;7.0;IHS PHARMACY MODIFICATIONS;**1013**;Sep 23, 2004;Build 33
;
EN ;EP
N APSPBD,APSPED,APSPBDF,APSPEDF,APSPDIV,APSPQ,APSPDSUB
N APSPDCT,APSPDCTN,APSPDRG,APSPSORT,STATS,APSPDOSE,APSPPRV
N APSPPAT,APSPIVN
S APSPDIV="",APSPDRG="",APSPQ=0,APSPDSUB=0,APSPDOSE=0,APSPPRV=""
S APSPPAT=""
W @IOF
W !!,"Critical Drug Interaction Report"
D ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)
Q:APSPQ
S APSPBDF=$P($TR($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)
S APSPEDF=$P($TR($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)
S APSPBD=APSPBD-.01,APSPED=APSPED+.99
S APSPDIV=$$DIR^APSPUTIL("Y","Would you like all pharmacy divisions","Yes",,.APSPQ)
Q:APSPQ
I APSPDIV D
.S APSPDIV="*"
E D Q:APSPQ
.S APSPDIV=$$GETIEN^APSPUTIL(59,"Select Pharmacy Division: ",.APSPQ)
Q:APSPQ
S APSPIVN=$$DIR^APSPUTIL("Y","Would you like to include Critical Drug Interactions from Pharmacy Intervention entries","Yes",,.APSPQ)
Q:APSPQ
S APSPSORT=+$$DIR^APSPUTIL("S^1:Drug Name;2:Fill Date;3:Patient;4:Prescriber","Sort report by","",,.APSPQ)
Q:APSPQ
S APSPPAT="*"
I APSPSORT=3 D
.S APSPPAT=$$DIR^APSPUTIL("Y","Would you like all patients","Yes",,.APSPQ)
.Q:APSPQ
.I APSPPAT D
..S APSPPAT="*"
.E D Q:APSPQ
..S APSPPAT=+$$DIR^APSPUTIL("9000001,.01","Select Patient: ",,,.APSPQ)
Q:APSPQ
S APSPPRV="*"
I APSPSORT=4 D
.S APSPPRV=$$DIR^APSPUTIL("Y","Would you like all prescribers","Yes",,.APSPQ)
.Q:APSPQ
.I APSPPRV D
..S APSPPRV="*"
.E D Q:APSPQ
..S APSPPRV=+$$DIR^APSPUTIL("52,4","Select Prescriber: ",,,.APSPQ)
Q:APSPQ
D DEV
Q
DEV ;
D OUT^APSPCDI
Q
N XBRP,XBNS
S XBRP="OUT^APSPCDI"
S XBNS="APS*"
D ^XBDBQUE
Q
OUT ;EP
U IO
K ^TMP($J)
D FIND(APSPBD,APSPED,"AD") ; Regular and Refill
D FIND(APSPBD,APSPED,"ADP") ; Partial
D:APSPIVN FINDINTV(APSPBD,APSPED) ; APSP Interventions
D SORT
D PRINT^APSPCDI1
;K ^TMP($J)
Q
;
FIND(SDT,EDT,XREF) ;EP
N RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN
S FDTLP=SDT-.01
F S FDTLP=$O(^PSRX(XREF,FDTLP)) Q:'FDTLP!(FDTLP>EDT) D
.S RXIEN=0
.F S RXIEN=$O(^PSRX(XREF,FDTLP,RXIEN)) Q:'RXIEN D
..Q:'$$PATVRY(RXIEN,APSPPAT) ;check patient
..Q:'$P(^PSRX(RXIEN,0),U,6) ; Prescription must have a drug
..Q:$$GET1^DIQ(52,RXIEN,100,"I")=13 ; Quit if Deleted status
..S IEN="" F S IEN=$O(^PSRX(XREF,FDTLP,RXIEN,IEN)) Q:IEN="" D
...Q:'IEN&($$GET1^DIQ(52,RXIEN,32.1,"I")) ; Quit if original fill and a return to stock date exists
...Q:'$$DIVVRY(RXIEN,APSPDIV,XREF,IEN) ;check division
...Q:'$$DSPRDT(RXIEN,XREF,IEN) ;check for release date
...Q:'$$PRVVRY(RXIEN,APSPPRV,XREF,IEN) ;check provider
...Q:'$$CDIVRY(RXIEN) ;check for Critical Drug Interaction on order
...D SET(FDTLP,RXIEN,XREF,IEN)
Q
;
FINDINTV(SDT,EDT) ;EP
N FDTLP,IEN
S FDTLP=SDT-.01
F S FDTLP=$O(^APSPQA(32.4,"B",FDTLP)) Q:'FDTLP!(FDTLP>EDT) D
.S IEN=0
.F S IEN=$O(^APSPQA(32.4,"B",FDTLP,IEN)) Q:'IEN D
..Q:'$$PATVRY(IEN,APSPPAT,1)
..Q:'$P(^APSPQA(32.4,IEN,0),U,5) ;Intervention must have a drug
..Q:'$$PRVVRY(IEN,APSPPRV,,,1) ;check provider
..Q:'$$CDIVRYA(IEN) ;check for Critical Drug Interaction on intervention
..D SETA(FDTLP,IEN) ;set intervention data
Q
;
SORT ;EP -
Q
; Set data into ^TMP global for output
SET(FDT,RX,XREF,SIEN) ;EP
;DATE FILLED
;CHART NUMBER;
;PATIENT NAME
;RX NUMBER
;MEDICATION FILLED
;INTERACTION
;OVER-RIDING PROVIDER OR PHARMACIST
;OVER-RIDING REASON
N LSTDSPDT,NODE0,NODE2,NODE3,DIV,RTSDATE,DRUG,RDT,RIFLG,FTYPE
N PNM,DFN,DAYS,OPRV,PHRM,QTY,OPRVNM,NXT
S FTYPE=$S(XREF="ADP":"P",SIEN:"R",1:"F")
S NXT=$O(^TMP($J,"DATA",$C(1)),-1)
S NXT=NXT+1
S NODE0=^PSRX(RX,0)
S NODE2=^PSRX(RX,2)
S NODE3=^PSRX(RX,3)
S DRUG=$P(NODE0,U,6)
S DFN=$P(NODE0,U,2)
S PNM=$$GET1^DIQ(2,DFN,.01)
S DRGNM=$P(^PSDRUG(DRUG,0),U)
S LSTDSPDT=+NODE3
S RIFLG=""
S DIV=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.09,FTYPE="R":8,1:20),"I") ; Pharmacy Division IEN
S RDT=$$GET1^DIQ(52,RX,31,"I") ;Release Date
S QTY=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.04,FTYPE="R":1,1:7))
S DAYS=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.041,FTYPE="R":1.1,1:8))
S OPRV=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":6,FTYPE="R":15,1:4),"I")
S OPRVNM=$$GET1^DIQ(200,OPRV,.01)
S:'$L(OPRVNM) OPRVNM="NONAME"
S PHRM=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.05,FTYPE="R":4,1:23),"I")
; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
;Format: Prescription IEN^Fill Date^Xref ("AD" or "ADP")^Fill SubIEN^Prescription Number^QTY^Drug Class^Drug Name^Fill Type^RI Flg^Drug IEN^RX Division^Days Supply^Prescriber^Pharmacist^Number of Order Checks
S ^TMP($J,"DATA",NXT)=RXIEN_U_FDT_U_XREF_U_SIEN_U_$P(NODE0,U)_U_QTY_U_""_U_DRGNM_U_FTYPE_U_RIFLG_U_DRUG_U_DIV_U_DAYS_U_OPRV_U_PHRM_U_$$OCKCNT(RXIEN)
S ^TMP($J,"XREF",DIV,"FDT",FDT,DRGNM,NXT)=""
S ^TMP($J,"XREF",DIV,"DRUG",DRGNM,FDT,NXT)=""
S ^TMP($J,"XREF",DIV,"S-DRUG",DRGNM,NXT)=""
S ^TMP($J,"XREF",DIV,"S-FDT",FDT,DRGNM,NXT)=""
S ^TMP($J,"XREF",DIV,"PAT",PNM,FDT,DRGNM,NXT)=""
S ^TMP($J,"XREF",DIV,"PRV",OPRVNM,DRGNM,FDT,NXT)=""
S ^TMP($J,"XREF","RX",RX,FTYPE,SIEN)=NXT
Q
;
SETA(FDT,IEN) ;EP-
N NXT,NODE0,DRUG,DFN,PNM,DRGNM,PHRMC,PRV,PRVNM,DIV
S NODE0=$G(^APSPQA(32.4,IEN,0))
S DRUG=$P(NODE0,U,5)
Q:DRUG=""
S DFN=$P(NODE0,U,2)
S PNM=$$GET1^DIQ(2,DFN,.01)
Q:PNM=""
S DRGNM=$P(^PSDRUG(DRUG,0),U)
Q:DRGNM=""
S PHRMC=$P(NODE0,U,4)
S PRV=+$P(NODE0,U,3)
S PRVNM=$$GET1^DIQ(200,PRV,.01)
S:'$L(PRVNM) PRVNM="UNKNOWN"
S DIV=$P(NODE0,U,16)
Q:DIV=""
S NXT=$O(^TMP($J,"DATA",$C(1)),-1)
S NXT=NXT+1
;
;Format: Prescription IEN^Fill Date^Xref ("AD" or "ADP")^Fill SubIEN^Pr
S ^TMP($J,"DATA",NXT)=IEN_U_FDT_U_"APSP"
S ^TMP($J,"XREF",DIV,"FDT",FDT,DRGNM,NXT)=""
S ^TMP($J,"XREF",DIV,"DRUG",DRGNM,FDT,NXT)=""
S ^TMP($J,"XREF",DIV,"S-DRUG",DRGNM,NXT)=""
S ^TMP($J,"XREF",DIV,"S-FDT",FDT,DRGNM,NXT)=""
S ^TMP($J,"XREF",DIV,"PAT",PNM,FDT,DRGNM,NXT)=""
S ^TMP($J,"XREF",DIV,"PRV",PRVNM,DRGNM,FDT,NXT)=""
Q
; Return boolean flag indicating valid pharmacy division
DIVVRY(RX,DIV,TYP,SIEN) ;EP
Q:DIV="*" 1
Q $S($G(SIEN):DIV=+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,9),1:DIV=+$P(^PSRX(RX,2),U,9))
; Return release date for dispense
DSPRDT(RX,TYP,SIEN) ;EP
Q $S($G(SIEN):+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,$S(TYP="ADP":19,1:18)),1:+$P(^PSRX(RX,2),U,13))
; Return boolean flag indicating valid provider
PRVVRY(RX,PRV,TYP,SIEN,APSP) ;EP
Q:PRV="*" 1
Q:$G(APSP) +$P($G(^APSPQA(32.4,IEN,0)),U,3)=PRV
Q $S($G(SIEN):PRV=+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,17),1:PRV=$P(^PSRX(RX,0),U,4))
; Return boolean flag indicating valid patient
PATVRY(IEN,PAT,APSP) ;EP
Q:PAT="*" 1
Q:$G(APSP) +$P($G(^APSPQA(32.4,IEN,0)),U,2)=PAT
Q +$P($G(^PSRX(IEN,0)),U,2)=PAT
; Return boolean flag indicating valid order with order check of Critical Drug Indication
CDIVRY(RX) ;EP-
N IEN,RES,ORDID
S RES=0
S ORDID=$P(^PSRX(RX,"OR1"),U,2)
S IEN=0 F S IEN=$O(^OR(100,ORDID,9,IEN)) Q:'IEN D Q:RES
.S RES=$$GET1^DIQ(100.8,$P($G(^OR(100,+ORDID,9,IEN,0)),U),.01)="CRITICAL DRUG INTERACTION"
Q RES
; Return boolean flag indicating intervention with Critical Drug Interaction
CDIVRYA(IEN) ;EP-
Q $P($G(^APSPQA(32.4,IEN,0)),U,7)=18
; Return number of order checks on order
OCKCNT(RX) ;EP-
N IEN,CNT,ORDID
S (IEN,CNT)=0
S ORDID=$P(^PSRX(RX,"OR1"),U,2)
F S IEN=$O(^OR(100,ORDID,9,IEN)) Q:'IEN S CNT=CNT+1
Q CNT
APSPCDI ; IHS/MSC/PLS - CRITICAL DRUG INTERACTION REPORT ;12-Jan-2012 12:00;PLS
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1013**;Sep 23, 2004;Build 33
+2 ;
EN ;EP
+1 NEW APSPBD,APSPED,APSPBDF,APSPEDF,APSPDIV,APSPQ,APSPDSUB
+2 NEW APSPDCT,APSPDCTN,APSPDRG,APSPSORT,STATS,APSPDOSE,APSPPRV
+3 NEW APSPPAT,APSPIVN
+4 SET APSPDIV=""
SET APSPDRG=""
SET APSPQ=0
SET APSPDSUB=0
SET APSPDOSE=0
SET APSPPRV=""
+5 SET APSPPAT=""
+6 WRITE @IOF
+7 WRITE !!,"Critical Drug Interaction Report"
+8 DO ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)
+9 IF APSPQ
QUIT
+10 SET APSPBDF=$PIECE($TRANSLATE($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)
+11 SET APSPEDF=$PIECE($TRANSLATE($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)
+12 SET APSPBD=APSPBD-.01
SET APSPED=APSPED+.99
+13 SET APSPDIV=$$DIR^APSPUTIL("Y","Would you like all pharmacy divisions","Yes",,.APSPQ)
+14 IF APSPQ
QUIT
+15 IF APSPDIV
Begin DoDot:1
+16 SET APSPDIV="*"
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 SET APSPDIV=$$GETIEN^APSPUTIL(59,"Select Pharmacy Division: ",.APSPQ)
End DoDot:1
IF APSPQ
QUIT
+19 IF APSPQ
QUIT
+20 SET APSPIVN=$$DIR^APSPUTIL("Y","Would you like to include Critical Drug Interactions from Pharmacy Intervention entries","Yes",,.APSPQ)
+21 IF APSPQ
QUIT
+22 SET APSPSORT=+$$DIR^APSPUTIL("S^1:Drug Name;2:Fill Date;3:Patient;4:Prescriber","Sort report by","",,.APSPQ)
+23 IF APSPQ
QUIT
+24 SET APSPPAT="*"
+25 IF APSPSORT=3
Begin DoDot:1
+26 SET APSPPAT=$$DIR^APSPUTIL("Y","Would you like all patients","Yes",,.APSPQ)
+27 IF APSPQ
QUIT
+28 IF APSPPAT
Begin DoDot:2
+29 SET APSPPAT="*"
End DoDot:2
+30 IF '$TEST
Begin DoDot:2
+31 SET APSPPAT=+$$DIR^APSPUTIL("9000001,.01","Select Patient: ",,,.APSPQ)
End DoDot:2
IF APSPQ
QUIT
End DoDot:1
+32 IF APSPQ
QUIT
+33 SET APSPPRV="*"
+34 IF APSPSORT=4
Begin DoDot:1
+35 SET APSPPRV=$$DIR^APSPUTIL("Y","Would you like all prescribers","Yes",,.APSPQ)
+36 IF APSPQ
QUIT
+37 IF APSPPRV
Begin DoDot:2
+38 SET APSPPRV="*"
End DoDot:2
+39 IF '$TEST
Begin DoDot:2
+40 SET APSPPRV=+$$DIR^APSPUTIL("52,4","Select Prescriber: ",,,.APSPQ)
End DoDot:2
IF APSPQ
QUIT
End DoDot:1
+41 IF APSPQ
QUIT
+42 DO DEV
+43 QUIT
DEV ;
+1 DO OUT^APSPCDI
+2 QUIT
+3 NEW XBRP,XBNS
+4 SET XBRP="OUT^APSPCDI"
+5 SET XBNS="APS*"
+6 DO ^XBDBQUE
+7 QUIT
OUT ;EP
+1 USE IO
+2 KILL ^TMP($JOB)
+3 ; Regular and Refill
DO FIND(APSPBD,APSPED,"AD")
+4 ; Partial
DO FIND(APSPBD,APSPED,"ADP")
+5 ; APSP Interventions
IF APSPIVN
DO FINDINTV(APSPBD,APSPED)
+6 DO SORT
+7 DO PRINT^APSPCDI1
+8 ;K ^TMP($J)
+9 QUIT
+10 ;
FIND(SDT,EDT,XREF) ;EP
+1 NEW RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN
+2 SET FDTLP=SDT-.01
+3 FOR
SET FDTLP=$ORDER(^PSRX(XREF,FDTLP))
IF 'FDTLP!(FDTLP>EDT)
QUIT
Begin DoDot:1
+4 SET RXIEN=0
+5 FOR
SET RXIEN=$ORDER(^PSRX(XREF,FDTLP,RXIEN))
IF 'RXIEN
QUIT
Begin DoDot:2
+6 ;check patient
IF '$$PATVRY(RXIEN,APSPPAT)
QUIT
+7 ; Prescription must have a drug
IF '$PIECE(^PSRX(RXIEN,0),U,6)
QUIT
+8 ; Quit if Deleted status
IF $$GET1^DIQ(52,RXIEN,100,"I")=13
QUIT
+9 SET IEN=""
FOR
SET IEN=$ORDER(^PSRX(XREF,FDTLP,RXIEN,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+10 ; Quit if original fill and a return to stock date exists
IF 'IEN&($$GET1^DIQ(52,RXIEN,32.1,"I"))
QUIT
+11 ;check division
IF '$$DIVVRY(RXIEN,APSPDIV,XREF,IEN)
QUIT
+12 ;check for release date
IF '$$DSPRDT(RXIEN,XREF,IEN)
QUIT
+13 ;check provider
IF '$$PRVVRY(RXIEN,APSPPRV,XREF,IEN)
QUIT
+14 ;check for Critical Drug Interaction on order
IF '$$CDIVRY(RXIEN)
QUIT
+15 DO SET(FDTLP,RXIEN,XREF,IEN)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
FINDINTV(SDT,EDT) ;EP
+1 NEW FDTLP,IEN
+2 SET FDTLP=SDT-.01
+3 FOR
SET FDTLP=$ORDER(^APSPQA(32.4,"B",FDTLP))
IF 'FDTLP!(FDTLP>EDT)
QUIT
Begin DoDot:1
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^APSPQA(32.4,"B",FDTLP,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+6 IF '$$PATVRY(IEN,APSPPAT,1)
QUIT
+7 ;Intervention must have a drug
IF '$PIECE(^APSPQA(32.4,IEN,0),U,5)
QUIT
+8 ;check provider
IF '$$PRVVRY(IEN,APSPPRV,,,1)
QUIT
+9 ;check for Critical Drug Interaction on intervention
IF '$$CDIVRYA(IEN)
QUIT
+10 ;set intervention data
DO SETA(FDTLP,IEN)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
SORT ;EP -
+1 QUIT
+2 ; Set data into ^TMP global for output
SET(FDT,RX,XREF,SIEN) ;EP
+1 ;DATE FILLED
+2 ;CHART NUMBER;
+3 ;PATIENT NAME
+4 ;RX NUMBER
+5 ;MEDICATION FILLED
+6 ;INTERACTION
+7 ;OVER-RIDING PROVIDER OR PHARMACIST
+8 ;OVER-RIDING REASON
+9 NEW LSTDSPDT,NODE0,NODE2,NODE3,DIV,RTSDATE,DRUG,RDT,RIFLG,FTYPE
+10 NEW PNM,DFN,DAYS,OPRV,PHRM,QTY,OPRVNM,NXT
+11 SET FTYPE=$SELECT(XREF="ADP":"P",SIEN:"R",1:"F")
+12 SET NXT=$ORDER(^TMP($JOB,"DATA",$CHAR(1)),-1)
+13 SET NXT=NXT+1
+14 SET NODE0=^PSRX(RX,0)
+15 SET NODE2=^PSRX(RX,2)
+16 SET NODE3=^PSRX(RX,3)
+17 SET DRUG=$PIECE(NODE0,U,6)
+18 SET DFN=$PIECE(NODE0,U,2)
+19 SET PNM=$$GET1^DIQ(2,DFN,.01)
+20 SET DRGNM=$PIECE(^PSDRUG(DRUG,0),U)
+21 SET LSTDSPDT=+NODE3
+22 SET RIFLG=""
+23 ; Pharmacy Division IEN
SET DIV=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:SIEN_","_RX_",",1:RX),$SELECT(FTYPE="P":.09,FTYPE="R":8,1:20),"I")
+24 ;Release Date
SET RDT=$$GET1^DIQ(52,RX,31,"I")
+25 SET QTY=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:SIEN_","_RX_",",1:RX),$SELECT(FTYPE="P":.04,FTYPE="R":1,1:7))
+26 SET DAYS=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:SIEN_","_RX_",",1:RX),$SELECT(FTYPE="P":.041,FTYPE="R":1.1,1:8))
+27 SET OPRV=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:SIEN_","_RX_",",1:RX),$SELECT(FTYPE="P":6,FTYPE="R":15,1:4),"I")
+28 SET OPRVNM=$$GET1^DIQ(200,OPRV,.01)
+29 IF '$LENGTH(OPRVNM)
SET OPRVNM="NONAME"
+30 SET PHRM=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:SIEN_","_RX_",",1:RX),$SELECT(FTYPE="P":.05,FTYPE="R":4,1:23),"I")
+31 ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
+32 ;Format: Prescription IEN^Fill Date^Xref ("AD" or "ADP")^Fill SubIEN^Prescription Number^QTY^Drug Class^Drug Name^Fill Type^RI Flg^Drug IEN^RX Division^Days Supply^Prescriber^Pharmacist^Number of Order Checks
+33 SET ^TMP($JOB,"DATA",NXT)=RXIEN_U_FDT_U_XREF_U_SIEN_U_$PIECE(NODE0,U)_U_QTY_U_""_U_DRGNM_U_FTYPE_U_RIFLG_U_DRUG_U_DIV_U_DAYS_U_OPRV_U_PHRM_U_$$OCKCNT(RXIEN)
+34 SET ^TMP($JOB,"XREF",DIV,"FDT",FDT,DRGNM,NXT)=""
+35 SET ^TMP($JOB,"XREF",DIV,"DRUG",DRGNM,FDT,NXT)=""
+36 SET ^TMP($JOB,"XREF",DIV,"S-DRUG",DRGNM,NXT)=""
+37 SET ^TMP($JOB,"XREF",DIV,"S-FDT",FDT,DRGNM,NXT)=""
+38 SET ^TMP($JOB,"XREF",DIV,"PAT",PNM,FDT,DRGNM,NXT)=""
+39 SET ^TMP($JOB,"XREF",DIV,"PRV",OPRVNM,DRGNM,FDT,NXT)=""
+40 SET ^TMP($JOB,"XREF","RX",RX,FTYPE,SIEN)=NXT
+41 QUIT
+42 ;
SETA(FDT,IEN) ;EP-
+1 NEW NXT,NODE0,DRUG,DFN,PNM,DRGNM,PHRMC,PRV,PRVNM,DIV
+2 SET NODE0=$GET(^APSPQA(32.4,IEN,0))
+3 SET DRUG=$PIECE(NODE0,U,5)
+4 IF DRUG=""
QUIT
+5 SET DFN=$PIECE(NODE0,U,2)
+6 SET PNM=$$GET1^DIQ(2,DFN,.01)
+7 IF PNM=""
QUIT
+8 SET DRGNM=$PIECE(^PSDRUG(DRUG,0),U)
+9 IF DRGNM=""
QUIT
+10 SET PHRMC=$PIECE(NODE0,U,4)
+11 SET PRV=+$PIECE(NODE0,U,3)
+12 SET PRVNM=$$GET1^DIQ(200,PRV,.01)
+13 IF '$LENGTH(PRVNM)
SET PRVNM="UNKNOWN"
+14 SET DIV=$PIECE(NODE0,U,16)
+15 IF DIV=""
QUIT
+16 SET NXT=$ORDER(^TMP($JOB,"DATA",$CHAR(1)),-1)
+17 SET NXT=NXT+1
+18 ;
+19 ;Format: Prescription IEN^Fill Date^Xref ("AD" or "ADP")^Fill SubIEN^Pr
+20 SET ^TMP($JOB,"DATA",NXT)=IEN_U_FDT_U_"APSP"
+21 SET ^TMP($JOB,"XREF",DIV,"FDT",FDT,DRGNM,NXT)=""
+22 SET ^TMP($JOB,"XREF",DIV,"DRUG",DRGNM,FDT,NXT)=""
+23 SET ^TMP($JOB,"XREF",DIV,"S-DRUG",DRGNM,NXT)=""
+24 SET ^TMP($JOB,"XREF",DIV,"S-FDT",FDT,DRGNM,NXT)=""
+25 SET ^TMP($JOB,"XREF",DIV,"PAT",PNM,FDT,DRGNM,NXT)=""
+26 SET ^TMP($JOB,"XREF",DIV,"PRV",PRVNM,DRGNM,FDT,NXT)=""
+27 QUIT
+28 ; Return boolean flag indicating valid pharmacy division
DIVVRY(RX,DIV,TYP,SIEN) ;EP
+1 IF DIV="*"
QUIT 1
+2 QUIT $SELECT($GET(SIEN):DIV=+$PIECE($GET(^PSRX(RX,$SELECT(TYP="ADP":"P",1:1),SIEN,0)),U,9),1:DIV=+$PIECE(^PSRX(RX,2),U,9))
+3 ; Return release date for dispense
DSPRDT(RX,TYP,SIEN) ;EP
+1 QUIT $SELECT($GET(SIEN):+$PIECE($GET(^PSRX(RX,$SELECT(TYP="ADP":"P",1:1),SIEN,0)),U,$SELECT(TYP="ADP":19,1:18)),1:+$PIECE(^PSRX(RX,2),U,13))
+2 ; Return boolean flag indicating valid provider
PRVVRY(RX,PRV,TYP,SIEN,APSP) ;EP
+1 IF PRV="*"
QUIT 1
+2 IF $GET(APSP)
QUIT +$PIECE($GET(^APSPQA(32.4,IEN,0)),U,3)=PRV
+3 QUIT $SELECT($GET(SIEN):PRV=+$PIECE($GET(^PSRX(RX,$SELECT(TYP="ADP":"P",1:1),SIEN,0)),U,17),1:PRV=$PIECE(^PSRX(RX,0),U,4))
+4 ; Return boolean flag indicating valid patient
PATVRY(IEN,PAT,APSP) ;EP
+1 IF PAT="*"
QUIT 1
+2 IF $GET(APSP)
QUIT +$PIECE($GET(^APSPQA(32.4,IEN,0)),U,2)=PAT
+3 QUIT +$PIECE($GET(^PSRX(IEN,0)),U,2)=PAT
+4 ; Return boolean flag indicating valid order with order check of Critical Drug Indication
CDIVRY(RX) ;EP-
+1 NEW IEN,RES,ORDID
+2 SET RES=0
+3 SET ORDID=$PIECE(^PSRX(RX,"OR1"),U,2)
+4 SET IEN=0
FOR
SET IEN=$ORDER(^OR(100,ORDID,9,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+5 SET RES=$$GET1^DIQ(100.8,$PIECE($GET(^OR(100,+ORDID,9,IEN,0)),U),.01)="CRITICAL DRUG INTERACTION"
End DoDot:1
IF RES
QUIT
+6 QUIT RES
+7 ; Return boolean flag indicating intervention with Critical Drug Interaction
CDIVRYA(IEN) ;EP-
+1 QUIT $PIECE($GET(^APSPQA(32.4,IEN,0)),U,7)=18
+2 ; Return number of order checks on order
OCKCNT(RX) ;EP-
+1 NEW IEN,CNT,ORDID
+2 SET (IEN,CNT)=0
+3 SET ORDID=$PIECE(^PSRX(RX,"OR1"),U,2)
+4 FOR
SET IEN=$ORDER(^OR(100,ORDID,9,IEN))
IF 'IEN
QUIT
SET CNT=CNT+1
+5 QUIT CNT
