Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HMPDJFSG

HMPDJFSG.m

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