PXRM ;SLC/PKR - Clinical Reminders entry points. ;04/01/2022
;;2.0;CLINICAL REMINDERS;**4,11,12,16,18,24,26,47,42,65**;Feb 04, 2005;Build 438
;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
;Load the definition into DEFARR.
D DEF^PXRMLDR(PXRMITEM,.DEFARR)
;
I $G(NODISC)="" S NODISC=1
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
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,TEXT
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,REASON=""
F S REASON=$O(^XTMP("PXRM_DISEV","REASON",REASON)) Q:REASON="" D
. S NTXT=NTXT+1
. S ^TMP("PXRHM",$J,PXRMITEM,RNAME,"TXT",NTXT)="Reason: "_REASON_"."
. S RDATA=""
. F S RDATA=$O(^XTMP("PXRM_DISEV","REASON",REASON,RDATA)) Q:RDATA="" D
.. S NTXT=NTXT+1
.. I REASON["index" D
... S TEXT="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="The reminder manager is - "_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 name spaced 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 LAST,PXRMAGE,PXRMDATE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMPDEM,PXRMPID
N PXRMITEM,PXRMRM,PXRMRNAM,PXRMSEX,PXRMSIG
;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
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"
;
;Make sure the "E" node exists
I $D(DEFARR(20))&'$D(DEFARR("E")) D G EXIT
. S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="ERROR"_U_"E NODE MISSING"
. S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","NO ENODE")=""
;
;Check for recursion.
N RECUR
S RECUR=$$RECCHK^PXRMRCUR(PXRMITEM)
I RECUR D G EXIT
. N ERROR,NTXT
. S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","RECURSION")=RECUR
. S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="ERROR"
. S NTXT=1
. S ERROR=$$FERROR^PXRMOUTU(.NTXT)
;
;Establish the main findings evaluation variables.
N CRSTATUS,DUE,DUEDATE,FREQ,PCLOGIC,RESDATE,RESLOGIC
S (DUE,DUEDATE,FREQ,RESDATE)=0
S (CRSTATUS,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"),PXRMSIG=PXRMPDEM("SIG")
;
;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.
D EVAL^PXRMEVFI(DFN,.DEFARR,.FIEVAL)
;
;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 there is CONTRAINDICATED LOGIC or RESOLUTION LOGIC, determine CRSTATUS.
I (DEFARR(80)'="")!(DEFARR(90)'="") S CRSTATUS=$$CRSTATUS^PXRMLOG(.DEFARR,.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,CRSTATUS,.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)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRM 9410 printed Dec 13, 2024@01:42:50 Page 2
PXRM ;SLC/PKR - Clinical Reminders entry points. ;04/01/2022
+1 ;;2.0;CLINICAL REMINDERS;**4,11,12,16,18,24,26,47,42,65**;Feb 04, 2005;Build 438
+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
+35 ;Load the definition into DEFARR.
+36 DO DEF^PXRMLDR(PXRMITEM,.DEFARR)
+37 ;
+38 IF $GET(NODISC)=""
SET NODISC=1
+39 SET EVALDT=$$NOW^XLFDT
+40 DO EVAL(DFN,.DEFARR,OUTTYPE,NODISC,.FIEVAL,EVALDT)
+41 QUIT
+42 ;
+43 ;==========================================================
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
+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,TEXT
+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
SET REASON=""
+5 FOR
SET REASON=$ORDER(^XTMP("PXRM_DISEV","REASON",REASON))
if REASON=""
QUIT
Begin DoDot:1
+6 SET NTXT=NTXT+1
+7 SET ^TMP("PXRHM",$JOB,PXRMITEM,RNAME,"TXT",NTXT)="Reason: "_REASON_"."
+8 SET RDATA=""
+9 FOR
SET RDATA=$ORDER(^XTMP("PXRM_DISEV","REASON",REASON,RDATA))
if RDATA=""
QUIT
Begin DoDot:2
+10 SET NTXT=NTXT+1
+11 IF REASON["index"
Begin DoDot:3
+12 SET TEXT="Of file #"_RDATA
+13 ;Check if the index has been rebuilt.
+14 DO INDXCHK^PXRMDIEV(REASON,RDATA)
End DoDot:3
+15 IF REASON["manager"
Begin DoDot:3
+16 SET MNAME=$PIECE(^VA(200,RDATA,0),U,1)
+17 SET TEXT="The reminder manager is - "_MNAME
End DoDot:3
+18 SET ^TMP("PXRHM",$JOB,PXRMITEM,RNAME,"TXT",NTXT)=TEXT_"."
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+21 ;==========================================================
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 name spaced 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 LAST,PXRMAGE,PXRMDATE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMPDEM,PXRMPID
+7 NEW PXRMITEM,PXRMRM,PXRMRNAM,PXRMSEX,PXRMSIG
+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
+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 ;Make sure the "E" node exists
+29 IF $DATA(DEFARR(20))&'$DATA(DEFARR("E"))
Begin DoDot:1
+30 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="ERROR"_U_"E NODE MISSING"
+31 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","NO ENODE")=""
End DoDot:1
GOTO EXIT
+32 ;
+33 ;Check for recursion.
+34 NEW RECUR
+35 SET RECUR=$$RECCHK^PXRMRCUR(PXRMITEM)
+36 IF RECUR
Begin DoDot:1
+37 NEW ERROR,NTXT
+38 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","RECURSION")=RECUR
+39 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="ERROR"
+40 SET NTXT=1
+41 SET ERROR=$$FERROR^PXRMOUTU(.NTXT)
End DoDot:1
GOTO EXIT
+42 ;
+43 ;Establish the main findings evaluation variables.
+44 NEW CRSTATUS,DUE,DUEDATE,FREQ,PCLOGIC,RESDATE,RESLOGIC
+45 SET (DUE,DUEDATE,FREQ,RESDATE)=0
+46 SET (CRSTATUS,PCLOGIC,RESLOGIC)=""
+47 ;
+48 ;Establish the patient demographic information.
+49 NEW TODAY
+50 SET TODAY=$GET(DATE,DT)
+51 DO DEM^PXRMPINF(DFN,TODAY,.PXRMPDEM)
+52 IF PXRMPDEM("PATIENT")=""
Begin DoDot:1
+53 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","PATIENT","NO PAT")="DFN "_DFN_" IS NOT A VALID PATIENT"
+54 SET PCLOGIC=0
End DoDot:1
GOTO EXIT
+55 ;
+56 ;Load the local demographic variables for use in condition.
+57 SET PXRMAGE=PXRMPDEM("AGE")
SET PXRMDOB=PXRMPDEM("DOB")
SET PXRMDOD=PXRMPDEM("DOD")
+58 SET PXRMLAD=PXRMPDEM("LAD")
SET PXRMSEX=PXRMPDEM("SEX")
SET PXRMSIG=PXRMPDEM("SIG")
+59 ;
+60 ;Check for a date of death.
+61 IF PXRMPDEM("DOD")'=""
Begin DoDot:1
+62 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"N/A","DEAD")=""
+63 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"DEAD")="Patient is deceased."
End DoDot:1
+64 ;
+65 ;If the component is CR and the patient is deceased we are done.
+66 IF OUTTYPE=0
IF PXRMPDEM("DOD")'=""
IF '$GET(PXRMIDOD)
GOTO OUTPUT
+67 ;
+68 ;Check for a sex specific reminder.
+69 NEW SEXOK
+70 SET SEXOK=$$SEX^PXRMLOG(.DEFARR,PXRMPDEM("SEX"))
+71 SET FIEVAL("SEX")=SEXOK
+72 ;If the patient is the wrong sex then don't do anything else.
+73 IF 'SEXOK
Begin DoDot:1
+74 SET PCLOGIC=0
+75 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"N/A","SEX")=""
+76 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"INFO","SEX")="Patient is the wrong sex!"
End DoDot:1
GOTO OUTPUT
+77 ;
+78 ;Evaluate the findings.
+79 DO EVAL^PXRMEVFI(DFN,.DEFARR,.FIEVAL)
+80 ;
+81 ;Check for missing index.
+82 IF $DATA(^TMP(PXRMPID,$JOB,PXRMITEM,"WARNING","MISSING INDEX"))
Begin DoDot:1
+83 SET (DUE,DUEDATE)="CNBD"
SET PCLOGIC=1
End DoDot:1
GOTO OUTPUT
+84 ;
+85 ;Evaluate the Patient Cohort Logic.
+86 DO EVALPCL^PXRMLOG(.DEFARR,.PXRMPDEM,.FREQ,.PCLOGIC,.FIEVAL)
+87 ;
+88 ;Evaluate the resolution logic and get the last resolution date.
+89 DO EVALRESL^PXRMLOG(.DEFARR,.RESDATE,.RESLOGIC,.FIEVAL)
+90 ;
+91 ;If there is CONTRAINDICATED LOGIC or RESOLUTION LOGIC, determine CRSTATUS.
+92 IF (DEFARR(80)'="")!(DEFARR(90)'="")
SET CRSTATUS=$$CRSTATUS^PXRMLOG(.DEFARR,.FIEVAL)
+93 ;
+94 ;If the reminder is applicable calculate the due date.
+95 IF PCLOGIC
DO DUE^PXRMDATE(.DEFARR,RESDATE,FREQ,.DUE,.DUEDATE,.FIEVAL)
+96 ;
OUTPUT ;Prepare the final output.
+1 DO OUTPUT^PXRMOUTD(OUTTYPE,.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,DUE,DUEDATE,RESDATE,FREQ,CRSTATUS,.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 ;
