HMPMETA ;SLC/PJH,ASM/RRB,CPC-collect domains, uids, & stamptimes ;Jan 20, 2017 17:18:18
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;Sep 01, 2011;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
Q ; no entry from top
;
; New routine for US6734
; DE6644 - fixes and general code cleanup, 7 September 2016
;
ADD(HMPDMNM,HMPUID,HMPSTMP) ; Build array for metastamp - called from HMPDJ0* routines
I ($G(HMPUID)="")!($G(HMPDMNM)="") Q
;For quick orders the JDS domain is 'qo'
S:HMPDMNM="quick" HMPDMNM="qo"
S ^TMP("HMPMETA",$J,HMPDMNM,HMPUID)=HMPSTMP
;unit tests use following nodes
S ^TMP("HMPMETA",$J,HMPDMNM)=$G(^TMP("HMPMETA",$J,HMPDMNM))+1
S ^TMP("HMPMETA",$J,"PATIENT")=$G(^TMP("HMPMETA",$J,"PATIENT"))+1
Q
;
;
DONE(HMPFDFN,HMPBATCH) ; Check if metastamp compile is complete
;For patients this will always be true since all patient domains compiled by one task
Q:+$G(HMPFDFN) 1
;For OPD requires to check that all domain compiles are completed
N HMPDOM,HMPCOMP
S HMPDOM="",HMPCOMP=1 F S HMPDOM=$O(^XTMP(HMPBATCH,0,"MSTA",HMPDOM)) Q:HMPDOM="" D Q:'HMPCOMP
. S:$G(^XTMP(HMPBATCH,0,"MSTA",HMPDOM))=0 HMPCOMP=0
Q HMPCOMP
;
;
OPD(HMPFHMP) ;Check if OPD metastamp is ready to collect
Q $S($$DONE("OPD","HMPFX~"_HMPFHMP_"~OPD"):1,1:0)
;
;
INIT(HMPBATCH,HMPFDFN,ARGS) ; Set metastamp status as in progress
N DOMAINS,HMPDOM,I
; set up domains to extract
D @($S(HMPFDFN="OPD":"OPDOMS",1:"PTDOMS")_"^HMPDJFSD(.DOMAINS)")
; remove any unneeded domains
I $G(ARGS("domains"))'="" F I=1:1 Q:'$D(DOMAINS(I)) I ARGS("domains")'[DOMAINS(I) K DOMAINS(I)
; put the domains into the batch in ^XTMP
F I=1:1 S HMPDOM=$G(DOMAINS(I)) Q:HMPDOM="" S ^XTMP(HMPBATCH,0,"MSTA",HMPDOM)=0
Q
;
;
UPD(HMPDOM) ; Update metastamp domain as complete
S ^XTMP(HMPBATCH,0,"MSTA",HMPDOM)=1 Q
;
MERGE1(HMPBATCH,HMPDOM) ; US11019 Merge a single domain
M ^XTMP(HMPBATCH,0,"META",HMPDOM)=^TMP("HMPMETA",$J,HMPDOM)
K ^TMP("HMPMETA",$J,HMPDOM)
Q
;
MERGE(HMPBATCH) ; Merge metastamp data into XTMP and mark domain complete in metastamp
;Formatting of metastamp into JSON format by HMPMETA goes here when ready
N HMPDOM
S HMPDOM="PATIENT"
F S HMPDOM=$O(^TMP("HMPMETA",$J,HMPDOM)) Q:HMPDOM="" M ^XTMP(HMPBATCH,0,"META",HMPDOM)=^TMP("HMPMETA",$J,HMPDOM)
K ^TMP("HMPMETA",$J)
Q
;
;
METAPT(A,HMPCDOM) ; MetaStamp for patient data (within its own syncStart chunk).;US11019 added second parameter
; --Input parameter
; A = "^^HMPFX~hmp-development-box~"<DFN> (e.g. ^^HMPFX~hmp-development-box~3)
; HMPCDOM = Single domain US11019
;
; --Expects
; DOMSIZE,OFFSET,HMPFCNT ;US11019 comment added not variables
;
; HMPA = "HMPFX~hmp-development-box~"<DFN>
; HMPB = ZTASK# --> ^XTMP(HMPA,<ZTASK#>
; HMPC = Domain (e.g. "allergy") --> ^XTMP(HMPA,HMPB,<Domain>
; HMPD = Counter (sequential number) --> ^XTMP(HMPA,HMPB,HMPC,<Counter>
; HMPN = Subscript --> ^XTMP(HMPA,HMPB,HMPC,HMPD,<Subscript>
; HMPE = ^XTMP(HMPA,HMPB,HMPC,HMPD,HMPN)
; HMPF = Domain id (e.g. the "C877:3:751" part of "urn:va:allergy:C877:3:751"
; HMPID = pid --> <site-hash>DFN (e.g. C877;3)
; HMPZ1 = DFN
; HMPP = $$PIDS^HMPDJFS(HMPZ1) --> JSON construct containing pid, systemId, localId, icn
; HMPQ = " (double quote literal)
; HMPT = The "total" node from ^XTMP --> ^XTMP(HMPA,HMPB,HMPC,"total")
; HMPX = JSON construct for the entire metaStamp
; HMPW = Event timeStamp
; HMPY = $$EN^HMPSTMP("NOW")
; HMPZ = Counter for breaking up the large nodes into sub-nodes in ^TMP
;
S U="^"
N HMPA,HMPB,HMPC,HMPC1,HMPD,HMPE,HMPF,HMPID,HMPM,HMPN
N HMPP,HMPQ,HMPT,HMPW,HMPX,HMPY,HMPZ,HMPZ1
S HMPA=$P(A,U,3),HMPB=$O(^XTMP(HMPA,0)),HMPZ1=$P(HMPA,"~",3)
S HMPE="",HMPQ="""",HMPZ=0 ;US11019
S HMPC=$G(HMPCDOM) ;US11019
S HMPP=$$PIDS^HMPDJFS(HMPZ1)
S HMPY=$$EN^HMPSTMP("NOW")
S HMPX=",""metaStamp"":"_"{""icn"":"""_$$GETICN^MPIF001(HMPZ1)_""""_","
S HMPX=HMPX_"""stampTime"":"""_HMPY_""""_",""sourceMetaStamp"":"_"{"
S HMPID=$TR($P($P(HMPP,"pid",2),","),""":")
S HMPX=HMPX_""""_$P(HMPID,";")_""""_":{"
S HMPX=HMPX_"""pid"":"""_HMPID_""""_","
S HMPX=HMPX_"""localId"":"""_$P(HMPID,";",2)_""""_","
S HMPX=HMPX_"""stampTime"":"""_HMPY_""""_","
S HMPX=HMPX_"""domainMetaStamp"""_":"_"{"
;Scan Domains
D:HMPC'="" I HMPC="" F S HMPC=$O(^XTMP(HMPA,0,"META",HMPC)) Q:HMPC']"" D ;US11019 allow process by single domain
.S HMPX=HMPX_""""_HMPC_""""_":{"
.S HMPX=HMPX_"""domain"":"""_HMPC_""""_","
.S HMPX=HMPX_"""stampTime"":"""_HMPY_""""_","
.S HMPD=0
.S HMPX=HMPX_"""eventMetaStamp"""_":"_"{" ; Patient data
.N HMPU,HMPS S HMPU=""
.I $O(^XTMP(HMPA,0,"META",HMPC,HMPU))="" S HMPX=HMPX_"}" ;US11019 - cater for zero entries
.F S HMPU=$O(^XTMP(HMPA,0,"META",HMPC,HMPU)) Q:HMPU']"" D
..N VAR0,VAR1
..S HMPS=$G(^XTMP(HMPA,0,"META",HMPC,HMPU)),VAR0=$P(HMPU,":",3),VAR1=$P(HMPU,":",4,99)
..I $L(HMPX)>20000 S HMPZ=HMPZ+1,^TMP("HMPF",$J,HMPFCNT,.3,HMPZ)=HMPX,HMPX=""
..S HMPX=HMPX_"""urn:va:"_VAR0_":"_VAR1_""""_":{"
..S HMPX=HMPX_"""stampTime"":"""_HMPS_""""_"}"
..S HMPX=HMPX_$S($O(^XTMP(HMPA,0,"META",HMPC,HMPU))="":"}",1:",")
.S HMPX=HMPX_"},"
.I $L(HMPX)>20000 S HMPZ=HMPZ+1,^TMP("HMPF",$J,HMPFCNT,.3,HMPZ)=HMPX,HMPX=""
I HMPZ!($L(HMPX)>0) D ;DE3759 avoid multiple edge case
.I $L(HMPX)=0 S HMPX=^TMP("HMPF",$J,HMPFCNT,.3,HMPZ),^TMP("HMPF",$J,HMPFCNT,.3,HMPZ)=$E(HMPX,1,$L(HMPX)-1),HMPX="" ;DE3759
.S HMPZ=HMPZ+1
.S HMPX=$E(HMPX,1,$L(HMPX)-1)_"}}}}" D
..I $E(HMPX,$L(HMPX))="{" S HMPX=HMPX_"""seq"":"_OFFSET_",""total"":"_DOMSIZE
..E S HMPX=HMPX_",""seq"":"_OFFSET_",""total"":"_DOMSIZE
.S HMPX=HMPX_",""object"":"
.S ^TMP("HMPF",$J,HMPFCNT,.3,HMPZ)=HMPX
Q
;
;
METAOP(A) ; MetaStamp for operational data (within its own syncStart chunk)
; A = HMPFX~hmp-development-box~OPD
;
; HMPA = "HMPFX~hmp-development-box~"<DFN>
; HMPB = ZTASK# --> ^XTMP(HMPA,<ZTASK#>
; HMPC = Domain (e.g. "allergy") --> ^XTMP(HMPA,HMPB,<Domain>
; HMPD = Counter (sequential number) --> ^XTMP(HMPA,HMPB,HMPC,<Counter>
; HMPN = Subscript --> ^XTMP(HMPA,HMPB,HMPC,HMPD,<Subscript>
; HMPE = ^XTMP(HMPA,HMPB,HMPC,HMPD,HMPN)
; HMPF = Domain id (e.g. the "C877:3:751" part of "urn:va:allergy:C877:3:751"
; HMPID = pid --> <site-hash>DFN (e.g. C877;3)
; HMPZ1 = DFN
; HMPP = $$PIDS^HMPDJFS(HMPZ1) --> JSON construct containing pid, systemId, localId, icn
; HMPQ = " (double quote literal)
; HMPT = The "total" node from ^XTMP --> ^XTMP(HMPA,HMPB,HMPC,"total")
; HMPX = JSON construct for the entire metaStamp
; HMPW = Event timeStamp
; HMPY = $$EN^HMPSTMP("NOW")
; HMPZ = Counter for breaking up the large nodes into sub-nodes in ^TMP
;
S U="^"
N HMPA,HMPJ,HMPQ,HMPSEP,HMPZ,HMPDAT,HMPDAT1,HMPDOM,HMPDOM1,HMPEVT,HMPX,HMPTOT,HMPTSK,HMPMOR,HMPLAS,HMPMOR,HMPLAS
S HMPA=$P(A,U,3),HMPQ="""",HMPZ=0,HMPSEP=","""
S HMPCNT=$G(HMPCNT)+1,HMPJ=$P(HMPA,"~",1,2)_"~OPD"
S HMPSEP=HMPQ
S HMPTSK=$O(^XTMP(A,0)),HMPY=$$EN^HMPSTMP("NOW"),HMPID=$$SYS^HMPUTILS
S HMPX="{""collection"":"""_"OPDsyncStart"_""""_","
S HMPX=HMPX_"""metaStamp"":"_"{"
S HMPX=HMPX_"""stampTime"":"""_HMPY_""""_",""sourceMetaStamp"":"_"{"
S HMPX=HMPX_""""_$P(HMPID,";")_""""_":{"
S HMPX=HMPX_"""stampTime"":"""_HMPY_""""_","
S HMPX=HMPX_"""domainMetaStamp"""_":"_"{"
;Scan Domains
S HMPC=""
F S HMPC=$O(^XTMP(HMPA,0,"META",HMPC)) Q:HMPC']"" D
.S HMPX=HMPX_""""_HMPC_""""_":{"
.S HMPX=HMPX_"""domain"":"""_HMPC_""""_","
.S HMPX=HMPX_"""stampTime"":"""_HMPY_""""_","
.S HMPD=0
.S HMPX=HMPX_"""itemMetaStamp"""_":"_"{" ; Patient data
.N HMPU,HMPS S HMPU=""
.F S HMPU=$O(^XTMP(HMPA,0,"META",HMPC,HMPU)) Q:HMPU']"" D
..N VAR0,VAR1
..S HMPS=$G(^XTMP(HMPA,0,"META",HMPC,HMPU)),VAR0=$P(HMPU,":",3),VAR1=$P(HMPU,":",4,99)
..I $L(HMPX)>20000 S HMPZ=HMPZ+1,^TMP("HMPF",$J,HMPFCNT,.3,HMPZ)=HMPX,HMPX=""
..S HMPX=HMPX_"""urn:va:"_VAR0_":"_VAR1_""""_":{"
..S HMPX=HMPX_"""stampTime"":"""_HMPS_""""_"}"
..S HMPX=HMPX_$S($O(^XTMP(HMPA,0,"META",HMPC,HMPU))="":"}",1:",")
.S HMPX=HMPX_"},"
.I $L(HMPX)>20000 S HMPZ=HMPZ+1,^TMP("HMPF",$J,HMPFCNT,.3,HMPZ)=HMPX,HMPX=""
I HMPZ!($L(HMPX)>0) D ;DE3759 avoid multiple edge case
.I $L(HMPX)=0 S HMPX=^TMP("HMPF",$J,HMPFCNT,.3,HMPZ),^TMP("HMPF",$J,HMPFCNT,.3,HMPZ)=$E(HMPX,1,$L(HMPX)-1),HMPX="" ;DE3759
.S HMPZ=HMPZ+1
.S HMPX=$E(HMPX,1,$L(HMPX)-1)_"}}}}},{"
.S ^TMP("HMPF",$J,HMPFCNT,.3,HMPZ)=HMPX
Q
;
;
STATUS(STOP,HMPFHMP) ; Set HMP GLOBAL USAGE MONITOR status
Q:$G(STOP)="" Q:$G(HMPFHMP)=""
N HMPFLG,HMPSTMP,HMPSRV
S HMPSRV=$O(^HMP(800000,"B",HMPFHMP,"")) Q:'HMPSRV
S HMPFLG=$P($G(^HMP(800000,HMPSRV,0)),U,5),HMPSTMP=$P($G(^HMP(800000,HMPSRV,0)),U,6)
;If stopped and already flagged as stopped do nothing
I STOP,HMPFLG Q
;If stopped but not flagged as stopped set flag and timestamp
I STOP,'HMPFLG D SET(STOP,HMPSRV) Q
;If running and flagged as stopped flag as running
I 'STOP,HMPFLG D SET(STOP,HMPSRV) Q
;No action needed if running and not flagged as stop
Q
;
SET(STOP,HMPSRV) ; Flag set/reset, Stamptime set
Q:'$G(HMPSRV)
L +^HMP(800000,HMPSRV,0):5 E Q
S $P(^HMP(800000,HMPSRV,0),U,5,6)=STOP_U_$$NOW^XLFDT
L -^HMP(800000,HMPSRV,0)
Q
;
CHECK(HMPFHMP) ; Check storage status and send MailMan message if appropriate
; Input HMPFHMP - server name
Q:$G(HMPFHMP)=""
N HMPDIFF,HMPFLG,HMPSRV,HMPSTTM
S HMPSRV=$O(^HMP(800000,"B",HMPFHMP,"")) Q:'HMPSRV
; ^DD(800000,.05,0)="DISK USAGE STATUS^S^0:WITHIN LIMIT;1:EXCEEDED LIMIT;^0;5^Q"
S HMPFLG=$P($G(^HMP(800000,HMPSRV,0)),U,5)
;No action required if status is not set
I HMPFLG="" Q
; (#.06) DISK USAGE STATUS TIME [6D]
S HMPSTTM=$P($G(^HMP(800000,HMPSRV,0)),U,6) Q:HMPSTTM=""
;quit if status time < five minutes ago
I $$FMDIFF^XLFDT($$NOW^XLFDT,HMPSTTM,2)<300 Q
;Otherwise send message
D MSG(HMPFLG)
; Clear DISK USAGE STATUS and DISK USAGE STATUS TIME
L +^HMP(800000,HMPSRV,0):5 E Q ; quit if no lock
S $P(^HMP(800000,HMPSRV,0),U,5,6)=""
L -^HMP(800000,HMPSRV,0)
Q
;
; DE6644: 2 MailMan message subroutines combined, 13 January 2017
MSG(HMPFLG) ; send email about space limit for ^XTMP("HMP*")
Q:'$D(HMPFLG) ; must have flag, if HMPFLG then limit exceeded
; 1 megabyte = 2**20 bytes = 1048576 bytes
N HMPMSG,HMPRCPNT,HMPSUBJ,HMPTXT,MAX
S MAX=$$GETMAX^HMPUTILS ; system parameter: HMP EXTRACT DISK SIZE LIMIT
S HMPSUBJ="HMP namepsace XTMP Global Size Monitor "_$S(HMPFLG:"PAUSE",1:"RESTART")_" alert"
D MSGLN(.HMPTXT,"*ALERT*: eHMP storage in the ^XTMP global has")
D MSGLN(.HMPTXT,$S(HMPFLG:"exceeded ",1:"been below ")_$FN(MAX,",")_" bytes ("_$J(MAX/1048576,2,2)_" MB) for more than 5 minutes.")
D MSGLN(.HMPTXT,"eHMP subscribing was "_$S(HMPFLG:"PAUSED.",1:"RESTARTED.")),MSGLN(.HMPTXT," ")
D MSGLN(.HMPTXT,"HMP* namespace data stored in ^XTMP is "_$J($P($$GETSIZE^HMPUTILS,"^")/1048576,2,2)_" MB.")
D MSGLN(.HMPTXT," "),MSGLN(.HMPTXT,"eHMP ^XTMP space check made "_$$HTE^XLFDT($H)),MSGLN(.HMPTXT," ")
I $G(ZTSK) D MSGLN(.HMPTXT,"TaskMan task number: "_ZTSK) ; add task number if available
D MSGLN(.HMPTXT," ")
S HMPRCPNT("G.HMP IRM GROUP")="",HMPRCPNT(DUZ)=""
D SENDMSG^XMXAPI(DUZ,HMPSUBJ,"HMPTXT",.HMPRCPNT,,.HMPMSG) ; HMPMSG returned as message number
Q
;
MSGLN(TXTARY,LN) ; add LN to TXTARY (passed by ref.) for MailMan message
Q:'$L($G(LN)) ; must have some text
S TXTARY(0)=$G(TXTARY(0))+1,TXTARY(TXTARY(0))=LN Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPMETA 11457 printed Sep 23, 2025@19:30:11 Page 2
HMPMETA ;SLC/PJH,ASM/RRB,CPC-collect domains, uids, & stamptimes ;Jan 20, 2017 17:18:18
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;Sep 01, 2011;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; no entry from top
QUIT
+5 ;
+6 ; New routine for US6734
+7 ; DE6644 - fixes and general code cleanup, 7 September 2016
+8 ;
ADD(HMPDMNM,HMPUID,HMPSTMP) ; Build array for metastamp - called from HMPDJ0* routines
+1 IF ($GET(HMPUID)="")!($GET(HMPDMNM)="")
QUIT
+2 ;For quick orders the JDS domain is 'qo'
+3 if HMPDMNM="quick"
SET HMPDMNM="qo"
+4 SET ^TMP("HMPMETA",$JOB,HMPDMNM,HMPUID)=HMPSTMP
+5 ;unit tests use following nodes
+6 SET ^TMP("HMPMETA",$JOB,HMPDMNM)=$GET(^TMP("HMPMETA",$JOB,HMPDMNM))+1
+7 SET ^TMP("HMPMETA",$JOB,"PATIENT")=$GET(^TMP("HMPMETA",$JOB,"PATIENT"))+1
+8 QUIT
+9 ;
+10 ;
DONE(HMPFDFN,HMPBATCH) ; Check if metastamp compile is complete
+1 ;For patients this will always be true since all patient domains compiled by one task
+2 if +$GET(HMPFDFN)
QUIT 1
+3 ;For OPD requires to check that all domain compiles are completed
+4 NEW HMPDOM,HMPCOMP
+5 SET HMPDOM=""
SET HMPCOMP=1
FOR
SET HMPDOM=$ORDER(^XTMP(HMPBATCH,0,"MSTA",HMPDOM))
if HMPDOM=""
QUIT
Begin DoDot:1
+6 if $GET(^XTMP(HMPBATCH,0,"MSTA",HMPDOM))=0
SET HMPCOMP=0
End DoDot:1
if 'HMPCOMP
QUIT
+7 QUIT HMPCOMP
+8 ;
+9 ;
OPD(HMPFHMP) ;Check if OPD metastamp is ready to collect
+1 QUIT $SELECT($$DONE("OPD","HMPFX~"_HMPFHMP_"~OPD"):1,1:0)
+2 ;
+3 ;
INIT(HMPBATCH,HMPFDFN,ARGS) ; Set metastamp status as in progress
+1 NEW DOMAINS,HMPDOM,I
+2 ; set up domains to extract
+3 DO @($SELECT(HMPFDFN="OPD":"OPDOMS",1:"PTDOMS")_"^HMPDJFSD(.DOMAINS)")
+4 ; remove any unneeded domains
+5 IF $GET(ARGS("domains"))'=""
FOR I=1:1
if '$DATA(DOMAINS(I))
QUIT
IF ARGS("domains")'[DOMAINS(I)
KILL DOMAINS(I)
+6 ; put the domains into the batch in ^XTMP
+7 FOR I=1:1
SET HMPDOM=$GET(DOMAINS(I))
if HMPDOM=""
QUIT
SET ^XTMP(HMPBATCH,0,"MSTA",HMPDOM)=0
+8 QUIT
+9 ;
+10 ;
UPD(HMPDOM) ; Update metastamp domain as complete
+1 SET ^XTMP(HMPBATCH,0,"MSTA",HMPDOM)=1
QUIT
+2 ;
MERGE1(HMPBATCH,HMPDOM) ; US11019 Merge a single domain
+1 MERGE ^XTMP(HMPBATCH,0,"META",HMPDOM)=^TMP("HMPMETA",$JOB,HMPDOM)
+2 KILL ^TMP("HMPMETA",$JOB,HMPDOM)
+3 QUIT
+4 ;
MERGE(HMPBATCH) ; Merge metastamp data into XTMP and mark domain complete in metastamp
+1 ;Formatting of metastamp into JSON format by HMPMETA goes here when ready
+2 NEW HMPDOM
+3 SET HMPDOM="PATIENT"
+4 FOR
SET HMPDOM=$ORDER(^TMP("HMPMETA",$JOB,HMPDOM))
if HMPDOM=""
QUIT
MERGE ^XTMP(HMPBATCH,0,"META",HMPDOM)=^TMP("HMPMETA",$JOB,HMPDOM)
+5 KILL ^TMP("HMPMETA",$JOB)
+6 QUIT
+7 ;
+8 ;
METAPT(A,HMPCDOM) ; MetaStamp for patient data (within its own syncStart chunk).;US11019 added second parameter
+1 ; --Input parameter
+2 ; A = "^^HMPFX~hmp-development-box~"<DFN> (e.g. ^^HMPFX~hmp-development-box~3)
+3 ; HMPCDOM = Single domain US11019
+4 ;
+5 ; --Expects
+6 ; DOMSIZE,OFFSET,HMPFCNT ;US11019 comment added not variables
+7 ;
+8 ; HMPA = "HMPFX~hmp-development-box~"<DFN>
+9 ; HMPB = ZTASK# --> ^XTMP(HMPA,<ZTASK#>
+10 ; HMPC = Domain (e.g. "allergy") --> ^XTMP(HMPA,HMPB,<Domain>
+11 ; HMPD = Counter (sequential number) --> ^XTMP(HMPA,HMPB,HMPC,<Counter>
+12 ; HMPN = Subscript --> ^XTMP(HMPA,HMPB,HMPC,HMPD,<Subscript>
+13 ; HMPE = ^XTMP(HMPA,HMPB,HMPC,HMPD,HMPN)
+14 ; HMPF = Domain id (e.g. the "C877:3:751" part of "urn:va:allergy:C877:3:751"
+15 ; HMPID = pid --> <site-hash>DFN (e.g. C877;3)
+16 ; HMPZ1 = DFN
+17 ; HMPP = $$PIDS^HMPDJFS(HMPZ1) --> JSON construct containing pid, systemId, localId, icn
+18 ; HMPQ = " (double quote literal)
+19 ; HMPT = The "total" node from ^XTMP --> ^XTMP(HMPA,HMPB,HMPC,"total")
+20 ; HMPX = JSON construct for the entire metaStamp
+21 ; HMPW = Event timeStamp
+22 ; HMPY = $$EN^HMPSTMP("NOW")
+23 ; HMPZ = Counter for breaking up the large nodes into sub-nodes in ^TMP
+24 ;
+25 SET U="^"
+26 NEW HMPA,HMPB,HMPC,HMPC1,HMPD,HMPE,HMPF,HMPID,HMPM,HMPN
+27 NEW HMPP,HMPQ,HMPT,HMPW,HMPX,HMPY,HMPZ,HMPZ1
+28 SET HMPA=$PIECE(A,U,3)
SET HMPB=$ORDER(^XTMP(HMPA,0))
SET HMPZ1=$PIECE(HMPA,"~",3)
+29 ;US11019
SET HMPE=""
SET HMPQ=""""
SET HMPZ=0
+30 ;US11019
SET HMPC=$GET(HMPCDOM)
+31 SET HMPP=$$PIDS^HMPDJFS(HMPZ1)
+32 SET HMPY=$$EN^HMPSTMP("NOW")
+33 SET HMPX=",""metaStamp"":"_"{""icn"":"""_$$GETICN^MPIF001(HMPZ1)_""""_","
+34 SET HMPX=HMPX_"""stampTime"":"""_HMPY_""""_",""sourceMetaStamp"":"_"{"
+35 SET HMPID=$TRANSLATE($PIECE($PIECE(HMPP,"pid",2),","),""":")
+36 SET HMPX=HMPX_""""_$PIECE(HMPID,";")_""""_":{"
+37 SET HMPX=HMPX_"""pid"":"""_HMPID_""""_","
+38 SET HMPX=HMPX_"""localId"":"""_$PIECE(HMPID,";",2)_""""_","
+39 SET HMPX=HMPX_"""stampTime"":"""_HMPY_""""_","
+40 SET HMPX=HMPX_"""domainMetaStamp"""_":"_"{"
+41 ;Scan Domains
+42 ;US11019 allow process by single domain
if HMPC'=""
Begin DoDot:1
+43 SET HMPX=HMPX_""""_HMPC_""""_":{"
+44 SET HMPX=HMPX_"""domain"":"""_HMPC_""""_","
+45 SET HMPX=HMPX_"""stampTime"":"""_HMPY_""""_","
+46 SET HMPD=0
+47 ; Patient data
SET HMPX=HMPX_"""eventMetaStamp"""_":"_"{"
+48 NEW HMPU,HMPS
SET HMPU=""
+49 ;US11019 - cater for zero entries
IF $ORDER(^XTMP(HMPA,0,"META",HMPC,HMPU))=""
SET HMPX=HMPX_"}"
+50 FOR
SET HMPU=$ORDER(^XTMP(HMPA,0,"META",HMPC,HMPU))
if HMPU']""
QUIT
Begin DoDot:2
+51 NEW VAR0,VAR1
+52 SET HMPS=$GET(^XTMP(HMPA,0,"META",HMPC,HMPU))
SET VAR0=$PIECE(HMPU,":",3)
SET VAR1=$PIECE(HMPU,":",4,99)
+53 IF $LENGTH(HMPX)>20000
SET HMPZ=HMPZ+1
SET ^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)=HMPX
SET HMPX=""
+54 SET HMPX=HMPX_"""urn:va:"_VAR0_":"_VAR1_""""_":{"
+55 SET HMPX=HMPX_"""stampTime"":"""_HMPS_""""_"}"
+56 SET HMPX=HMPX_$SELECT($ORDER(^XTMP(HMPA,0,"META",HMPC,HMPU))="":"}",1:",")
End DoDot:2
+57 SET HMPX=HMPX_"},"
+58 IF $LENGTH(HMPX)>20000
SET HMPZ=HMPZ+1
SET ^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)=HMPX
SET HMPX=""
End DoDot:1
IF HMPC=""
FOR
SET HMPC=$ORDER(^XTMP(HMPA,0,"META",HMPC))
if HMPC']""
QUIT
Begin DoDot:1
End DoDot:1
+59 ;DE3759 avoid multiple edge case
IF HMPZ!($LENGTH(HMPX)>0)
Begin DoDot:1
+60 ;DE3759
IF $LENGTH(HMPX)=0
SET HMPX=^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)
SET ^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)=$EXTRACT(HMPX,1,$LENGTH(HMPX)-1)
SET HMPX=""
+61 SET HMPZ=HMPZ+1
+62 SET HMPX=$EXTRACT(HMPX,1,$LENGTH(HMPX)-1)_"}}}}"
Begin DoDot:2
+63 IF $EXTRACT(HMPX,$LENGTH(HMPX))="{"
SET HMPX=HMPX_"""seq"":"_OFFSET_",""total"":"_DOMSIZE
+64 IF '$TEST
SET HMPX=HMPX_",""seq"":"_OFFSET_",""total"":"_DOMSIZE
End DoDot:2
+65 SET HMPX=HMPX_",""object"":"
+66 SET ^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)=HMPX
End DoDot:1
+67 QUIT
+68 ;
+69 ;
METAOP(A) ; MetaStamp for operational data (within its own syncStart chunk)
+1 ; A = HMPFX~hmp-development-box~OPD
+2 ;
+3 ; HMPA = "HMPFX~hmp-development-box~"<DFN>
+4 ; HMPB = ZTASK# --> ^XTMP(HMPA,<ZTASK#>
+5 ; HMPC = Domain (e.g. "allergy") --> ^XTMP(HMPA,HMPB,<Domain>
+6 ; HMPD = Counter (sequential number) --> ^XTMP(HMPA,HMPB,HMPC,<Counter>
+7 ; HMPN = Subscript --> ^XTMP(HMPA,HMPB,HMPC,HMPD,<Subscript>
+8 ; HMPE = ^XTMP(HMPA,HMPB,HMPC,HMPD,HMPN)
+9 ; HMPF = Domain id (e.g. the "C877:3:751" part of "urn:va:allergy:C877:3:751"
+10 ; HMPID = pid --> <site-hash>DFN (e.g. C877;3)
+11 ; HMPZ1 = DFN
+12 ; HMPP = $$PIDS^HMPDJFS(HMPZ1) --> JSON construct containing pid, systemId, localId, icn
+13 ; HMPQ = " (double quote literal)
+14 ; HMPT = The "total" node from ^XTMP --> ^XTMP(HMPA,HMPB,HMPC,"total")
+15 ; HMPX = JSON construct for the entire metaStamp
+16 ; HMPW = Event timeStamp
+17 ; HMPY = $$EN^HMPSTMP("NOW")
+18 ; HMPZ = Counter for breaking up the large nodes into sub-nodes in ^TMP
+19 ;
+20 SET U="^"
+21 NEW HMPA,HMPJ,HMPQ,HMPSEP,HMPZ,HMPDAT,HMPDAT1,HMPDOM,HMPDOM1,HMPEVT,HMPX,HMPTOT,HMPTSK,HMPMOR,HMPLAS,HMPMOR,HMPLAS
+22 SET HMPA=$PIECE(A,U,3)
SET HMPQ=""""
SET HMPZ=0
SET HMPSEP=","""
+23 SET HMPCNT=$GET(HMPCNT)+1
SET HMPJ=$PIECE(HMPA,"~",1,2)_"~OPD"
+24 SET HMPSEP=HMPQ
+25 SET HMPTSK=$ORDER(^XTMP(A,0))
SET HMPY=$$EN^HMPSTMP("NOW")
SET HMPID=$$SYS^HMPUTILS
+26 SET HMPX="{""collection"":"""_"OPDsyncStart"_""""_","
+27 SET HMPX=HMPX_"""metaStamp"":"_"{"
+28 SET HMPX=HMPX_"""stampTime"":"""_HMPY_""""_",""sourceMetaStamp"":"_"{"
+29 SET HMPX=HMPX_""""_$PIECE(HMPID,";")_""""_":{"
+30 SET HMPX=HMPX_"""stampTime"":"""_HMPY_""""_","
+31 SET HMPX=HMPX_"""domainMetaStamp"""_":"_"{"
+32 ;Scan Domains
+33 SET HMPC=""
+34 FOR
SET HMPC=$ORDER(^XTMP(HMPA,0,"META",HMPC))
if HMPC']""
QUIT
Begin DoDot:1
+35 SET HMPX=HMPX_""""_HMPC_""""_":{"
+36 SET HMPX=HMPX_"""domain"":"""_HMPC_""""_","
+37 SET HMPX=HMPX_"""stampTime"":"""_HMPY_""""_","
+38 SET HMPD=0
+39 ; Patient data
SET HMPX=HMPX_"""itemMetaStamp"""_":"_"{"
+40 NEW HMPU,HMPS
SET HMPU=""
+41 FOR
SET HMPU=$ORDER(^XTMP(HMPA,0,"META",HMPC,HMPU))
if HMPU']""
QUIT
Begin DoDot:2
+42 NEW VAR0,VAR1
+43 SET HMPS=$GET(^XTMP(HMPA,0,"META",HMPC,HMPU))
SET VAR0=$PIECE(HMPU,":",3)
SET VAR1=$PIECE(HMPU,":",4,99)
+44 IF $LENGTH(HMPX)>20000
SET HMPZ=HMPZ+1
SET ^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)=HMPX
SET HMPX=""
+45 SET HMPX=HMPX_"""urn:va:"_VAR0_":"_VAR1_""""_":{"
+46 SET HMPX=HMPX_"""stampTime"":"""_HMPS_""""_"}"
+47 SET HMPX=HMPX_$SELECT($ORDER(^XTMP(HMPA,0,"META",HMPC,HMPU))="":"}",1:",")
End DoDot:2
+48 SET HMPX=HMPX_"},"
+49 IF $LENGTH(HMPX)>20000
SET HMPZ=HMPZ+1
SET ^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)=HMPX
SET HMPX=""
End DoDot:1
+50 ;DE3759 avoid multiple edge case
IF HMPZ!($LENGTH(HMPX)>0)
Begin DoDot:1
+51 ;DE3759
IF $LENGTH(HMPX)=0
SET HMPX=^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)
SET ^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)=$EXTRACT(HMPX,1,$LENGTH(HMPX)-1)
SET HMPX=""
+52 SET HMPZ=HMPZ+1
+53 SET HMPX=$EXTRACT(HMPX,1,$LENGTH(HMPX)-1)_"}}}}},{"
+54 SET ^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)=HMPX
End DoDot:1
+55 QUIT
+56 ;
+57 ;
STATUS(STOP,HMPFHMP) ; Set HMP GLOBAL USAGE MONITOR status
+1 if $GET(STOP)=""
QUIT
if $GET(HMPFHMP)=""
QUIT
+2 NEW HMPFLG,HMPSTMP,HMPSRV
+3 SET HMPSRV=$ORDER(^HMP(800000,"B",HMPFHMP,""))
if 'HMPSRV
QUIT
+4 SET HMPFLG=$PIECE($GET(^HMP(800000,HMPSRV,0)),U,5)
SET HMPSTMP=$PIECE($GET(^HMP(800000,HMPSRV,0)),U,6)
+5 ;If stopped and already flagged as stopped do nothing
+6 IF STOP
IF HMPFLG
QUIT
+7 ;If stopped but not flagged as stopped set flag and timestamp
+8 IF STOP
IF 'HMPFLG
DO SET(STOP,HMPSRV)
QUIT
+9 ;If running and flagged as stopped flag as running
+10 IF 'STOP
IF HMPFLG
DO SET(STOP,HMPSRV)
QUIT
+11 ;No action needed if running and not flagged as stop
+12 QUIT
+13 ;
SET(STOP,HMPSRV) ; Flag set/reset, Stamptime set
+1 if '$GET(HMPSRV)
QUIT
+2 LOCK +^HMP(800000,HMPSRV,0):5
IF '$TEST
QUIT
+3 SET $PIECE(^HMP(800000,HMPSRV,0),U,5,6)=STOP_U_$$NOW^XLFDT
+4 LOCK -^HMP(800000,HMPSRV,0)
+5 QUIT
+6 ;
CHECK(HMPFHMP) ; Check storage status and send MailMan message if appropriate
+1 ; Input HMPFHMP - server name
+2 if $GET(HMPFHMP)=""
QUIT
+3 NEW HMPDIFF,HMPFLG,HMPSRV,HMPSTTM
+4 SET HMPSRV=$ORDER(^HMP(800000,"B",HMPFHMP,""))
if 'HMPSRV
QUIT
+5 ; ^DD(800000,.05,0)="DISK USAGE STATUS^S^0:WITHIN LIMIT;1:EXCEEDED LIMIT;^0;5^Q"
+6 SET HMPFLG=$PIECE($GET(^HMP(800000,HMPSRV,0)),U,5)
+7 ;No action required if status is not set
+8 IF HMPFLG=""
QUIT
+9 ; (#.06) DISK USAGE STATUS TIME [6D]
+10 SET HMPSTTM=$PIECE($GET(^HMP(800000,HMPSRV,0)),U,6)
if HMPSTTM=""
QUIT
+11 ;quit if status time < five minutes ago
+12 IF $$FMDIFF^XLFDT($$NOW^XLFDT,HMPSTTM,2)<300
QUIT
+13 ;Otherwise send message
+14 DO MSG(HMPFLG)
+15 ; Clear DISK USAGE STATUS and DISK USAGE STATUS TIME
+16 ; quit if no lock
LOCK +^HMP(800000,HMPSRV,0):5
IF '$TEST
QUIT
+17 SET $PIECE(^HMP(800000,HMPSRV,0),U,5,6)=""
+18 LOCK -^HMP(800000,HMPSRV,0)
+19 QUIT
+20 ;
+21 ; DE6644: 2 MailMan message subroutines combined, 13 January 2017
MSG(HMPFLG) ; send email about space limit for ^XTMP("HMP*")
+1 ; must have flag, if HMPFLG then limit exceeded
if '$DATA(HMPFLG)
QUIT
+2 ; 1 megabyte = 2**20 bytes = 1048576 bytes
+3 NEW HMPMSG,HMPRCPNT,HMPSUBJ,HMPTXT,MAX
+4 ; system parameter: HMP EXTRACT DISK SIZE LIMIT
SET MAX=$$GETMAX^HMPUTILS
+5 SET HMPSUBJ="HMP namepsace XTMP Global Size Monitor "_$SELECT(HMPFLG:"PAUSE",1:"RESTART")_" alert"
+6 DO MSGLN(.HMPTXT,"*ALERT*: eHMP storage in the ^XTMP global has")
+7 DO MSGLN(.HMPTXT,$SELECT(HMPFLG:"exceeded ",1:"been below ")_$FNUMBER(MAX,",")_" bytes ("_$JUSTIFY(MAX/1048576,2,2)_" MB) for more than 5 minutes.")
+8 DO MSGLN(.HMPTXT,"eHMP subscribing was "_$SELECT(HMPFLG:"PAUSED.",1:"RESTARTED."))
DO MSGLN(.HMPTXT," ")
+9 DO MSGLN(.HMPTXT,"HMP* namespace data stored in ^XTMP is "_$JUSTIFY($PIECE($$GETSIZE^HMPUTILS,"^")/1048576,2,2)_" MB.")
+10 DO MSGLN(.HMPTXT," ")
DO MSGLN(.HMPTXT,"eHMP ^XTMP space check made "_$$HTE^XLFDT($HOROLOG))
DO MSGLN(.HMPTXT," ")
+11 ; add task number if available
IF $GET(ZTSK)
DO MSGLN(.HMPTXT,"TaskMan task number: "_ZTSK)
+12 DO MSGLN(.HMPTXT," ")
+13 SET HMPRCPNT("G.HMP IRM GROUP")=""
SET HMPRCPNT(DUZ)=""
+14 ; HMPMSG returned as message number
DO SENDMSG^XMXAPI(DUZ,HMPSUBJ,"HMPTXT",.HMPRCPNT,,.HMPMSG)
+15 QUIT
+16 ;
MSGLN(TXTARY,LN) ; add LN to TXTARY (passed by ref.) for MailMan message
+1 ; must have some text
if '$LENGTH($GET(LN))
QUIT
+2 SET TXTARY(0)=$GET(TXTARY(0))+1
SET TXTARY(TXTARY(0))=LN
QUIT
+3 ;
