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

HMPDJFSP.m

Go to the documentation of this file. 
  1. HMPDJFSP ;SLC/KCM.ASMR/RRB,CPC-PUT/POST for extract & freshness ;Jan 20, 2017 17:18:18
  1.  ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;Sep 01, 2011;Build 15
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q  ; no entry at top
  1.  ;
  1.  ;
  1.  ; --- create a new patient subscription
  1.  ;
  1. PUTSUB(ARGS) ; return location after creating a new subscription
  1.  ; called by:
  1.  ;   API^HMPDJFS
  1.  ; falls through to:
  1.  ;   QREJOIN
  1.  ; calls:
  1.  ;   $$TM^%ZTLOAD
  1.  ;   SETERR^HMPDJFS
  1.  ;   $$GETDFN^MPIF001
  1.  ;   SETERR^HMPDJFS
  1.  ;   OPDOMS^HMPDJFSD
  1.  ;   PTDOMS^HMPDJFSD
  1.  ;   SETPAT
  1.  ;   NEWXTMP^HMPDJFS
  1.  ;   SETMARK
  1.  ;   INIT^HMPMETA
  1.  ;   $$HTFM^XLFDT
  1.  ;   SAVETASK^HMPDJFSQ
  1.  ;   $$PID^HMPDJFS
  1.  ; output:
  1.  ;  fn returns      : /hmp/subscription/{hmpSrvId}/patient/{sysId;dfn}
  1.  ;                  : "" if error, errors in ^TMP("HMPFERR",$J)
  1.  ; .ARGS("server")  : name of HMP server
  1.  ; .ARGS("localId") : dfn for patient to subscribe or "OPD" (operational data)
  1.  ; .ARGS("icn")     : icn for patient to subscribe
  1.  ; .ARGS("domains") : optional array of domains to initialize (deprecated)
  1.  ;
  1.  I '$$TM^%ZTLOAD D SETERR^HMPDJFS("Taskman not running") Q ""
  1.  ;
  1.  N HMPSRV,HMPFDFN,HMPBATCH,HMPFERR,I,NEWSUB,DOMAINS,HMPSVERS,HMPSTMP,HMPPRITY,HMPQBTCH ;US13442
  1.  ;
  1.  ; make sure we can identify the patient ("OPD" signals sync operational)
  1.  S HMPFDFN=$G(ARGS("localId"))
  1.  S HMPSVERS=+$G(ARGS("HMPSVERS")) ;US11019 get sync version
  1.  I HMPFDFN'="OPD" D  Q:$G(HMPFERR) ""
  1.  . I '$L(HMPFDFN),$L(ARGS("icn")) S HMPFDFN=+$$GETDFN^MPIF001(ARGS("icn"))
  1.  . I 'HMPFDFN D SETERR^HMPDJFS("No patient specified") Q
  1.  . I '$D(^DPT(HMPFDFN)) D SETERR^HMPDJFS("Patient not found")  ; IA 10035, DE2818
  1.  ;
  1.  ; make sure server is known and create batch id
  1.  S HMPSRV=HMPFHMP  ; TODO: switch to HMPFHMP as server ien
  1.  I '$L(HMPSRV) D SETERR^HMPDJFS("Missing HMP Server ID") Q ""
  1.  S HMPSRV("ien")=$O(^HMP(800000,"B",HMPSRV,0))
  1.  I 'HMPSRV("ien") D SETERR^HMPDJFS("HMP Server not registered") Q ""
  1.  S HMPBATCH="HMPFX~"_HMPSRV_"~"_HMPFDFN
  1.  S HMPQBTCH="HMPFS~"_HMPSRV_"~queue"
  1.  ;
  1.  ; set up domains to extract
  1.  D @($S(HMPFDFN="OPD":"OPDOMS",1:"PTDOMS")_"^HMPDJFSD(.DOMAINS)")
  1.  ;
  1.  ; ejk US5647
  1.  ; code below restores selective domain functionality.
  1.  ; once the complete list of domains is returned from HMPDJFSD,
  1.  ; if ARGS("domains") is passed in, anything not in that parameter
  1.  ; will be excluded from the ODS extract.
  1.  I $G(ARGS("domains"))'="" D
  1.  .F I=1:1 Q:'$D(DOMAINS(I))  I ARGS("domains")'[DOMAINS(I) K DOMAINS(I)
  1.  ;
  1.  ; see if this is new subscription and task extract if new
  1.  D SETPAT(HMPFDFN,HMPSRV,.NEWSUB) Q:$G(HMPFERR) ""
  1.  ;For operational data set stamptime as time subscription placed US6734
  1.  S HMPSTMP=$$EN^HMPSTMP("NOW") ;DE3377
  1.  ;
  1.  ;cpc US11019 following chunk of code moved out of QUINIT as was being called multiple times
  1.  ;US11019 get array of job ids by domain
  1.  ; only done once when beginning the batch, no matter how many tasked jobs
  1.  L +^XTMP(HMPBATCH):5 E  D SETERR^HMPDJFS("Cannot lock batch:"_HMPBATCH) QUIT
  1.  I '$D(^XTMP(HMPBATCH)) D
  1.  . D NEWXTMP^HMPDJFS(HMPBATCH,2,"HMP Patient Extract")
  1.  . ;US11019 - store domain specific job ids
  1.  . N EMPB S EMPB="jobDomainId-" ;US11019
  1.  . F  S EMPB=$O(ARGS(EMPB)) Q:EMPB=""  Q:EMPB'["jobDomainId-"  S:'HMPSVERS HMPSVERS=1 S ^XTMP(HMPBATCH,"JOBID",$P(EMPB,"jobDomainId-",2))=ARGS(EMPB) ; US11019 3rd version
  1.  . S ^XTMP(HMPBATCH,"HMPSVERS")=HMPSVERS ;US11019 store sync version
  1.  . I $G(ARGS("jobId"))]"" S ^XTMP(HMPBATCH,"JOBID")=ARGS("jobId")  ;US3907 /US11019
  1.  . I $G(ARGS("rootJobId"))]"" S ^XTMP(HMPBATCH,"ROOTJOBID")=ARGS("rootJobId")  ;US3907
  1.  . S ^XTMP(HMPBATCH,0,"time")=$H
  1.  . ; US6734 - setting of syncStart for OPD only
  1.  . I HMPFDFN="OPD" D SETMARK("Start",HMPFDFN,HMPBATCH),INIT^HMPMETA(HMPBATCH,HMPFDFN,.ARGS) ; US6734
  1.  L -^XTMP(HMPBATCH)
  1.  ;cpc US11019 end moved code
  1.  ;US13442
  1.  S HMPPRITY=1 S:+$G(ARGS("HMPPriority")) HMPPRITY=+ARGS("HMPPriority")
  1.  I '$D(^XTMP(HMPQBTCH,0)) D  ;check basic controls exist
  1.  . S ^XTMP(HMPQBTCH,0)=$$HTFM^XLFDT(+$H+5)_U_$$HTFM^XLFDT(+$H)_U_"HMP task queue"
  1.  . S ^XTMP(HMPQBTCH,0,0)=2 ;default concurrent patients
  1.  ;put task onto task queue if new subscription for patient
  1.  I NEWSUB,+HMPFDFN D SAVETASK^HMPDJFSQ Q "/hmp/subscription/"_HMPSRV_"/patient/"_$$PID^HMPDJFS(HMPFDFN)
  1.  ;
  1. QREJOIN  ; task And come back in from queue
  1.  ; falls through from:
  1.  ;   PUTSUB
  1.  ; called by:
  1.  ;   NEWTASK^HMPDJFSQ: ZTRTN="QREJOIN^HMPDJFSP"
  1.  ; calls:
  1.  ;   UPDSTS
  1.  ;   QUINIT^HMPDJFSQ
  1.  ;   SETMARK
  1.  ;   $$PID^HMPDJFS
  1.  ;
  1.  ;Every Domain in it's own task (unless running in original mode)
  1.  I NEWSUB D  Q:$G(HMPFERR) ""
  1.  . ; if patient's extracts are held (version mismatch), put DFN on wait list
  1.  . I +HMPFDFN,$G(^XTMP("HMPFS~"_HMPSRV("ien"),"waiting")) S ^XTMP("HMPFS~"_HMPSRV("ien"),"waiting",HMPFDFN)="" QUIT
  1.  . D UPDSTS(HMPFDFN,$P(HMPBATCH,"~",2),1) ;moved from background job to once in foreground 12/17/2015
  1.  . I 'HMPSVERS N HMPFDOM M HMPFDOM=DOMAINS D QUINIT^HMPDJFSQ(HMPBATCH,HMPFDFN,.HMPFDOM) Q  ;US11019 Enable previous behavior
  1.  . S I="" F  S I=$O(DOMAINS(I)) Q:'I  D
  1.  ..  N HMPFDOM
  1.  ..  S HMPFDOM(1)=DOMAINS(I)
  1.  ..  D QUINIT^HMPDJFSQ(HMPBATCH,HMPFDFN,.HMPFDOM)
  1.  ;===JD START===
  1.  ; For patient resubscribes, need to send demographics ONLY
  1.  I 'NEWSUB,HMPFDFN'="OPD",'$D(^XTMP(HMPBATCH,0,"status")) D  ;DE3331 check expanded to ensure not current
  1.  . N HMPFDOM,HMPDSAVE ;DE3331
  1.  . M HMPDSAVE=DOMAINS ;DE3331
  1.  . K DOMAINS S DOMAINS(1)="patient"
  1.  . M HMPFDOM=DOMAINS
  1.  . D QUINIT^HMPDJFSQ(HMPBATCH,HMPFDFN,.HMPFDOM)
  1.  . I $G(HMPSVERS) S I="" F  S I=$O(HMPDSAVE(I)) Q:'I  D  ;DE3331 create empty metastamp entries for remaining domains
  1.  ..  I HMPDSAVE(I)'="patient" D SETMARK("Meta",HMPFDFN,HMPDSAVE(I))
  1.  ;===JD END===
  1.  Q "/hmp/subscription/"_HMPSRV_"/patient/"_$$PID^HMPDJFS(HMPFDFN)
  1.  ;
  1.  ;
  1. QUINIT(HMPBATCH,HMPFDFN,HMPFDOM) ; Queue the initial extracts for a patient
  1.  ; called by:
  1.  ;   VERMATCH^HMPDJFSG
  1.  ;   CVTSEL^HMPP3I
  1.  ; calls:
  1.  ;   QUINIT^HMPDJFSQ
  1.  ;
  1.  do QUINIT^HMPDJFSQ(HMPBATCH,HMPFDFN,.HMPFDOM)
  1.  ;
  1.  quit  ; end of QUINIT
  1.  ;
  1.  ;
  1. SETDOM(ATTRIB,DOMAIN,VALUE,HMPMETA) ; Set value for a domain ; cpc TA41760
  1.  ; called by:
  1.  ;   QUINIT^HMPDJFSQ
  1.  ;   QUINIT^HMPMETA
  1.  ;   DQINIT^HMPDJFSQ
  1.  ;   DOMPT
  1.  ;   MOD4STRM
  1.  ; calls: none
  1.  ; input:
  1.  ;   ATTRIB: "status" or "count" attribute
  1.  ;   VALUE:
  1.  ;      for status, VALUE: 0=waiting, 1=ready
  1.  ;      for count,  VALUE: count of items
  1.  ;      don't update to finished value if just tracking metastamp
  1.  ;
  1.  I $G(HMPMETA)'="" S ^XTMP(HMPBATCH,0,ATTRIB,DOMAIN,$S(HMPMETA=1:"MetaStamp",HMPMETA=2:"Combined",1:"Staging"),$S(VALUE:"Stop",1:"Start"))=$H Q:(HMPMETA=1&VALUE)  ;cpc TA41760 10/7/2015 add time logging
  1.  S ^XTMP(HMPBATCH,0,ATTRIB,DOMAIN)=VALUE
  1.  Q
  1.  ;
  1.  ;
  1. SETMARK(TYPE,HMPFDFN,HMPBATCH) ; Post markers for begin and end of initial synch
  1.  ; called by:
  1.  ;   PUTSUB
  1.  ;   PUTSUB-QREJOIN
  1.  ;   QUINIT^HMPMETA
  1.  ;   DQINIT^HMPDJFSQ
  1.  ; calls:
  1.  ;   POST^HMPDJFS
  1.  ;   SETTIDY
  1.  ;
  1.  ; ^XTMP("HMPFP","tidy",hmpServer,fmDate,sequence)=batch
  1.  Q:$G(HMPENVIR("converting"))  ; don't set markers during conversion
  1.  N HMPSRV,NODES,X
  1.  S HMPSRV=$P(HMPBATCH,"~",2)
  1.  D POST^HMPDJFS(HMPFDFN,"sync"_TYPE,HMPBATCH,"",HMPSRV,.NODES)
  1.  Q:TYPE="Start"!(TYPE="Meta")  ; US11019
  1.  D SETTIDY("<done>",.NODES)
  1.  Q
  1.  ;
  1.  ;
  1. DQINIT ; task Dequeue initial extracts
  1.  ; called by: none
  1.  ; calls:
  1.  ;   DQINIT^HMPDJFSQ
  1.  ;
  1.  do DQINIT^HMPDJFSQ
  1.  ;
  1.  quit  ; end of DQINIT
  1.  ;
  1.  ;
  1. DOMPT(HMPFADOM) ; Load a patient domain
  1.  ; called by:
  1.  ;   DQBACKDM^HMPDJFS1
  1.  ;   DQINIT^HMPDJFSQ
  1.  ; calls:
  1.  ;   $$CHNKCNT
  1.  ;   GET^HMPDJ
  1.  ;   SETDOM
  1.  ;   CHNKFIN
  1.  ;
  1.  N FILTER,RSLT,HMPFEST,HMPCHNK  ; *S68-JCH*
  1.  S FILTER("noHead")=1
  1.  S FILTER("domain")=HMPFADOM
  1.  S FILTER("patientId")=HMPFDFN
  1.  ; -- domain var used for chunking patient objects using <domain>#<number> construct  *BEGIN*S68-JCH*
  1.  S HMPCHNK=HMPFADOM
  1.  S HMPCHNK("trigger count")=$$CHNKCNT(HMPFADOM)  ; *END*S68-JCH*
  1.  D GET^HMPDJ(.RSLT,.FILTER) ;US11019 I $G(HMPMETA) D SETDOM("status",HMPFADOM,1,1) Q  ;US11019/US6734 - do not update stream if compiling metastamp ; CPC TA41760
  1.  I $G(HMPMETA)=1 D SETDOM("status",HMPFADOM,1,1) Q  ;US11019/US6734 - do not update stream if compiling metastamp ; CPC TA41760
  1.  ; add to HMPFS queue if total>0 OR this is the first chunck (#0) section  *S68-JCH*
  1.  I ($G(@RSLT@("total"),0)>0)!($P(HMPCHNK,"#",2)=0) D CHNKFIN  ; *S68-JCH*
  1.  Q
  1.  ;
  1.  ;
  1. DOMOPD(HMPFADOM) ; Load an operational domain in smaller batches
  1.  ; called by: none
  1.  ; calls:
  1.  ;   DOMOPD^HMPDJFSQ
  1.  ;
  1.  D DOMOPD^HMPDJFSQ(HMPFADOM) Q
  1.  ;
  1.  ;
  1. CHNKCNT(DOMAIN) ; -- get patient object chunk count trigger                        *BEGIN*S68-JCH*
  1.  ; called by:
  1.  ;   DOMPT
  1.  ; calls:
  1.  ;   $$GET^XPAR
  1.  ; input:
  1.  ;   DOMAIN := current domain name being processed
  1.  ;
  1.  Q $S(+$$GET^XPAR("PKG","HMP DOMAIN SIZES",$P($G(DOMAIN),"#"),"Q")>3000:500,1:1000)  ; *END*S68-JCH*
  1.  ;
  1.  ;
  1. CHNKINIT(HMP,HMPI) ; -- init chunk section callback  *BEGIN*S68-JCH*
  1.  ; called by:
  1.  ;   GET^HMPDJ
  1.  ;   DQINIT^HMPDJFSQ
  1.  ;   CHNKCHK
  1.  ; calls: none
  1.  ; input by ref:
  1.  ;   HMP := $NA of location for chunk of objects
  1.  ;   HMPI := number of objects in @HMP
  1.  ;
  1.  ; -- quit if not in chunking mode
  1.  Q:'$D(HMPCHNK)
  1.  ;
  1.  S $P(HMPCHNK,"#",2)=$S(HMPCHNK["#":$P(HMPCHNK,"#",2)+1,1:0)
  1.  S HMP=$NA(^XTMP(HMPBATCH,HMPFZTSK,HMPCHNK))
  1.  K @HMP
  1.  S HMPI=0
  1.  Q  ; *END*S68-JCH*
  1.  ;
  1.  ;
  1. CHNKCHK(HMP,HMPI) ; -- check if chunk should be queued callback *BEGIN*S68-JCH*
  1.  ; called by:
  1.  ;   ADD^HMPDJ
  1.  ;   HMP1^HMPDJ02
  1.  ; calls:
  1.  ;   GTQ^HMPDJ
  1.  ;   CHNKFIN
  1.  ;   CHKXTMP
  1.  ;   CHNKINIT
  1.  ; input by ref:
  1.  ;   HMP := $NA of location for chunk of objects
  1.  ;   HMPI := number of objects in @HMP
  1.  ;
  1.  ; quit if not in chunking mode
  1.  Q:'$D(HMPCHNK)
  1.  ;
  1.  ; execute 'whether to chunk' criteria
  1.  Q:HMPI<HMPCHNK("trigger count")
  1.  ; -- add tail to json to section
  1.  D GTQ^HMPDJ
  1.  ; -- finish section and put on HMPFS~ queue
  1.  D CHNKFIN
  1.  ; -- check ^XTMP size before continuing; may have to HANG if too big
  1.  D CHKXTMP(HMPBATCH,HMPFZTSK)  ; US5074 disable loopback
  1.  ; -- initialize for next section
  1.  D CHNKINIT(.HMP,.HMPI)
  1.  Q  ; *END*S68-JCH*
  1.  ;
  1.  ;
  1. CHNKFIN ; -- finish chunk section callback *BEGIN*S68-JCH*
  1.  ; called by:
  1.  ;   DOMPT
  1.  ;   CHNKCHK
  1.  ; calls:
  1.  ;   MOD4STRM
  1.  ;   POSTSEC
  1.  ;
  1.  ; -- quit if not in chunking mode
  1.  Q:'$D(HMPCHNK)
  1.  ;
  1.  D MOD4STRM(HMPCHNK)
  1.  ; -- domain#number, <no estimated do> , chunk trigger count for domain
  1.  D POSTSEC(HMPCHNK,,HMPCHNK("trigger count"))
  1.  Q  ; *END*S68-JCH*
  1.  ;
  1.  ;
  1. MOD4STRM(DOMAIN) ; modify extract to be ready for stream
  1.  ; called by:
  1.  ;   DOMOPD^HMPDJFSQ
  1.  ;   CHNKFIN
  1.  ; calls:
  1.  ;   SETDOM
  1.  ; expects:
  1.  ;   HMPBATCH, HMPFSYS, HMPFZTSK
  1.  ; results are in:
  1.  ;   ^XTMP("HMPFX~hmpsrv~dfn",DFN,DOMAIN,...)
  1.  ;
  1.  ; syncError: {uid,collection,error}  uid=urn:va:syncError:sysId:dfn:extract
  1.  N DFN,HMPSRV,COUNT,DOMONLY
  1.  S DOMONLY=$P(DOMAIN,"#")
  1.  S DFN=$P(HMPBATCH,"~",3),HMPSRV=$P(HMPBATCH,"~",2)
  1.  S COUNT=+$G(^XTMP(HMPBATCH,HMPFZTSK,DOMAIN,"total"),0)
  1.  I COUNT=0 S ^XTMP(HMPBATCH,HMPFZTSK,DOMAIN,1,1)="null"
  1.  ;
  1.  S ^XTMP(HMPBATCH,HMPFZTSK,DOMAIN,"total")=COUNT  ; include errors and/or empty
  1.  D SETDOM("count",DOMONLY,$G(^XTMP(HMPBATCH,0,"count",DOMONLY),0)+COUNT)
  1.  Q
  1.  ;
  1.  ;
  1. POSTSEC(DOMAIN,ETOTAL,SECSIZE) ; post domain section to stream and set tidy nodes
  1.  ; called by:
  1.  ;   DOMOPD^HMPDJFSQ
  1.  ;   CHNKFIN
  1.  ; calls:
  1.  ;   POST^HMPDJFS
  1.  ;   SETTIDY
  1.  ;
  1.  N DFN,HMPSRV,COUNT,X,NODES
  1.  S COUNT=^XTMP(HMPBATCH,HMPFZTSK,DOMAIN,"total")
  1.  S ETOTAL=$G(ETOTAL,COUNT)
  1.  s SECSIZE=$G(SECSIZE,0)
  1.  S DFN=$P(HMPBATCH,"~",3)
  1.  S HMPSRV=$P(HMPBATCH,"~",2)
  1.  D POST^HMPDJFS(DFN,"syncDomain",DOMAIN_":"_HMPFZTSK_":"_COUNT_":"_ETOTAL_":"_SECSIZE,"",HMPSRV,.NODES)
  1.  D SETTIDY(DOMAIN,.NODES)
  1.  I $G(HMPQREF)'="" S @HMPQREF=$P($H,",",2) ;update heartbeat US13442
  1.  Q
  1.  ;
  1.  ;
  1. SETTIDY(DOMAIN,NODES) ; Set tidy nodes for clean-up of the extracts in ^XTMP
  1.  ; called by:
  1.  ;   SETMARK
  1.  ;   POSTSEC
  1.  ; calls: none
  1.  ; expects:
  1.  ;   HMPBATCH,HMPFZTSK
  1.  ;
  1.  N X,STREAM,SEQ
  1.  S X="" F  S X=$O(NODES(X)) Q:X=""  D      ; iterate hmp servers
  1.  . S STREAM="HMPFS~"_X_"~"_$P(NODES(X),U)  ; HMPFS~hmpSrv~fmDate
  1.  . S SEQ=$P(NODES(X),U,2)
  1.  . S ^XTMP(STREAM,"tidy",SEQ,"batch")=HMPBATCH
  1.  . S ^XTMP(STREAM,"tidy",SEQ,"domain")=DOMAIN
  1.  . S ^XTMP(STREAM,"tidy",SEQ,"task")=HMPFZTSK
  1.  Q
  1.  ;
  1.  ;
  1. MVFRUPD(HMPBATCH,HMPFDFN) ; Move freshness updates over active stream
  1.  ; called by: none
  1.  ; calls:
  1.  ;   MVFRUPD^HMPDJFSQ
  1.  ;
  1.  do MVFRUPD^HMPDJFSQ(HMPBATCH,HMPFDFN)
  1.  ;
  1.  quit  ; end of MVFRUPD
  1.  ;
  1.  ;
  1. BLDSERR(DFN,DOMAIN,ERRJSON) ; Create syncError object in ERRJSON
  1.  ; called by: none
  1.  ; calls:
  1.  ;   DECODE^HMPJSON
  1.  ;   ENCODE^HMPJSON
  1.  ; expects:
  1.  ;   HMPBATCH, HMPFSYS, HMPFZTSK
  1.  ;
  1.  N COUNT,ERRVAL,ERROBJ,ERR,ERRMSG,SYNCERR
  1.  M ERRVAL=^XTMP(HMPBATCH,HMPFZTSK,DOMAIN,"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.  K ^XTMP(HMPBATCH,HMPFZTSK,DOMAIN,"error")
  1.  S ERRMSG=ERROBJ("error","message")
  1.  Q:'$L(ERRMSG)
  1.  S SYNCERR("uid")="urn:va:syncError:"_HMPFSYS_":"_DFN_":"_DOMAIN
  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(^TMP("HMPERR",$J,""),-1)+1
  1.  M ^TMP("HMPERR",$J,COUNT)=ERRJSON
  1.  Q
  1.  ;
  1.  ;
  1. POSTERR(COUNT,DFN) ; put error into ^XTMP(batch)
  1.  ; called by:
  1.  ;   DQINIT^HMPDJFSQ
  1.  ; calls:
  1.  ;   POST^HMPDJFS
  1.  ;
  1.  N CNT,NODE,HMPSRV
  1.  S HMPSRV=$P(HMPBATCH,"~",2)
  1.  S CNT=0 F  S CNT=$O(^TMP("HMPERR",$J,CNT)) Q:CNT'>0  D
  1.  .S NODE=$G(^TMP("HMPERR",$J,CNT,1))
  1.  .S ^XTMP(HMPBATCH,HMPFZTSK,"error",CNT,1)=NODE
  1.  .I CNT>1 S ^XTMP(HMPBATCH,HMPFZTSK,"error",CNT,.3)=","
  1.  D POST^HMPDJFS(DFN,"syncError","error:"_HMPFZTSK_":"_COUNT_":"_COUNT,"",HMPSRV)
  1.  Q
  1.  ;
  1.  ;
  1. INITDONE(HMPBATCH) ; Return 1 if all domains are done
  1.  ; called by:
  1.  ;   DQINIT^HMPDJFSQ
  1.  ; calls: none
  1.  ;
  1.  N X,DONE
  1.  S X="",DONE=1
  1.  F  S X=$O(^XTMP(HMPBATCH,0,"status",X)) Q:'$L(X)  I '^(X) S DONE=0
  1.  Q DONE
  1.  ;
  1.  ;
  1. SETPAT(DFN,SRV,NEWSUB) ; Add patient to 800000 if not there
  1.  ; called by:
  1.  ;   EN^HMPMETA
  1.  ;   PUTSUB
  1.  ; calls:
  1.  ;   SETERR^HMPDJFS
  1.  ;   UPDOPD
  1.  ;   ADDPAT
  1.  ;
  1.  N ERR,FDA,IEN,IENROOT
  1.  S IEN=$O(^HMP(800000,"B",SRV,0))
  1.  I 'IEN D SETERR^HMPDJFS("Unable to find server: "_SRV) QUIT
  1.  ; for operational, only start sync if not yet subscribed
  1.  I DFN="OPD" D  QUIT
  1.  . L +^HMP(800000,IEN):5 E  D SETERR^HMPDJFS("Unable to lock server: "_SRV) Q
  1.  . ; status is empty string (not 0) when unsubscribed
  1.  . S NEWSUB='$L($P($G(^HMP(800000,IEN,0)),U,3))
  1.  . I NEWSUB D UPDOPD(IEN,1) ; set to subscribed
  1.  . L -^HMP(800000,IEN)
  1.  ;
  1.  ; for patient, check subscribed and get the PID
  1.  L +^HMP(800000,IEN,1,DFN):5 E  D SETERR^HMPDJFS("Unable to lock patient: "_DFN) Q
  1.  S NEWSUB='$D(^HMP(800000,IEN,1,DFN))
  1.  I NEWSUB D ADDPAT(DFN,IEN)
  1.  L -^HMP(800000,IEN,1,DFN)
  1.  Q
  1.  ;
  1.  ;
  1. UPDOPD(SRV,STS) ; Update status of operational synch
  1.  ; called by:
  1.  ;   UNSUB^HMPMETA
  1.  ;   UPDSTS
  1.  ;   SETPAT
  1.  ; calls:
  1.  ;   FILE^DIE
  1.  ;   SETERR^HMPDJFS
  1.  ;   CLEAN^DILF
  1.  ;
  1.  N FDA,ERR,DIERR
  1.  S FDA(800000,SRV_",",.03)=STS
  1.  D FILE^DIE("","FDA","ERR")
  1.  I $D(ERR) D SETERR^HMPDJFS("Error changing operational status")
  1.  D CLEAN^DILF
  1.  Q
  1.  ;
  1.  ;
  1. ADDPAT(DFN,SRV) ; Add a patient as subscribed for server
  1.  ; called by:
  1.  ;   SETPAT
  1.  ; calls:
  1.  ;   $$NOW^XLFDT
  1.  ;   UPDATE^DIE
  1.  ;   SETERR^HMPDJFS
  1.  ;   CLEAN^DILF
  1.  ;
  1.  N FDA,FDAIEN,DIERR,ERR,IENS
  1.  S IENS="?+"_DFN_","_SRV_","
  1.  S FDAIEN(DFN)=DFN  ; help DINUM to work
  1.  S FDA(800000.01,IENS,.01)=DFN
  1.  S FDA(800000.01,IENS,2)=0
  1.  S FDA(800000.01,IENS,3)=$$NOW^XLFDT
  1.  D UPDATE^DIE("","FDA","FDAIEN","ERR")
  1.  I $D(ERR) D SETERR^HMPDJFS("Error adding patient subscription")
  1.  D CLEAN^DILF
  1.  Q
  1.  ;
  1.  ;
  1. UPDSTS(DFN,SRVNM,STS) ; Update the sync status
  1.  ; called by:
  1.  ;   PUTSUB-QREJOIN
  1.  ;   MVFRUPD^HMPDJFSQ
  1.  ; calls:
  1.  ;   SETERR^HMPDJFS
  1.  ;   UPDOPD
  1.  ;   $$NOW^XLFDT
  1.  ;   FILE^DIE
  1.  ;   CLEAN^DILF
  1.  ;
  1.  N SRV,ERR ;US11019
  1.  S SRV=$O(^HMP(800000,"B",SRVNM,0)) I 'SRV D SETERR^HMPDJFS("Missing Server") Q
  1.  I DFN="OPD" D UPDOPD(SRV,STS) QUIT
  1.  ;
  1.  S FDA(800000.01,DFN_","_SRV_",",2)=STS
  1.  S FDA(800000.01,DFN_","_SRV_",",3)=$$NOW^XLFDT
  1.  D FILE^DIE("","FDA","ERR")
  1.  I $D(ERR) D SETERR^HMPDJFS("Error updating patient sync status")
  1.  D CLEAN^DILF
  1.  Q
  1.  ;
  1. CHKXTMP(HMPBATCH,HMPFZTSK) ; -- ^XTMP check at end each domain loop iteration ; if too big HANG
  1.  ; called by:
  1.  ;   DQINIT^HMPDJFSQ
  1.  ;   CHNKCHK
  1.  ;
  1.  N HMPOK S HMPOK=0  ; OK to run flag
  1.  F  D  Q:HMPOK
  1.  . ; if max disk size > estimated size then done with HANG 
  1.  . I $$GETMAX^HMPUTILS>$$GETSIZE^HMPUTILS("estimate") K ^XTMP(HMPBATCH,0,"task",HMPFZTSK,"hanging") S HMPOK=1 Q
  1.  . S ^("hanging")=$G(^XTMP(HMPBATCH,0,"task",HMPFZTSK,"hanging"))+1  ; increment
  1.  . I $G(HMPQREF)'="" S @HMPQREF=$P($H,",",2)  ;update heartbeat US13442
  1.  . H $$GETSECS
  1.  Q
  1.  ;
  1. GETSECS() ; return default # of seconds to requeue in future or hang when processing domains
  1.  ; called by:
  1.  ;   CHKSP^HMPUTILS
  1.  ;   CHKXTMP
  1.  ;
  1.  N SECS S SECS=+$$GET^XPAR("SYS","HMP EXTRACT TASK REQUEUE SECS")
  1.  Q $S(SECS>0:SECS,1:10)   ; if not set, wait 10 seconds
  1.  ;