- 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 Feb 18, 2025@23:21 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