HMPDJFSG ;SLC/KCM,ASMR/RRB,CPC,JD,ASF,CK -- GET for Extract and Freshness Stream;Aug 11, 2016 10:35:07
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;May 15, 2016;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; US3907 - Allow for jobId and rootJobId to be retrieved from ^XTMP. JD 1/20/15
; DE2818 - SQA findings. Newed ERRCNT in BLDSERR+2. RRB 10/24/2015
; DE3869 - Remove the freshness stream entries with undefined DFNs. JD 3/4/16
;
Q
; --- retrieve updates for an HMP server's subscriptions
;
GETSUB(HMPFRSP,ARGS) ; retrieve items from stream
; GET from: /hmp/subscription/{hmpSrvId}/{last}?limit={limit}
; ARGS("last") : date-seq of last item retrieved (ex. 3131206-27)
; ARGS("max") : maximum number of items to return (default 99999) *S68-JCH*
; ARGS("maxSize"): approximate number bytes to return *S68-JCH*
;
; HMPFSYS : the id (hash) of the VistA system
; HMPFHMP : the name of the HMP server
; HMPFSEQ : final sequence (becomes next LASTSEQ)
; HMPFIDX : index to iterate from LASTSEQ to final sequence
; HMPFLAST: used to clean up extracts prior to this
; HMPFSTRM: the extract/freshness stream (HMPFS~hmpSrvId~fmDate)
;
K ^TMP("HMPF",$J)
N HMPFSYS,HMPFSTRM,HMPFLAST,HMPFDT,HMPFLIM,HMPFMAX,HMPFSIZE,HMPCLFLG
N HMPFSEQ,HMPFIDX,HMPFCNT,SNODE,STYPE,HMPFERR,HMPDEL,HMPERR,HMPSTGET,HMPLITEM ;*S68-JCH*,DE3502
S HMPFRSP=$NA(^TMP("HMPF",$J))
;Next line added US6734 - Make sure OPD metastamp data has been completed before fetching.
I '$$OPD^HMPMETA(HMPFHMP) S @HMPFRSP@(1)="{""warning"":""Staging is not complete yet!""}" Q
;
S HMPFSYS=$$SYS^HMPUTILS
S HMPFHMP("ien")=$O(^HMP(800000,"B",HMPFHMP,0))
S HMPFDT=$P($G(ARGS("lastUpdate")),"-")
S HMPFSEQ=+$P($G(ARGS("lastUpdate")),"-",2)
S HMPSTGET=$G(ARGS("getStatus"))
S HMPLITEM="" ;DE3502 initialise tracking of last item type
;stream goes back a maximum of 8 days
I HMPFDT<$$FMADD^XLFDT($$DT^XLFDT,-8) S HMPFDT=$$HTFM^XLFDT(+$H-8),HMPFSEQ=0
S HMPFLAST=HMPFDT_"-"_HMPFSEQ
D LASTUPD(HMPFHMP,HMPFLAST)
D SETLIMIT(.ARGS) ; set HMPFLIM, HMPFMAX, HMPFSIZE;*S68-PJH*
S HMPFLIM=$G(ARGS("max"),99999)
S HMPFSTRM="HMPFS~"_HMPFHMP_"~"_HMPFDT ; stream identifier
I '$D(^XTMP(HMPFSTRM,"job",$J)) S ^XTMP(HMPFSTRM,"job",$J,"start")=$H
S ^XTMP(HMPFSTRM,"job",$J)=$H ; record connection info
I '$$VERMATCH(HMPFHMP("ien"),$G(ARGS("extractSchema"))) D NOOP(HMPFLAST) QUIT
S HMPFCNT=0,HMPFIDX=HMPFSEQ
;BL;DE7809 stop processing each day if we have hit item limit added the limitation quit
F D Q:HMPFSIZE'<HMPFMAX Q:HMPFCNT'<HMPFLIM D NXTSTRM Q:HMPFSTRM="" ;*S68-JCH*
. F S HMPFIDX=$O(^XTMP(HMPFSTRM,HMPFIDX)) Q:'HMPFIDX D Q:HMPFCNT'<HMPFLIM
.. S SNODE=^XTMP(HMPFSTRM,HMPFIDX),STYPE=$P(SNODE,U,2)
.. K FILTER("freshnessDateTime")
.. ;===JD START===
.. K ARGS("hmp-fst") I $P(SNODE,U,4)="@" S ARGS("hmp-fst")=$P(SNODE,U,5)
.. ;===JD END===
.. S $P(^XTMP(HMPFSTRM,HMPFIDX),U,6)=$P($H,",",2) ;timestamp when sent
.. I STYPE="syncNoop" Q ;skip, patient was unsubscribed
.. I STYPE="syncDomain" D DOMITMS Q ;add multiple extract items
.. S HMPFSEQ=HMPFIDX
.. I STYPE="syncCommand" D SYNCCMD(SNODE) Q ; command to middle tier
.. I STYPE="syncError" D SYNCERR(SNODE,.HMPERR) Q
.. I STYPE="syncStart" D SYNCSTRT(SNODE) S HMPLITEM="SYNC" Q ; begin initial extraction ;DE3502
.. I STYPE="syncMeta" D SYNCMETA(SNODE) S HMPLITEM="SYNC" Q ; US11019 - Build replacement syncstart ;DE3502
.. I STYPE="syncDone" D SYNCDONE(SNODE) S HMPLITEM="SYNC" Q ; end of initial extraction ;DE3502
.. D FRESHITM(SNODE,.HMPDEL,.HMPERR) S HMPLITEM="FRESH" ; otherwise, freshness item ;DE3502
Q:$G(HMPFERR)
D FINISH(.HMPDEL,.HMPERR)
;Check if HMP GLOBAL USAGE MONITOR mail message is required -US8228
D CHECK^HMPMETA(HMPFHMP) ;US8228
Q
DOMITMS ;loop thru extract items, OFFSET is last sent
;expects HMPFSTRM,HMPFIDX,HMPFHMP,HMPFSYS
;changes HMPFSEQ,HMPFCNT,HMPFSIZE as each item added ;*S68-JCH*
N X,OFFSET,DFN,PIDS,DOMAIN,TASK,BATCH,COUNT,ITEMNUM,DOMSIZE,SECSIZE
S X=^XTMP(HMPFSTRM,HMPFIDX),DFN=$P(X,U),X=$P(X,U,3)
S PIDS=$S(DFN:$$PIDS^HMPDJFS(DFN),1:"")
S DOMAIN=$P(X,":") ;domain{#sectionNumber}
S TASK=$P(X,":",2) ;task number in ^XTMP
S COUNT=$P(X,":",3) ;count in this section
S DOMSIZE=$P(X,":",4) ;estimated total for the domain
S SECSIZE=$P(X,":",5) ;section size (for operational)
S BATCH="HMPFX~"_HMPFHMP_"~"_DFN ;extract node in ^XTMP
S OFFSET=COUNT-(HMPFIDX-HMPFSEQ)
F S OFFSET=$O(^XTMP(BATCH,TASK,DOMAIN,OFFSET)) Q:'OFFSET D Q:HMPFCNT'<HMPFLIM
. ;;PJH;;S HMPFCNT=HMPFCNT+1 ;increment the count of returned items
. S HMPFSEQ=HMPFSEQ+1 ;increment the sequence number in the stream
. S HMPFSIZE=$$INCITEM($P(DOMAIN,"#")) ;*S68-JCH*
. S ITEMNUM=OFFSET+($P(DOMAIN,"#",2)*SECSIZE)
. M ^TMP("HMPF",$J,HMPFCNT)=^XTMP(BATCH,TASK,DOMAIN,OFFSET)
. ;S ^TMP("HMPF",$J,HMPFCNT,.3)=$$WRAPPER(DOMAIN,PIDS,$S('COUNT:0,1:ITEMNUM),+DOMSIZE)
. S ^TMP("HMPF",$J,HMPFCNT,.3)=$$WRAPPER(DOMAIN,PIDS,$S('COUNT:0,1:ITEMNUM),+DOMSIZE,1) ;*S68-JCH*
. S HMPLITEM="SYNC",HMPCLFLG=0 ;DE3502
Q
MIDXTRCT() ; Return true if mid-extract
;from GETSUB expects HMPFSTRM,HMPFSEQ
I 'HMPFSEQ Q 0
I '$D(^XTMP(HMPFSTRM,HMPFSEQ)) Q 1 ;middle of extract
I $P(^XTMP(HMPFSTRM,HMPFSEQ),U,2)="syncDomain" Q 1 ;just starting extract
Q 0
;
NXTSTRM ; Reset variables for next date in this HMP stream
; from GETSUB expects HMPFSTRM,HMPFDT,HMPFIDX
; HMPFSTRM set to "" if no next stream
; HMPFIDX set to 0 if next stream, or left as is
; HMPFDT set to last date actually used
N NEXTDT,DONE
S NEXTDT=HMPFDT,DONE=0
F D Q:DONE
. S NEXTDT=$$FMADD^XLFDT(NEXTDT,1)
. I NEXTDT>$$DT^XLFDT S HMPFSTRM="" S DONE=1 Q
. S $P(HMPFSTRM,"~",3)=NEXTDT
. I '+$O(^XTMP(HMPFSTRM,0)) Q ; nothing here, try next date
. S HMPFDT=NEXTDT,HMPFIDX=0,HMPFSEQ=0,DONE=1
Q
;
SETLIMIT(ARGS) ; sets HMPFLIM, HMPFMAX, HMPFSIZE variables *BEGIN*S68-JCH*
I $G(ARGS("maxSize")) D Q
. S HMPFLIM="s"
. S HMPFMAX=ARGS("maxSize")
. D GETLST^XPAR(.HMPFSIZE,"PKG","HMP DOMAIN SIZES","I")
. S HMPFSIZE=0
; otherwise
S HMPFLIM="c"
S HMPFMAX=$G(ARGS("max"),99999)
S HMPFSIZE=0
Q
;
INCITEM(DOMAIN) ; increment counters as item added *BEGIN*S68-JCH*
S HMPFCNT=HMPFCNT+1
I HMPFLIM="s" Q HMPFSIZE+$G(HMPFSIZE(DOMAIN),1200)
I HMPFLIM="c" Q HMPFCNT
Q 0
; *END*S68-JCH*
;
FINISH(HMPDEL,HMPERR) ;reset the FIRST object delimiter, add header and tail
; expects HMPFCNT,HMPFDT,HMPFSEQ,HMPFHMP,HMPFLAST
N CLOSE,I,START,TEXT,UID,X,II
S X=$G(^TMP("HMPF",$J,1,.3))
I $E(X,1,2)="}," S X=$E(X,3,$L(X)),^TMP("HMPF",$J,1,.3)=X
S ^TMP("HMPF",$J,.5)=$$APIHDR(HMPFCNT,HMPFDT_"-"_HMPFSEQ)
I $D(HMPERR) D
.S CLOSE=$S(HMPFCNT:"},",1:""),START=1
.S HMPFCNT=HMPFCNT+1,^TMP("HMPF",$J,HMPFCNT)=CLOSE_"{""error"":["
.S I=0 F S I=$O(HMPERR(I)) Q:I'>0 D
..S TEXT=HMPERR(I)
..S HMPFCNT=HMPFCNT+1,^TMP("HMPF",$J,HMPFCNT)=$S(START:"",1:",")_TEXT S START=0
.S HMPFCNT=HMPFCNT+1,^TMP("HMPF",$J,HMPFCNT)="]"
; operational sync item or patient
; Check for closing flag & HMPFCNT and if it doesn't exist add a closing brace, always close array
S ^TMP("HMPF",$J,HMPFCNT+1)=$S(HMPFCNT&('$G(HMPCLFLG)):"}",1:"")_"]",HMPFCNT=HMPFCNT+1
; modified
I $G(HMPSTGET)="true" D ; true if "getStatus" argument passed in
. S HMPFCNT=HMPFCNT+1,^TMP("HMPF",$J,HMPFCNT)=",""syncStatii"":[",START=1
. S I=0 F S I=$O(^HMP(800000,I)) Q:+I=0 D
. . I $P($G(^HMP(800000,I,0)),"^",1)=HMPFHMP D
. . . S II=0 F S II=$O(^HMP(800000,I,1,II)) Q:+II=0 D
. . . . S TEXT="{""pid"":"_II_",""status"":"_$P(^HMP(800000,I,1,II,0),"^",2)_"}"
. . . . S HMPFCNT=HMPFCNT+1,^TMP("HMPF",$J,HMPFCNT)=$S(START:"",1:",")_TEXT S START=0
. S HMPFCNT=HMPFCNT+1,^TMP("HMPF",$J,HMPFCNT)="]"
;
S ^TMP("HMPF",$J,HMPFCNT+1)="}}"
; remove any ^XTMP nodes that have been successfully sent based on LAST
N DATE,SEQ,LASTDT,LASTSEQ,STRM,LSTRM,RSTRM
S LASTDT=+$P(HMPFLAST,"-"),LASTSEQ=+$P(HMPFLAST,"-",2)
S RSTRM="HMPFS~"_HMPFHMP_"~",LSTRM=$L(RSTRM),STRM=RSTRM
F S STRM=$O(^XTMP(STRM)) Q:'$L(STRM) Q:$E(STRM,1,LSTRM)'=RSTRM D
. S DATE=$P(STRM,"~",3) Q:DATE>LASTDT
. S SEQ=0 F S SEQ=$O(^XTMP(STRM,"tidy",SEQ)) Q:'SEQ Q:(DATE=LASTDT)&(SEQ>LASTSEQ) D TIDYX(STRM,SEQ)
Q
TIDYX(STREAM,SEQ) ; clean up extracts after they have been retrieved
; from FINISH
;DE6047 make resilient
N BATCH,DOMAIN,TASK
Q:$G(STREAM)="" Q:$G(SEQ)=""
S BATCH=$G(^XTMP(STREAM,"tidy",SEQ,"batch"))
S DOMAIN=$G(^XTMP(STREAM,"tidy",SEQ,"domain"))
S TASK=$G(^XTMP(STREAM,"tidy",SEQ,"task"))
I BATCH=""!(DOMAIN="")!(TASK="") D
. N C,J,TXT
. S C=1,TXT(C)=" Freshness Stream: "_STREAM_", missing TIDY elements in SEQ: "_SEQ
. S C=C+1,TXT(C)=" " ; blank line following word-processing text, $$NWNTRY^HMPLOG appends to end
. S J=$$NWNTRY^HMPLOG($$NOW^XLFDT,"M",.TXT) ; log event as type "missing"
I BATCH'="" D
. I DOMAIN="<done>" K ^XTMP(BATCH) Q
. I TASK'="",DOMAIN'="" K ^XTMP(BATCH,TASK,DOMAIN)
K ^XTMP(STREAM,"tidy",SEQ)
Q
SYNCCMD(SEQNODE) ; Build syncCommand object and stick in ^TMP
; expects: HMPSYS, HMPFCNT
N DFN,CMD,CMDJSON,ERR
S DFN=+SEQNODE
S CMD("command")=$P($P(SEQNODE,U,3),":")
S CMD("domain")=$P($P(SEQNODE,U,3),":",2)
S:DFN CMD("pid")=$$PID^HMPDJFS(DFN)
S CMD("system")=HMPSYS
D ENCODE^HMPJSON("CMD","CMDJSON","ERR")
I $D(ERR) S $EC=",UJSON encode error," Q
S HMPFSIZE=$$INCITEM("syncCommand") ; *S68-JCH*
M ^TMP("HMPF",$J,HMPFCNT)=CMDJSON
S ^TMP("HMPF",$J,HMPFCNT,.3)=$$WRAPPER("syncCommand",$$PIDS^HMPDJFS(DFN),1,1)
Q
SYNCSTRT(SEQNODE) ;Build syncStart object with demograhics
;expects HMPFSYS, HMPFHMP, HMPFCNT, HMPFSIZE *S68-JCH*
S HMPFSIZE=$$INCITEM("patient") ;*S68-JCH*
N DFN,FILTER,DFN,WRAP
S DFN=$P($P(SEQNODE,U,3),"~",3) ; HMPFX~hmpSrvId~dfn
I DFN D
. N RSLT ;cpc 2015/10/01
. S FILTER("patientId")=DFN,FILTER("domain")="patient"
. D GET^HMPDJ(.RSLT,.FILTER)
. M ^TMP("HMPF",$J,HMPFCNT)=^TMP("HMP",$J,1)
; for OPD there is no object, so 4th argument is 0
S ^TMP("HMPF",$J,HMPFCNT,.3)=$$WRAPPER("syncStart",$$PIDS^HMPDJFS(DFN),$S(DFN:1,1:-1),$S(DFN:1,1:-1))
Q
SYNCDONE(SEQNODE) ; Build syncStatus object and stick in ^TMP
;expects: HMPFSYS, HMPFCNT, HMPFHMP, HMPFSIZE *S68-JCH*
N HMPBATCH,DFN,STS,STSJSON,X,ERR
S HMPBATCH=$P(SEQNODE,U,3) ; HMPFX~hmpSrvId~dfn
S DFN=$P(HMPBATCH,"~",3)
S STS("uid")="urn:va:syncStatus:"_HMPFSYS_":"_DFN
S STS("initialized")="true"
I DFN S STS("localId")=DFN
S X="" F S X=$O(^XTMP(HMPBATCH,0,"count",X)) Q:'$L(X) D
. S STS("domainTotals",X)=^XTMP(HMPBATCH,0,"count",X)
;If resubscribing a patient, just send demographics
I DFN'="OPD",$D(^HMP(800000,"AITEM",DFN)) D
. N HMP99
. S HMP99=""
. ;Reset all domain counts to zero except for demographics
. F S HMP99=$O(STS("domainTotals",HMP99)) Q:'HMP99 I HMP99'="patient" S STS("domainTotals",HMP99)=0
D ENCODE^HMPJSON("STS","STSJSON","ERR")
I $D(ERR) S $EC=",UJSON encode error," Q
S HMPFSIZE=$$INCITEM("syncstatus") ; *S68-JCH*
M ^TMP("HMPF",$J,HMPFCNT)=STSJSON
S ^TMP("HMPF",$J,HMPFCNT,.3)=$$WRAPPER("syncStatus",$$PIDS^HMPDJFS(DFN),1,1)
Q
;
SYNCMETA(SNODE) ;US11019 Build NEW syncStart object
;expects HMPFSYS, HMPFHMP, HMPFCNT
;need to rebuild SNODE because WRAPPER expects it to fall in
N BATCH,DFN,WRAP,METADOM
S DFN=$P(SNODE,U,1)
S METADOM=$P(SNODE,U,3)
S BATCH="HMPFX~"_HMPFHMP_"~"_DFN
S $P(SNODE,U,3)=BATCH
S HMPFSIZE=$$INCITEM("syncmeta") ;need to increment count
S ^TMP("HMPF",$J,HMPFCNT,.3)=$$WRAPPER("syncStart"_"#"_METADOM,$$PIDS^HMPDJFS(DFN),$S(DFN:1,1:-1),$S(DFN:1,1:-1))
S ^TMP("HMPF",$J,HMPFCNT,1)="null" ;always null object with this record
S HMPCLFLG=0 ; DE3502
Q
;
SYNCERR(SNODE,HMPERR) ;
N BATCH,CNT,DFN,NUM,OFFSET,PIDS,TASK,TOTAL,X
S DFN=$P(SNODE,U),X=$P(SNODE,U,3)
S PIDS=$$PIDS^HMPDJFS(DFN)
S TASK=$P(X,":",2),TOTAL=$P(X,":",4)
S BATCH="HMPFX~"_HMPFHMP_"~"_DFN ; extract node in ^XTMP
S CNT=$O(HMPERR(""),-1)
S NUM=0 F S NUM=$O(^XTMP(BATCH,TASK,"error",NUM)) Q:NUM'>0 D
.S CNT=CNT+1 S HMPERR(CNT)=$G(^XTMP(BATCH,TASK,"error",NUM,1))
Q
;
FRESHITM(SEQNODE,DELETE,ERROR) ;Get freshness item and stick in ^TMP
; expects HMPFSYS, HMPFHMP
N ACT,DFN,DOMAIN,ECNT,FILTER,ID,RSLT,UID,HMP97,HMPI,WRAP,HMPPAT7,HMPPAT8
S FILTER("noHead")=1
S DFN=$P(SEQNODE,U),DOMAIN=$P(SEQNODE,U,2),ID=$P(SEQNODE,U,3),ACT=$P(SEQNODE,U,4)
;Next 2 IFs added to prevent <UNDEFINED> in LKUP^HMPDJ00. JD - 3/4/16. DE3869
;Make sure deletes ('@') are not included.
;HMPFSTRM and HMPFIDX are defined in the GETSUB section above.
;For "pt-select", ID=patient IEN and DFN="OPD" For ptient domains ID=DFN=patient IEN
;checks for all patient domains and pt-select of the operational data domain
;Kill the freshness stream entry with the bad patient IEN
I ACT'="@",DFN=+DFN,'$D(^DPT(DFN,0)) K ^XTMP(HMPFSTRM,HMPFIDX) Q ;For patient domains
I ACT'="@",DOMAIN="pt-select",ID=+ID,'$D(^DPT(ID,0)) K ^XTMP(HMPFSTRM,HMPFIDX) Q
;
;Create a phantom "patient" if visit is the domain
I DOMAIN="visit" D
.S HMPPAT7=HMPFIDX_".99",HMPPAT8=^XTMP(HMPFSTRM,HMPFIDX),$P(HMPPAT8,U,2)="patient" ;BL;DE2280
.S ^XTMP(HMPFSTRM,HMPPAT7)=HMPPAT8
I ACT'="@" D
. S FILTER("id")=ID
. S FILTER("domain")=DOMAIN
. I DFN="OPD" D GET^HMPEF(.RSLT,.FILTER)
. I +DFN>0 D
.. S FILTER("patientId")=DFN
.. D ; DE3691, add date/time with seconds to FILTER parameters, Feb 29 2016
... N DAY,SECS,TM S SECS=$P($G(^XTMP(HMPFSTRM,HMPFIDX)),U,5),DAY=$P(HMPFSTRM,"~",3)
... Q:('DAY)!('$L(SECS)) ; must have date and seconds, could be zero seconds (midnight)
... S TM=$S(SECS:SECS#60/100+(SECS#3600\60)/100+(SECS\3600)/100,SECS=0:".000001",1:"") ; if zero (midnight) push to 1 second after
... Q:'$L(TM) ; couldn't compute time
... S FILTER("freshnessDateTime")=DAY+TM
.. D GET^HMPDJ(.RSLT,.FILTER)
I ACT'="@",$L($G(^TMP("HMP",$J,"error")))>0 D BLDSERR(DFN,.ERROR) Q
I '$D(^TMP("HMP",$J,1)) S ACT="@"
I ACT="@" D
. S UID=$$SETUID^HMPUTILS(DOMAIN,$S(+DFN>0:DFN,1:""),ID)
. S HMP97=UID
. K ^TMP("HMP",$J) S ^TMP("HMP",$J,1)="" ; Need to dummy this up or it will never get set later
;
;Add syncstart, data and syncstatus to JSON for unsolicited updates - US4588 & US3682
I (DOMAIN="pt-select")!(DOMAIN="user")!(DOMAIN["asu-")!(DOMAIN="doc-def")!(DFN=+DFN) D Q
.D ADHOC^HMPUTIL1(DOMAIN,.HMPFCNT,DFN)
.I $P(HMPFIDX,".",2)=99 K ^XTMP(HMPFSTRM,HMPFIDX) ;Remove the phantom "patient"; JD
.S HMPLITEM="FRESH" ;DE3502
;
S WRAP=$$WRAPPER(DOMAIN,$$PIDS^HMPDJFS(DFN),1,1) ;N.B. this updates the .3 node on this HMPFCNT
F HMPI=1:1 Q:'$D(^TMP("HMP",$J,HMPI)) D
. S HMPFCNT=HMPFCNT+1
. M ^TMP("HMPF",$J,HMPFCNT)=^TMP("HMP",$J,HMPI)
. I HMPLITEM="SYNC" S HMPLITEM="FRESH" I WRAP="," S ^TMP("HMPF",$J,HMPFCNT,.3)="}," Q ;DE3502 add closing
. S ^TMP("HMPF",$J,HMPFCNT,.3)=WRAP
Q
;
BLDSERR(DFN,ERROR) ;Create syncError object in ERRJSON
;expects: HMPBATCH, HMPFSYS, HMPFZTSK
N COUNT,ERRVAL,ERROBJ,ERR,ERRCNT,ERRMSG,SYNCERR
M ERRVAL=^TMP("HMP",$J,"error")
I $G(ERRVAL)="" Q
S ERRVAL="{"_ERRVAL_"}"
D DECODE^HMPJSON("ERRVAL","ERROBJ","ERR")
I $D(ERR) S $EC=",UJSON decode error,"
S ERRMSG=ERROBJ("error","message")
Q:'$L(ERRMSG)
S SYNCERR("uid")="urn:va:syncError:"_HMPFSYS_":"_DFN_":FRESHNESS"
S SYNCERR("collection")=DOMAIN
S SYNCERR("error")=ERRMSG
D ENCODE^HMPJSON("SYNCERR","ERRJSON","ERR") I $D(ERR) S $EC=",UJSON encode error," Q
S COUNT=$O(ERROR(""),-1) ;*BEGIN*S68-JCH*
S ERRCNT=0 F S ERRCNT=$O(ERRJSON(ERRCNT)) Q:ERRCNT'>0 D
.S COUNT=COUNT+1 M ERROR(COUNT)=ERRJSON(COUNT) ;*END*S68-JCH*
Q
WRAPPER(DOMAIN,PIDS,OFFSET,DOMSIZE,FROMXTR) ;return JSON wrapper for each item *S68-JCH*
;add object tag if extract total not zero or if total passed as -1
;seq and total tags only added if non-zero
N X,Y,Z,HMPSVERS ;US11019
;Ensure that X exists
S X=""
S Z=$P(SNODE,U,3)
S HMPSVERS=$G(^XTMP(Z,"HMPSVERS")) ;US11019 If HMPSVERS=0 then running in previous mode
S HMPSTMP=$G(^XTMP(Z,"HMPSTMP")) ;PJH - THIS USED ONLY FOR OPD COMPILE IN PRIOR VERSION - NEEDS REMOVING US6734
;This was working for operational data, not patient data
;DFN will be OPD if this is operational data
I DFN="OPD" D
. S:$P($G(DOMAIN),"#")'="syncStart" X="},{""collection"":"""_$P(DOMAIN,"#")_""""_PIDS ;US11019
E S X="},{""collection"":"""_$P(DOMAIN,"#")_""""_PIDS ; If ONLY patient data exists
I HMPLITEM="FRESH" I $E(X)="}" S X=$E(X,2,$L(X)) ; DE3502 - remove closing when coming from Fresh
I $P(DOMAIN,"#")="syncStart",$O(^XTMP(Z,0))]"" D Q X
.;--- Start US3907 ---
.;Pass JobId and RootJobId back in the response if we were given them
.;This bridges the gap between Job status and Sync Status (since VistA will be giving the syncStatus)
.;US11019 use domain specific Job id
.S Y=$S($P(DOMAIN,"#",2)="":$G(^XTMP(Z,"JOBID")),1:$G(^XTMP(Z,"JOBID",$P(DOMAIN,"#",2)))) ;US11019
.I Y]"" S X=X_",""jobId"":"""_Y_""""
.S Y=$G(^XTMP(Z,"ROOTJOBID"))
.I Y]"" S X=X_",""rootJobId"":"""_Y_""""
.;--- End US3907 ---
.I DFN'="OPD" D METAPT^HMPMETA(SNODE,$S(HMPSVERS:$P(DOMAIN,"#",2),1:"")) Q ;US11019 extra para ;Collect Patient metastamp data from XTMP - US6734
.D METAOP^HMPMETA(SNODE) ; Collect OPD metastamp data from XTMP - US6734
S X=X_","
;if batched by extract *S68-JCH*
I $G(OFFSET)>-1 S X=X_"""seq"":"_OFFSET_","
I $G(DOMSIZE)>-1 S X=X_"""total"":"_DOMSIZE_","
I $G(OFFSET)>-1 S X=X_"""object"":"
Q X
;
APIHDR(COUNT,LASTITM) ;return JSON
;expects HMPFSYS
I $P($G(LASTITM),".",2)="99" S LASTITM=$P(LASTITM,".") ;make sure lastUpdate is correct;JD;BL;DE2280
N X
S X="{""apiVersion"":1.02,""params"":{""domain"":"""_$$KSP^XUPARAM("WHERE")_""""
S X=X_",""systemId"":"""_HMPFSYS_"""},""data"":{""updated"":"""_$$HL7NOW^HMPDJ_""""
S X=X_",""totalItems"":"_COUNT_",""lastUpdate"":"""_LASTITM_""""_$$PROGRESS^HMPDJFS(LASTITM)
S X=X_",""items"":["
Q X
NOOP(LASTITM) ;No-op, don't return any items
S ^TMP("HMPF",$J,.5)=$$APIHDR(0,LASTITM)_"]}}"
Q
VERMATCH(HMPIEN,VERSION) ;true if middle tier HMP and VistA version match
;versions match, queue any patients waiting for match
I $P($$GET^XPAR("PKG","HMP JSON SCHEMA"),".")=$P(VERSION,".") D QUIT 1
. Q:'$G(^XTMP("HMPFS~"_HMPIEN,"waiting")) ; no patients awaiting queuing
. S ^XTMP("HMPFS~"_HMPIEN,"waiting")=0
. N DOMAINS,BATCH,HMPNAME
. S HMPNAME=$P(^HMP(800000,HMPIEN,0),U)
. D PTDOMS^HMPDJFSD(.DOMAINS)
. S DFN=0 F S DFN=$O(^XTMP("HMPFS~"_HMPIEN,"waiting",DFN)) Q:'DFN D
. . Q:'$D(^HMP(800000,HMPIEN,1,DFN)) ; subscription cancelled while waiting *S68-JCH*
. . S BATCH="HMPFX~"_HMPNAME_"~"_DFN
. . D QUINIT^HMPDJFSP(BATCH,DFN,.DOMAINS)
. K ^XTMP("HMPFS~"_HMPIEN)
;
;otherwise, hold things
D NEWXTMP^HMPDJFS("HMPFS~"_HMPIEN,8,"HMP Awaiting Version Match")
S ^XTMP("HMPFS~"_HMPIEN,"waiting")=1
Q 0
;
LASTUPD(HMPSRV,LASTUPD) ;save the last update
; TODO: change this to use Fileman call
N IEN,CURRUPD,REPEAT
S IEN=$O(^HMP(800000,"B",HMPSRV,0)) Q:'IEN
Q:LASTUPD["^"
S CURRUPD=$P(^HMP(800000,IEN,0),"^",2),REPEAT=$P(^HMP(800000,IEN,0),"^",4)
I LASTUPD=CURRUPD S $P(^HMP(800000,IEN,0),"^",4)=REPEAT+1 QUIT
S $P(^HMP(800000,IEN,0),"^",2)=LASTUPD,$P(^HMP(800000,IEN,0),"^",4)=0
Q
JSONOUT ;Write out JSON in ^TMP
N X
S X=$NA(^TMP("HMPF",$J))
F S X=$Q(@X) Q:($QS(X,1)'="HMPF")!($QS(X,2)'=$J) W !,@X
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJFSG 19450 printed Dec 13, 2024@01:53:34 Page 2
HMPDJFSG ;SLC/KCM,ASMR/RRB,CPC,JD,ASF,CK -- GET for Extract and Freshness Stream;Aug 11, 2016 10:35:07
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;May 15, 2016;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; US3907 - Allow for jobId and rootJobId to be retrieved from ^XTMP. JD 1/20/15
+5 ; DE2818 - SQA findings. Newed ERRCNT in BLDSERR+2. RRB 10/24/2015
+6 ; DE3869 - Remove the freshness stream entries with undefined DFNs. JD 3/4/16
+7 ;
+8 QUIT
+9 ; --- retrieve updates for an HMP server's subscriptions
+10 ;
GETSUB(HMPFRSP,ARGS) ; retrieve items from stream
+1 ; GET from: /hmp/subscription/{hmpSrvId}/{last}?limit={limit}
+2 ; ARGS("last") : date-seq of last item retrieved (ex. 3131206-27)
+3 ; ARGS("max") : maximum number of items to return (default 99999) *S68-JCH*
+4 ; ARGS("maxSize"): approximate number bytes to return *S68-JCH*
+5 ;
+6 ; HMPFSYS : the id (hash) of the VistA system
+7 ; HMPFHMP : the name of the HMP server
+8 ; HMPFSEQ : final sequence (becomes next LASTSEQ)
+9 ; HMPFIDX : index to iterate from LASTSEQ to final sequence
+10 ; HMPFLAST: used to clean up extracts prior to this
+11 ; HMPFSTRM: the extract/freshness stream (HMPFS~hmpSrvId~fmDate)
+12 ;
+13 KILL ^TMP("HMPF",$JOB)
+14 NEW HMPFSYS,HMPFSTRM,HMPFLAST,HMPFDT,HMPFLIM,HMPFMAX,HMPFSIZE,HMPCLFLG
+15 ;*S68-JCH*,DE3502
NEW HMPFSEQ,HMPFIDX,HMPFCNT,SNODE,STYPE,HMPFERR,HMPDEL,HMPERR,HMPSTGET,HMPLITEM
+16 SET HMPFRSP=$NAME(^TMP("HMPF",$JOB))
+17 ;Next line added US6734 - Make sure OPD metastamp data has been completed before fetching.
+18 IF '$$OPD^HMPMETA(HMPFHMP)
SET @HMPFRSP@(1)="{""warning"":""Staging is not complete yet!""}"
QUIT
+19 ;
+20 SET HMPFSYS=$$SYS^HMPUTILS
+21 SET HMPFHMP("ien")=$ORDER(^HMP(800000,"B",HMPFHMP,0))
+22 SET HMPFDT=$PIECE($GET(ARGS("lastUpdate")),"-")
+23 SET HMPFSEQ=+$PIECE($GET(ARGS("lastUpdate")),"-",2)
+24 SET HMPSTGET=$GET(ARGS("getStatus"))
+25 ;DE3502 initialise tracking of last item type
SET HMPLITEM=""
+26 ;stream goes back a maximum of 8 days
+27 IF HMPFDT<$$FMADD^XLFDT($$DT^XLFDT,-8)
SET HMPFDT=$$HTFM^XLFDT(+$HOROLOG-8)
SET HMPFSEQ=0
+28 SET HMPFLAST=HMPFDT_"-"_HMPFSEQ
+29 DO LASTUPD(HMPFHMP,HMPFLAST)
+30 ; set HMPFLIM, HMPFMAX, HMPFSIZE;*S68-PJH*
DO SETLIMIT(.ARGS)
+31 SET HMPFLIM=$GET(ARGS("max"),99999)
+32 ; stream identifier
SET HMPFSTRM="HMPFS~"_HMPFHMP_"~"_HMPFDT
+33 IF '$DATA(^XTMP(HMPFSTRM,"job",$JOB))
SET ^XTMP(HMPFSTRM,"job",$JOB,"start")=$HOROLOG
+34 ; record connection info
SET ^XTMP(HMPFSTRM,"job",$JOB)=$HOROLOG
+35 IF '$$VERMATCH(HMPFHMP("ien"),$GET(ARGS("extractSchema")))
DO NOOP(HMPFLAST)
QUIT
+36 SET HMPFCNT=0
SET HMPFIDX=HMPFSEQ
+37 ;BL;DE7809 stop processing each day if we have hit item limit added the limitation quit
+38 ;*S68-JCH*
FOR
Begin DoDot:1
+39 FOR
SET HMPFIDX=$ORDER(^XTMP(HMPFSTRM,HMPFIDX))
if 'HMPFIDX
QUIT
Begin DoDot:2
+40 SET SNODE=^XTMP(HMPFSTRM,HMPFIDX)
SET STYPE=$PIECE(SNODE,U,2)
+41 KILL FILTER("freshnessDateTime")
+42 ;===JD START===
+43 KILL ARGS("hmp-fst")
IF $PIECE(SNODE,U,4)="@"
SET ARGS("hmp-fst")=$PIECE(SNODE,U,5)
+44 ;===JD END===
+45 ;timestamp when sent
SET $PIECE(^XTMP(HMPFSTRM,HMPFIDX),U,6)=$PIECE($HOROLOG,",",2)
+46 ;skip, patient was unsubscribed
IF STYPE="syncNoop"
QUIT
+47 ;add multiple extract items
IF STYPE="syncDomain"
DO DOMITMS
QUIT
+48 SET HMPFSEQ=HMPFIDX
+49 ; command to middle tier
IF STYPE="syncCommand"
DO SYNCCMD(SNODE)
QUIT
+50 IF STYPE="syncError"
DO SYNCERR(SNODE,.HMPERR)
QUIT
+51 ; begin initial extraction ;DE3502
IF STYPE="syncStart"
DO SYNCSTRT(SNODE)
SET HMPLITEM="SYNC"
QUIT
+52 ; US11019 - Build replacement syncstart ;DE3502
IF STYPE="syncMeta"
DO SYNCMETA(SNODE)
SET HMPLITEM="SYNC"
QUIT
+53 ; end of initial extraction ;DE3502
IF STYPE="syncDone"
DO SYNCDONE(SNODE)
SET HMPLITEM="SYNC"
QUIT
+54 ; otherwise, freshness item ;DE3502
DO FRESHITM(SNODE,.HMPDEL,.HMPERR)
SET HMPLITEM="FRESH"
End DoDot:2
if HMPFCNT'<HMPFLIM
QUIT
End DoDot:1
if HMPFSIZE'<HMPFMAX
QUIT
if HMPFCNT'<HMPFLIM
QUIT
DO NXTSTRM
if HMPFSTRM=""
QUIT
+55 if $GET(HMPFERR)
QUIT
+56 DO FINISH(.HMPDEL,.HMPERR)
+57 ;Check if HMP GLOBAL USAGE MONITOR mail message is required -US8228
+58 ;US8228
DO CHECK^HMPMETA(HMPFHMP)
+59 QUIT
DOMITMS ;loop thru extract items, OFFSET is last sent
+1 ;expects HMPFSTRM,HMPFIDX,HMPFHMP,HMPFSYS
+2 ;changes HMPFSEQ,HMPFCNT,HMPFSIZE as each item added ;*S68-JCH*
+3 NEW X,OFFSET,DFN,PIDS,DOMAIN,TASK,BATCH,COUNT,ITEMNUM,DOMSIZE,SECSIZE
+4 SET X=^XTMP(HMPFSTRM,HMPFIDX)
SET DFN=$PIECE(X,U)
SET X=$PIECE(X,U,3)
+5 SET PIDS=$SELECT(DFN:$$PIDS^HMPDJFS(DFN),1:"")
+6 ;domain{#sectionNumber}
SET DOMAIN=$PIECE(X,":")
+7 ;task number in ^XTMP
SET TASK=$PIECE(X,":",2)
+8 ;count in this section
SET COUNT=$PIECE(X,":",3)
+9 ;estimated total for the domain
SET DOMSIZE=$PIECE(X,":",4)
+10 ;section size (for operational)
SET SECSIZE=$PIECE(X,":",5)
+11 ;extract node in ^XTMP
SET BATCH="HMPFX~"_HMPFHMP_"~"_DFN
+12 SET OFFSET=COUNT-(HMPFIDX-HMPFSEQ)
+13 FOR
SET OFFSET=$ORDER(^XTMP(BATCH,TASK,DOMAIN,OFFSET))
if 'OFFSET
QUIT
Begin DoDot:1
+14 ;;PJH;;S HMPFCNT=HMPFCNT+1 ;increment the count of returned items
+15 ;increment the sequence number in the stream
SET HMPFSEQ=HMPFSEQ+1
+16 ;*S68-JCH*
SET HMPFSIZE=$$INCITEM($PIECE(DOMAIN,"#"))
+17 SET ITEMNUM=OFFSET+($PIECE(DOMAIN,"#",2)*SECSIZE)
+18 MERGE ^TMP("HMPF",$JOB,HMPFCNT)=^XTMP(BATCH,TASK,DOMAIN,OFFSET)
+19 ;S ^TMP("HMPF",$J,HMPFCNT,.3)=$$WRAPPER(DOMAIN,PIDS,$S('COUNT:0,1:ITEMNUM),+DOMSIZE)
+20 ;*S68-JCH*
SET ^TMP("HMPF",$JOB,HMPFCNT,.3)=$$WRAPPER(DOMAIN,PIDS,$SELECT('COUNT:0,1:ITEMNUM),+DOMSIZE,1)
+21 ;DE3502
SET HMPLITEM="SYNC"
SET HMPCLFLG=0
End DoDot:1
if HMPFCNT'<HMPFLIM
QUIT
+22 QUIT
MIDXTRCT() ; Return true if mid-extract
+1 ;from GETSUB expects HMPFSTRM,HMPFSEQ
+2 IF 'HMPFSEQ
QUIT 0
+3 ;middle of extract
IF '$DATA(^XTMP(HMPFSTRM,HMPFSEQ))
QUIT 1
+4 ;just starting extract
IF $PIECE(^XTMP(HMPFSTRM,HMPFSEQ),U,2)="syncDomain"
QUIT 1
+5 QUIT 0
+6 ;
NXTSTRM ; Reset variables for next date in this HMP stream
+1 ; from GETSUB expects HMPFSTRM,HMPFDT,HMPFIDX
+2 ; HMPFSTRM set to "" if no next stream
+3 ; HMPFIDX set to 0 if next stream, or left as is
+4 ; HMPFDT set to last date actually used
+5 NEW NEXTDT,DONE
+6 SET NEXTDT=HMPFDT
SET DONE=0
+7 FOR
Begin DoDot:1
+8 SET NEXTDT=$$FMADD^XLFDT(NEXTDT,1)
+9 IF NEXTDT>$$DT^XLFDT
SET HMPFSTRM=""
SET DONE=1
QUIT
+10 SET $PIECE(HMPFSTRM,"~",3)=NEXTDT
+11 ; nothing here, try next date
IF '+$ORDER(^XTMP(HMPFSTRM,0))
QUIT
+12 SET HMPFDT=NEXTDT
SET HMPFIDX=0
SET HMPFSEQ=0
SET DONE=1
End DoDot:1
if DONE
QUIT
+13 QUIT
+14 ;
SETLIMIT(ARGS) ; sets HMPFLIM, HMPFMAX, HMPFSIZE variables *BEGIN*S68-JCH*
+1 IF $GET(ARGS("maxSize"))
Begin DoDot:1
+2 SET HMPFLIM="s"
+3 SET HMPFMAX=ARGS("maxSize")
+4 DO GETLST^XPAR(.HMPFSIZE,"PKG","HMP DOMAIN SIZES","I")
+5 SET HMPFSIZE=0
End DoDot:1
QUIT
+6 ; otherwise
+7 SET HMPFLIM="c"
+8 SET HMPFMAX=$GET(ARGS("max"),99999)
+9 SET HMPFSIZE=0
+10 QUIT
+11 ;
INCITEM(DOMAIN) ; increment counters as item added *BEGIN*S68-JCH*
+1 SET HMPFCNT=HMPFCNT+1
+2 IF HMPFLIM="s"
QUIT HMPFSIZE+$GET(HMPFSIZE(DOMAIN),1200)
+3 IF HMPFLIM="c"
QUIT HMPFCNT
+4 QUIT 0
+5 ; *END*S68-JCH*
+6 ;
FINISH(HMPDEL,HMPERR) ;reset the FIRST object delimiter, add header and tail
+1 ; expects HMPFCNT,HMPFDT,HMPFSEQ,HMPFHMP,HMPFLAST
+2 NEW CLOSE,I,START,TEXT,UID,X,II
+3 SET X=$GET(^TMP("HMPF",$JOB,1,.3))
+4 IF $EXTRACT(X,1,2)="},"
SET X=$EXTRACT(X,3,$LENGTH(X))
SET ^TMP("HMPF",$JOB,1,.3)=X
+5 SET ^TMP("HMPF",$JOB,.5)=$$APIHDR(HMPFCNT,HMPFDT_"-"_HMPFSEQ)
+6 IF $DATA(HMPERR)
Begin DoDot:1
+7 SET CLOSE=$SELECT(HMPFCNT:"},",1:"")
SET START=1
+8 SET HMPFCNT=HMPFCNT+1
SET ^TMP("HMPF",$JOB,HMPFCNT)=CLOSE_"{""error"":["
+9 SET I=0
FOR
SET I=$ORDER(HMPERR(I))
if I'>0
QUIT
Begin DoDot:2
+10 SET TEXT=HMPERR(I)
+11 SET HMPFCNT=HMPFCNT+1
SET ^TMP("HMPF",$JOB,HMPFCNT)=$SELECT(START:"",1:",")_TEXT
SET START=0
End DoDot:2
+12 SET HMPFCNT=HMPFCNT+1
SET ^TMP("HMPF",$JOB,HMPFCNT)="]"
End DoDot:1
+13 ; operational sync item or patient
+14 ; Check for closing flag & HMPFCNT and if it doesn't exist add a closing brace, always close array
+15 SET ^TMP("HMPF",$JOB,HMPFCNT+1)=$SELECT(HMPFCNT&('$GET(HMPCLFLG)):"}",1:"")_"]"
SET HMPFCNT=HMPFCNT+1
+16 ; modified
+17 ; true if "getStatus" argument passed in
IF $GET(HMPSTGET)="true"
Begin DoDot:1
+18 SET HMPFCNT=HMPFCNT+1
SET ^TMP("HMPF",$JOB,HMPFCNT)=",""syncStatii"":["
SET START=1
+19 SET I=0
FOR
SET I=$ORDER(^HMP(800000,I))
if +I=0
QUIT
Begin DoDot:2
+20 IF $PIECE($GET(^HMP(800000,I,0)),"^",1)=HMPFHMP
Begin DoDot:3
+21 SET II=0
FOR
SET II=$ORDER(^HMP(800000,I,1,II))
if +II=0
QUIT
Begin DoDot:4
+22 SET TEXT="{""pid"":"_II_",""status"":"_$PIECE(^HMP(800000,I,1,II,0),"^",2)_"}"
+23 SET HMPFCNT=HMPFCNT+1
SET ^TMP("HMPF",$JOB,HMPFCNT)=$SELECT(START:"",1:",")_TEXT
SET START=0
End DoDot:4
End DoDot:3
End DoDot:2
+24 SET HMPFCNT=HMPFCNT+1
SET ^TMP("HMPF",$JOB,HMPFCNT)="]"
End DoDot:1
+25 ;
+26 SET ^TMP("HMPF",$JOB,HMPFCNT+1)="}}"
+27 ; remove any ^XTMP nodes that have been successfully sent based on LAST
+28 NEW DATE,SEQ,LASTDT,LASTSEQ,STRM,LSTRM,RSTRM
+29 SET LASTDT=+$PIECE(HMPFLAST,"-")
SET LASTSEQ=+$PIECE(HMPFLAST,"-",2)
+30 SET RSTRM="HMPFS~"_HMPFHMP_"~"
SET LSTRM=$LENGTH(RSTRM)
SET STRM=RSTRM
+31 FOR
SET STRM=$ORDER(^XTMP(STRM))
if '$LENGTH(STRM)
QUIT
if $EXTRACT(STRM,1,LSTRM)'=RSTRM
QUIT
Begin DoDot:1
+32 SET DATE=$PIECE(STRM,"~",3)
if DATE>LASTDT
QUIT
+33 SET SEQ=0
FOR
SET SEQ=$ORDER(^XTMP(STRM,"tidy",SEQ))
if 'SEQ
QUIT
if (DATE=LASTDT)&(SEQ>LASTSEQ)
QUIT
DO TIDYX(STRM,SEQ)
End DoDot:1
+34 QUIT
TIDYX(STREAM,SEQ) ; clean up extracts after they have been retrieved
+1 ; from FINISH
+2 ;DE6047 make resilient
+3 NEW BATCH,DOMAIN,TASK
+4 if $GET(STREAM)=""
QUIT
if $GET(SEQ)=""
QUIT
+5 SET BATCH=$GET(^XTMP(STREAM,"tidy",SEQ,"batch"))
+6 SET DOMAIN=$GET(^XTMP(STREAM,"tidy",SEQ,"domain"))
+7 SET TASK=$GET(^XTMP(STREAM,"tidy",SEQ,"task"))
+8 IF BATCH=""!(DOMAIN="")!(TASK="")
Begin DoDot:1
+9 NEW C,J,TXT
+10 SET C=1
SET TXT(C)=" Freshness Stream: "_STREAM_", missing TIDY elements in SEQ: "_SEQ
+11 ; blank line following word-processing text, $$NWNTRY^HMPLOG appends to end
SET C=C+1
SET TXT(C)=" "
+12 ; log event as type "missing"
SET J=$$NWNTRY^HMPLOG($$NOW^XLFDT,"M",.TXT)
End DoDot:1
+13 IF BATCH'=""
Begin DoDot:1
+14 IF DOMAIN="<done>"
KILL ^XTMP(BATCH)
QUIT
+15 IF TASK'=""
IF DOMAIN'=""
KILL ^XTMP(BATCH,TASK,DOMAIN)
End DoDot:1
+16 KILL ^XTMP(STREAM,"tidy",SEQ)
+17 QUIT
SYNCCMD(SEQNODE) ; Build syncCommand object and stick in ^TMP
+1 ; expects: HMPSYS, HMPFCNT
+2 NEW DFN,CMD,CMDJSON,ERR
+3 SET DFN=+SEQNODE
+4 SET CMD("command")=$PIECE($PIECE(SEQNODE,U,3),":")
+5 SET CMD("domain")=$PIECE($PIECE(SEQNODE,U,3),":",2)
+6 if DFN
SET CMD("pid")=$$PID^HMPDJFS(DFN)
+7 SET CMD("system")=HMPSYS
+8 DO ENCODE^HMPJSON("CMD","CMDJSON","ERR")
+9 IF $DATA(ERR)
SET $ECODE=",UJSON encode error,"
QUIT
+10 ; *S68-JCH*
SET HMPFSIZE=$$INCITEM("syncCommand")
+11 MERGE ^TMP("HMPF",$JOB,HMPFCNT)=CMDJSON
+12 SET ^TMP("HMPF",$JOB,HMPFCNT,.3)=$$WRAPPER("syncCommand",$$PIDS^HMPDJFS(DFN),1,1)
+13 QUIT
SYNCSTRT(SEQNODE) ;Build syncStart object with demograhics
+1 ;expects HMPFSYS, HMPFHMP, HMPFCNT, HMPFSIZE *S68-JCH*
+2 ;*S68-JCH*
SET HMPFSIZE=$$INCITEM("patient")
+3 NEW DFN,FILTER,DFN,WRAP
+4 ; HMPFX~hmpSrvId~dfn
SET DFN=$PIECE($PIECE(SEQNODE,U,3),"~",3)
+5 IF DFN
Begin DoDot:1
+6 ;cpc 2015/10/01
NEW RSLT
+7 SET FILTER("patientId")=DFN
SET FILTER("domain")="patient"
+8 DO GET^HMPDJ(.RSLT,.FILTER)
+9 MERGE ^TMP("HMPF",$JOB,HMPFCNT)=^TMP("HMP",$JOB,1)
End DoDot:1
+10 ; for OPD there is no object, so 4th argument is 0
+11 SET ^TMP("HMPF",$JOB,HMPFCNT,.3)=$$WRAPPER("syncStart",$$PIDS^HMPDJFS(DFN),$SELECT(DFN:1,1:-1),$SELECT(DFN:1,1:-1))
+12 QUIT
SYNCDONE(SEQNODE) ; Build syncStatus object and stick in ^TMP
+1 ;expects: HMPFSYS, HMPFCNT, HMPFHMP, HMPFSIZE *S68-JCH*
+2 NEW HMPBATCH,DFN,STS,STSJSON,X,ERR
+3 ; HMPFX~hmpSrvId~dfn
SET HMPBATCH=$PIECE(SEQNODE,U,3)
+4 SET DFN=$PIECE(HMPBATCH,"~",3)
+5 SET STS("uid")="urn:va:syncStatus:"_HMPFSYS_":"_DFN
+6 SET STS("initialized")="true"
+7 IF DFN
SET STS("localId")=DFN
+8 SET X=""
FOR
SET X=$ORDER(^XTMP(HMPBATCH,0,"count",X))
if '$LENGTH(X)
QUIT
Begin DoDot:1
+9 SET STS("domainTotals",X)=^XTMP(HMPBATCH,0,"count",X)
End DoDot:1
+10 ;If resubscribing a patient, just send demographics
+11 IF DFN'="OPD"
IF $DATA(^HMP(800000,"AITEM",DFN))
Begin DoDot:1
+12 NEW HMP99
+13 SET HMP99=""
+14 ;Reset all domain counts to zero except for demographics
+15 FOR
SET HMP99=$ORDER(STS("domainTotals",HMP99))
if 'HMP99
QUIT
IF HMP99'="patient"
SET STS("domainTotals",HMP99)=0
End DoDot:1
+16 DO ENCODE^HMPJSON("STS","STSJSON","ERR")
+17 IF $DATA(ERR)
SET $ECODE=",UJSON encode error,"
QUIT
+18 ; *S68-JCH*
SET HMPFSIZE=$$INCITEM("syncstatus")
+19 MERGE ^TMP("HMPF",$JOB,HMPFCNT)=STSJSON
+20 SET ^TMP("HMPF",$JOB,HMPFCNT,.3)=$$WRAPPER("syncStatus",$$PIDS^HMPDJFS(DFN),1,1)
+21 QUIT
+22 ;
SYNCMETA(SNODE) ;US11019 Build NEW syncStart object
+1 ;expects HMPFSYS, HMPFHMP, HMPFCNT
+2 ;need to rebuild SNODE because WRAPPER expects it to fall in
+3 NEW BATCH,DFN,WRAP,METADOM
+4 SET DFN=$PIECE(SNODE,U,1)
+5 SET METADOM=$PIECE(SNODE,U,3)
+6 SET BATCH="HMPFX~"_HMPFHMP_"~"_DFN
+7 SET $PIECE(SNODE,U,3)=BATCH
+8 ;need to increment count
SET HMPFSIZE=$$INCITEM("syncmeta")
+9 SET ^TMP("HMPF",$JOB,HMPFCNT,.3)=$$WRAPPER("syncStart"_"#"_METADOM,$$PIDS^HMPDJFS(DFN),$SELECT(DFN:1,1:-1),$SELECT(DFN:1,1:-1))
+10 ;always null object with this record
SET ^TMP("HMPF",$JOB,HMPFCNT,1)="null"
+11 ; DE3502
SET HMPCLFLG=0
+12 QUIT
+13 ;
SYNCERR(SNODE,HMPERR) ;
+1 NEW BATCH,CNT,DFN,NUM,OFFSET,PIDS,TASK,TOTAL,X
+2 SET DFN=$PIECE(SNODE,U)
SET X=$PIECE(SNODE,U,3)
+3 SET PIDS=$$PIDS^HMPDJFS(DFN)
+4 SET TASK=$PIECE(X,":",2)
SET TOTAL=$PIECE(X,":",4)
+5 ; extract node in ^XTMP
SET BATCH="HMPFX~"_HMPFHMP_"~"_DFN
+6 SET CNT=$ORDER(HMPERR(""),-1)
+7 SET NUM=0
FOR
SET NUM=$ORDER(^XTMP(BATCH,TASK,"error",NUM))
if NUM'>0
QUIT
Begin DoDot:1
+8 SET CNT=CNT+1
SET HMPERR(CNT)=$GET(^XTMP(BATCH,TASK,"error",NUM,1))
End DoDot:1
+9 QUIT
+10 ;
FRESHITM(SEQNODE,DELETE,ERROR) ;Get freshness item and stick in ^TMP
+1 ; expects HMPFSYS, HMPFHMP
+2 NEW ACT,DFN,DOMAIN,ECNT,FILTER,ID,RSLT,UID,HMP97,HMPI,WRAP,HMPPAT7,HMPPAT8
+3 SET FILTER("noHead")=1
+4 SET DFN=$PIECE(SEQNODE,U)
SET DOMAIN=$PIECE(SEQNODE,U,2)
SET ID=$PIECE(SEQNODE,U,3)
SET ACT=$PIECE(SEQNODE,U,4)
+5 ;Next 2 IFs added to prevent <UNDEFINED> in LKUP^HMPDJ00. JD - 3/4/16. DE3869
+6 ;Make sure deletes ('@') are not included.
+7 ;HMPFSTRM and HMPFIDX are defined in the GETSUB section above.
+8 ;For "pt-select", ID=patient IEN and DFN="OPD" For ptient domains ID=DFN=patient IEN
+9 ;checks for all patient domains and pt-select of the operational data domain
+10 ;Kill the freshness stream entry with the bad patient IEN
+11 ;For patient domains
IF ACT'="@"
IF DFN=+DFN
IF '$DATA(^DPT(DFN,0))
KILL ^XTMP(HMPFSTRM,HMPFIDX)
QUIT
+12 IF ACT'="@"
IF DOMAIN="pt-select"
IF ID=+ID
IF '$DATA(^DPT(ID,0))
KILL ^XTMP(HMPFSTRM,HMPFIDX)
QUIT
+13 ;
+14 ;Create a phantom "patient" if visit is the domain
+15 IF DOMAIN="visit"
Begin DoDot:1
+16 ;BL;DE2280
SET HMPPAT7=HMPFIDX_".99"
SET HMPPAT8=^XTMP(HMPFSTRM,HMPFIDX)
SET $PIECE(HMPPAT8,U,2)="patient"
+17 SET ^XTMP(HMPFSTRM,HMPPAT7)=HMPPAT8
End DoDot:1
+18 IF ACT'="@"
Begin DoDot:1
+19 SET FILTER("id")=ID
+20 SET FILTER("domain")=DOMAIN
+21 IF DFN="OPD"
DO GET^HMPEF(.RSLT,.FILTER)
+22 IF +DFN>0
Begin DoDot:2
+23 SET FILTER("patientId")=DFN
+24 ; DE3691, add date/time with seconds to FILTER parameters, Feb 29 2016
Begin DoDot:3
+25 NEW DAY,SECS,TM
SET SECS=$PIECE($GET(^XTMP(HMPFSTRM,HMPFIDX)),U,5)
SET DAY=$PIECE(HMPFSTRM,"~",3)
+26 ; must have date and seconds, could be zero seconds (midnight)
if ('DAY)!('$LENGTH(SECS))
QUIT
+27 ; if zero (midnight) push to 1 second after
SET TM=$SELECT(SECS:SECS#60/100+(SECS#3600\60)/100+(SECS\3600)/100,SECS=0:".000001",1:"")
+28 ; couldn't compute time
if '$LENGTH(TM)
QUIT
+29 SET FILTER("freshnessDateTime")=DAY+TM
End DoDot:3
+30 DO GET^HMPDJ(.RSLT,.FILTER)
End DoDot:2
End DoDot:1
+31 IF ACT'="@"
IF $LENGTH($GET(^TMP("HMP",$JOB,"error")))>0
DO BLDSERR(DFN,.ERROR)
QUIT
+32 IF '$DATA(^TMP("HMP",$JOB,1))
SET ACT="@"
+33 IF ACT="@"
Begin DoDot:1
+34 SET UID=$$SETUID^HMPUTILS(DOMAIN,$SELECT(+DFN>0:DFN,1:""),ID)
+35 SET HMP97=UID
+36 ; Need to dummy this up or it will never get set later
KILL ^TMP("HMP",$JOB)
SET ^TMP("HMP",$JOB,1)=""
End DoDot:1
+37 ;
+38 ;Add syncstart, data and syncstatus to JSON for unsolicited updates - US4588 & US3682
+39 IF (DOMAIN="pt-select")!(DOMAIN="user")!(DOMAIN["asu-")!(DOMAIN="doc-def")!(DFN=+DFN)
Begin DoDot:1
+40 DO ADHOC^HMPUTIL1(DOMAIN,.HMPFCNT,DFN)
+41 ;Remove the phantom "patient"; JD
IF $PIECE(HMPFIDX,".",2)=99
KILL ^XTMP(HMPFSTRM,HMPFIDX)
+42 ;DE3502
SET HMPLITEM="FRESH"
End DoDot:1
QUIT
+43 ;
+44 ;N.B. this updates the .3 node on this HMPFCNT
SET WRAP=$$WRAPPER(DOMAIN,$$PIDS^HMPDJFS(DFN),1,1)
+45 FOR HMPI=1:1
if '$DATA(^TMP("HMP",$JOB,HMPI))
QUIT
Begin DoDot:1
+46 SET HMPFCNT=HMPFCNT+1
+47 MERGE ^TMP("HMPF",$JOB,HMPFCNT)=^TMP("HMP",$JOB,HMPI)
+48 ;DE3502 add closing
IF HMPLITEM="SYNC"
SET HMPLITEM="FRESH"
IF WRAP=","
SET ^TMP("HMPF",$JOB,HMPFCNT,.3)="},"
QUIT
+49 SET ^TMP("HMPF",$JOB,HMPFCNT,.3)=WRAP
End DoDot:1
+50 QUIT
+51 ;
BLDSERR(DFN,ERROR) ;Create syncError object in ERRJSON
+1 ;expects: HMPBATCH, HMPFSYS, HMPFZTSK
+2 NEW COUNT,ERRVAL,ERROBJ,ERR,ERRCNT,ERRMSG,SYNCERR
+3 MERGE ERRVAL=^TMP("HMP",$JOB,"error")
+4 IF $GET(ERRVAL)=""
QUIT
+5 SET ERRVAL="{"_ERRVAL_"}"
+6 DO DECODE^HMPJSON("ERRVAL","ERROBJ","ERR")
+7 IF $DATA(ERR)
SET $ECODE=",UJSON decode error,"
+8 SET ERRMSG=ERROBJ("error","message")
+9 if '$LENGTH(ERRMSG)
QUIT
+10 SET SYNCERR("uid")="urn:va:syncError:"_HMPFSYS_":"_DFN_":FRESHNESS"
+11 SET SYNCERR("collection")=DOMAIN
+12 SET SYNCERR("error")=ERRMSG
+13 DO ENCODE^HMPJSON("SYNCERR","ERRJSON","ERR")
IF $DATA(ERR)
SET $ECODE=",UJSON encode error,"
QUIT
+14 ;*BEGIN*S68-JCH*
SET COUNT=$ORDER(ERROR(""),-1)
+15 SET ERRCNT=0
FOR
SET ERRCNT=$ORDER(ERRJSON(ERRCNT))
if ERRCNT'>0
QUIT
Begin DoDot:1
+16 ;*END*S68-JCH*
SET COUNT=COUNT+1
MERGE ERROR(COUNT)=ERRJSON(COUNT)
End DoDot:1
+17 QUIT
WRAPPER(DOMAIN,PIDS,OFFSET,DOMSIZE,FROMXTR) ;return JSON wrapper for each item *S68-JCH*
+1 ;add object tag if extract total not zero or if total passed as -1
+2 ;seq and total tags only added if non-zero
+3 ;US11019
NEW X,Y,Z,HMPSVERS
+4 ;Ensure that X exists
+5 SET X=""
+6 SET Z=$PIECE(SNODE,U,3)
+7 ;US11019 If HMPSVERS=0 then running in previous mode
SET HMPSVERS=$GET(^XTMP(Z,"HMPSVERS"))
+8 ;PJH - THIS USED ONLY FOR OPD COMPILE IN PRIOR VERSION - NEEDS REMOVING US6734
SET HMPSTMP=$GET(^XTMP(Z,"HMPSTMP"))
+9 ;This was working for operational data, not patient data
+10 ;DFN will be OPD if this is operational data
+11 IF DFN="OPD"
Begin DoDot:1
+12 ;US11019
if $PIECE($GET(DOMAIN),"#")'="syncStart"
SET X="},{""collection"":"""_$PIECE(DOMAIN,"#")_""""_PIDS
End DoDot:1
+13 ; If ONLY patient data exists
IF '$TEST
SET X="},{""collection"":"""_$PIECE(DOMAIN,"#")_""""_PIDS
+14 ; DE3502 - remove closing when coming from Fresh
IF HMPLITEM="FRESH"
IF $EXTRACT(X)="}"
SET X=$EXTRACT(X,2,$LENGTH(X))
+15 IF $PIECE(DOMAIN,"#")="syncStart"
IF $ORDER(^XTMP(Z,0))]""
Begin DoDot:1
+16 ;--- Start US3907 ---
+17 ;Pass JobId and RootJobId back in the response if we were given them
+18 ;This bridges the gap between Job status and Sync Status (since VistA will be giving the syncStatus)
+19 ;US11019 use domain specific Job id
+20 ;US11019
SET Y=$SELECT($PIECE(DOMAIN,"#",2)="":$GET(^XTMP(Z,"JOBID")),1:$GET(^XTMP(Z,"JOBID",$PIECE(DOMAIN,"#",2))))
+21 IF Y]""
SET X=X_",""jobId"":"""_Y_""""
+22 SET Y=$GET(^XTMP(Z,"ROOTJOBID"))
+23 IF Y]""
SET X=X_",""rootJobId"":"""_Y_""""
+24 ;--- End US3907 ---
+25 ;US11019 extra para ;Collect Patient metastamp data from XTMP - US6734
IF DFN'="OPD"
DO METAPT^HMPMETA(SNODE,$SELECT(HMPSVERS:$PIECE(DOMAIN,"#",2),1:""))
QUIT
+26 ; Collect OPD metastamp data from XTMP - US6734
DO METAOP^HMPMETA(SNODE)
End DoDot:1
QUIT X
+27 SET X=X_","
+28 ;if batched by extract *S68-JCH*
+29 IF $GET(OFFSET)>-1
SET X=X_"""seq"":"_OFFSET_","
+30 IF $GET(DOMSIZE)>-1
SET X=X_"""total"":"_DOMSIZE_","
+31 IF $GET(OFFSET)>-1
SET X=X_"""object"":"
+32 QUIT X
+33 ;
APIHDR(COUNT,LASTITM) ;return JSON
+1 ;expects HMPFSYS
+2 ;make sure lastUpdate is correct;JD;BL;DE2280
IF $PIECE($GET(LASTITM),".",2)="99"
SET LASTITM=$PIECE(LASTITM,".")
+3 NEW X
+4 SET X="{""apiVersion"":1.02,""params"":{""domain"":"""_$$KSP^XUPARAM("WHERE")_""""
+5 SET X=X_",""systemId"":"""_HMPFSYS_"""},""data"":{""updated"":"""_$$HL7NOW^HMPDJ_""""
+6 SET X=X_",""totalItems"":"_COUNT_",""lastUpdate"":"""_LASTITM_""""_$$PROGRESS^HMPDJFS(LASTITM)
+7 SET X=X_",""items"":["
+8 QUIT X
NOOP(LASTITM) ;No-op, don't return any items
+1 SET ^TMP("HMPF",$JOB,.5)=$$APIHDR(0,LASTITM)_"]}}"
+2 QUIT
VERMATCH(HMPIEN,VERSION) ;true if middle tier HMP and VistA version match
+1 ;versions match, queue any patients waiting for match
+2 IF $PIECE($$GET^XPAR("PKG","HMP JSON SCHEMA"),".")=$PIECE(VERSION,".")
Begin DoDot:1
+3 ; no patients awaiting queuing
if '$GET(^XTMP("HMPFS~"_HMPIEN,"waiting"))
QUIT
+4 SET ^XTMP("HMPFS~"_HMPIEN,"waiting")=0
+5 NEW DOMAINS,BATCH,HMPNAME
+6 SET HMPNAME=$PIECE(^HMP(800000,HMPIEN,0),U)
+7 DO PTDOMS^HMPDJFSD(.DOMAINS)
+8 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("HMPFS~"_HMPIEN,"waiting",DFN))
if 'DFN
QUIT
Begin DoDot:2
+9 ; subscription cancelled while waiting *S68-JCH*
if '$DATA(^HMP(800000,HMPIEN,1,DFN))
QUIT
+10 SET BATCH="HMPFX~"_HMPNAME_"~"_DFN
+11 DO QUINIT^HMPDJFSP(BATCH,DFN,.DOMAINS)
End DoDot:2
+12 KILL ^XTMP("HMPFS~"_HMPIEN)
End DoDot:1
QUIT 1
+13 ;
+14 ;otherwise, hold things
+15 DO NEWXTMP^HMPDJFS("HMPFS~"_HMPIEN,8,"HMP Awaiting Version Match")
+16 SET ^XTMP("HMPFS~"_HMPIEN,"waiting")=1
+17 QUIT 0
+18 ;
LASTUPD(HMPSRV,LASTUPD) ;save the last update
+1 ; TODO: change this to use Fileman call
+2 NEW IEN,CURRUPD,REPEAT
+3 SET IEN=$ORDER(^HMP(800000,"B",HMPSRV,0))
if 'IEN
QUIT
+4 if LASTUPD["^"
QUIT
+5 SET CURRUPD=$PIECE(^HMP(800000,IEN,0),"^",2)
SET REPEAT=$PIECE(^HMP(800000,IEN,0),"^",4)
+6 IF LASTUPD=CURRUPD
SET $PIECE(^HMP(800000,IEN,0),"^",4)=REPEAT+1
QUIT
+7 SET $PIECE(^HMP(800000,IEN,0),"^",2)=LASTUPD
SET $PIECE(^HMP(800000,IEN,0),"^",4)=0
+8 QUIT
JSONOUT ;Write out JSON in ^TMP
+1 NEW X
+2 SET X=$NAME(^TMP("HMPF",$JOB))
+3 FOR
SET X=$QUERY(@X)
if ($QSUBSCRIPT(X,1)'="HMPF")!($QSUBSCRIPT(X,2)'=$JOB)
QUIT
WRITE !,@X
+4 QUIT
+5 ;
