PXRMCDEF ;SLC/AGP - Computed findings for Reminder Definition. ;06/30/2020
;;2.0;CLINICAL REMINDERS;**4,18,24,26,47,45,42**;Feb 04, 2005;Build 245
;
;======================================================
RDEF(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding for returning a Reminder
;definition evaluation status.
I $G(TEST)="" D Q
. S TEST=0
. S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="No reminder definition"
;New PXRMFFSS and PXRMTDEB so that reminder test function finding
;and term output is not corrupted.
N DEFARR,FIEVAL,NAME,PNAME,RIEN,TEMP,PARAM,PXRMDEBG,PXRMFFSS,PXRMTDEB
N SAVETMP,OUTTYPE
S NAME=$P(TEST,U,1)
I NAME="" D Q
. S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="No reminder definition."
I +NAME=NAME S RIEN=+NAME,NAME=$P(^PXD(811.9,RIEN,0),U,1)
E S RIEN=+$O(^PXD(811.9,"B",NAME,""))
I RIEN=0 D Q
. S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="The reminder definition does not exist."
I +$P(^PXD(811.9,RIEN,0),U,6)=1 D Q
. S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="The reminder definition is inactive."
. S TEST=0
S PARAM=$P(TEST,U,2),PARAM=$P($G(PARAM),"=",2),SAVETMP=+$P(TEST,U,3),OUTTYPE=$P(TEST,U,4)
I OUTTYPE="" S OUTTYPE=1
S TEST=0,DATE=$$NOW^PXRMDATE
K ^TMP("PXRHM",$J,RIEN)
S PNAME=$S($P($G(^PXD(811.9,RIEN,0)),U,3)'="":$P(^PXD(811.9,RIEN,0),U,3),1:NAME)
;Load the definition into DEFARR.
D DEF^PXRMLDR(RIEN,.DEFARR)
D EVAL^PXRM(DFN,.DEFARR,OUTTYPE,0,.FIEVAL,DATE)
S TEMP=$G(^TMP("PXRHM",$J,RIEN,PNAME))
I SAVETMP,$G(PXRMSRCFF) D
. K ^TMP("PXRM BL DATA",$J)
. M ^TMP("PXRM BL DATA",$J,"FIEVAL")=FIEVAL
. M ^TMP("PXRM BL DATA",$J,"PXRHM")=^TMP("PXRHM",$J)
. S ^TMP("PXRM BL DATA",$J,"REMINDER IEN")=RIEN
. S ^TMP("PXRM BL DATA",$J,"REMINDER NAME")=PNAME
K ^TMP("PXRHM",$J,RIEN)
S TEST=$S(TEMP="":0,TEMP["ERROR":0,TEMP["CNBD":0,1:1)
Q:'TEST
S TEXT="Reminder: "_NAME
S VALUE=$P(TEMP,U)
S VALUE("STATUS")=VALUE
S VALUE("DUEDATE")=$P(TEMP,U,2)
S VALUE("LASTDONE")=$P(TEMP,U,3)
Q:PARAM=""
I PARAM="DUE DATE",+VALUE("DUEDATE")>0 S DATE=VALUE("DUEDATE")
I PARAM="LAST DONE",+VALUE("LASTDONE")>0 S DATE=VALUE("LASTDONE")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCDEF 2233 printed Dec 13, 2024@01:43:07 Page 2
PXRMCDEF ;SLC/AGP - Computed findings for Reminder Definition. ;06/30/2020
+1 ;;2.0;CLINICAL REMINDERS;**4,18,24,26,47,45,42**;Feb 04, 2005;Build 245
+2 ;
+3 ;======================================================
RDEF(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding for returning a Reminder
+1 ;definition evaluation status.
+2 IF $GET(TEST)=""
Begin DoDot:1
+3 SET TEST=0
+4 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="No reminder definition"
End DoDot:1
QUIT
+5 ;New PXRMFFSS and PXRMTDEB so that reminder test function finding
+6 ;and term output is not corrupted.
+7 NEW DEFARR,FIEVAL,NAME,PNAME,RIEN,TEMP,PARAM,PXRMDEBG,PXRMFFSS,PXRMTDEB
+8 NEW SAVETMP,OUTTYPE
+9 SET NAME=$PIECE(TEST,U,1)
+10 IF NAME=""
Begin DoDot:1
+11 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="No reminder definition."
End DoDot:1
QUIT
+12 IF +NAME=NAME
SET RIEN=+NAME
SET NAME=$PIECE(^PXD(811.9,RIEN,0),U,1)
+13 IF '$TEST
SET RIEN=+$ORDER(^PXD(811.9,"B",NAME,""))
+14 IF RIEN=0
Begin DoDot:1
+15 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="The reminder definition does not exist."
End DoDot:1
QUIT
+16 IF +$PIECE(^PXD(811.9,RIEN,0),U,6)=1
Begin DoDot:1
+17 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","CF.VA-REMINDER DEFINITION")="The reminder definition is inactive."
+18 SET TEST=0
End DoDot:1
QUIT
+19 SET PARAM=$PIECE(TEST,U,2)
SET PARAM=$PIECE($GET(PARAM),"=",2)
SET SAVETMP=+$PIECE(TEST,U,3)
SET OUTTYPE=$PIECE(TEST,U,4)
+20 IF OUTTYPE=""
SET OUTTYPE=1
+21 SET TEST=0
SET DATE=$$NOW^PXRMDATE
+22 KILL ^TMP("PXRHM",$JOB,RIEN)
+23 SET PNAME=$SELECT($PIECE($GET(^PXD(811.9,RIEN,0)),U,3)'="":$PIECE(^PXD(811.9,RIEN,0),U,3),1:NAME)
+24 ;Load the definition into DEFARR.
+25 DO DEF^PXRMLDR(RIEN,.DEFARR)
+26 DO EVAL^PXRM(DFN,.DEFARR,OUTTYPE,0,.FIEVAL,DATE)
+27 SET TEMP=$GET(^TMP("PXRHM",$JOB,RIEN,PNAME))
+28 IF SAVETMP
IF $GET(PXRMSRCFF)
Begin DoDot:1
+29 KILL ^TMP("PXRM BL DATA",$JOB)
+30 MERGE ^TMP("PXRM BL DATA",$JOB,"FIEVAL")=FIEVAL
+31 MERGE ^TMP("PXRM BL DATA",$JOB,"PXRHM")=^TMP("PXRHM",$JOB)
+32 SET ^TMP("PXRM BL DATA",$JOB,"REMINDER IEN")=RIEN
+33 SET ^TMP("PXRM BL DATA",$JOB,"REMINDER NAME")=PNAME
End DoDot:1
+34 KILL ^TMP("PXRHM",$JOB,RIEN)
+35 SET TEST=$SELECT(TEMP="":0,TEMP["ERROR":0,TEMP["CNBD":0,1:1)
+36 if 'TEST
QUIT
+37 SET TEXT="Reminder: "_NAME
+38 SET VALUE=$PIECE(TEMP,U)
+39 SET VALUE("STATUS")=VALUE
+40 SET VALUE("DUEDATE")=$PIECE(TEMP,U,2)
+41 SET VALUE("LASTDONE")=$PIECE(TEMP,U,3)
+42 if PARAM=""
QUIT
+43 IF PARAM="DUE DATE"
IF +VALUE("DUEDATE")>0
SET DATE=VALUE("DUEDATE")
+44 IF PARAM="LAST DONE"
IF +VALUE("LASTDONE")>0
SET DATE=VALUE("LASTDONE")
+45 QUIT
+46 ;
