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

PXRMDRUG.m

Go to the documentation of this file.
  1. PXRMDRUG ;SLC/PKR - Handle drug findings. ;01/13/2017
  1. ;;2.0;CLINICAL REMINDERS;**4,6,12,18,47**;Feb 04, 2005;Build 291
  1. ;DBIA #5187 for PSSCLINR
  1. ;
  1. ;===============================================
  1. DEVAL(DFN,FINDPA,DEFARR,FINDING,RXTYL,DRUG,POI,FIEVAL) ;Evaluate a drug
  1. ;finding.
  1. I DRUG=0,POI=0 S FIEVAL=0 Q
  1. N DTERM,FIEVT
  1. ;Create the pseudo term.
  1. S DTERM(0)="DTERM",DTERM("IEN")=0
  1. I $D(RXTYL("I")),DRUG>0 D
  1. . M DTERM(20,1)=DEFARR(20,FINDING)
  1. . S $P(DTERM(20,1,0),U,1)=DRUG_";PS(55,"
  1. . S DTERM("E","PS(55,",DRUG,1)=""
  1. I $D(RXTYL("O")),DRUG>0 D
  1. . M DTERM(20,3)=DEFARR(20,FINDING)
  1. . S $P(DTERM(20,3,0),U,1)=DRUG_";PSRX("
  1. . S DTERM("E","PSRX(",DRUG,3)=""
  1. I $D(RXTYL("N")),POI>0 D
  1. . M DTERM(20,2)=DEFARR(20,FINDING)
  1. . S $P(DTERM(20,2,0),U,1)=POI_";PS(55NVA,"
  1. . S DTERM("E","PS(55NVA,",POI,2)=""
  1. K FIEVT
  1. D IEVALTER^PXRMTERM(DFN,.FINDPA,.DTERM,1,.FIEVT)
  1. M FIEVAL=FIEVT(1)
  1. I FIEVAL S FIEVAL("FINDING")=DRUG_";PSDRUG(",FIEVAL("DISPENSE DRUG")=DRUG
  1. Q
  1. ;
  1. ;===============================================
  1. EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate drug findings.
  1. N DRUGIEN,DTERM,FIEVT,FINDPA,FINDING
  1. N NOINDEX,POI,RXTYL
  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 DRUGIEN=""
  1. F S DRUGIEN=$O(DEFARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D
  1. . S POI=$$ITEM^PSSCLINR(DRUGIEN)
  1. . S FINDING=""
  1. . F S FINDING=$O(DEFARR("E",ENODE,DRUGIEN,FINDING)) Q:+FINDING=0 D
  1. .. I NOINDEX S FIEVAL(FINDING)=0 Q
  1. .. M FINDPA=DEFARR(20,FINDING)
  1. .. K FIEVT,RXTYL
  1. ..;Determine where we search.
  1. .. D SRXTYL^PXRMRXTY(FINDPA(0),.RXTYL)
  1. .. D DEVAL(DFN,.FINDPA,.DEFARR,FINDING,.RXTYL,DRUGIEN,POI,.FIEVT)
  1. .. M FIEVAL(FINDING)=FIEVT
  1. Q
  1. ;
  1. ;===============================================
  1. EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate drug terms for
  1. ;building patient lists.
  1. N BDT,EDT,DATE,DFN,DRUGIEN,ITEM,FILENUM,IND,LIST,NFOUND,NOCC,NOINDEX
  1. N PFINDPA,POI,RXTYL,TEMP,TF,TFINDPA,TFINDING,TGLIST,TLIST
  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 TGLIST="EVALPL_PXRMDRUG"
  1. K ^TMP($J,TGLIST)
  1. S DRUGIEN=""
  1. F S DRUGIEN=$O(TERMARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D
  1. . S POI=$$ITEM^PSSCLINR(DRUGIEN)
  1. . S TFINDING=""
  1. . F S TFINDING=$O(TERMARR("E",ENODE,DRUGIEN,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. ..;Determine where we search.
  1. .. D SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL)
  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)
  1. Q
  1. ;
  1. ;===============================================
  1. EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate drug terms.
  1. N DATEORDR,DRUGIEN,DTERM,DTFIEVAL,IND,JND,NOINDEX,PFINDPA,POI
  1. N RXTYL,TEMP,TFINDING,TFINDPA
  1. N DATEORDR,NOCC,SDIR
  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. ;Set NOCC and SDIR.
  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. S DRUGIEN=""
  1. F S DRUGIEN=$O(TERMARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D
  1. . S POI=$$ITEM^PSSCLINR(DRUGIEN)
  1. . S TFINDING=""
  1. . F S TFINDING=$O(TERMARR("E",ENODE,DRUGIEN,TFINDING)) Q:+TFINDING=0 D
  1. .. S TFIEVAL(TFINDING)=0
  1. .. I NOINDEX Q
  1. .. K DTERM,DTFIEVAL,PFINDPA,TFINDPA
  1. .. S DTERM(0)="DTERM",DTERM("IEN")=0
  1. .. M TFINDPA=TERMARR(20,TFINDING)
  1. ..;Set the finding parameters.
  1. .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
  1. ..;Determine where we search.
  1. .. D SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL)
  1. .. I $D(RXTYL("I")) D
  1. ... M DTERM(20,1)=TERMARR(20,TFINDING)
  1. ... S $P(DTERM(20,1,0),U,1)=DRUGIEN_";PS(55,"
  1. ... S DTERM("E","PS(55,",DRUGIEN,1)=""
  1. .. I $D(RXTYL("N")),POI'="" D
  1. ... M DTERM(20,2)=TERMARR(20,TFINDING)
  1. ... S $P(DTERM(20,2,0),U,1)=POI_";PS(55NVA,"
  1. ... S DTERM("E","PS(55NVA,",POI,2)=""
  1. .. I $D(RXTYL("O")) D
  1. ... M DTERM(20,3)=TERMARR(20,TFINDING)
  1. ... S $P(DTERM(20,3,0),U,1)=DRUGIEN_";PSRX("
  1. ... S DTERM("E","PSRX(",DRUGIEN,3)=""
  1. .. D IEVALTER^PXRMTERM(DFN,.PFINDPA,.DTERM,TFINDING,.DTFIEVAL)
  1. .. D DORDER^PXRMTERM(.DTFIEVAL,.DATEORDR)
  1. .. D COPY^PXRMTERM(NOCC,SDIR,.DTFIEVAL,.DATEORDR,TFINDING,.TFIEVAL,0)
  1. ..;Save the dispense drug
  1. .. S JND=0
  1. .. F S JND=+$O(TFIEVAL(TFINDING,JND)) Q:JND=0 S TFIEVAL(TFINDING,JND,"DISPENSE DRUG")=DRUGIEN
  1. Q
  1. ;
  1. ;===============================================
  1. MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
  1. N DRUG,DRUGIEN,IND,FTYPE,NAME,PFIEVAL,TEMP
  1. I $D(IFIEVAL("TERM FINDING")) S NLINES=NLINES+1,TEXT(NLINES)=" "_$$CLORGNT(IFIEVAL("TERM FINDING"))
  1. S DRUGIEN=IFIEVAL("DISPENSE DRUG")
  1. S DRUG=$$DRUG^PSSCLINR(DRUGIEN)
  1. S NAME="Drug: "_DRUG_" = "
  1. S NLINES=NLINES+1
  1. S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Drug: "_DRUG
  1. S IND=0
  1. F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
  1. . S TEMP=IFIEVAL(IND,"FINDING")
  1. . S FTYPE=$P(TEMP,";",2)
  1. . K PFIEVAL M PFIEVAL=IFIEVAL(IND)
  1. . S PFIEVAL("DISPENSE DRUG")=DRUG
  1. . I FTYPE="PS(55," D MHVOUT^PXRMDIN(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
  1. . I FTYPE="PS(55NVA," D MHVOUT^PXRMDNVA(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
  1. . I FTYPE="PSRX(" D MHVOUT^PXRMDOUT(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
  1. S NLINES=NLINES+1,TEXT(NLINES)=""
  1. Q
  1. ;
  1. ;===============================================
  1. OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
  1. ;maintenance output.
  1. N DRUG,FTYPE,IND,PFIEVAL,TEMP,TEXTOUT
  1. I $D(IFIEVAL("TERM FINDING")) S NLINES=NLINES+1,TEXT(NLINES)=" "_$$CLORGNT(IFIEVAL("TERM FINDING"))
  1. S DRUG=$$DRUG^PSSCLINR(IFIEVAL("DISPENSE DRUG"))
  1. S NLINES=NLINES+1,TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Drug: "_DRUG
  1. S IND=0
  1. F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
  1. . S TEMP=IFIEVAL(IND,"FINDING")
  1. . S FTYPE=$P(TEMP,";",2)
  1. . K PFIEVAL M PFIEVAL=IFIEVAL(IND)
  1. . S PFIEVAL("DISPENSE DRUG")=DRUG
  1. . I FTYPE="PS(55," D OUTPUT^PXRMDIN(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
  1. . I FTYPE="PS(55NVA," D OUTPUT^PXRMDNVA(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
  1. . I FTYPE="PSRX(" D OUTPUT^PXRMDOUT(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
  1. Q
  1. ;
  1. ;===============================================
  1. CLORGNT(FINDING) ;Generate drug class or VA Generic text.
  1. N DRUGCLAS,IEN,GBL,TEXT
  1. S TEXT=""
  1. S IEN=$P(FINDING,";",1)
  1. S GBL=$P(FINDING,";",2)
  1. I GBL="PS(50.605," D
  1. .;DBIA #2574
  1. . S DRUGCLAS=$$CLASS2^PSNAPIS(IEN)
  1. . S TEXT="Drug class "_$P(DRUGCLAS,U,1)_"-"_$P(DRUGCLAS,U,2)
  1. ;
  1. I GBL="PSNDF(50.6," D
  1. .;DBIA #2531
  1. . S TEXT="VA Generic: "_$$VAGN^PSNAPIS(IEN)
  1. Q TEXT
  1. ;