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

PXRM.m

Go to the documentation of this file. 
  1. PXRM ;SLC/PKR - Clinical Reminders entry points. ;04/14/2014
  1.  ;;2.0;CLINICAL REMINDERS;**4,11,12,16,18,24,26**;Feb 04, 2005;Build 404
  1.  ;Entry points in this routine are listed in DBIA #2182.
  1.  ;==========================================================
  1. MAIN(DFN,PXRMITEM,OUTTYPE,DISC) ;Main driver for clinical reminders.
  1.  ;INPUT  DFN - Pointer to Patient File (#2)
  1.  ;       PXRMITEM - IEN of reminder to evaluate.
  1.  ;       OUTTYPE - Flag to indicate type of output information.
  1.  ;         0 - Reminders DUE NOW only (CLINICAL REMINDERS DUE
  1.  ;             HS component)
  1.  ;         1 - All Reminders with Next and Last Information
  1.  ;             (CLINICAL REMINDERS SUMMARY HS component)
  1.  ;         5 - Health Maintenance (CLINICAL REMINDERS MAINTENANCE
  1.  ;              HS component)
  1.  ;        10 - MyHealtheVet summary
  1.  ;        11 - MyHealtheVet detailed
  1.  ;        12 - MyHealtheVet combined
  1.  ;        55 - Order check
  1.  ;        DISC - (optional) if this is true then the disclaimer will
  1.  ;             be loaded in ^TMP("PXRM",$J,"DISC").
  1.  ;
  1.  ;OUTPUT  ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)=
  1.  ;              STATUS_U_DUE DATE_U_LAST DONE
  1.  ;        where PXRMRNAM is the PRINT NAME or if it is undefined then
  1.  ;        it is the NAME (.01).
  1.  ;        For the Clinical Maintenance component, OUTTYPE=5, there is 
  1.  ;        subsequent output of the form
  1.  ;        ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM,"TXT",N)=TEXT
  1.  ;        where N is a number and TEXT is a text string.
  1.  ;
  1.  ;        If DISC is true then the disclaimer will be loaded into
  1.  ;        ^TMP("PXRM",$J,"DISC"). The calling application should
  1.  ;        delete this when it is done.
  1.  ;
  1.  ;        The calling application can display the contents of these
  1.  ;        two ^TMP arrays as it chooses. The caller should also make
  1.  ;        sure the ^TMP globals are killed before it exits.
  1.  ;
  1.  N DEFARR,EVALDT,FIEVAL,PXRMDEFS
  1.  ;Load the definition into DEFARR.
  1.  D DEF^PXRMLDR(PXRMITEM,.DEFARR)
  1.  ;
  1.  I $G(NODISC)="" S NODISC=1
  1.  I $D(GMFLAG) S NODISC=0
  1.  S EVALDT=$$NOW^XLFDT
  1.  D EVAL(DFN,.DEFARR,OUTTYPE,NODISC,.FIEVAL,EVALDT)
  1.  Q
  1.  ;
  1.  ;==========================================================
  1. MAINDF(DFN,PXRMITEM,OUTTYPE,EVALDT) ;Alternate entry point that allows
  1.  ;evaluation date/time as input parameter and saves FIEVAL in
  1.  ;^TMP("PXRHM,$J,PXRMITEM,"FIEVAL").
  1.  N DEFARR,FIEVAL,PXRMDEFS
  1.  D DEF^PXRMLDR(PXRMITEM,.DEFARR)
  1.  D EVAL(DFN,.DEFARR,OUTTYPE,0,.FIEVAL,EVALDT)
  1.  M ^TMP("PXRHM",$J,PXRMITEM,"FIEVAL")=FIEVAL
  1.  Q
  1.  ;
  1.  ;==========================================================
  1. DISABLE(PXRMITEM,RNAME) ;
  1.  N MNAME,NTXT,RDATA,REASON
  1.  S ^TMP("PXRHM",$J,PXRMITEM,RNAME)="CNBD^DISABLED^DISABLED"
  1.  S ^TMP("PXRHM",$J,PXRMITEM,RNAME,"TXT",1)="Reminder evaluation is temporarily disabled."
  1.  S NTXT=1
  1.  S REASON=0
  1.  F  S REASON=$O(^XTMP("PXRM_DISEV",REASON)) Q:REASON=""  D
  1.  . I $D(^XTMP("PXRM_DISEV",REASON))=1 D  Q
  1.  .. S NTXT=NTXT+1
  1.  .. S ^TMP("PXRHM",$J,PXRMITEM,RNAME,"TXT",NTXT)="Reason: "_REASON_"."
  1.  . S RDATA=""
  1.  . F  S RDATA=$O(^XTMP("PXRM_DISEV",REASON,RDATA)) Q:RDATA=""  D
  1.  .. S NTXT=NTXT+1
  1.  .. I REASON["index" D
  1.  ... S TEXT="Reason: "_REASON_" of file #"_RDATA
  1.  ...;Check if the index has been rebuilt.
  1.  ... D INDXCHK^PXRMDIEV(REASON,RDATA)
  1.  .. I REASON["manager" D
  1.  ... S MNAME=$P(^VA(200,RDATA,0),U,1)
  1.  ... S TEXT="Reason: "_REASON_" - "_MNAME
  1.  .. S ^TMP("PXRHM",$J,PXRMITEM,RNAME,"TXT",NTXT)=TEXT_"."
  1.  Q
  1.  ;
  1.  ;==========================================================
  1. EVAL(DFN,DEFARR,OUTTYPE,NODISC,FIEVAL,DATE) ;Reminder evaluation entry
  1.  ;point. This entry point uses the local array DEFARR for the reminder
  1.  ;definition and returns the Finding Evaluation Array, FIEVAL.
  1.  ;PXRM namespaced variables are the reminder evaluation "global"
  1.  ;variables. If date is specified then the reminder will be evaluated
  1.  ;as if the current date is DATE.
  1.  N PXRMAGE,PXRMDATE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMPDEM,PXRMPID
  1.  N PXRMITEM,PXRMRM,PXRMRNAM,PXRMSEX,PXRMXTLK
  1.  ;Make sure the reminder exists.
  1.  I $D(DEFARR("DNE")) D NODEF^PXRMERRH(DEFARR("IEN")) Q
  1.  ;PXRMRM is the right margin for output.
  1.  S PXRMRM=80
  1.  S PXRMDATE=+$G(DATE)
  1.  S PXRMITEM=DEFARR("IEN")
  1.  S PXRMPID="PXRM"_PXRMITEM_$H
  1.  N D00,RNAME,PID
  1.  S D00=DEFARR(0)
  1.  S PXRMRNAM=$P(D00,U,3)
  1.  ;If the print name is null use the .01.
  1.  I PXRMRNAM="" S PXRMRNAM=$P(D00,U,1)
  1.  ;
  1.  I $D(^XTMP("PXRM_DISEV",0)) D DISABLE(PXRMITEM,PXRMRNAM) G EXIT
  1.  ;
  1.  ;Set the error handler to the PXRMERRH routine. Use the new style of
  1.  ;error trapping.
  1.  N $ES,$ET
  1.  S $ET="D ERRHDLR^PXRMERRH"
  1.  ;
  1.  ;Initialize the ^TMP arrays.
  1.  K ^TMP("PXRHM",$J,PXRMITEM),^TMP(PXRMPID,$J,PXRMITEM)
  1.  ;
  1.  N DUE,DUEDATE,FREQ,IND,PCLOGIC,RESDATE,RESLOGIC
  1.  ;Make sure the reminder is active.
  1.  I $P(D00,U,6) D  G OUTPUT
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","INACTIVE")="The reminder "_PXRMRNAM_" was inactivated "_$$FMTE^XLFDT($P(D00,U,7),"5Z")
  1.  . S PXRMPDEM("DFN")=DFN,PCLOGIC=0,RESLOGIC="",DUE="",DUEDATE=0
  1.  . S RESDATE="",FREQ="0Y"
  1.  ;
  1.  ;Make sure the "E" node exists
  1.  I $D(DEFARR(20))&'$D(DEFARR("E")) D  G EXIT
  1.  . W !,"Reminder definition is corrupted, ENODE is missing cannot continue!"
  1.  . S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="ERROR"_U_"E NODE MISSING"
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","NO ENODE")=""
  1.  ;
  1.  ;Set the definition stack.
  1.  S RNAME=$P(D00,U,1)
  1.  S LAST=+$O(PXRMDEFS(""),-1)
  1.  F IND=1:1:LAST D
  1.  . I $P(PXRMDEFS(IND),U,1)=RNAME D
  1.  .. S PID=$P(PXRMDEFS(IND),U,2)
  1.  .. S ^TMP(PID,$J,PXRMITEM,"FERROR","RECURSION")=RNAME
  1.  S LAST=LAST+1,PXRMDEFS(LAST)=RNAME_U_PXRMPID
  1.  I $D(PID),$D(^TMP(PID,$J,PXRMITEM,"FERROR","RECURSION")) G EXIT
  1.  ;
  1.  ;Establish the main findings evaluation variables.
  1.  S (DUE,DUEDATE,FREQ,RESDATE)=0
  1.  S (PCLOGIC,RESLOGIC)=""
  1.  ;
  1.  ;Establish the patient demographic information.
  1.  N TODAY
  1.  S TODAY=$G(DATE,DT)
  1.  D DEM^PXRMPINF(DFN,TODAY,.PXRMPDEM)
  1.  I PXRMPDEM("PATIENT")="" D  G EXIT
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","PATIENT","NO PAT")="DFN "_DFN_" IS NOT A VALID PATIENT"
  1.  . S PCLOGIC=0
  1.  ;
  1.  ;Load the local demographic variables for use in condition.
  1.  S PXRMAGE=PXRMPDEM("AGE"),PXRMDOB=PXRMPDEM("DOB"),PXRMDOD=PXRMPDEM("DOD")
  1.  S PXRMLAD=PXRMPDEM("LAD"),PXRMSEX=PXRMPDEM("SEX")
  1.  ;
  1.  ;Check for a date of death.
  1.  I PXRMPDEM("DOD")'="" D
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","DEAD")=""
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"DEAD")="Patient is deceased."
  1.  ;
  1.  ;If the component is CR and the patient is deceased we are done.
  1.  I OUTTYPE=0,PXRMPDEM("DOD")'="",'$G(PXRMIDOD) G OUTPUT
  1.  ;
  1.  ;Check for a sex specific reminder.
  1.  N SEXOK
  1.  S SEXOK=$$SEX^PXRMLOG(.DEFARR,PXRMPDEM("SEX"))
  1.  S FIEVAL("SEX")=SEXOK
  1.  ;If the patient is the wrong sex then don't do anything else.
  1.  I 'SEXOK D  G OUTPUT
  1.  . S PCLOGIC=0
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","SEX")=""
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","SEX")="Patient is the wrong sex!"
  1.  ;
  1.  ;Evaluate the findings.
  1.  S PXRMXTLK=""
  1.  D EVAL^PXRMEVFI(DFN,.DEFARR,.FIEVAL)
  1.  I +PXRMXTLK>0 D  G OUTPUT
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","EXPANDED TAXONOMY","NO LOCK")="NO LOCK for ien "_+PXRMXTLK
  1.  . S PCLOGIC=0
  1.  ;
  1.  ;Check for missing index.
  1.  I $D(^TMP(PXRMPID,$J,PXRMITEM,"WARNING","MISSING INDEX")) D  G OUTPUT
  1.  . S (DUE,DUEDATE)="CNBD",PCLOGIC=1
  1.  ;
  1.  ;Evaluate the Patient Cohort Logic.
  1.  D EVALPCL^PXRMLOG(.DEFARR,.PXRMPDEM,.FREQ,.PCLOGIC,.FIEVAL)
  1.  ;
  1.  ;Evaluate the resolution logic and get the last resolution date.
  1.  D EVALRESL^PXRMLOG(.DEFARR,.RESDATE,.RESLOGIC,.FIEVAL)
  1.  ;
  1.  ;If the reminder is applicable calculate the due date.
  1.  I PCLOGIC D DUE^PXRMDATE(.DEFARR,RESDATE,FREQ,.DUE,.DUEDATE,.FIEVAL)
  1.  ;
  1. OUTPUT ;Prepare the final output.
  1.  D OUTPUT^PXRMOUTD(OUTTYPE,.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,DUE,DUEDATE,RESDATE,FREQ,.FIEVAL)
  1.  ;
  1. EXIT ;Kill the working arrays unless this was a test run.
  1.  K ^TMP($J,"SVC",DFN)
  1.  I $G(PXRMDEBG) D
  1.  . S PXRMID=PXRMPID
  1.  . S FIEVAL("PATIENT AGE")=$G(PXRMPDEM("AGE"))
  1.  . S FIEVAL("DFN")=DFN
  1.  . S FIEVAL("EVAL DATE/TIME")=$$NOW^PXRMDATE
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"REMINDER NAME")=$G(PXRMRNAM)
  1.  E  K ^TMP(PXRMPID,$J)
  1.  ;
  1.  ;I DISC is true load the disclaimer.
  1.  I $G(DISC) D LOAD^PXRMDISC
  1.  Q
  1.  ;
  1.  ;==========================================================
  1. FIDATA(DFN,PXRMITEM,FINDINGS) ;Return the finding evaluation array to the
  1.  ;caller in the array FINDINGS. The caller should use the form
  1.  ;D FIDATA^PXRM(DFN,PXRMITEM,.FINDINGS)
  1.  ;The elements of the FINDINGS array will correspond to the
  1.  ;findings in the reminder definition. For finding N FINDINGS(N)
  1.  ;will be 0 if the finding is false and 1 if it is true. For
  1.  ;true findings there will be additional elements. The exact set
  1.  ;of additional elements will depend of the type of finding.
  1.  ;Some typical examples are:
  1.  ;FINDINGS(N)=1
  1.  ;FINDINGS(N,"DATE")=FileMan date
  1.  ;FINDINGS(N,"FINDING")=variable pointer to the finding
  1.  ;FINDINGS(N,"FILE NUMBER")=file number of data source
  1.  ;FINDINGS(N,"VALUE")=value of the finding, for example the
  1.  ;                    value of a lab test
  1.  ;
  1.  N DEFARR,FI,FIEVAL
  1.  ;Load the definition into DEFARR.
  1.  D DEF^PXRMLDR(PXRMITEM,.DEFARR)
  1.  D EVAL(DFN,.DEFARR,0,1,.FIEVAL)
  1.  K ^TMP("PXRM",$J),^TMP("PXRHM",$J)
  1.  ;Load the FINDINGS array.
  1.  S FI=0
  1.  F  S FI=+$O(FIEVAL(FI)) Q:FI=0  D
  1.  . S FINDINGS(FI)=FIEVAL(FI)
  1.  . I 'FIEVAL(FI) Q
  1.  . S FINDINGS(FI,"DATE")=FIEVAL(FI,"DATE")
  1.  . I FIEVAL(FI,"FINDING")["PSDRUG" S FINDINGS(FI,"DRUG")=1
  1.  . S FINDINGS(FI,"FILE NUMBER")=FIEVAL(FI,"FILE NUMBER")
  1.  . S FINDINGS(FI,"FINDING")=FIEVAL(FI,"FINDING")
  1.  . I $D(FIEVAL(FI,"TERM")) S FINDINGS(FI,"TERM")=FIEVAL(FI,"TERM")
  1.  . I $D(FIEVAL(FI,"VALUE")) S (FINDINGS(FI,"RESULT"),FINDINGS(FI,"VALUE"))=FIEVAL(FI,"VALUE")
  1.  . I $D(FIEVAL(FI,"VISIT")) S FINDINGS(FI,"VIEN")=FIEVAL(FI,"VISIT")
  1.  Q
  1.  ;
  1.  ;==========================================================
  1. INACTIVE(PXRMITEM) ;Return the INACTIVE FLAG, which has a value of 1
  1.  ;if the reminder is inactive.
  1.  I '$D(^PXD(811.9,PXRMITEM)) Q 1
  1.  Q $P(^PXD(811.9,PXRMITEM,0),U,6)
  1.  ;