HMPEQ ;SLC/MJK,ASMR/RRB - HMP Freshness Utilities;02-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 ; -- go to event queue viewer (convenience tag)
D EN^HMPEQLM
Q
;
EVTS(DATA,PARAMS) ; -- return events for server's last stream in inverse sequence # order
; input: PARAMS("server") := ien of 800000
; "filter") := event state filter [ P:processed | W:waiting ]
; "domain") := domain of interest or "ALL'
; "dfn") := dfn of desired patient
; "max") := max number events to return
;
; output: @DATA@("stream") := name of stream for server
; "count") := number of events returned
; "events",<n>,"sequence") := sequence # / node in stream for event
; "events",<n>,"node") := event node for sequence
;
N STREAM,DOMAIN,FILTER,PAT,SEQ,MAX,CNT,X
S STREAM=$$LSTREAM^HMPDJFSM(+$G(PARAMS("server")))
S DOMAIN=$G(PARAMS("domain"))
S FILTER=$G(PARAMS("filter"))
S PAT=+$G(PARAMS("dfn"))
S MAX=$G(PARAMS("max"),10)
S CNT=0
S SEQ=" "
F S SEQ=$O(^XTMP(STREAM,SEQ),-1) Q:'SEQ S X=^(SEQ) D Q:CNT=MAX
. I DOMAIN'="ALL",DOMAIN'=$P(X,"^",2) Q
. ; quit if waiting and want processed
. I FILTER["P",'$P(X,"^",6) Q
. ; quit if processed and want waiting
. I FILTER["W",'$P(X,"^",6) Q
. ; quit if not patient desired
. I PAT,PAT'=+X Q
. S CNT=CNT+1
. S @DATA@("events",CNT,"sequence")=SEQ
. S @DATA@("events",CNT,"node")=X
;
S @DATA@("stream")=STREAM
S @DATA@("count")=CNT
Q
;
GETEVTS(RET,PARAMS) ; -- get events for server's last stream in inverse sequence # order
; RPC: HMPM EVT QUE GET EVTS (future)
N HMPDATA,HMPERR
S HMPDATA=$NA(^TMP("HMPM EVT QUE GET EVTS",$J))
K @HMPDATA
D EVTS(HMPDATA,.PARAMS)
D ENCODE^HMPJSON(HMPDATA,RET,"HMPERR")
K @HMPDATA
Q
;
SRVS(DATA) ; -- loop thru & sort by server names and return summary freshness queue info for each
; output: @DATA@("servers",<n>,"name") := server name
; "server",<n>,"lastUpdate") := date server last updated
; "server",<n>,"repeated") := how many times updated
; "server",<n>,"stream") := stream name
; "server",<n>,"queueEnd") := current end of queue
; "server",<n>,"extracts",<n>,"domain") := domain name
; "server",<n>,"extracts",<n>,"tasks") := tasks waiting to be processed
; "server",<n>,"extracts",<n>,"waiting") := how many seconds waiting
; "server",<n>,"extracts",<n>,"lastCount") := last count retrieved or <finished>
;
N HMPSRVNM,HMPCNT,IEN
S HMPSRVNM=""
S HMPCNT=0
F S HMPSRVNM=$O(^HMP(800000,"B",HMPSRVNM)) Q:HMPSRVNM="" S IEN=$O(^(HMPSRVNM,"")) D
. S HMPCNT=HMPCNT+1
. D SRV($NA(@DATA@("servers",HMPCNT)),IEN)
Q
;
SRV(DATA,SRV) ; -- process one server
N X0,ROOT,BATCH,STREAM,SRVNM,TASK,TASKS,ENDQ,EXTRACT,CNT
S X0=$G(^HMP(800000,SRV,0))
Q:X0=""
S SRVNM=$P(X0,"^")
S @DATA@("name")=$P(X0,"^")
S @DATA@("lastUpdate")=$P(X0,"^",2)
S @DATA@("repeated")=$P(X0,"^",4)
S STREAM=$$LSTREAM^HMPDJFSM(SRV)
S @DATA@("stream")=STREAM
S @DATA@("queueEnd")=$S($D(^XTMP(STREAM)):$P(STREAM,"~",3)_"-"_$G(^XTMP(STREAM,"last")),1:"")
;
; -- loop thru extracts for this server
S ROOT="HMPFX~"_SRVNM_"~"
S BATCH=ROOT
S CNT=0
F S BATCH=$O(^XTMP(BATCH)) Q:$E(BATCH,1,$L(ROOT))'=ROOT D
. S CNT=CNT+1
. S @DATA@("extracts",CNT,"domain")=$P(BATCH,"~",3)
. S TASK=0,TASKS=""
. F S TASK=$O(^XTMP(BATCH,0,"task",TASK)) Q:'TASK S TASKS=TASKS_$S($L(TASKS):",",1:"")_TASK
. S @DATA@("extracts",CNT,"tasks")=TASKS
. I '$D(^XTMP(BATCH,0,"wait")) S @DATA@("extracts",CNT,"waiting")=$$WAIT^HMPDJFSM(BATCH) Q
. S @DATA@("extracts",CNT,"lastCount")=$$LOBJ^HMPDJFSM(BATCH,TASK)
Q
;
GETSRVS(RET) ; -- get summary freshness event queue info for all servers
; RPC: HMPM EVT QUE GET SVRS (future)
N HMPDATA,HMPERR
S HMPDATA=$NA(^TMP("HMPM EVT QUE GET SVRS",$J))
K @HMPDATA
D SRVS(HMPDATA)
D ENCODE^HMPJSON(HMPDATA,RET,"HMPERR")
K @HMPDATA
Q
;
GLBS(DATA) ; -- return summary info on HMP related temp globals
; output: @HMPDATA@( "xtmpNodes",<n>,"server") := server name
; "xtmpNodes",<n>,"rootNode") := ^XTMP root node for server/stream
; "xtmpNodes",<n>,"lastNode") := last sequence in root structure
;
; "tmpJobNodes",<n>,"rootNode") := root ^TMP("HMP*",$J) node
; "tmpJobNodes",<n>,"lastNode") := last sequence in root structure
;
; "jobTmpNodes",<n>,"rootNode") := root ^TMP($J,"HMP*") node
; "jobTmpNodes",<n>,"lastNode") := last sequence in root structure
;
N HMPX,CNT,J,Y,RNODE
S HMPX="VPQ~"
S CNT=0
F S HMPX=$O(^XTMP(HMPX)) Q:$E(HMPX,1,3)'="HMP" D
. S CNT=CNT+1
. S @DATA@("xtmpNodes",CNT,"server")=$P(HMPX,"~",2)
. S @DATA@("xtmpNodes",CNT,"rootNode")="^XTMP("""_HMPX_""")"
. S Y=$O(^XTMP(HMPX," "),-1)
. S:'$L(Y) Y=$O(^XTMP(HMPX,""),-1)
. S @DATA@("xtmpNodes",CNT,"lastNode")=Y
;
S HMPX="VPQ~"
S CNT=0
F S HMPX=$O(^TMP(HMPX)) Q:$E(HMPX,1,3)'="HMP" D
. S J=0
. F S J=$O(^TMP(HMPX,J)) Q:'J D
. . ; -- don't include this report's ^TMP
. . S RNODE="^TMP("""_HMPX_""","_J_")"
. . I RNODE=DATA,J=$J Q
. . S CNT=CNT+1
. . S @DATA@("tmpJobNodes",CNT,"rootNode")=RNODE
. . S Y=$O(^TMP(HMPX,J," "),-1)
. . S:'$L(Y) Y=$O(^TMP(HMPX,J,""),-1)
. . S @DATA@("tmpJobNodes",CNT,"lastNode")=Y
;
S (J,CNT)=0
F S J=$O(^TMP(J)) Q:'J D
. S HMPX="VPQ~"
. F S HMPX=$O(^TMP(J,HMPX)) Q:$E(HMPX,1,3)'="HMP" D
. . S CNT=CNT+1
. . S @DATA@("jobTmpNodes",CNT,"rootNode")="^TMP("_J_","""_HMPX_""")"
. . S Y=$O(^TMP(J,HMPX," "),-1)
. . S:'$L(Y) Y=$O(^TMP(J,HMPX,""),-1)
. . S @DATA@("jobTmpNodes",CNT,"lastNode")=Y
;
Q
;
GETGLBS(RET) ; -- get summary info on HMP related temp globals
; RPC: HMPM EVT QUE GET GLBS (future)
N HMPDATA,HMPERR
S HMPDATA=$NA(^TMP("HMPM EVT QUE GET GLBS",$J))
K @HMPDATA
D GLBS(HMPDATA)
D ENCODE^HMPJSON(HMPDATA,RET,"HMPERR")
K @HMPDATA
Q
;
NOROWS(MSG) ; -- add standard text lines to indicate no rows to display
S VALMCNT=1
S @VALMAR@(VALMCNT,0)=""
S VALMCNT=2
S @VALMAR@(VALMCNT,0)=" o "_MSG
D CNTRL^VALM10(VALMCNT,2,78,IOINHI,IOINORM)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPEQ 6494 printed Sep 23, 2025@19:29:57 Page 2
HMPEQ ;SLC/MJK,ASMR/RRB - HMP Freshness Utilities;02-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 ; -- go to event queue viewer (convenience tag)
+1 DO EN^HMPEQLM
+2 QUIT
+3 ;
EVTS(DATA,PARAMS) ; -- return events for server's last stream in inverse sequence # order
+1 ; input: PARAMS("server") := ien of 800000
+2 ; "filter") := event state filter [ P:processed | W:waiting ]
+3 ; "domain") := domain of interest or "ALL'
+4 ; "dfn") := dfn of desired patient
+5 ; "max") := max number events to return
+6 ;
+7 ; output: @DATA@("stream") := name of stream for server
+8 ; "count") := number of events returned
+9 ; "events",<n>,"sequence") := sequence # / node in stream for event
+10 ; "events",<n>,"node") := event node for sequence
+11 ;
+12 NEW STREAM,DOMAIN,FILTER,PAT,SEQ,MAX,CNT,X
+13 SET STREAM=$$LSTREAM^HMPDJFSM(+$GET(PARAMS("server")))
+14 SET DOMAIN=$GET(PARAMS("domain"))
+15 SET FILTER=$GET(PARAMS("filter"))
+16 SET PAT=+$GET(PARAMS("dfn"))
+17 SET MAX=$GET(PARAMS("max"),10)
+18 SET CNT=0
+19 SET SEQ=" "
+20 FOR
SET SEQ=$ORDER(^XTMP(STREAM,SEQ),-1)
if 'SEQ
QUIT
SET X=^(SEQ)
Begin DoDot:1
+21 IF DOMAIN'="ALL"
IF DOMAIN'=$PIECE(X,"^",2)
QUIT
+22 ; quit if waiting and want processed
+23 IF FILTER["P"
IF '$PIECE(X,"^",6)
QUIT
+24 ; quit if processed and want waiting
+25 IF FILTER["W"
IF '$PIECE(X,"^",6)
QUIT
+26 ; quit if not patient desired
+27 IF PAT
IF PAT'=+X
QUIT
+28 SET CNT=CNT+1
+29 SET @DATA@("events",CNT,"sequence")=SEQ
+30 SET @DATA@("events",CNT,"node")=X
End DoDot:1
if CNT=MAX
QUIT
+31 ;
+32 SET @DATA@("stream")=STREAM
+33 SET @DATA@("count")=CNT
+34 QUIT
+35 ;
GETEVTS(RET,PARAMS) ; -- get events for server's last stream in inverse sequence # order
+1 ; RPC: HMPM EVT QUE GET EVTS (future)
+2 NEW HMPDATA,HMPERR
+3 SET HMPDATA=$NAME(^TMP("HMPM EVT QUE GET EVTS",$JOB))
+4 KILL @HMPDATA
+5 DO EVTS(HMPDATA,.PARAMS)
+6 DO ENCODE^HMPJSON(HMPDATA,RET,"HMPERR")
+7 KILL @HMPDATA
+8 QUIT
+9 ;
SRVS(DATA) ; -- loop thru & sort by server names and return summary freshness queue info for each
+1 ; output: @DATA@("servers",<n>,"name") := server name
+2 ; "server",<n>,"lastUpdate") := date server last updated
+3 ; "server",<n>,"repeated") := how many times updated
+4 ; "server",<n>,"stream") := stream name
+5 ; "server",<n>,"queueEnd") := current end of queue
+6 ; "server",<n>,"extracts",<n>,"domain") := domain name
+7 ; "server",<n>,"extracts",<n>,"tasks") := tasks waiting to be processed
+8 ; "server",<n>,"extracts",<n>,"waiting") := how many seconds waiting
+9 ; "server",<n>,"extracts",<n>,"lastCount") := last count retrieved or <finished>
+10 ;
+11 NEW HMPSRVNM,HMPCNT,IEN
+12 SET HMPSRVNM=""
+13 SET HMPCNT=0
+14 FOR
SET HMPSRVNM=$ORDER(^HMP(800000,"B",HMPSRVNM))
if HMPSRVNM=""
QUIT
SET IEN=$ORDER(^(HMPSRVNM,""))
Begin DoDot:1
+15 SET HMPCNT=HMPCNT+1
+16 DO SRV($NAME(@DATA@("servers",HMPCNT)),IEN)
End DoDot:1
+17 QUIT
+18 ;
SRV(DATA,SRV) ; -- process one server
+1 NEW X0,ROOT,BATCH,STREAM,SRVNM,TASK,TASKS,ENDQ,EXTRACT,CNT
+2 SET X0=$GET(^HMP(800000,SRV,0))
+3 if X0=""
QUIT
+4 SET SRVNM=$PIECE(X0,"^")
+5 SET @DATA@("name")=$PIECE(X0,"^")
+6 SET @DATA@("lastUpdate")=$PIECE(X0,"^",2)
+7 SET @DATA@("repeated")=$PIECE(X0,"^",4)
+8 SET STREAM=$$LSTREAM^HMPDJFSM(SRV)
+9 SET @DATA@("stream")=STREAM
+10 SET @DATA@("queueEnd")=$SELECT($DATA(^XTMP(STREAM)):$PIECE(STREAM,"~",3)_"-"_$GET(^XTMP(STREAM,"last")),1:"")
+11 ;
+12 ; -- loop thru extracts for this server
+13 SET ROOT="HMPFX~"_SRVNM_"~"
+14 SET BATCH=ROOT
+15 SET CNT=0
+16 FOR
SET BATCH=$ORDER(^XTMP(BATCH))
if $EXTRACT(BATCH,1,$LENGTH(ROOT))'=ROOT
QUIT
Begin DoDot:1
+17 SET CNT=CNT+1
+18 SET @DATA@("extracts",CNT,"domain")=$PIECE(BATCH,"~",3)
+19 SET TASK=0
SET TASKS=""
+20 FOR
SET TASK=$ORDER(^XTMP(BATCH,0,"task",TASK))
if 'TASK
QUIT
SET TASKS=TASKS_$SELECT($LENGTH(TASKS):",",1:"")_TASK
+21 SET @DATA@("extracts",CNT,"tasks")=TASKS
+22 IF '$DATA(^XTMP(BATCH,0,"wait"))
SET @DATA@("extracts",CNT,"waiting")=$$WAIT^HMPDJFSM(BATCH)
QUIT
+23 SET @DATA@("extracts",CNT,"lastCount")=$$LOBJ^HMPDJFSM(BATCH,TASK)
End DoDot:1
+24 QUIT
+25 ;
GETSRVS(RET) ; -- get summary freshness event queue info for all servers
+1 ; RPC: HMPM EVT QUE GET SVRS (future)
+2 NEW HMPDATA,HMPERR
+3 SET HMPDATA=$NAME(^TMP("HMPM EVT QUE GET SVRS",$JOB))
+4 KILL @HMPDATA
+5 DO SRVS(HMPDATA)
+6 DO ENCODE^HMPJSON(HMPDATA,RET,"HMPERR")
+7 KILL @HMPDATA
+8 QUIT
+9 ;
GLBS(DATA) ; -- return summary info on HMP related temp globals
+1 ; output: @HMPDATA@( "xtmpNodes",<n>,"server") := server name
+2 ; "xtmpNodes",<n>,"rootNode") := ^XTMP root node for server/stream
+3 ; "xtmpNodes",<n>,"lastNode") := last sequence in root structure
+4 ;
+5 ; "tmpJobNodes",<n>,"rootNode") := root ^TMP("HMP*",$J) node
+6 ; "tmpJobNodes",<n>,"lastNode") := last sequence in root structure
+7 ;
+8 ; "jobTmpNodes",<n>,"rootNode") := root ^TMP($J,"HMP*") node
+9 ; "jobTmpNodes",<n>,"lastNode") := last sequence in root structure
+10 ;
+11 NEW HMPX,CNT,J,Y,RNODE
+12 SET HMPX="VPQ~"
+13 SET CNT=0
+14 FOR
SET HMPX=$ORDER(^XTMP(HMPX))
if $EXTRACT(HMPX,1,3)'="HMP"
QUIT
Begin DoDot:1
+15 SET CNT=CNT+1
+16 SET @DATA@("xtmpNodes",CNT,"server")=$PIECE(HMPX,"~",2)
+17 SET @DATA@("xtmpNodes",CNT,"rootNode")="^XTMP("""_HMPX_""")"
+18 SET Y=$ORDER(^XTMP(HMPX," "),-1)
+19 if '$LENGTH(Y)
SET Y=$ORDER(^XTMP(HMPX,""),-1)
+20 SET @DATA@("xtmpNodes",CNT,"lastNode")=Y
End DoDot:1
+21 ;
+22 SET HMPX="VPQ~"
+23 SET CNT=0
+24 FOR
SET HMPX=$ORDER(^TMP(HMPX))
if $EXTRACT(HMPX,1,3)'="HMP"
QUIT
Begin DoDot:1
+25 SET J=0
+26 FOR
SET J=$ORDER(^TMP(HMPX,J))
if 'J
QUIT
Begin DoDot:2
+27 ; -- don't include this report's ^TMP
+28 SET RNODE="^TMP("""_HMPX_""","_J_")"
+29 IF RNODE=DATA
IF J=$JOB
QUIT
+30 SET CNT=CNT+1
+31 SET @DATA@("tmpJobNodes",CNT,"rootNode")=RNODE
+32 SET Y=$ORDER(^TMP(HMPX,J," "),-1)
+33 if '$LENGTH(Y)
SET Y=$ORDER(^TMP(HMPX,J,""),-1)
+34 SET @DATA@("tmpJobNodes",CNT,"lastNode")=Y
End DoDot:2
End DoDot:1
+35 ;
+36 SET (J,CNT)=0
+37 FOR
SET J=$ORDER(^TMP(J))
if 'J
QUIT
Begin DoDot:1
+38 SET HMPX="VPQ~"
+39 FOR
SET HMPX=$ORDER(^TMP(J,HMPX))
if $EXTRACT(HMPX,1,3)'="HMP"
QUIT
Begin DoDot:2
+40 SET CNT=CNT+1
+41 SET @DATA@("jobTmpNodes",CNT,"rootNode")="^TMP("_J_","""_HMPX_""")"
+42 SET Y=$ORDER(^TMP(J,HMPX," "),-1)
+43 if '$LENGTH(Y)
SET Y=$ORDER(^TMP(J,HMPX,""),-1)
+44 SET @DATA@("jobTmpNodes",CNT,"lastNode")=Y
End DoDot:2
End DoDot:1
+45 ;
+46 QUIT
+47 ;
GETGLBS(RET) ; -- get summary info on HMP related temp globals
+1 ; RPC: HMPM EVT QUE GET GLBS (future)
+2 NEW HMPDATA,HMPERR
+3 SET HMPDATA=$NAME(^TMP("HMPM EVT QUE GET GLBS",$JOB))
+4 KILL @HMPDATA
+5 DO GLBS(HMPDATA)
+6 DO ENCODE^HMPJSON(HMPDATA,RET,"HMPERR")
+7 KILL @HMPDATA
+8 QUIT
+9 ;
NOROWS(MSG) ; -- add standard text lines to indicate no rows to display
+1 SET VALMCNT=1
+2 SET @VALMAR@(VALMCNT,0)=""
+3 SET VALMCNT=2
+4 SET @VALMAR@(VALMCNT,0)=" o "_MSG
+5 DO CNTRL^VALM10(VALMCNT,2,78,IOINHI,IOINORM)
+6 QUIT
+7 ;
