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

BPXRMAS1.m

Go to the documentation of this file. 
  1. BPXRMAS1 ; IHS/MSC/MGH - Handle Asthma findings. ;24-May-2013 15:04;DU
  1.  ;;2.0;CLINICAL REMINDERS;**1001**;Feb 04 2005;Build 21
  1.  ;
  1.  ;Entries in the PCC asthma types can be used in findings for the EHR reminder terms
  1.  ;=======================================================================
  1. EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate refusal findings.
  1.  N ITEM,INVDATE,REFTYP,FINDING,FIEVT
  1.  S ITEM=""
  1.  F  S ITEM=$O(DEFARR("E",ENODE,ITEM)) Q:ITEM=""  D
  1.  . S FINDING=""
  1.  . F  S FINDING=$O(DEFARR("E",ENODE,ITEM,FINDING)) Q:+FINDING=0  D
  1.  ..M FINDPA=DEFARR(20,FINDING)
  1.  ..K FIEVT
  1.  ..D FIEVAL(DFN,ITEM,FINDING,.FINDPA,.FIEVT)
  1.  ..M FIEVAL(FINDING)=FIEVT
  1.  ..S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
  1.  Q
  1.  ;
  1.  ;=======================================================================
  1. EVALTERM(DFN,FINDING,TERMIEN,TFIEVAL) ;Evaluate refusal terms.
  1.  N REFIEN,FIND0,FIND3,INVDATE,LFIEVAL,TFIND0,TFIND3,TFINDING
  1.  F  S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0  D
  1.  . S TFINDING=""
  1.  . F  S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0  D
  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,ITEM,.PFINDPA,.FIEVT)
  1.  .. M TFIEVAL(TFINDING)=FIEVT
  1.  .. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
  1.  Q
  1.  ;
  1.  ;=======================================================================
  1. FIEVAL(DFN,ITEM,FINDING,PFINDPA,FIEVAL) ;
  1.  N DATE,IEN,IND,USESTRT,RSLT,TEMP,VALID,VIEN,FIEN,FINISHED,ASTYPE
  1.  ;Set finding to zero to start
  1.  ;Set the finding search parameters.
  1.  N NFOUND,NGET,NOCC,NP,SDIR,SAVE,SSFIND,CASESEN,UCIFS,VSLIST
  1.  N NP,DAS,IND
  1.  D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
  1.  S SDIR=$S(NOCC<0:+1,1:-1)
  1.  S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
  1.  S NGET=NOCC
  1.  S SSFIND=0,USESTRT=0
  1.  S ASTYP=$P($G(DEFARR(20,FINDING,0)),";",1)
  1.  D FPDAT(DFN,ASTYP,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST)
  1.  I NFOUND=0 S FIEVAL=0 Q
  1.  S NP=0
  1.  S SAVE=0
  1.  F IND=1:1:NFOUND Q:NP=NOCC  D
  1.  . S DAS=$P(FLIST(IND),U,1)
  1.  . ;get the data on the findings
  1.  . D GETDATA(DAS,.FIEVD)
  1.  . S NP=NP+1
  1.  . S FIEVAL(NP)=1
  1.  . S FIEVAL(NP,"DAS")=$P(FLIST(IND),U,1)
  1.  . S FIEVAL(NP,"DATE")=$P(FLIST(IND),U,2)
  1.  . M FIEVAL(NP)=FIEVD
  1.  . I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=FIEVD
  1.  ;Save the finding result.
  1.  D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
  1.  S FIEVAL("FILE NUMBER")=9000010.41
  1.  Q
  1.  ;=======================================================================
  1. FPDAT(DFN,ASTYP,NGET,SDIR,BDT,EDT,NFOUND,FLIST) ;Find pt data
  1.  N DAS,DATE,DONE,EDTT,FIEN,INVDATE,FOUND,IEN,VIEN,DATE,RSLT,TEMP,CONTROL,INV
  1.  S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
  1.  S (FINISHED,NFOUND)=0
  1.  ;S DATE=$S(SDIR=+1:BDT-.000001,1:EDTT)
  1.  S FOUND=0
  1.  S INV=999999-BDT
  1.  S CONTROL=$P($G(^APCDACV(ASTYP,0)),U,2)
  1.  S INVDATE="" F  S INVDATE=$O(^AUPNVAST("AA",DFN,INVDATE)) Q:'+INVDATE!(FOUND=1)  D
  1.  .S FIEN="" F  S FIEN=$O(^AUPNVAST("AA",DFN,INVDATE,FIEN)) Q:'+FIEN!(FOUND=1)  D
  1.  ..S TEMP=$G(^AUPNVAST(FIEN,0))
  1.  ..S RSLT=$P(TEMP,U,14)
  1.  ..S VIEN=$P(TEMP,U,3)
  1.  ..Q:RSLT=""
  1.  ..Q:RSLT'=CONTROL
  1.  ..S DATE=$P($G(^AUPNVAST(FIEN,12)),U,1)    ;Get date entered
  1.  ..I DATE="" S DATE=$$VDATE^PXRMDATE(VIEN) ;else get visit date
  1.  ..Q:DATE<BDT
  1.  ..Q:DATE>EDTT
  1.  ..S NFOUND=NFOUND+1
  1.  ..S FOUND=1
  1.  ..S FLIST(NFOUND)=FIEN_U_DATE
  1.  Q
  1.  ;===========================================================
  1. GETDATA(DAS,FIEVD) ;Get the asthma data
  1.  N TEMP,VIEN,DATE,RES1,RES2
  1.  S TEMP=$G(^AUPNVAST(DAS,0))
  1.  S VIEN=$P(TEMP,U,3)
  1.  S DATE=$P($G(^AUPNVAST(DAS,12)),U,1)    ;Get date entered
  1.  I DATE="" S DATE=$$VDATE^PXRMDATE(VIEN)
  1.  S RES1=$P(TEMP,U,14)
  1.  S RES2=$S(RES1="W":"WELL CONTROLLED",RES1="N":"NOT WELL CONTROLLED",RES1="V":"VERY POORLY CONTROLLED",1:"")
  1.  S FIEVD("RESULT")=RES2
  1.  S FIEVD("DATE")=DATE
  1.  S FIEVD("VISIT")=$P(TEMP,U,3)
  1.  Q
  1.  ;============================================================
  1. MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output
  1.  N EM,FIEN,IND,JND,NAME,NOUT,PNAME,RESULT,TEMP,TEXTOUT,VDATE
  1.  S FIEN=$P(IFIEVAL("FINDING"),";",1)
  1.  S TEMP=$G(^AUPNVAST(FIEN,0))
  1.  S PNAME=$P(TEMP,U,1)
  1.  S PNAME=$P(^APCDACV(PNAME,0),U,1)
  1.  S NAME=$$INSCHR^PXRMEXLC(INDENT," ")_"Asthma Control: "_PNAME_" = "
  1.  S IND=0
  1.  F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  D
  1.  . S VDATE=IFIEVAL(IND,"DATE")
  1.  . S RESULT=$G(IFIEVAL(IND,"RESULT"))
  1.  . S TEMP=RESULT_"("_$$EDATE^PXRMDATE(VDATE)_")"
  1.  . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
  1.  . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
  1.  S NLINES=NLINES+1,TEXT(NLINES)=""
  1.  Q
  1.  ;============================================================
  1. OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
  1.  ;maintenance output.
  1.  N REFIEN,EM,FIEN,IND,PNAME,RSLT,TEMP,VDATE
  1.  S FIEN=$P(IFIEVAL("FINDING"),";",1)
  1.  S NLINES=NLINES+1
  1.  S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Asthma Control: "
  1.  S IND=0
  1.  F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  D
  1.  . S VDATE=IFIEVAL(IND,"DATE")
  1.  . S RESULT=$G(IFIEVAL(IND,"RESULT"))
  1.  . S TEMP=RESULT_" "_$$EDATE^PXRMDATE(VDATE)
  1.  . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
  1.  . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
  1.  S NLINES=NLINES+1,TEXT(NLINES)=""
  1.  Q
  1.  ;=======================================================================