PXRMHVET.m

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 ---PXRMHVET   1054     printed  Apr 09, 2024@20:54: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      ;