HMPMONM ;ASMR/BL, monitor server selection ;Sep 19, 2016 20:02:20
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2,3**;April 14,2016;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
Q ; no entry from top
;DE6526, DE6644 - routine refactored, 7 September 2016
;
M ; interactive, monitor a different server
; called after ^DIR call in OPTION^HMPMON
; places into symbol table:
; HMPMNTR("server") = ien of server to monitor
; HMPMNTR("zero node") - zero node of selected entry
;
W ! N DIC,DIROUT,DUOUT,X,Y
S DIC="^HMP(800000,",DIC(0)="AEMQZ",DIC("A")="Select eHMP Server to Monitor: ",DIC("B")=HMPMNTR("server") ; default to current selection
D ^DIC ;interactive lookup
Q:$D(DTOUT) ; time-out, leave in symbol table
Q:$D(DUOUT)!$D(DIROUT)!'(Y>0) ; nothing selected
S HMPMNTR("server")=+Y ; update server IEN
S HMPMNTR("zero node")=Y(0) ;save node zero
Q
;
GETSRVR() ;extrinsic variable, returns IEN of default server to monitor
;
N F,J,RSLT S RSLT=+$O(^HMP(800000,0))
Q:'$O(^HMP(800000,RSLT)) RSLT ; nothing else to check, return first IEN found
;
;^DD(800000,.07,0)="DEFAULT?^S^1:YES;0:NO;^0;7^Q"
Q:$P(^HMP(800000,RSLT,0),U,7) RSLT ; 1st entry is default
; if nothing marked as default, 1st entry will be returned
S F=0,J=RSLT ; F is flag, default IEN found
;start with RSLT, check other entries for DEFAULT flag, stop if one found
F S J=$O(^HMP(800000,J)) Q:'J!F S:$P(^HMP(800000,J,0),U,7) (F,RSLT)=J
Q RSLT
;
NOSRVR ; interactive help display if no server selected
W !!,"There must be a SERVER entry in the HMP SUBSCRIPTION file (#800000)."
W !,"You can set the field DEFAULT? (#.07) to 'YES'"
W !,"and that entry will become the default server to monitor.",!
D RTRN2CON^HMPMONL ; Enter RETURN to continue
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPMONM 1827 printed Sep 23, 2025@19:30:22 Page 2
HMPMONM ;ASMR/BL, monitor server selection ;Sep 19, 2016 20:02:20
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2,3**;April 14,2016;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; no entry from top
QUIT
+5 ;DE6526, DE6644 - routine refactored, 7 September 2016
+6 ;
M ; interactive, monitor a different server
+1 ; called after ^DIR call in OPTION^HMPMON
+2 ; places into symbol table:
+3 ; HMPMNTR("server") = ien of server to monitor
+4 ; HMPMNTR("zero node") - zero node of selected entry
+5 ;
+6 WRITE !
NEW DIC,DIROUT,DUOUT,X,Y
+7 ; default to current selection
SET DIC="^HMP(800000,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Select eHMP Server to Monitor: "
SET DIC("B")=HMPMNTR("server")
+8 ;interactive lookup
DO ^DIC
+9 ; time-out, leave in symbol table
if $DATA(DTOUT)
QUIT
+10 ; nothing selected
if $DATA(DUOUT)!$DATA(DIROUT)!'(Y>0)
QUIT
+11 ; update server IEN
SET HMPMNTR("server")=+Y
+12 ;save node zero
SET HMPMNTR("zero node")=Y(0)
+13 QUIT
+14 ;
GETSRVR() ;extrinsic variable, returns IEN of default server to monitor
+1 ;
+2 NEW F,J,RSLT
SET RSLT=+$ORDER(^HMP(800000,0))
+3 ; nothing else to check, return first IEN found
if '$ORDER(^HMP(800000,RSLT))
QUIT RSLT
+4 ;
+5 ;^DD(800000,.07,0)="DEFAULT?^S^1:YES;0:NO;^0;7^Q"
+6 ; 1st entry is default
if $PIECE(^HMP(800000,RSLT,0),U,7)
QUIT RSLT
+7 ; if nothing marked as default, 1st entry will be returned
+8 ; F is flag, default IEN found
SET F=0
SET J=RSLT
+9 ;start with RSLT, check other entries for DEFAULT flag, stop if one found
+10 FOR
SET J=$ORDER(^HMP(800000,J))
if 'J!F
QUIT
if $PIECE(^HMP(800000,J,0),U,7)
SET (F,RSLT)=J
+11 QUIT RSLT
+12 ;
NOSRVR ; interactive help display if no server selected
+1 WRITE !!,"There must be a SERVER entry in the HMP SUBSCRIPTION file (#800000)."
+2 WRITE !,"You can set the field DEFAULT? (#.07) to 'YES'"
+3 WRITE !,"and that entry will become the default server to monitor.",!
+4 ; Enter RETURN to continue
DO RTRN2CON^HMPMONL
+5 QUIT
+6 ;
