- 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 Feb 18, 2025@23:16:33 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 ;