Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APSPCDI

APSPCDI.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EN ;EP
  1.  N APSPBD,APSPED,APSPBDF,APSPEDF,APSPDIV,APSPQ,APSPDSUB
  1.  N APSPDCT,APSPDCTN,APSPDRG,APSPSORT,STATS,APSPDOSE,APSPPRV
  1.  N APSPPAT,APSPIVN
  1.  S APSPDIV="",APSPDRG="",APSPQ=0,APSPDSUB=0,APSPDOSE=0,APSPPRV=""
  1.  S APSPPAT=""
  1.  W @IOF
  1.  W !!,"Critical Drug Interaction Report"
  1.  D ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)
  1.  Q:APSPQ
  1.  S APSPBDF=$P($TR($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)
  1.  S APSPEDF=$P($TR($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)
  1.  S APSPBD=APSPBD-.01,APSPED=APSPED+.99
  1.  S APSPDIV=$$DIR^APSPUTIL("Y","Would you like all pharmacy divisions","Yes",,.APSPQ)
  1.  Q:APSPQ
  1.  I APSPDIV D
  1.  .S APSPDIV="*"
  1.  E  D  Q:APSPQ
  1.  .S APSPDIV=$$GETIEN^APSPUTIL(59,"Select Pharmacy Division: ",.APSPQ)
  1.  Q:APSPQ
  1.  S APSPIVN=$$DIR^APSPUTIL("Y","Would you like to include Critical Drug Interactions from Pharmacy Intervention entries","Yes",,.APSPQ)
  1.  Q:APSPQ
  1.  S APSPSORT=+$$DIR^APSPUTIL("S^1:Drug Name;2:Fill Date;3:Patient;4:Prescriber","Sort report by","",,.APSPQ)
  1.  Q:APSPQ
  1.  S APSPPAT="*"
  1.  I APSPSORT=3 D
  1.  .S APSPPAT=$$DIR^APSPUTIL("Y","Would you like all patients","Yes",,.APSPQ)
  1.  .Q:APSPQ
  1.  .I APSPPAT D
  1.  ..S APSPPAT="*"
  1.  .E  D  Q:APSPQ
  1.  ..S APSPPAT=+$$DIR^APSPUTIL("9000001,.01","Select Patient: ",,,.APSPQ)
  1.  Q:APSPQ
  1.  S APSPPRV="*"
  1.  I APSPSORT=4 D
  1.  .S APSPPRV=$$DIR^APSPUTIL("Y","Would you like all prescribers","Yes",,.APSPQ)
  1.  .Q:APSPQ
  1.  .I APSPPRV D
  1.  ..S APSPPRV="*"
  1.  .E  D  Q:APSPQ
  1.  ..S APSPPRV=+$$DIR^APSPUTIL("52,4","Select Prescriber: ",,,.APSPQ)
  1.  Q:APSPQ
  1.  D DEV
  1.  Q
  1. DEV ;
  1.  D OUT^APSPCDI
  1.  Q
  1.  N XBRP,XBNS
  1.  S XBRP="OUT^APSPCDI"
  1.  S XBNS="APS*"
  1.  D ^XBDBQUE
  1.  Q
  1. OUT ;EP
  1.  U IO
  1.  K ^TMP($J)
  1.  D FIND(APSPBD,APSPED,"AD")  ; Regular and Refill
  1.  D FIND(APSPBD,APSPED,"ADP")  ; Partial
  1.  D:APSPIVN FINDINTV(APSPBD,APSPED)  ; APSP Interventions
  1.  D SORT
  1.  D PRINT^APSPCDI1
  1.  ;K ^TMP($J)
  1.  Q
  1.  ;
  1. FIND(SDT,EDT,XREF) ;EP
  1.  N RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN
  1.  S FDTLP=SDT-.01
  1.  F  S FDTLP=$O(^PSRX(XREF,FDTLP)) Q:'FDTLP!(FDTLP>EDT)  D
  1.  .S RXIEN=0
  1.  .F  S RXIEN=$O(^PSRX(XREF,FDTLP,RXIEN)) Q:'RXIEN  D
  1.  ..Q:'$$PATVRY(RXIEN,APSPPAT)  ;check patient
  1.  ..Q:'$P(^PSRX(RXIEN,0),U,6)   ; Prescription must have a drug
  1.  ..Q:$$GET1^DIQ(52,RXIEN,100,"I")=13  ; Quit if Deleted status
  1.  ..S IEN="" F  S IEN=$O(^PSRX(XREF,FDTLP,RXIEN,IEN)) Q:IEN=""  D
  1.  ...Q:'IEN&($$GET1^DIQ(52,RXIEN,32.1,"I"))  ; Quit if original fill and a return to stock date exists
  1.  ...Q:'$$DIVVRY(RXIEN,APSPDIV,XREF,IEN)  ;check division
  1.  ...Q:'$$DSPRDT(RXIEN,XREF,IEN)  ;check for release date
  1.  ...Q:'$$PRVVRY(RXIEN,APSPPRV,XREF,IEN)  ;check provider
  1.  ...Q:'$$CDIVRY(RXIEN)  ;check for Critical Drug Interaction on order
  1.  ...D SET(FDTLP,RXIEN,XREF,IEN)
  1.  Q
  1.  ;
  1. FINDINTV(SDT,EDT) ;EP
  1.  N FDTLP,IEN
  1.  S FDTLP=SDT-.01
  1.  F  S FDTLP=$O(^APSPQA(32.4,"B",FDTLP)) Q:'FDTLP!(FDTLP>EDT)  D
  1.  .S IEN=0
  1.  .F  S IEN=$O(^APSPQA(32.4,"B",FDTLP,IEN)) Q:'IEN  D
  1.  ..Q:'$$PATVRY(IEN,APSPPAT,1)
  1.  ..Q:'$P(^APSPQA(32.4,IEN,0),U,5)  ;Intervention must have a drug
  1.  ..Q:'$$PRVVRY(IEN,APSPPRV,,,1)  ;check provider
  1.  ..Q:'$$CDIVRYA(IEN)  ;check for Critical Drug Interaction on intervention
  1.  ..D SETA(FDTLP,IEN)  ;set intervention data
  1.  Q
  1.  ;
  1. SORT ;EP -
  1.  Q
  1.  ; Set data into ^TMP global for output
  1. SET(FDT,RX,XREF,SIEN) ;EP
  1.  ;DATE FILLED
  1.  ;CHART NUMBER;
  1.  ;PATIENT NAME
  1.  ;RX NUMBER
  1.  ;MEDICATION FILLED
  1.  ;INTERACTION
  1.  ;OVER-RIDING PROVIDER OR PHARMACIST
  1.  ;OVER-RIDING REASON
  1.  N LSTDSPDT,NODE0,NODE2,NODE3,DIV,RTSDATE,DRUG,RDT,RIFLG,FTYPE
  1.  N PNM,DFN,DAYS,OPRV,PHRM,QTY,OPRVNM,NXT
  1.  S FTYPE=$S(XREF="ADP":"P",SIEN:"R",1:"F")
  1.  S NXT=$O(^TMP($J,"DATA",$C(1)),-1)
  1.  S NXT=NXT+1
  1.  S NODE0=^PSRX(RX,0)
  1.  S NODE2=^PSRX(RX,2)
  1.  S NODE3=^PSRX(RX,3)
  1.  S DRUG=$P(NODE0,U,6)
  1.  S DFN=$P(NODE0,U,2)
  1.  S PNM=$$GET1^DIQ(2,DFN,.01)
  1.  S DRGNM=$P(^PSDRUG(DRUG,0),U)
  1.  S LSTDSPDT=+NODE3
  1.  S RIFLG=""
  1.  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
  1.  S RDT=$$GET1^DIQ(52,RX,31,"I")  ;Release Date
  1.  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))
  1.  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))
  1.  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")
  1.  S OPRVNM=$$GET1^DIQ(200,OPRV,.01)
  1.  S:'$L(OPRVNM) OPRVNM="NONAME"
  1.  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.  ;                1            2             3                  4             5            6       7         8         9       10      11         12          13          14        15            16
  1.  ;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
  1.  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)
  1.  S ^TMP($J,"XREF",DIV,"FDT",FDT,DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"DRUG",DRGNM,FDT,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"S-DRUG",DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"S-FDT",FDT,DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"PAT",PNM,FDT,DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"PRV",OPRVNM,DRGNM,FDT,NXT)=""
  1.  S ^TMP($J,"XREF","RX",RX,FTYPE,SIEN)=NXT
  1.  Q
  1.  ;
  1. SETA(FDT,IEN) ;EP-
  1.  N NXT,NODE0,DRUG,DFN,PNM,DRGNM,PHRMC,PRV,PRVNM,DIV
  1.  S NODE0=$G(^APSPQA(32.4,IEN,0))
  1.  S DRUG=$P(NODE0,U,5)
  1.  Q:DRUG=""
  1.  S DFN=$P(NODE0,U,2)
  1.  S PNM=$$GET1^DIQ(2,DFN,.01)
  1.  Q:PNM=""
  1.  S DRGNM=$P(^PSDRUG(DRUG,0),U)
  1.  Q:DRGNM=""
  1.  S PHRMC=$P(NODE0,U,4)
  1.  S PRV=+$P(NODE0,U,3)
  1.  S PRVNM=$$GET1^DIQ(200,PRV,.01)
  1.  S:'$L(PRVNM) PRVNM="UNKNOWN"
  1.  S DIV=$P(NODE0,U,16)
  1.  Q:DIV=""
  1.  S NXT=$O(^TMP($J,"DATA",$C(1)),-1)
  1.  S NXT=NXT+1
  1.  ;
  1.  ;Format: Prescription IEN^Fill Date^Xref ("AD" or "ADP")^Fill SubIEN^Pr
  1.  S ^TMP($J,"DATA",NXT)=IEN_U_FDT_U_"APSP"
  1.  S ^TMP($J,"XREF",DIV,"FDT",FDT,DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"DRUG",DRGNM,FDT,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"S-DRUG",DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"S-FDT",FDT,DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"PAT",PNM,FDT,DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"PRV",PRVNM,DRGNM,FDT,NXT)=""
  1.  Q
  1.  ; Return boolean flag indicating valid pharmacy division
  1. DIVVRY(RX,DIV,TYP,SIEN) ;EP
  1.  Q:DIV="*" 1
  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))
  1.  ; Return release date for dispense
  1. DSPRDT(RX,TYP,SIEN) ;EP
  1.  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))
  1.  ; Return boolean flag indicating valid provider
  1. PRVVRY(RX,PRV,TYP,SIEN,APSP) ;EP
  1.  Q:PRV="*" 1
  1.  Q:$G(APSP) +$P($G(^APSPQA(32.4,IEN,0)),U,3)=PRV
  1.  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))
  1.  ; Return boolean flag indicating valid patient
  1. PATVRY(IEN,PAT,APSP) ;EP
  1.  Q:PAT="*" 1
  1.  Q:$G(APSP) +$P($G(^APSPQA(32.4,IEN,0)),U,2)=PAT
  1.  Q +$P($G(^PSRX(IEN,0)),U,2)=PAT
  1.  ; Return boolean flag indicating valid order with order check of Critical Drug Indication
  1. CDIVRY(RX) ;EP-
  1.  N IEN,RES,ORDID
  1.  S RES=0
  1.  S ORDID=$P(^PSRX(RX,"OR1"),U,2)
  1.  S IEN=0 F  S IEN=$O(^OR(100,ORDID,9,IEN)) Q:'IEN  D  Q:RES
  1.  .S RES=$$GET1^DIQ(100.8,$P($G(^OR(100,+ORDID,9,IEN,0)),U),.01)="CRITICAL DRUG INTERACTION"
  1.  Q RES
  1.  ; Return boolean flag indicating intervention with Critical Drug Interaction
  1. CDIVRYA(IEN) ;EP-
  1.  Q $P($G(^APSPQA(32.4,IEN,0)),U,7)=18
  1.  ; Return number of order checks on order
  1. OCKCNT(RX) ;EP-
  1.  N IEN,CNT,ORDID
  1.  S (IEN,CNT)=0
  1.  S ORDID=$P(^PSRX(RX,"OR1"),U,2)
  1.  F  S IEN=$O(^OR(100,ORDID,9,IEN)) Q:'IEN  S CNT=CNT+1
  1.  Q CNT