HMPTOOLS ;ASMR/JD - More HMP utilities ; 9/25/15 10:59am
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
CHKXTMP(RSLT) ; RPC(HMP CHKXTMP) to return the state of ^XTMP data
; RSLT - Return array:
; "There are a total of xxx patients in queue. yyy Complete zzz Staging"
; Where xxx,yyy, and zzz are zero or greater.
; NOTE: If xxx is zero, then the sentence after "queue." will NOT be displayed
;
; Goes through ^XTMP and figures out the total number of patients, how many
; have completed data staging, and how many are still staging.
; There is code to allow a bit more information than requested to be stored
; in a global (^TMP("FINDSTATUS",$J)) for future needs (e.g. Complete/staging
; is broken down by domain). *** This currently commented out ***.
;
; ^XTMP("HMPFX~<server id>~DFN",0,"status",<domain>)=STATUS, where STATUS=1 means
; data is completely staged and 0 means data is being staged but not complete yet.
;
; GLB = ^TMP("FINDSTATUS",$J) (FUTURE USE)
; HMPBAT = "HMPFX~<sever id>~DFN"
; HMPCM = Number of patients who have completed staging
; HMPCMP = Number of domains that have completed staging for a patient
; HMPCNT = Domain status (1 = complete; 0 = staging)
; HMPDFN = Patient IEN
; HMPDOM = Patient domain (e.g. lab, med, allergy, etc.)
; HMPST = Number of patients who are still in the staging state
; HMPSTG = Number of domains that are still staging for a patient
; HMPT = HMPCM+HMPST
;
N GLB,HMPBAT,HMPCM,HMPCMP,HMPCNT,HMPDFN,HMPDOM,HMPST,HMPSTG,HMPT
;S GLB=$NA(^TMP("FINDSTATUS",$J))
;K @GLB
S HMPBAT="HMPFX",(HMPCM,HMPST)=0
F S HMPBAT=$O(^XTMP(HMPBAT)) Q:$E(HMPBAT,1,5)'="HMPFX" D
.S HMPDOM="",HMPDFN=$P(HMPBAT,"~",3),(HMPCMP,HMPSTG)=0
.I HMPDFN'=+HMPDFN Q ; Patients ONLY!
.F S HMPDOM=$O(^XTMP(HMPBAT,0,"status",HMPDOM)) Q:HMPDOM']"" D
..S HMPCNT=^XTMP(HMPBAT,0,"status",HMPDOM)
..I HMPCNT=1 D
...S HMPCMP=HMPCMP+1
...;S @GLB@(HMPDFN,HMPDOM)="Complete"
..I HMPCNT'=1 D
...S HMPSTG=HMPSTG+1
...;S @GLB@(HMPDFN,HMPDOM)="Staging"
.I HMPSTG>0 D
..S HMPST=HMPST+1
..;S @GLB@(HMPDFN)="Staging"
.I HMPSTG'>0 D
..S HMPCM=HMPCM+1
..;S @GLB@(HMPDFN)="Complete"
S HMPT=HMPCM+HMPST
K RSLT
S RSLT(1)="There are a total of "_HMPT_" patient"_$S(HMPT=1:"",1:"s")_" in queue."
I HMPCM>0 S RSLT(1)=RSLT(1)_" "_HMPCM_" Complete"
I HMPST>0 S RSLT(1)=RSLT(1)_" "_HMPST_" Staging"
Q
;
MON ; Monitor the progress of ^XTMP growth. JD - 6/11/15
N DONE,SIZE,RES
D HOME^%ZIS
S DONE=-1
F Q:DONE'=-1 D
.S SIZE=+$P($P($$GETSIZE(),U)/1000+.5,".")
.W @IOF,"eHMP usage of ^XTMP = "_SIZE_" kilo byte(s)"
.D CHKXTMP(.RES)
.W !!,RES(1)
.W !!,"Hit any key to exit the monitor"
.X "R *DONE:2"
Q
;
SIZE(RSLT) ; calculate the size of XTMP global
S RSLT(1)=$P($$GETSIZE(),"^")
Q
;
GETSIZE(HMPMODE,HMPSRVN) ; -- return current aggregate extract size for extracts waiting to be sent to HMP servers
; input: HMPMODE := [ estimate - use estimated domain average sizes (default) |
; actual - walk though object nodes to calculate using $LENGTH ]
; HMPSRVN := name of HMP server [optional - defaults to all HMP servers]
; returns: total size in bytes ^ object count
;
; -- loop thru extracts for server(s)
N ROOT,BATCH,TASK,DOMAIN,OBJS,OBJCNT,OBJSIZES,TOTAL
S (OBJCNT,TOTAL)=0
S ROOT="HMPFX~"_$S($G(HMPSRVN)]"":HMPSRVN_"~",1:"")
S BATCH=ROOT
F S BATCH=$O(^XTMP(BATCH)) Q:$E(BATCH,1,$L(ROOT))'=ROOT D
. S TASK=0 F S TASK=$O(^XTMP(BATCH,TASK)) Q:'TASK D
. . S DOMAIN="" F S DOMAIN=$O(^XTMP(BATCH,TASK,DOMAIN)) Q:DOMAIN="" D
. . . S OBJS=+$O(^XTMP(BATCH,TASK,DOMAIN," "),-1)
. . . S OBJCNT=OBJCNT+OBJS
. . . S TOTAL=TOTAL+$$WALK(BATCH,TASK,DOMAIN) Q
. . . S TOTAL=TOTAL+(OBJS*$G(OBJSIZES($P(DOMAIN,"#")),1000))
Q TOTAL_"^"_OBJCNT
;
WALK(BATCH,TASK,DOMAIN) ; -- walk through domain objectS in task to get actual size
N OBJ,SIZE,NODE
S (OBJ,SIZE)=0
F S OBJ=$O(^XTMP(BATCH,TASK,DOMAIN,OBJ)) Q:'OBJ D
. S NODE=0 F S NODE=$O(^XTMP(BATCH,TASK,DOMAIN,OBJ,NODE)) Q:'NODE S SIZE=SIZE+$L($G(^(NODE)))
Q SIZE
;
MSG(M,Q,V) ;
;Create a message (M) in JSON format with a qualifier (Q)
;Returns RSLT(1)
; M - Message text - The paramater is message being reported for instance "DFN" could the message
; Q - Qualifier: - The quailifier is reporting where the JSON message is Required or Invalid.
; 1 - Required
; 2 - Invalid
; V - If Q=1, then V is ignored (or not passed in)
; If Q=2, then V=<the invalid value>
N TEXT,ERRMSG,JSONERR
K ERRMSG,RSLT,JSONERR
S M=$G(M),Q=$G(Q),V=$G(V)
S TEXT=M
I Q=1 S TEXT=M_" is required"
I Q=2 S TEXT="Invalid "_M_": "_V
S ERRMSG("Message")=TEXT D ENCODE^HMPJSON("ERRMSG","RSLT","JSONERR")
I $G(JSONERR) S RSLT(1)=JSONERR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPTOOLS 4956 printed Dec 13, 2024@01:54:39 Page 2
HMPTOOLS ;ASMR/JD - More HMP utilities ; 9/25/15 10:59am
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
CHKXTMP(RSLT) ; RPC(HMP CHKXTMP) to return the state of ^XTMP data
+1 ; RSLT - Return array:
+2 ; "There are a total of xxx patients in queue. yyy Complete zzz Staging"
+3 ; Where xxx,yyy, and zzz are zero or greater.
+4 ; NOTE: If xxx is zero, then the sentence after "queue." will NOT be displayed
+5 ;
+6 ; Goes through ^XTMP and figures out the total number of patients, how many
+7 ; have completed data staging, and how many are still staging.
+8 ; There is code to allow a bit more information than requested to be stored
+9 ; in a global (^TMP("FINDSTATUS",$J)) for future needs (e.g. Complete/staging
+10 ; is broken down by domain). *** This currently commented out ***.
+11 ;
+12 ; ^XTMP("HMPFX~<server id>~DFN",0,"status",<domain>)=STATUS, where STATUS=1 means
+13 ; data is completely staged and 0 means data is being staged but not complete yet.
+14 ;
+15 ; GLB = ^TMP("FINDSTATUS",$J) (FUTURE USE)
+16 ; HMPBAT = "HMPFX~<sever id>~DFN"
+17 ; HMPCM = Number of patients who have completed staging
+18 ; HMPCMP = Number of domains that have completed staging for a patient
+19 ; HMPCNT = Domain status (1 = complete; 0 = staging)
+20 ; HMPDFN = Patient IEN
+21 ; HMPDOM = Patient domain (e.g. lab, med, allergy, etc.)
+22 ; HMPST = Number of patients who are still in the staging state
+23 ; HMPSTG = Number of domains that are still staging for a patient
+24 ; HMPT = HMPCM+HMPST
+25 ;
+26 NEW GLB,HMPBAT,HMPCM,HMPCMP,HMPCNT,HMPDFN,HMPDOM,HMPST,HMPSTG,HMPT
+27 ;S GLB=$NA(^TMP("FINDSTATUS",$J))
+28 ;K @GLB
+29 SET HMPBAT="HMPFX"
SET (HMPCM,HMPST)=0
+30 FOR
SET HMPBAT=$ORDER(^XTMP(HMPBAT))
if $EXTRACT(HMPBAT,1,5)'="HMPFX"
QUIT
Begin DoDot:1
+31 SET HMPDOM=""
SET HMPDFN=$PIECE(HMPBAT,"~",3)
SET (HMPCMP,HMPSTG)=0
+32 ; Patients ONLY!
IF HMPDFN'=+HMPDFN
QUIT
+33 FOR
SET HMPDOM=$ORDER(^XTMP(HMPBAT,0,"status",HMPDOM))
if HMPDOM']""
QUIT
Begin DoDot:2
+34 SET HMPCNT=^XTMP(HMPBAT,0,"status",HMPDOM)
+35 IF HMPCNT=1
Begin DoDot:3
+36 SET HMPCMP=HMPCMP+1
+37 ;S @GLB@(HMPDFN,HMPDOM)="Complete"
End DoDot:3
+38 IF HMPCNT'=1
Begin DoDot:3
+39 SET HMPSTG=HMPSTG+1
+40 ;S @GLB@(HMPDFN,HMPDOM)="Staging"
End DoDot:3
End DoDot:2
+41 IF HMPSTG>0
Begin DoDot:2
+42 SET HMPST=HMPST+1
+43 ;S @GLB@(HMPDFN)="Staging"
End DoDot:2
+44 IF HMPSTG'>0
Begin DoDot:2
+45 SET HMPCM=HMPCM+1
+46 ;S @GLB@(HMPDFN)="Complete"
End DoDot:2
End DoDot:1
+47 SET HMPT=HMPCM+HMPST
+48 KILL RSLT
+49 SET RSLT(1)="There are a total of "_HMPT_" patient"_$SELECT(HMPT=1:"",1:"s")_" in queue."
+50 IF HMPCM>0
SET RSLT(1)=RSLT(1)_" "_HMPCM_" Complete"
+51 IF HMPST>0
SET RSLT(1)=RSLT(1)_" "_HMPST_" Staging"
+52 QUIT
+53 ;
MON ; Monitor the progress of ^XTMP growth. JD - 6/11/15
+1 NEW DONE,SIZE,RES
+2 DO HOME^%ZIS
+3 SET DONE=-1
+4 FOR
if DONE'=-1
QUIT
Begin DoDot:1
+5 SET SIZE=+$PIECE($PIECE($$GETSIZE(),U)/1000+.5,".")
+6 WRITE @IOF,"eHMP usage of ^XTMP = "_SIZE_" kilo byte(s)"
+7 DO CHKXTMP(.RES)
+8 WRITE !!,RES(1)
+9 WRITE !!,"Hit any key to exit the monitor"
+10 XECUTE "R *DONE:2"
End DoDot:1
+11 QUIT
+12 ;
SIZE(RSLT) ; calculate the size of XTMP global
+1 SET RSLT(1)=$PIECE($$GETSIZE(),"^")
+2 QUIT
+3 ;
GETSIZE(HMPMODE,HMPSRVN) ; -- return current aggregate extract size for extracts waiting to be sent to HMP servers
+1 ; input: HMPMODE := [ estimate - use estimated domain average sizes (default) |
+2 ; actual - walk though object nodes to calculate using $LENGTH ]
+3 ; HMPSRVN := name of HMP server [optional - defaults to all HMP servers]
+4 ; returns: total size in bytes ^ object count
+5 ;
+6 ; -- loop thru extracts for server(s)
+7 NEW ROOT,BATCH,TASK,DOMAIN,OBJS,OBJCNT,OBJSIZES,TOTAL
+8 SET (OBJCNT,TOTAL)=0
+9 SET ROOT="HMPFX~"_$SELECT($GET(HMPSRVN)]"":HMPSRVN_"~",1:"")
+10 SET BATCH=ROOT
+11 FOR
SET BATCH=$ORDER(^XTMP(BATCH))
if $EXTRACT(BATCH,1,$LENGTH(ROOT))'=ROOT
QUIT
Begin DoDot:1
+12 SET TASK=0
FOR
SET TASK=$ORDER(^XTMP(BATCH,TASK))
if 'TASK
QUIT
Begin DoDot:2
+13 SET DOMAIN=""
FOR
SET DOMAIN=$ORDER(^XTMP(BATCH,TASK,DOMAIN))
if DOMAIN=""
QUIT
Begin DoDot:3
+14 SET OBJS=+$ORDER(^XTMP(BATCH,TASK,DOMAIN," "),-1)
+15 SET OBJCNT=OBJCNT+OBJS
+16 SET TOTAL=TOTAL+$$WALK(BATCH,TASK,DOMAIN)
QUIT
+17 SET TOTAL=TOTAL+(OBJS*$GET(OBJSIZES($PIECE(DOMAIN,"#")),1000))
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT TOTAL_"^"_OBJCNT
+19 ;
WALK(BATCH,TASK,DOMAIN) ; -- walk through domain objectS in task to get actual size
+1 NEW OBJ,SIZE,NODE
+2 SET (OBJ,SIZE)=0
+3 FOR
SET OBJ=$ORDER(^XTMP(BATCH,TASK,DOMAIN,OBJ))
if 'OBJ
QUIT
Begin DoDot:1
+4 SET NODE=0
FOR
SET NODE=$ORDER(^XTMP(BATCH,TASK,DOMAIN,OBJ,NODE))
if 'NODE
QUIT
SET SIZE=SIZE+$LENGTH($GET(^(NODE)))
End DoDot:1
+5 QUIT SIZE
+6 ;
MSG(M,Q,V) ;
+1 ;Create a message (M) in JSON format with a qualifier (Q)
+2 ;Returns RSLT(1)
+3 ; M - Message text - The paramater is message being reported for instance "DFN" could the message
+4 ; Q - Qualifier: - The quailifier is reporting where the JSON message is Required or Invalid.
+5 ; 1 - Required
+6 ; 2 - Invalid
+7 ; V - If Q=1, then V is ignored (or not passed in)
+8 ; If Q=2, then V=<the invalid value>
+9 NEW TEXT,ERRMSG,JSONERR
+10 KILL ERRMSG,RSLT,JSONERR
+11 SET M=$GET(M)
SET Q=$GET(Q)
SET V=$GET(V)
+12 SET TEXT=M
+13 IF Q=1
SET TEXT=M_" is required"
+14 IF Q=2
SET TEXT="Invalid "_M_": "_V
+15 SET ERRMSG("Message")=TEXT
DO ENCODE^HMPJSON("ERRMSG","RSLT","JSONERR")
+16 IF $GET(JSONERR)
SET RSLT(1)=JSONERR
+17 QUIT
