PXRM ;SLC/PKR - Clinical Reminders entry points. ;04/14/2014
;;2.0;CLINICAL REMINDERS;**4,11,12,16,18,24,26**;Feb 04, 2005;Build 404
;Entry points in this routine are listed in DBIA #2182.
;==========================================================
MAIN(DFN,PXRMITEM,OUTTYPE,DISC) ;Main driver for clinical reminders.
;INPUT DFN - Pointer to Patient File (#2)
; PXRMITEM - IEN of reminder to evaluate.
; OUTTYPE - Flag to indicate type of output information.
; 0 - Reminders DUE NOW only (CLINICAL REMINDERS DUE
; HS component)
; 1 - All Reminders with Next and Last Information
; (CLINICAL REMINDERS SUMMARY HS component)
; 5 - Health Maintenance (CLINICAL REMINDERS MAINTENANCE
; HS component)
; 10 - MyHealtheVet summary
; 11 - MyHealtheVet detailed
; 12 - MyHealtheVet combined
; 55 - Order check
; DISC - (optional) if this is true then the disclaimer will
; be loaded in ^TMP("PXRM",$J,"DISC").
;
;OUTPUT ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)=
; STATUS_U_DUE DATE_U_LAST DONE
; where PXRMRNAM is the PRINT NAME or if it is undefined then
; it is the NAME (.01).
; For the Clinical Maintenance component, OUTTYPE=5, there is
; subsequent output of the form
; ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM,"TXT",N)=TEXT
; where N is a number and TEXT is a text string.
;
; If DISC is true then the disclaimer will be loaded into
; ^TMP("PXRM",$J,"DISC"). The calling application should
; delete this when it is done.
;
; The calling application can display the contents of these
; two ^TMP arrays as it chooses. The caller should also make
; sure the ^TMP globals are killed before it exits.
;
N DEFARR,EVALDT,FIEVAL,PXRMDEFS
;Load the definition into DEFARR.
D DEF^PXRMLDR(PXRMITEM,.DEFARR)
;
I $G(NODISC)="" S NODISC=1
I $D(GMFLAG) S NODISC=0
S EVALDT=$$NOW^XLFDT
D EVAL(DFN,.DEFARR,OUTTYPE,NODISC,.FIEVAL,EVALDT)
Q
;
;==========================================================
MAINDF(DFN,PXRMITEM,OUTTYPE,EVALDT) ;Alternate entry point that allows
;evaluation date/time as input parameter and saves FIEVAL in
;^TMP("PXRHM,$J,PXRMITEM,"FIEVAL").
N DEFARR,FIEVAL,PXRMDEFS
D DEF^PXRMLDR(PXRMITEM,.DEFARR)
D EVAL(DFN,.DEFARR,OUTTYPE,0,.FIEVAL,EVALDT)
M ^TMP("PXRHM",$J,PXRMITEM,"FIEVAL")=FIEVAL
Q
;
;==========================================================
DISABLE(PXRMITEM,RNAME) ;
N MNAME,NTXT,RDATA,REASON
S ^TMP("PXRHM",$J,PXRMITEM,RNAME)="CNBD^DISABLED^DISABLED"
S ^TMP("PXRHM",$J,PXRMITEM,RNAME,"TXT",1)="Reminder evaluation is temporarily disabled."
S NTXT=1
S REASON=0
F S REASON=$O(^XTMP("PXRM_DISEV",REASON)) Q:REASON="" D
. I $D(^XTMP("PXRM_DISEV",REASON))=1 D Q
.. S NTXT=NTXT+1
.. S ^TMP("PXRHM",$J,PXRMITEM,RNAME,"TXT",NTXT)="Reason: "_REASON_"."
. S RDATA=""
. F S RDATA=$O(^XTMP("PXRM_DISEV",REASON,RDATA)) Q:RDATA="" D
.. S NTXT=NTXT+1
.. I REASON["index" D
... S TEXT="Reason: "_REASON_" of file #"_RDATA
...;Check if the index has been rebuilt.
... D INDXCHK^PXRMDIEV(REASON,RDATA)
.. I REASON["manager" D
... S MNAME=$P(^VA(200,RDATA,0),U,1)
... S TEXT="Reason: "_REASON_" - "_MNAME
.. S ^TMP("PXRHM",$J,PXRMITEM,RNAME,"TXT",NTXT)=TEXT_"."
Q
;
;==========================================================
EVAL(DFN,DEFARR,OUTTYPE,NODISC,FIEVAL,DATE) ;Reminder evaluation entry
;point. This entry point uses the local array DEFARR for the reminder
;definition and returns the Finding Evaluation Array, FIEVAL.
;PXRM namespaced variables are the reminder evaluation "global"
;variables. If date is specified then the reminder will be evaluated
;as if the current date is DATE.
N PXRMAGE,PXRMDATE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMPDEM,PXRMPID
N PXRMITEM,PXRMRM,PXRMRNAM,PXRMSEX,PXRMXTLK
;Make sure the reminder exists.
I $D(DEFARR("DNE")) D NODEF^PXRMERRH(DEFARR("IEN")) Q
;PXRMRM is the right margin for output.
S PXRMRM=80
S PXRMDATE=+$G(DATE)
S PXRMITEM=DEFARR("IEN")
S PXRMPID="PXRM"_PXRMITEM_$H
N D00,RNAME,PID
S D00=DEFARR(0)
S PXRMRNAM=$P(D00,U,3)
;If the print name is null use the .01.
I PXRMRNAM="" S PXRMRNAM=$P(D00,U,1)
;
I $D(^XTMP("PXRM_DISEV",0)) D DISABLE(PXRMITEM,PXRMRNAM) G EXIT
;
;Set the error handler to the PXRMERRH routine. Use the new style of
;error trapping.
N $ES,$ET
S $ET="D ERRHDLR^PXRMERRH"
;
;Initialize the ^TMP arrays.
K ^TMP("PXRHM",$J,PXRMITEM),^TMP(PXRMPID,$J,PXRMITEM)
;
N DUE,DUEDATE,FREQ,IND,PCLOGIC,RESDATE,RESLOGIC
;Make sure the reminder is active.
I $P(D00,U,6) D G OUTPUT
. S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","INACTIVE")="The reminder "_PXRMRNAM_" was inactivated "_$$FMTE^XLFDT($P(D00,U,7),"5Z")
. S PXRMPDEM("DFN")=DFN,PCLOGIC=0,RESLOGIC="",DUE="",DUEDATE=0
. S RESDATE="",FREQ="0Y"
;
;Make sure the "E" node exists
I $D(DEFARR(20))&'$D(DEFARR("E")) D G EXIT
. W !,"Reminder definition is corrupted, ENODE is missing cannot continue!"
. S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="ERROR"_U_"E NODE MISSING"
. S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","NO ENODE")=""
;
;Set the definition stack.
S RNAME=$P(D00,U,1)
S LAST=+$O(PXRMDEFS(""),-1)
F IND=1:1:LAST D
. I $P(PXRMDEFS(IND),U,1)=RNAME D
.. S PID=$P(PXRMDEFS(IND),U,2)
.. S ^TMP(PID,$J,PXRMITEM,"FERROR","RECURSION")=RNAME
S LAST=LAST+1,PXRMDEFS(LAST)=RNAME_U_PXRMPID
I $D(PID),$D(^TMP(PID,$J,PXRMITEM,"FERROR","RECURSION")) G EXIT
;
;Establish the main findings evaluation variables.
S (DUE,DUEDATE,FREQ,RESDATE)=0
S (PCLOGIC,RESLOGIC)=""
;
;Establish the patient demographic information.
N TODAY
S TODAY=$G(DATE,DT)
D DEM^PXRMPINF(DFN,TODAY,.PXRMPDEM)
I PXRMPDEM("PATIENT")="" D G EXIT
. S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","PATIENT","NO PAT")="DFN "_DFN_" IS NOT A VALID PATIENT"
. S PCLOGIC=0
;
;Load the local demographic variables for use in condition.
S PXRMAGE=PXRMPDEM("AGE"),PXRMDOB=PXRMPDEM("DOB"),PXRMDOD=PXRMPDEM("DOD")
S PXRMLAD=PXRMPDEM("LAD"),PXRMSEX=PXRMPDEM("SEX")
;
;Check for a date of death.
I PXRMPDEM("DOD")'="" D
. S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","DEAD")=""
. S ^TMP(PXRMPID,$J,PXRMITEM,"DEAD")="Patient is deceased."
;
;If the component is CR and the patient is deceased we are done.
I OUTTYPE=0,PXRMPDEM("DOD")'="",'$G(PXRMIDOD) G OUTPUT
;
;Check for a sex specific reminder.
N SEXOK
S SEXOK=$$SEX^PXRMLOG(.DEFARR,PXRMPDEM("SEX"))
S FIEVAL("SEX")=SEXOK
;If the patient is the wrong sex then don't do anything else.
I 'SEXOK D G OUTPUT
. S PCLOGIC=0
. S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","SEX")=""
. S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","SEX")="Patient is the wrong sex!"
;
;Evaluate the findings.
S PXRMXTLK=""
D EVAL^PXRMEVFI(DFN,.DEFARR,.FIEVAL)
I +PXRMXTLK>0 D G OUTPUT
. S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","EXPANDED TAXONOMY","NO LOCK")="NO LOCK for ien "_+PXRMXTLK
. S PCLOGIC=0
;
;Check for missing index.
I $D(^TMP(PXRMPID,$J,PXRMITEM,"WARNING","MISSING INDEX")) D G OUTPUT
. S (DUE,DUEDATE)="CNBD",PCLOGIC=1
;
;Evaluate the Patient Cohort Logic.
D EVALPCL^PXRMLOG(.DEFARR,.PXRMPDEM,.FREQ,.PCLOGIC,.FIEVAL)
;
;Evaluate the resolution logic and get the last resolution date.
D EVALRESL^PXRMLOG(.DEFARR,.RESDATE,.RESLOGIC,.FIEVAL)
;
;If the reminder is applicable calculate the due date.
I PCLOGIC D DUE^PXRMDATE(.DEFARR,RESDATE,FREQ,.DUE,.DUEDATE,.FIEVAL)
;
OUTPUT ;Prepare the final output.
D OUTPUT^PXRMOUTD(OUTTYPE,.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,DUE,DUEDATE,RESDATE,FREQ,.FIEVAL)
;
EXIT ;Kill the working arrays unless this was a test run.
K ^TMP($J,"SVC",DFN)
I $G(PXRMDEBG) D
. S PXRMID=PXRMPID
. S FIEVAL("PATIENT AGE")=$G(PXRMPDEM("AGE"))
. S FIEVAL("DFN")=DFN
. S FIEVAL("EVAL DATE/TIME")=$$NOW^PXRMDATE
. S ^TMP(PXRMPID,$J,PXRMITEM,"REMINDER NAME")=$G(PXRMRNAM)
E K ^TMP(PXRMPID,$J)
;
;I DISC is true load the disclaimer.
I $G(DISC) D LOAD^PXRMDISC
Q
;
;==========================================================
FIDATA(DFN,PXRMITEM,FINDINGS) ;Return the finding evaluation array to the
;caller in the array FINDINGS. The caller should use the form
;D FIDATA^PXRM(DFN,PXRMITEM,.FINDINGS)
;The elements of the FINDINGS array will correspond to the
;findings in the reminder definition. For finding N FINDINGS(N)
;will be 0 if the finding is false and 1 if it is true. For
;true findings there will be additional elements. The exact set
;of additional elements will depend of the type of finding.
;Some typical examples are:
;FINDINGS(N)=1
;FINDINGS(N,"DATE")=FileMan date
;FINDINGS(N,"FINDING")=variable pointer to the finding
;FINDINGS(N,"FILE NUMBER")=file number of data source
;FINDINGS(N,"VALUE")=value of the finding, for example the
; value of a lab test
;
N DEFARR,FI,FIEVAL
;Load the definition into DEFARR.
D DEF^PXRMLDR(PXRMITEM,.DEFARR)
D EVAL(DFN,.DEFARR,0,1,.FIEVAL)
K ^TMP("PXRM",$J),^TMP("PXRHM",$J)
;Load the FINDINGS array.
S FI=0
F S FI=+$O(FIEVAL(FI)) Q:FI=0 D
. S FINDINGS(FI)=FIEVAL(FI)
. I 'FIEVAL(FI) Q
. S FINDINGS(FI,"DATE")=FIEVAL(FI,"DATE")
. I FIEVAL(FI,"FINDING")["PSDRUG" S FINDINGS(FI,"DRUG")=1
. S FINDINGS(FI,"FILE NUMBER")=FIEVAL(FI,"FILE NUMBER")
. S FINDINGS(FI,"FINDING")=FIEVAL(FI,"FINDING")
. I $D(FIEVAL(FI,"TERM")) S FINDINGS(FI,"TERM")=FIEVAL(FI,"TERM")
. I $D(FIEVAL(FI,"VALUE")) S (FINDINGS(FI,"RESULT"),FINDINGS(FI,"VALUE"))=FIEVAL(FI,"VALUE")
. I $D(FIEVAL(FI,"VISIT")) S FINDINGS(FI,"VIEN")=FIEVAL(FI,"VISIT")
Q
;
;==========================================================
INACTIVE(PXRMITEM) ;Return the INACTIVE FLAG, which has a value of 1
;if the reminder is inactive.
I '$D(^PXD(811.9,PXRMITEM)) Q 1
Q $P(^PXD(811.9,PXRMITEM,0),U,6)
;
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
+2 ;Entry points in this routine are listed in DBIA #2182.
+3 ;==========================================================
MAIN(DFN,PXRMITEM,OUTTYPE,DISC) ;Main driver for clinical reminders.
+1 ;INPUT DFN - Pointer to Patient File (#2)
+2 ; PXRMITEM - IEN of reminder to evaluate.
+3 ; OUTTYPE - Flag to indicate type of output information.
+4 ; 0 - Reminders DUE NOW only (CLINICAL REMINDERS DUE
+5 ; HS component)
+6 ; 1 - All Reminders with Next and Last Information
+7 ; (CLINICAL REMINDERS SUMMARY HS component)
+8 ; 5 - Health Maintenance (CLINICAL REMINDERS MAINTENANCE
+9 ; HS component)
+10 ; 10 - MyHealtheVet summary
+11 ; 11 - MyHealtheVet detailed
+12 ; 12 - MyHealtheVet combined
+13 ; 55 - Order check
+14 ; DISC - (optional) if this is true then the disclaimer will
+15 ; be loaded in ^TMP("PXRM",$J,"DISC").
+16 ;
+17 ;OUTPUT ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)=
+18 ; STATUS_U_DUE DATE_U_LAST DONE
+19 ; where PXRMRNAM is the PRINT NAME or if it is undefined then
+20 ; it is the NAME (.01).
+21 ; For the Clinical Maintenance component, OUTTYPE=5, there is
+22 ; subsequent output of the form
+23 ; ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM,"TXT",N)=TEXT
+24 ; where N is a number and TEXT is a text string.
+25 ;
+26 ; If DISC is true then the disclaimer will be loaded into
+27 ; ^TMP("PXRM",$J,"DISC"). The calling application should
+28 ; delete this when it is done.
+29 ;
+30 ; The calling application can display the contents of these
+31 ; two ^TMP arrays as it chooses. The caller should also make
+32 ; sure the ^TMP globals are killed before it exits.
+33 ;
+34 NEW DEFARR,EVALDT,FIEVAL,PXRMDEFS
+35 ;Load the definition into DEFARR.
+36 DO DEF^PXRMLDR(PXRMITEM,.DEFARR)
+37 ;
+38 IF $GET(NODISC)=""
SET NODISC=1
+39 IF $DATA(GMFLAG)
SET NODISC=0
+40 SET EVALDT=$$NOW^XLFDT
+41 DO EVAL(DFN,.DEFARR,OUTTYPE,NODISC,.FIEVAL,EVALDT)
+42 QUIT
+43 ;
+44 ;==========================================================
MAINDF(DFN,PXRMITEM,OUTTYPE,EVALDT) ;Alternate entry point that allows
+1 ;evaluation date/time as input parameter and saves FIEVAL in
+2 ;^TMP("PXRHM,$J,PXRMITEM,"FIEVAL").
+3 NEW DEFARR,FIEVAL,PXRMDEFS
+4 DO DEF^PXRMLDR(PXRMITEM,.DEFARR)
+5 DO EVAL(DFN,.DEFARR,OUTTYPE,0,.FIEVAL,EVALDT)
+6 MERGE ^TMP("PXRHM",$JOB,PXRMITEM,"FIEVAL")=FIEVAL
+7 QUIT
+8 ;
+9 ;==========================================================
DISABLE(PXRMITEM,RNAME) ;
+1 NEW MNAME,NTXT,RDATA,REASON
+2 SET ^TMP("PXRHM",$JOB,PXRMITEM,RNAME)="CNBD^DISABLED^DISABLED"
+3 SET ^TMP("PXRHM",$JOB,PXRMITEM,RNAME,"TXT",1)="Reminder evaluation is temporarily disabled."
+4 SET NTXT=1
+5 SET REASON=0
+6 FOR
SET REASON=$ORDER(^XTMP("PXRM_DISEV",REASON))
IF REASON=""
QUIT
Begin DoDot:1
+7 IF $DATA(^XTMP("PXRM_DISEV",REASON))=1
Begin DoDot:2
+8 SET NTXT=NTXT+1
+9 SET ^TMP("PXRHM",$JOB,PXRMITEM,RNAME,"TXT",NTXT)="Reason: "_REASON_"."
End DoDot:2
QUIT
+10 SET RDATA=""
+11 FOR
SET RDATA=$ORDER(^XTMP("PXRM_DISEV",REASON,RDATA))
IF RDATA=""
QUIT
Begin DoDot:2
+12 SET NTXT=NTXT+1
+13 IF REASON["index"
Begin DoDot:3
+14 SET TEXT="Reason: "_REASON_" of file #"_RDATA
+15 ;Check if the index has been rebuilt.
+16 DO INDXCHK^PXRMDIEV(REASON,RDATA)
End DoDot:3
+17 IF REASON["manager"
Begin DoDot:3
+18 SET MNAME=$PIECE(^VA(200,RDATA,0),U,1)
+19 SET TEXT="Reason: "_REASON_" - "_MNAME
End DoDot:3
+20 SET ^TMP("PXRHM",$JOB,PXRMITEM,RNAME,"TXT",NTXT)=TEXT_"."
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
+23 ;==========================================================
EVAL(DFN,DEFARR,OUTTYPE,NODISC,FIEVAL,DATE) ;Reminder evaluation entry
+1 ;point. This entry point uses the local array DEFARR for the reminder
+2 ;definition and returns the Finding Evaluation Array, FIEVAL.
+3 ;PXRM namespaced variables are the reminder evaluation "global"
+4 ;variables. If date is specified then the reminder will be evaluated
+5 ;as if the current date is DATE.
+6 NEW PXRMAGE,PXRMDATE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMPDEM,PXRMPID
+7 NEW PXRMITEM,PXRMRM,PXRMRNAM,PXRMSEX,PXRMXTLK
+8 ;Make sure the reminder exists.
+9 IF $DATA(DEFARR("DNE"))
DO NODEF^PXRMERRH(DEFARR("IEN"))
QUIT
+10 ;PXRMRM is the right margin for output.
+11 SET PXRMRM=80
+12 SET PXRMDATE=+$GET(DATE)
+13 SET PXRMITEM=DEFARR("IEN")
+14 SET PXRMPID="PXRM"_PXRMITEM_$HOROLOG
+15 NEW D00,RNAME,PID
+16 SET D00=DEFARR(0)
+17 SET PXRMRNAM=$PIECE(D00,U,3)
+18 ;If the print name is null use the .01.
+19 IF PXRMRNAM=""
SET PXRMRNAM=$PIECE(D00,U,1)
+20 ;
+21 IF $DATA(^XTMP("PXRM_DISEV",0))
DO DISABLE(PXRMITEM,PXRMRNAM)
GOTO EXIT
+22 ;
+23 ;Set the error handler to the PXRMERRH routine. Use the new style of
+24 ;error trapping.
+25 NEW $ESTACK,$ETRAP
+26 SET $ETRAP="D ERRHDLR^PXRMERRH"
+27 ;
+28 ;Initialize the ^TMP arrays.
+29 KILL ^TMP("PXRHM",$JOB,PXRMITEM),^TMP(PXRMPID,$JOB,PXRMITEM)
+30 ;
+31 NEW DUE,DUEDATE,FREQ,IND,PCLOGIC,RESDATE,RESLOGIC
+32 ;Make sure the reminder is active.
+33 IF $PIECE(D00,U,6)
Begin DoDot:1
+34 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"N/A","INACTIVE")="The reminder "_PXRMRNAM_" was inactivated "_$$FMTE^XLFDT($PIECE(D00,U,7),"5Z")
+35 SET PXRMPDEM("DFN")=DFN
SET PCLOGIC=0
SET RESLOGIC=""
SET DUE=""
SET DUEDATE=0
+36 SET RESDATE=""
SET FREQ="0Y"
End DoDot:1
GOTO OUTPUT
+37 ;
+38 ;Make sure the "E" node exists
+39 IF $DATA(DEFARR(20))&'$DATA(DEFARR("E"))
Begin DoDot:1
+40 WRITE !,"Reminder definition is corrupted, ENODE is missing cannot continue!"
+41 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="ERROR"_U_"E NODE MISSING"
+42 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","NO ENODE")=""
End DoDot:1
GOTO EXIT
+43 ;
+44 ;Set the definition stack.
+45 SET RNAME=$PIECE(D00,U,1)
+46 SET LAST=+$ORDER(PXRMDEFS(""),-1)
+47 FOR IND=1:1:LAST
Begin DoDot:1
+48 IF $PIECE(PXRMDEFS(IND),U,1)=RNAME
Begin DoDot:2
+49 SET PID=$PIECE(PXRMDEFS(IND),U,2)
+50 SET ^TMP(PID,$JOB,PXRMITEM,"FERROR","RECURSION")=RNAME
End DoDot:2
End DoDot:1
+51 SET LAST=LAST+1
SET PXRMDEFS(LAST)=RNAME_U_PXRMPID
+52 IF $DATA(PID)
IF $DATA(^TMP(PID,$JOB,PXRMITEM,"FERROR","RECURSION"))
GOTO EXIT
+53 ;
+54 ;Establish the main findings evaluation variables.
+55 SET (DUE,DUEDATE,FREQ,RESDATE)=0
+56 SET (PCLOGIC,RESLOGIC)=""
+57 ;
+58 ;Establish the patient demographic information.
+59 NEW TODAY
+60 SET TODAY=$GET(DATE,DT)
+61 DO DEM^PXRMPINF(DFN,TODAY,.PXRMPDEM)
+62 IF PXRMPDEM("PATIENT")=""
Begin DoDot:1
+63 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","PATIENT","NO PAT")="DFN "_DFN_" IS NOT A VALID PATIENT"
+64 SET PCLOGIC=0
End DoDot:1
GOTO EXIT
+65 ;
+66 ;Load the local demographic variables for use in condition.
+67 SET PXRMAGE=PXRMPDEM("AGE")
SET PXRMDOB=PXRMPDEM("DOB")
SET PXRMDOD=PXRMPDEM("DOD")
+68 SET PXRMLAD=PXRMPDEM("LAD")
SET PXRMSEX=PXRMPDEM("SEX")
+69 ;
+70 ;Check for a date of death.
+71 IF PXRMPDEM("DOD")'=""
Begin DoDot:1
+72 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"N/A","DEAD")=""
+73 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"DEAD")="Patient is deceased."
End DoDot:1
+74 ;
+75 ;If the component is CR and the patient is deceased we are done.
+76 IF OUTTYPE=0
IF PXRMPDEM("DOD")'=""
IF '$GET(PXRMIDOD)
GOTO OUTPUT
+77 ;
+78 ;Check for a sex specific reminder.
+79 NEW SEXOK
+80 SET SEXOK=$$SEX^PXRMLOG(.DEFARR,PXRMPDEM("SEX"))
+81 SET FIEVAL("SEX")=SEXOK
+82 ;If the patient is the wrong sex then don't do anything else.
+83 IF 'SEXOK
Begin DoDot:1
+84 SET PCLOGIC=0
+85 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"N/A","SEX")=""
+86 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"INFO","SEX")="Patient is the wrong sex!"
End DoDot:1
GOTO OUTPUT
+87 ;
+88 ;Evaluate the findings.
+89 SET PXRMXTLK=""
+90 DO EVAL^PXRMEVFI(DFN,.DEFARR,.FIEVAL)
+91 IF +PXRMXTLK>0
Begin DoDot:1
+92 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","EXPANDED TAXONOMY","NO LOCK")="NO LOCK for ien "_+PXRMXTLK
+93 SET PCLOGIC=0
End DoDot:1
GOTO OUTPUT
+94 ;
+95 ;Check for missing index.
+96 IF $DATA(^TMP(PXRMPID,$JOB,PXRMITEM,"WARNING","MISSING INDEX"))
Begin DoDot:1
+97 SET (DUE,DUEDATE)="CNBD"
SET PCLOGIC=1
End DoDot:1
GOTO OUTPUT
+98 ;
+99 ;Evaluate the Patient Cohort Logic.
+100 DO EVALPCL^PXRMLOG(.DEFARR,.PXRMPDEM,.FREQ,.PCLOGIC,.FIEVAL)
+101 ;
+102 ;Evaluate the resolution logic and get the last resolution date.
+103 DO EVALRESL^PXRMLOG(.DEFARR,.RESDATE,.RESLOGIC,.FIEVAL)
+104 ;
+105 ;If the reminder is applicable calculate the due date.
+106 IF PCLOGIC
DO DUE^PXRMDATE(.DEFARR,RESDATE,FREQ,.DUE,.DUEDATE,.FIEVAL)
+107 ;
OUTPUT ;Prepare the final output.
+1 DO OUTPUT^PXRMOUTD(OUTTYPE,.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,DUE,DUEDATE,RESDATE,FREQ,.FIEVAL)
+2 ;
EXIT ;Kill the working arrays unless this was a test run.
+1 KILL ^TMP($JOB,"SVC",DFN)
+2 IF $GET(PXRMDEBG)
Begin DoDot:1
+3 SET PXRMID=PXRMPID
+4 SET FIEVAL("PATIENT AGE")=$GET(PXRMPDEM("AGE"))
+5 SET FIEVAL("DFN")=DFN
+6 SET FIEVAL("EVAL DATE/TIME")=$$NOW^PXRMDATE
+7 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"REMINDER NAME")=$GET(PXRMRNAM)
End DoDot:1
+8 IF '$TEST
KILL ^TMP(PXRMPID,$JOB)
+9 ;
+10 ;I DISC is true load the disclaimer.
+11 IF $GET(DISC)
DO LOAD^PXRMDISC
+12 QUIT
+13 ;
+14 ;==========================================================
FIDATA(DFN,PXRMITEM,FINDINGS) ;Return the finding evaluation array to the
+1 ;caller in the array FINDINGS. The caller should use the form
+2 ;D FIDATA^PXRM(DFN,PXRMITEM,.FINDINGS)
+3 ;The elements of the FINDINGS array will correspond to the
+4 ;findings in the reminder definition. For finding N FINDINGS(N)
+5 ;will be 0 if the finding is false and 1 if it is true. For
+6 ;true findings there will be additional elements. The exact set
+7 ;of additional elements will depend of the type of finding.
+8 ;Some typical examples are:
+9 ;FINDINGS(N)=1
+10 ;FINDINGS(N,"DATE")=FileMan date
+11 ;FINDINGS(N,"FINDING")=variable pointer to the finding
+12 ;FINDINGS(N,"FILE NUMBER")=file number of data source
+13 ;FINDINGS(N,"VALUE")=value of the finding, for example the
+14 ; value of a lab test
+15 ;
+16 NEW DEFARR,FI,FIEVAL
+17 ;Load the definition into DEFARR.
+18 DO DEF^PXRMLDR(PXRMITEM,.DEFARR)
+19 DO EVAL(DFN,.DEFARR,0,1,.FIEVAL)
+20 KILL ^TMP("PXRM",$JOB),^TMP("PXRHM",$JOB)
+21 ;Load the FINDINGS array.
+22 SET FI=0
+23 FOR
SET FI=+$ORDER(FIEVAL(FI))
IF FI=0
QUIT
Begin DoDot:1
+24 SET FINDINGS(FI)=FIEVAL(FI)
+25 IF 'FIEVAL(FI)
QUIT
+26 SET FINDINGS(FI,"DATE")=FIEVAL(FI,"DATE")
+27 IF FIEVAL(FI,"FINDING")["PSDRUG"
SET FINDINGS(FI,"DRUG")=1
+28 SET FINDINGS(FI,"FILE NUMBER")=FIEVAL(FI,"FILE NUMBER")
+29 SET FINDINGS(FI,"FINDING")=FIEVAL(FI,"FINDING")
+30 IF $DATA(FIEVAL(FI,"TERM"))
SET FINDINGS(FI,"TERM")=FIEVAL(FI,"TERM")
+31 IF $DATA(FIEVAL(FI,"VALUE"))
SET (FINDINGS(FI,"RESULT"),FINDINGS(FI,"VALUE"))=FIEVAL(FI,"VALUE")
+32 IF $DATA(FIEVAL(FI,"VISIT"))
SET FINDINGS(FI,"VIEN")=FIEVAL(FI,"VISIT")
End DoDot:1
+33 QUIT
+34 ;
+35 ;==========================================================
INACTIVE(PXRMITEM) ;Return the INACTIVE FLAG, which has a value of 1
+1 ;if the reminder is inactive.
+2 IF '$DATA(^PXD(811.9,PXRMITEM))
QUIT 1
+3 QUIT $PIECE(^PXD(811.9,PXRMITEM,0),U,6)
+4 ;
