PXRMXEVL ;SLC/AGP - Reports Reminder Evaluation routine ;Jan 12, 2023@17:59
;;2.0;CLINICAL REMINDERS;**4,12,26,47,42,84**;Feb 04, 2005;Build 2
;
; Called by label from PXRMXSE1
;
;Detailed report
EVAL(SUB,REMINDER) ;
N CNT,DFN,DEFARR,FIEV,ITEM,LIT
S CNT=0
K ^TMP("PXRHM",$J)
F S CNT=$O(REMINDER(CNT)) Q:CNT'>0 D
. S ITEM=$P(REMINDER(CNT),U,1),LIT=$P(REMINDER(CNT),U,4)
. I LIT="" S LIT=$P(REMINDER(CNT),U,2)
. I $P($G(^PXD(811.9,ITEM,0)),U,6)=1 Q
. D DEF^PXRMLDR(ITEM,.DEFARR)
.;Make sure the definition exists.
. I $D(DEFARR("DNE")) Q
. S DFN=0
. F S DFN=$O(^TMP($J,SUB,DFN)) Q:DFN'>0!(ZTSTOP=1) D
.. D NOTIFY^PXRMXBSY("Evaluating Reminders",.BUSY)
.. K FIEV
..;Evaluate the reminder for the patient and save the results.
.. D EVAL^PXRM(DFN,.DEFARR,1,1,.FIEV,PXRMSDT)
.. S ^TMP($J,SUB,DFN,ITEM)=$G(^TMP("PXRHM",$J,ITEM,LIT))
.. K ^TMP("PXRHM",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXEVL 908 printed Dec 13, 2024@01:50:11 Page 2
PXRMXEVL ;SLC/AGP - Reports Reminder Evaluation routine ;Jan 12, 2023@17:59
+1 ;;2.0;CLINICAL REMINDERS;**4,12,26,47,42,84**;Feb 04, 2005;Build 2
+2 ;
+3 ; Called by label from PXRMXSE1
+4 ;
+5 ;Detailed report
EVAL(SUB,REMINDER) ;
+1 NEW CNT,DFN,DEFARR,FIEV,ITEM,LIT
+2 SET CNT=0
+3 KILL ^TMP("PXRHM",$JOB)
+4 FOR
SET CNT=$ORDER(REMINDER(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+5 SET ITEM=$PIECE(REMINDER(CNT),U,1)
SET LIT=$PIECE(REMINDER(CNT),U,4)
+6 IF LIT=""
SET LIT=$PIECE(REMINDER(CNT),U,2)
+7 IF $PIECE($GET(^PXD(811.9,ITEM,0)),U,6)=1
QUIT
+8 DO DEF^PXRMLDR(ITEM,.DEFARR)
+9 ;Make sure the definition exists.
+10 IF $DATA(DEFARR("DNE"))
QUIT
+11 SET DFN=0
+12 FOR
SET DFN=$ORDER(^TMP($JOB,SUB,DFN))
if DFN'>0!(ZTSTOP=1)
QUIT
Begin DoDot:2
+13 DO NOTIFY^PXRMXBSY("Evaluating Reminders",.BUSY)
+14 KILL FIEV
+15 ;Evaluate the reminder for the patient and save the results.
+16 DO EVAL^PXRM(DFN,.DEFARR,1,1,.FIEV,PXRMSDT)
+17 SET ^TMP($JOB,SUB,DFN,ITEM)=$GET(^TMP("PXRHM",$JOB,ITEM,LIT))
+18 KILL ^TMP("PXRHM",$JOB)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
