HMPEQLM2 ;SLC/MJK,ASMR/RRB - HMP Temporary Global Lister;01-JUL-2014
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN(HMPSRV) ; -- main entry point for HMPM EVT QUE GLOBALS
D EN^VALM("HMPM EVT QUE GLOBALS")
Q
;
HDR ; -- header code
Q
;
INIT ; -- init variables and list array
N SRVNM,HMPDATA,X,SEQ,TYPE
K HMPDATA
S HMPDATA=$NA(^TMP("HMP TEMP GLOBALS RPT",$J))
K @HMPDATA
D GLBS^HMPEQ(HMPDATA)
;
D KILL
S VALMCNT=0
;
; -- just get selected server info if defined
S SRVNM=$S('$G(HMPSRV):"",1:$P($G(^HMP(800000,+$G(HMPSRV),0)),"^"))
S SEQ=0 F S SEQ=$O(@HMPDATA@("xtmpNodes",SEQ)) Q:'SEQ D
. M X=@HMPDATA@("xtmpNodes",SEQ) D:$G(X("server"))=SRVNM GLB(.X)
;
S TYPE="" F S TYPE=$O(@HMPDATA@(TYPE)) Q:TYPE="" D
. D SET(" ")
. S SEQ=0 F S SEQ=$O(@HMPDATA@(TYPE,SEQ)) Q:'SEQ D
. . M X=@HMPDATA@(TYPE,SEQ) D GLB(.X)
;
I VALMCNT=0 D NOROWS^HMPEQ("No globals to display")
S VALMBG=1
K @HMPDATA
Q
;
GLB(GLB) ; --
S X=""
S X=$$SETFLD^VALM1($$DOTS($G(GLB("rootNode"))),X,"SUBSCRIPT")
S X=$$SETFLD^VALM1($G(GLB("lastNode")),X,"LAST")
D SET(X)
Q
;
SET(X) ; -- add line
S VALMCNT=VALMCNT+1
S @VALMAR@(VALMCNT,0)=X
Q
;
DOTS(Z) ; -- use dots
N DOTS
S $P(DOTS,". ",20)=""
Q Z_$E(DOTS,$L(Z),65)
;
KILL ; -- kill off build data
K @VALMAR
; clean up video control data
D KILL^VALM10()
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPEQLM2 1597 printed Dec 13, 2024@01:53:58 Page 2
HMPEQLM2 ;SLC/MJK,ASMR/RRB - HMP Temporary Global Lister;01-JUL-2014
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN(HMPSRV) ; -- main entry point for HMPM EVT QUE GLOBALS
+1 DO EN^VALM("HMPM EVT QUE GLOBALS")
+2 QUIT
+3 ;
HDR ; -- header code
+1 QUIT
+2 ;
INIT ; -- init variables and list array
+1 NEW SRVNM,HMPDATA,X,SEQ,TYPE
+2 KILL HMPDATA
+3 SET HMPDATA=$NAME(^TMP("HMP TEMP GLOBALS RPT",$JOB))
+4 KILL @HMPDATA
+5 DO GLBS^HMPEQ(HMPDATA)
+6 ;
+7 DO KILL
+8 SET VALMCNT=0
+9 ;
+10 ; -- just get selected server info if defined
+11 SET SRVNM=$SELECT('$GET(HMPSRV):"",1:$PIECE($GET(^HMP(800000,+$GET(HMPSRV),0)),"^"))
+12 SET SEQ=0
FOR
SET SEQ=$ORDER(@HMPDATA@("xtmpNodes",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+13 MERGE X=@HMPDATA@("xtmpNodes",SEQ)
if $GET(X("server"))=SRVNM
DO GLB(.X)
End DoDot:1
+14 ;
+15 SET TYPE=""
FOR
SET TYPE=$ORDER(@HMPDATA@(TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+16 DO SET(" ")
+17 SET SEQ=0
FOR
SET SEQ=$ORDER(@HMPDATA@(TYPE,SEQ))
if 'SEQ
QUIT
Begin DoDot:2
+18 MERGE X=@HMPDATA@(TYPE,SEQ)
DO GLB(.X)
End DoDot:2
End DoDot:1
+19 ;
+20 IF VALMCNT=0
DO NOROWS^HMPEQ("No globals to display")
+21 SET VALMBG=1
+22 KILL @HMPDATA
+23 QUIT
+24 ;
GLB(GLB) ; --
+1 SET X=""
+2 SET X=$$SETFLD^VALM1($$DOTS($GET(GLB("rootNode"))),X,"SUBSCRIPT")
+3 SET X=$$SETFLD^VALM1($GET(GLB("lastNode")),X,"LAST")
+4 DO SET(X)
+5 QUIT
+6 ;
SET(X) ; -- add line
+1 SET VALMCNT=VALMCNT+1
+2 SET @VALMAR@(VALMCNT,0)=X
+3 QUIT
+4 ;
DOTS(Z) ; -- use dots
+1 NEW DOTS
+2 SET $PIECE(DOTS,". ",20)=""
+3 QUIT Z_$EXTRACT(DOTS,$LENGTH(Z),65)
+4 ;
KILL ; -- kill off build data
+1 KILL @VALMAR
+2 ; clean up video control data
+3 DO KILL^VALM10()
+4 QUIT
+5 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
