PXRMHVET.m

PXRMHVET ; SLC/AGP - Clinical Reminders entry points. ; 03/03/2004

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ;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 MAIN^PXRM(DFN,REMIEN,DISP)

 Q

 ;

 ;==========================================================

HS(DFN,HVDISP) ;

 N NAME,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

 . I $P($G(^PXD(811.9,REMIEN,0)),U,6)'=1 D MAIN^PXRM(DFN,REMIEN,$G(HVDISP))

 S REMIEN=0 F  S REMIEN=$O(^TMP("PXRHM",$J,REMIEN)) Q:REMIEN'>0  D

 . S NAME="" F  S NAME=$O(^TMP("PXRHM",$J,REMIEN,NAME)) Q:NAME=""  D

 . . S STATUS=$P($G(^TMP("PXRHM",$J,REMIEN,NAME)),U)

 . . I STATUS=0 S STATUS="UNKNOWN"

 . . M ^TMP("PXRMHV",$J,STATUS,NAME,REMIEN)=^TMP("PXRHM",$J,REMIEN,NAME)

 K ^TMP("PXRHM",$J)

 Q

 ;

PXRMHVET  ; SLC/AGP - Clinical Reminders entry points. ; 03/03/2004

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +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

                       DO MAIN^PXRM(DFN,REMIEN,DISP)

               End DoDot:1

 +7        QUIT 

 +8       ;

 +9       ;==========================================================

HS(DFN,HVDISP) ;

 +1        NEW NAME,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                IF $PIECE($GET(^PXD(811.9,REMIEN,0)),U,6)'=1

                       DO MAIN^PXRM(DFN,REMIEN,$GET(HVDISP))

               End DoDot:1

 +6        SET REMIEN=0

           FOR 

               SET REMIEN=$ORDER(^TMP("PXRHM",$JOB,REMIEN))

               IF REMIEN'>0

                   QUIT 

               Begin DoDot:1

 +7                SET NAME=""

                   FOR 

                       SET NAME=$ORDER(^TMP("PXRHM",$JOB,REMIEN,NAME))

                       IF NAME=""

                           QUIT 

                       Begin DoDot:2

 +8                        SET STATUS=$PIECE($GET(^TMP("PXRHM",$JOB,REMIEN,NAME)),U)

 +9                        IF STATUS=0

                               SET STATUS="UNKNOWN"

 +10                       MERGE ^TMP("PXRMHV",$JOB,STATUS,NAME,REMIEN)=^TMP("PXRHM",$JOB,REMIEN,NAME)

                       End DoDot:2

               End DoDot:1

 +11       KILL ^TMP("PXRHM",$JOB)

 +12       QUIT 

 +13      ;