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

PXRMDRGR.m

Go to the documentation of this file. 
  1. PXRMDRGR ; SLC/PKR - Handle groups of drug findings. ;01/25/2008
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
  1.  ;Groups are drug classes or VA Generic.
  1.  ;==================================================
  1. EVALFI(DFN,DEFARR,ENODE,XREF,FIEVAL) ;Evaluate drug group findings.
  1.  N DRGRIEN,FIEVT,FINDPA,FINDING,NOINDEX
  1.  S NOINDEX=0
  1.  I $G(^PXRMINDX(52,"DATE BUILT"))="" D
  1.  . D NOINDEX^PXRMERRH("D",PXRMITEM,52)
  1.  . S NOINDEX=1
  1.  I $G(^PXRMINDX(55,"DATE BUILT"))="" D
  1.  . D NOINDEX^PXRMERRH("D",PXRMITEM,55)
  1.  . S NOINDEX=1
  1.  S DRGRIEN=""
  1.  F  S DRGRIEN=$O(DEFARR("E",ENODE,DRGRIEN)) Q:+DRGRIEN=0  D
  1.  . S FINDING=""
  1.  . F  S FINDING=$O(DEFARR("E",ENODE,DRGRIEN,FINDING)) Q:+FINDING=0  D
  1.  .. I NOINDEX S FIEVAL(FINDING)=0 Q
  1.  .. K FIEVT,FINDPA
  1.  .. M FINDPA=DEFARR(20,FINDING)
  1.  .. D FIEVAL(DFN,DRGRIEN,.FINDPA,.DEFARR,FINDING,XREF,.FIEVT)
  1.  .. M FIEVAL(FINDING)=FIEVT
  1.  .. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
  1.  Q
  1.  ;
  1.  ;==================================================
  1. EVALPL(FINDPA,ENODE,XREF,TERMARR,PLIST) ;Evaluate drug group
  1.  ;terms for building patient lists.
  1.  N DRGRIEN,NOINDEX,PFINDPA
  1.  N TEMP,TFINDPA,TFINDING
  1.  S NOINDEX=0
  1.  I $G(^PXRMINDX(52,"DATE BUILT"))="" D
  1.  . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52)
  1.  . S NOINDEX=1
  1.  I $G(^PXRMINDX(55,"DATE BUILT"))="" D
  1.  . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55)
  1.  . S NOINDEX=1
  1.  I NOINDEX Q
  1.  S DRGRIEN=""
  1.  F  S DRGRIEN=$O(TERMARR("E",ENODE,DRGRIEN)) Q:+DRGRIEN=0  D
  1.  . S TFINDING=""
  1.  . F  S TFINDING=$O(TERMARR("E",ENODE,DRGRIEN,TFINDING)) Q:+TFINDING=0  D
  1.  .. K PFINDPA,TFINDPA
  1.  .. M TFINDPA=TERMARR(20,TFINDING)
  1.  ..;Set the finding parameters.
  1.  .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
  1.  .. D GPLIST(DRGRIEN,.PFINDPA,XREF,.PLIST)
  1.  Q
  1.  ;
  1.  ;==================================================
  1. EVALTERM(DFN,FINDPA,ENODE,XREF,TERMARR,TFIEVAL) ;Evaluate drug
  1.  ;group terms.
  1.  N DRGRIEN,FIEVT,NOINDEX,PFINDPA
  1.  N TEMP,TFINDPA,TFINDING
  1.  S NOINDEX=0
  1.  I $G(^PXRMINDX(52,"DATE BUILT"))="" D
  1.  . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52)
  1.  . S NOINDEX=1
  1.  I $G(^PXRMINDX(55,"DATE BUILT"))="" D
  1.  . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55)
  1.  . S NOINDEX=1
  1.  S DRGRIEN=""
  1.  F  S DRGRIEN=$O(TERMARR("E",ENODE,DRGRIEN)) Q:+DRGRIEN=0  D
  1.  . S TFINDING=""
  1.  . F  S TFINDING=$O(TERMARR("E",ENODE,DRGRIEN,TFINDING)) Q:+TFINDING=0  D
  1.  .. I NOINDEX S TFIEVAL(TFINDING)=0 Q
  1.  .. K FIEVT,PFINDPA,TFINDPA
  1.  .. M TFINDPA=TERMARR(20,TFINDING)
  1.  ..;Set the finding parameters.
  1.  .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
  1.  .. D FIEVAL(DFN,DRGRIEN,.PFINDPA,.TERMARR,TFINDING,XREF,.FIEVT)
  1.  .. M TFIEVAL(TFINDING)=FIEVT
  1.  .. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
  1.  Q
  1.  ;
  1.  ;==================================================
  1. FIEVAL(DFN,DRGRIEN,FINDPA,DEFARR,FINDING,XREF,FIEVAL) ;
  1.  ;Calls to PSSCLINR covered by DBIA #5187
  1.  N DATE,DATEORDR,DRBEG,DREND,DRUG,DRUGIEN,IND,FIEVT,FIEVTL
  1.  N NOCC,NFOUND,POI,POIBEG,POIEND,POIIEN,RXTYL
  1.  N SDIR,TDATE,TIND
  1.  S NOCC=$P(FINDPA(0),U,14)
  1.  I NOCC="" S NOCC=1
  1.  S SDIR=$S(NOCC<0:+1,1:-1)
  1.  S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
  1.  ;Determine where we search.
  1.  D SRXTYL^PXRMRXTY(FINDPA(0),.RXTYL)
  1.  D GETPDR(DFN,.RXTYL,.DRBEG,.DREND,.POIBEG,.POIEND)
  1.  I DREND=0,POIEND=0 S FIEVAL=0 Q
  1.  D IX^PSSCLINR(XREF,DRGRIEN)
  1.  S (DRUGIEN,NFOUND)=0
  1.  F  S DRUGIEN=+$O(^TMP($J,XREF,DRGRIEN,DRUGIEN)) Q:DRUGIEN=0  D
  1.  . I DRUGIEN'<DRBEG,DRUGIEN'>DREND S DRUG=DRUGIEN
  1.  . E  S DRUG=0
  1.  . S POIIEN=$$ITEM^PSSCLINR(DRUGIEN)
  1.  . I POIIEN'<POIBEG,POIIEN'>POIEND S POI=POIIEN
  1.  . E  S POI=0
  1.  . K FIEVT
  1.  . D DEVAL^PXRMDRUG(DFN,.FINDPA,.DEFARR,FINDING,.RXTYL,DRUG,POI,.FIEVT)
  1.  . I FIEVT D
  1.  .. S IND=0
  1.  .. F  S IND=+$O(FIEVT(IND)) Q:IND=0  D
  1.  ...;Make sure this is not already on the list
  1.  ... I $$ONLIST(.FIEVTL,IND,.FIEVT) Q
  1.  ... S NFOUND=NFOUND+1,FIEVTL(NFOUND,"DISPENSE DRUG")=DRUGIEN
  1.  ... M FIEVTL(NFOUND)=FIEVT(IND)
  1.  ... S DATEORDR(FIEVT(IND,"DATE"),NFOUND)=FIEVT(IND,"FINDING")
  1.  ...;Don't keep more than NOCC occurrences on the list.
  1.  ... I NFOUND>NOCC D
  1.  .... S TDATE=$O(DATEORDR(""),-SDIR),TIND=$O(DATEORDR(TDATE,""))
  1.  .... K FIEVTL(TIND),DATEORDR(TDATE,TIND)
  1.  I NFOUND=0 S FIEVAL=0 Q
  1.  ;Order by date.
  1.  S DATE="",NFOUND=0
  1.  F  S DATE=$O(DATEORDR(DATE),SDIR)  Q:(DATE="")!(NFOUND=NOCC)  D
  1.  . S IND=0
  1.  . F  S IND=$O(DATEORDR(DATE,IND)) Q:(IND="")!(NFOUND=NOCC)  D
  1.  .. S NFOUND=NFOUND+1
  1.  .. M FIEVAL(NFOUND)=FIEVTL(IND)
  1.  ;Save the finding result.
  1.  D SFRES^PXRMUTIL(SDIR,NFOUND,.FIEVAL)
  1.  K ^TMP($J,XREF)
  1.  Q
  1.  ;
  1.  ;==================================================
  1. GETPDR(DFN,RXTYL,DRBEG,DREND,POIBEG,POIEND) ;Return the beginning drug and 
  1.  ;ending drug for a patient.
  1.  N IBEG,IEND,OBEG,OEND
  1.  I $D(RXTYL("I")) D
  1.  . S IBEG=+$O(^PXRMINDX(55,"PI",DFN,0))
  1.  . S IEND=+$O(^PXRMINDX(55,"PI",DFN,""),-1)
  1.  E  S (IBEG,IEND)=0
  1.  I $D(RXTYL("O")) D
  1.  . S OBEG=+$O(^PXRMINDX(52,"PI",DFN,0))
  1.  . S OEND=+$O(^PXRMINDX(52,"PI",DFN,""),-1)
  1.  E  S (OBEG,OEND)=0
  1.  S DRBEG=$S(IBEG<OBEG:IBEG,1:OBEG)
  1.  S DREND=$S(IEND>OEND:IEND,1:OEND)
  1.  I $D(RXTYL("N")) D
  1.  . S POIBEG=+$O(^PXRMINDX("55NVA","PI",DFN,0))
  1.  . S POIEND=+$O(^PXRMINDX("55NVA","PI",DFN,""),-1)
  1.  E  S (POIBEG,POIEND)=0
  1.  Q
  1.  ;
  1.  ;==================================================
  1. GPLIST(DRGRIEN,PFINDPA,XREF,PLIST) ;
  1.  ;Calls to PSSCLINR covered by DBIA #5187
  1.  N DATE,DFN,DRUGIEN,FILENUM,IND,ITEM,NFOUND,NOCC,POI,RXTYL
  1.  N TF,TEMP,TGLIST,TLIST
  1.  S TGLIST="GPLIST_PXRMDRGR"
  1.  K ^TMP($J,TGLIST)
  1.  ;Determine where we search.
  1.  D SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL)
  1.  D IX^PSSCLINR(XREF,DRGRIEN)
  1.  S DRUGIEN=0
  1.  F  S DRUGIEN=+$O(^TMP($J,XREF,DRGRIEN,DRUGIEN)) Q:DRUGIEN=0  D
  1.  . S POI=$$ITEM^PSSCLINR(DRUGIEN)
  1.  . I $D(RXTYL("I")) D GPLIST^PXRMINDL(55,"IP",DRUGIEN,.PFINDPA,TGLIST)
  1.  . I $D(RXTYL("N")),POI'="" D GPLIST^PXRMINDL("55NVA","IP",POI,.PFINDPA,TGLIST)
  1.  . I $D(RXTYL("O")) D GPLIST^PXRMINDL(52,"IP",DRUGIEN,.PFINDPA,TGLIST)
  1.  ;Return the NOCC most recent results for each DFN.
  1.  S NOCC=$P(FINDPA(0),U,14)
  1.  S NOCC=$S(NOCC<0:-NOCC,NOCC="":1,1:NOCC)
  1.  F TF=0,1 D
  1.  . S DFN=0
  1.  . F  S DFN=$O(^TMP($J,TGLIST,TF,DFN)) Q:DFN=""  D
  1.  .. K TLIST
  1.  .. S ITEM=""
  1.  .. F  S ITEM=$O(^TMP($J,TGLIST,TF,DFN,ITEM)) Q:ITEM=""  D
  1.  ... S NFOUND=""
  1.  ... F  S NFOUND=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND)) Q:NFOUND=""  D
  1.  .... S FILENUM=""
  1.  .... F  S FILENUM=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM)) Q:FILENUM=""  D
  1.  ..... S TEMP=^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM)
  1.  ..... S DATE=+$P(TEMP,U,3)
  1.  ..... S TLIST(TF,DATE,ITEM,NFOUND,FILENUM)=""
  1.  .. S DATE="",NFOUND=0
  1.  .. F  S DATE=$O(TLIST(TF,DATE),-1) Q:(DATE="")!(NFOUND=NOCC)  D
  1.  ... S ITEM=""
  1.  ... F  S ITEM=$O(TLIST(TF,DATE,ITEM)) Q:(ITEM="")!(NFOUND=NOCC)  D
  1.  .... S IND=""
  1.  .... F  S IND=$O(TLIST(TF,DATE,ITEM,IND)) Q:(IND="")!(NFOUND=NOCC)  D
  1.  ..... S FILENUM=""
  1.  ..... F  S FILENUM=$O(TLIST(TF,DATE,ITEM,IND,FILENUM)) Q:(FILENUM="")!(NFOUND=NOCC)  D
  1.  ...... S NFOUND=NFOUND+1
  1.  ...... S ^TMP($J,PLIST,TF,DFN,ITEM,NFOUND,FILENUM)=^TMP($J,TGLIST,TF,DFN,ITEM,IND,FILENUM)
  1.  K ^TMP($J,TGLIST),^TMP($J,XREF)
  1.  Q
  1.  ;
  1.  ;==================================================
  1. ONLIST(FIEVTL,IND,FIEVT) ;Return true if FIEVT(IND) is already on
  1.  ;FIEVTL.
  1.  N JND,ONLIST
  1.  S (JND,ONLIST)=0
  1.  F  S JND=$O(FIEVTL(JND)) Q:(ONLIST)!(JND="")  D
  1.  . I FIEVTL(JND,"FILE NUMBER")'=FIEVT(IND,"FILE NUMBER") Q
  1.  . I FIEVTL(JND,"DAS")'=FIEVT(IND,"DAS") Q
  1.  . S ONLIST=1
  1.  Q ONLIST
  1.  ;