PXRMHVET ;SLC/AGP - Clinical Reminders entry points. ;Jan 13, 2023@17:22
;;2.0;CLINICAL REMINDERS;**47,84**;Feb 04, 2005;Build 2
;Supports DBIA #4455.
;==========================================================
START(DFN,DISP) ;
N NAME,REMIEN
I $G(DISP)="" S DISP=0
K ^TMP("PXRHM",$J)
S REMIEN=0
F S REMIEN=$O(^PXD(811.9,"P",REMIEN)) Q:+REMIEN'>0 D
. I $P($G(^PXD(811.9,REMIEN,0)),U,6)'=1 D
.. D MAIN^PXRM(DFN,REMIEN,DISP)
.. K ^TMP("PXRHM",$J)
Q
;
;==========================================================
HS(DFN,HVDISP) ;
N NAME,NODE,REMIEN,STATUS
K ^TMP("PXRHM",$J),^TMP("PXRMHV",$J)
S REMIEN=0
F S REMIEN=$O(^PXD(811.9,"P",REMIEN)) Q:+REMIEN'>0 D
. S NODE=$G(^PXD(811.9,REMIEN,0))
. I $P(NODE,U,6)=1 Q
. S NAME=$S($P(NODE,U,3)'="":$P(NODE,U,3),1:$P(NODE,U))
. D MAIN^PXRM(DFN,REMIEN,$G(HVDISP))
. S STATUS=$P($G(^TMP("PXRHM",$J,REMIEN,NAME)),U)
. I STATUS=0!(STATUS=" ") S STATUS="UNKNOWN"
. M ^TMP("PXRMHV",$J,STATUS,NAME,REMIEN)=^TMP("PXRHM",$J,REMIEN,NAME)
. K ^TMP("PXRHM",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMHVET 1054 printed Oct 16, 2024@17:46:56 Page 2
PXRMHVET ;SLC/AGP - Clinical Reminders entry points. ;Jan 13, 2023@17:22
+1 ;;2.0;CLINICAL REMINDERS;**47,84**;Feb 04, 2005;Build 2
+2 ;Supports DBIA #4455.
+3 ;==========================================================
START(DFN,DISP) ;
+1 NEW NAME,REMIEN
+2 IF $GET(DISP)=""
SET DISP=0
+3 KILL ^TMP("PXRHM",$JOB)
+4 SET REMIEN=0
+5 FOR
SET REMIEN=$ORDER(^PXD(811.9,"P",REMIEN))
if +REMIEN'>0
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^PXD(811.9,REMIEN,0)),U,6)'=1
Begin DoDot:2
+7 DO MAIN^PXRM(DFN,REMIEN,DISP)
+8 KILL ^TMP("PXRHM",$JOB)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
+11 ;==========================================================
HS(DFN,HVDISP) ;
+1 NEW NAME,NODE,REMIEN,STATUS
+2 KILL ^TMP("PXRHM",$JOB),^TMP("PXRMHV",$JOB)
+3 SET REMIEN=0
+4 FOR
SET REMIEN=$ORDER(^PXD(811.9,"P",REMIEN))
if +REMIEN'>0
QUIT
Begin DoDot:1
+5 SET NODE=$GET(^PXD(811.9,REMIEN,0))
+6 IF $PIECE(NODE,U,6)=1
QUIT
+7 SET NAME=$SELECT($PIECE(NODE,U,3)'="":$PIECE(NODE,U,3),1:$PIECE(NODE,U))
+8 DO MAIN^PXRM(DFN,REMIEN,$GET(HVDISP))
+9 SET STATUS=$PIECE($GET(^TMP("PXRHM",$JOB,REMIEN,NAME)),U)
+10 IF STATUS=0!(STATUS=" ")
SET STATUS="UNKNOWN"
+11 MERGE ^TMP("PXRMHV",$JOB,STATUS,NAME,REMIEN)=^TMP("PXRHM",$JOB,REMIEN,NAME)
+12 KILL ^TMP("PXRHM",$JOB)
End DoDot:1
+13 QUIT
+14 ;
