HMPDJFSQ ;ASMR/CPC -- Extract Queue manager ;Jan 25, 2017 11:08:07
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2,3**;Sep 01, 2011;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
Q ; no entry from top
; DE6644 - code cleanup, 7 September 2016
;
; 2016-05-05 asmr-cpc HMP*2.0*1: create routine HMPDJFSQ from
; subroutines in HMPDJFSP to bring it down under the SAC size limit;
; includes NEWQMGR,NEWTASK,QMGR,SAVETASK,QUINIT.
;
; 2016-06-30/07-01 toad:
; move subroutines over from HMPDJFSP for SAC size limit: DQINIT,DOMOPD,$$TOTAL,MVFRUPD.
;
QUINIT(HMPBATCH,HMPFDFN,HMPFDOM) ; Queue the initial extracts for a patient
; called by:
; PUTSUB-QREJOIN^HMPDJFSP
; QUINIT^HMPDJFSP
; input:
; HMPBATCH="HMPFX~hmpsrvid~dfn" example: HMPFX~hmpXYZ~229
; HMPFDOM(n)="domainName"
;
; ^XTMP("HMPFX~hmpsrvid~dfn",0)=expires^created^HMP Patient Extract
; ,0,"status",domain)=0:waiting;1:ready
; ,0,"task",taskIen)=""
; ,taskIen,domain,... (extract data)
;
; set up domains to be done by this task
N I S I=0 F S I=$O(HMPFDOM(I)) Q:'I D SETDOM^HMPDJFSP("status",HMPFDOM(I),0)
;
; create task for this set of domains within the batch
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
S ZTRTN="DQINIT^HMPDJFSQ",ZTIO="HMP EXTRACT RESOURCE",ZTDTH=$H
S ZTSAVE("HMPBATCH")="",ZTSAVE("HMPFDFN")="",ZTSAVE("HMPFDOM(")=""
S ZTSAVE("HMPENVIR(")="" ; environment information
S ZTSAVE("HMPSTMP")="" ; Operational data stamptime US6734
S ZTSAVE("HMPSVERS")="" ; sync version US11019
S ZTSAVE("HMPQREF")="" ; US13442
S ZTDESC="Build HMP domains for a patient"
D ^%ZTLOAD
I $G(ZTSK) S ^XTMP(HMPBATCH,0,"task",ZTSK)="" Q
D SETERR^HMPDJFS("Task not created")
Q
;
DQINIT ; task Dequeue initial extracts
; called by:
; QUINIT: ZTRTN="DQINIT^HMPDJFSQ"
; QUINIT^HMPDJFSP: ZTRTN="DQINIT^HMPDJFSQ"
; DQINIT^HMPDJFSP
; QUINIT^HMPMETA
; expects:
; HMPBATCH, HMPFDFN, HMPFDOM, ZTSK
;
N COUNT,HMPFDOMI,HMPFSYS,HMPFZTSK
F COUNT=1:1:10 Q:$D(^XTMP(HMPBATCH,0,"task",ZTSK)) H .5 ;cpc 9/18/2015 In case job running too quickly
I '$D(^XTMP(HMPBATCH,0,"task",ZTSK)) Q ; extract was superceded
K ^TMP("HMPERR",$J)
S HMPFSYS=$$SYS^HMPUTILS
S HMPFZTSK=ZTSK ; just in case the unexpected happens to ZTSK
S ^XTMP(HMPBATCH,0,"task",ZTSK,"job")=$J
S ^XTMP(HMPBATCH,0,"task",ZTSK,"wait")=$$HDIFF^XLFDT($H,$G(^XTMP(HMPBATCH,0,"time")),2)
;
; S68 check space
D CHKSP^HMPUTILS($P(HMPBATCH,"~",2)) ; US8228
N HMPMETA ; US6734
F HMPMETA=$S(HMPSVERS:2,1:1):-1:0 D Q:HMPMETA=2 ;
. I HMPMETA=0,+HMPFDFN D SETMARK^HMPDJFSP("Start",HMPFDFN,HMPBATCH) ; US6734
. S HMPFDOMI=""
. F S HMPFDOMI=$O(HMPFDOM(HMPFDOMI)) Q:'HMPFDOMI D
.. D SETDOM^HMPDJFSP("status",HMPFDOM(HMPFDOMI),0,HMPMETA) ; cpc TA41760
.. I HMPFDFN="OPD" D
... D DOMOPD(HMPFDOM(HMPFDOMI))
... I HMPMETA=2 D UPD^HMPMETA(HMPFDOM(HMPFDOMI)) ; US6734 - mark OPD domain as complete in metastamp
.. I +HMPFDFN D DOMPT^HMPDJFSP(HMPFDOM(HMPFDOMI))
.. I HMPMETA=1 D:'$O(HMPFDOM(HMPFDOMI)) MERGE^HMPMETA(HMPBATCH) D:HMPFDFN="OPD" UPD^HMPMETA(HMPFDOM(HMPFDOMI)) Q
.. I HMPMETA=2 D
... D MERGE1^HMPMETA(HMPBATCH,HMPFDOM(HMPFDOMI)) ;US11019 - merge data into metastamp
... I +HMPFDFN D SETMARK^HMPDJFSP("Meta",HMPFDFN,HMPFDOM(HMPFDOMI)) ;US11019 - new freshness entry replacing syncStart
... I HMPFDFN="OPD" D:'$O(HMPFDOM(HMPFDOMI)) MERGE^HMPMETA(HMPBATCH) ; US6734 - merge data into metastamp
.. D SETDOM^HMPDJFSP("status",HMPFDOM(HMPFDOMI),1,HMPMETA) ; ready ; cpc TA41760
.. ; if superceded, stop processing domains
.. I '$D(^XTMP(HMPBATCH,0,"task",HMPFZTSK)) S HMPFDOMI=999 Q
.. ; -- if more domains, check ^XTMP size before continuing; may have to HANG if too big *BEGIN*S68-JCH*
.. I +HMPFDFN,HMPFDOMI'=+$O(HMPFDOM(""),-1) D CHKXTMP^HMPDJFSP(HMPBATCH,HMPFZTSK) ;; US 5074 - removed
; if superceded, remove extracts produced by this task
I '$D(^XTMP(HMPBATCH,0,"task",HMPFZTSK)) K ^XTMP(HMPBATCH,HMPFZTSK) Q
; don't assume initialized, since we may split domains to other tasks
I $G(HMPQREF)'="" S @HMPQREF=$P($H,",",2) ;US13442 update heartbeat
I $$INITDONE^HMPDJFSP(HMPBATCH) D ; if all domains extracted
. S COUNT=$O(^TMP("HMPERR",$J,"")) I COUNT>0 D POSTERR^HMPDJFSP(COUNT,HMPFDFN)
. D SETMARK^HMPDJFSP("Done",HMPFDFN,HMPBATCH) ; - add updated syncStatus
. D MVFRUPD(HMPBATCH,HMPFDFN) ; - move freshness updates over
. I $G(HMPQREF)'="" K @HMPQREF ;US13442 remove completed entry from queue
;
K ^XTMP(HMPBATCH,0,"task",HMPFZTSK) ; this task is done
Q
;
DOMOPD(HMPFADOM) ; Load an operational domain in smaller batches
; called by:
; DQINIT
; DOMOPD^HMPDJFSP
; calls:
; $$TOTAL
; GET^HMPEF
; MOD4STRM^HMPDJFSP
; POSTSEC^HMPDJFSP
; expects:
; HMPBATCH,HMPFZTSK
;
N FILTER,RSLT,NEXTID,DONE,HMPFEST,HMPFSEC,HMPFSIZE,HMPFLDON ; cpc
S HMPFSIZE=1000 ; section size (adjust to taste)
S HMPFEST=$$TOTAL(HMPFADOM) ; set estimated domain total
S NEXTID=0,HMPFSEC=0,DONE=0,HMPFLDON=0 ;cpc
S HMPFADOM=HMPFADOM_"#"_HMPFSEC
F D Q:DONE
. N FILTER,RSLT
. S FILTER("noHead")=1
. S FILTER("domain")=HMPFADOM ; include section for ^XTMP location
. S FILTER("start")=NEXTID
. S FILTER("limit")=HMPFSIZE
. D GET^HMPEF(.RSLT,.FILTER)
. I $G(HMPMETA)=1 S DONE=1 Q ;US6734 - do not update stream if compiling metastamp
. I '$D(^XTMP(HMPBATCH,0,"task",HMPFZTSK)) S DONE=1 QUIT ; superceded
. I $G(^XTMP(HMPBATCH,HMPFZTSK,HMPFADOM,"total"),0)=0,(HMPFSEC>0) S DONE=1 QUIT
. I $G(^XTMP(HMPBATCH,HMPFZTSK,HMPFADOM,"finished")) S DONE=1
. D MOD4STRM^HMPDJFSP(HMPFADOM)
. I DONE S HMPFEST=^XTMP(HMPBATCH,0,"count",$P(HMPFADOM,"#")) S:'HMPFEST HMPFEST=1
. D POSTSEC^HMPDJFSP(HMPFADOM,HMPFEST,HMPFSIZE)
. Q:DONE
. S NEXTID=$G(^XTMP(HMPBATCH,HMPFZTSK,HMPFADOM,"last"),0)
. S HMPFSEC=HMPFSEC+1
. S $P(HMPFADOM,"#",2)=HMPFSEC
;
Q
;
TOTAL(DOMAIN) ; function, return size total
; called by:
; DOMOPD
; $$TOTAL^HMPDJFSP
;
N I,X,ROOT,SIZE
S SIZE=0
F I=1:1 S X=$T(OPDOMS+I^HMPDJFSD) Q:$P(X,";",3)="zzzzz" D Q:SIZE
. I $P(X,";",3)'=DOMAIN Q
. S ROOT=$P(X,";",4)
. I ROOT="^HMP(800000.11)" S SIZE=$G(^HMP(800000.11,"ACNT",DOMAIN)) Q
. I $L(ROOT) S SIZE=$P($G(@ROOT@(0)),U,4)
;
Q $S(SIZE:SIZE,1:9999)
;
;
MVFRUPD(HMPBATCH,HMPFDFN) ; Move freshness updates over active stream
; called by:
; DQINIT
; MVFRUPD^HMPDJFSP
;
N ACT,DFN,FROM,HMPSRV,I,ID,TYPE,X
S HMPSRV=$P(HMPBATCH,"~",2)
D UPDSTS^HMPDJFSP(HMPFDFN,HMPSRV,2) ; now initialized
S FROM="HMPFH~"_HMPSRV_"~"_HMPFDFN
S I=0 F S I=$O(^XTMP(FROM,I)) Q:'I D ; move over held updates
. S X=^XTMP(FROM,I)
. S DFN=$P(X,U),TYPE=$P(X,U,2),ID=$P(X,U,3),ACT=$P(X,U,4)
. D POST^HMPDJFS(DFN,TYPE,ID,ACT,HMPSRV)
K ^XTMP(FROM) Q
;
SAVETASK ; save task request on job queue
; called by:
; PUTSUB^HMPDJFSP
;
N HMPQS
S HMPQS=$O(^XTMP(HMPQBTCH,HMPPRITY,""),-1)+1
S ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN)=""
M ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"ARGS")=ARGS
M ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"DOMAINS")=DOMAINS
M ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPBATCH")=HMPBATCH
M ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPSRV")=HMPSRV
S ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPSVERS")=HMPSVERS
;check if task manager running if not start one
L +^XTMP(HMPQBTCH,0):1 E Q
D NEWQMGR L -^XTMP(HMPQBTCH,0) Q
;
NEWQMGR ; queuer Start new background queue manager
; called by:
; SAVETASK
;
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
S ZTRTN="QMGR^HMPDJFSQ",ZTIO="",ZTDTH=$H
S ZTSAVE("HMPQBTCH")=""
S ZTDESC="HMP patient QMGR"
D ^%ZTLOAD
I '$G(ZTSK) D SETERR^HMPDJFS("sync queue manager failed to start")
Q
;
;
QMGR ; task Manager patient queues
; called by:
; NEWQMGR: queues this subroutine as a task
;
L +^XTMP(HMPQBTCH,0):5 E Q ;prove running
S $P(^XTMP(HMPQBTCH,0),U,1)=$$HTFM^XLFDT(+$H+5) ;Update deletion times
N HMPQRC,HMPQPC,HMPQNOW,HMPQRUN,HMPQRUNC,HMPQTOTP,HMPQDAT,HMPQUIT,HMPQI,HMPQQ,HMPQREF
S HMPQUIT=0 F D H 1 Q:HMPQUIT
. S HMPQTOTP=+$P($G(^XTMP(HMPQBTCH,0,0)),U) I 'HMPQTOTP S HMPQTOTP=2 ;max no of patients to run
. S HMPQNOW=$P($H,",",2)
. K HMPQRUNC S HMPQRUNC=0
. ;de4661 First count current running
. S HMPQQ="^XTMP("""_HMPQBTCH_""",0,0)"
. F HMPQI=0:1 S HMPQQ=$Q(@HMPQQ) Q:HMPQQ'[HMPQBTCH Q:HMPQQ="" I $QL(HMPQQ)=4 D Q:HMPQRUNC>=HMPQTOTP
.. S HMPQDAT=$G(@HMPQQ),HMPFDFN=$QS(HMPQQ,4)
.. D:HMPQDAT ; DE7401, check timeout on initial run and throttling restart
... I (HMPQNOW-HMPQDAT)>300!(HMPQNOW>300&((HMPQNOW-HMPQDAT)<0)) K @HMPQQ Q ;job static too long go to next
... S HMPQRUNC=HMPQRUNC+1,HMPQRUNC(HMPFDFN)=""
. Q:HMPQRUNC>=HMPQTOTP
. S HMPQRUN=HMPQRUNC
. S HMPQQ="^XTMP("""_HMPQBTCH_""",0,0)"
. F HMPQI=0:1 S HMPQQ=$Q(@HMPQQ) Q:HMPQQ'[HMPQBTCH Q:HMPQQ="" I $QL(HMPQQ)=4 D Q:HMPQRUN>=HMPQTOTP
.. S HMPQDAT=$G(@HMPQQ)
.. N NEWSUB,HMMPDFN,ARGS,DOMAINS,HMPBATCH,HMPSRV,HMPPRITY,HMPQS,HMPSVERS
.. S HMPPRITY=$QS(HMPQQ,2),HMPQS=$QS(HMPQQ,3),HMPFDFN=$QS(HMPQQ,4)
.. I 'HMPQDAT D Q ;task job
... ;restore data
... S NEWSUB=1
... M ARGS=^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"ARGS")
... M DOMAINS=^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"DOMAINS")
... M HMPBATCH=^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPBATCH")
... M HMPSRV=^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPSRV")
... S HMPSVERS=^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPSVERS")
... S @HMPQQ=$P($H,",",2) ;set start time
... S HMPQREF=HMPQQ
... D NEWTASK
... S HMPQRUN=HMPQRUN+1
.. I '$D(HMPQRUNC(HMPFDFN)) S HMPQRUN=HMPQRUN+1 ;de4661 - don't add already counted
. I 'HMPQI S HMPQUIT=1 ;nothing left to process
L -^XTMP(HMPQBTCH,0) ;clear lock when ending
;
Q
;
NEWTASK ; Start patient specific extract
; called by:
; QMGR
;
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
S ZTRTN="QREJOIN^HMPDJFSP",ZTIO="",ZTDTH=$H
S ZTSAVE("HMPQBTCH")=""
S ZTSAVE("HMPBATCH")="",ZTSAVE("HMPFDFN")="",ZTSAVE("DOMAINS(")=""
S ZTSAVE("HMPENVIR(")="",ZTSAVE("ARGS(")="" ; environment information
S ZTSAVE("HMPSTMP")="" ; Operational data stamptime US6734
S ZTSAVE("HMPSVERS")="" ;sync version US11019
S ZTSAVE("NEWSUB")=""
S ZTSAVE("HMPSRV")="",ZTSAVE("HMPSRV(")=""
S ZTSAVE("HMPQREF")="" ;US13442
S ZTDESC="HMP patient QMGRTSK"
D ^%ZTLOAD
I '$G(ZTSK) D SETERR^HMPDJFS("Task MANAGER TASK not created")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJFSQ 10592 printed Sep 23, 2025@19:29:39 Page 2
HMPDJFSQ ;ASMR/CPC -- Extract Queue manager ;Jan 25, 2017 11:08:07
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**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 ; DE6644 - code cleanup, 7 September 2016
+6 ;
+7 ; 2016-05-05 asmr-cpc HMP*2.0*1: create routine HMPDJFSQ from
+8 ; subroutines in HMPDJFSP to bring it down under the SAC size limit;
+9 ; includes NEWQMGR,NEWTASK,QMGR,SAVETASK,QUINIT.
+10 ;
+11 ; 2016-06-30/07-01 toad:
+12 ; move subroutines over from HMPDJFSP for SAC size limit: DQINIT,DOMOPD,$$TOTAL,MVFRUPD.
+13 ;
QUINIT(HMPBATCH,HMPFDFN,HMPFDOM) ; Queue the initial extracts for a patient
+1 ; called by:
+2 ; PUTSUB-QREJOIN^HMPDJFSP
+3 ; QUINIT^HMPDJFSP
+4 ; input:
+5 ; HMPBATCH="HMPFX~hmpsrvid~dfn" example: HMPFX~hmpXYZ~229
+6 ; HMPFDOM(n)="domainName"
+7 ;
+8 ; ^XTMP("HMPFX~hmpsrvid~dfn",0)=expires^created^HMP Patient Extract
+9 ; ,0,"status",domain)=0:waiting;1:ready
+10 ; ,0,"task",taskIen)=""
+11 ; ,taskIen,domain,... (extract data)
+12 ;
+13 ; set up domains to be done by this task
+14 NEW I
SET I=0
FOR
SET I=$ORDER(HMPFDOM(I))
if 'I
QUIT
DO SETDOM^HMPDJFSP("status",HMPFDOM(I),0)
+15 ;
+16 ; create task for this set of domains within the batch
+17 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+18 SET ZTRTN="DQINIT^HMPDJFSQ"
SET ZTIO="HMP EXTRACT RESOURCE"
SET ZTDTH=$HOROLOG
+19 SET ZTSAVE("HMPBATCH")=""
SET ZTSAVE("HMPFDFN")=""
SET ZTSAVE("HMPFDOM(")=""
+20 ; environment information
SET ZTSAVE("HMPENVIR(")=""
+21 ; Operational data stamptime US6734
SET ZTSAVE("HMPSTMP")=""
+22 ; sync version US11019
SET ZTSAVE("HMPSVERS")=""
+23 ; US13442
SET ZTSAVE("HMPQREF")=""
+24 SET ZTDESC="Build HMP domains for a patient"
+25 DO ^%ZTLOAD
+26 IF $GET(ZTSK)
SET ^XTMP(HMPBATCH,0,"task",ZTSK)=""
QUIT
+27 DO SETERR^HMPDJFS("Task not created")
+28 QUIT
+29 ;
DQINIT ; task Dequeue initial extracts
+1 ; called by:
+2 ; QUINIT: ZTRTN="DQINIT^HMPDJFSQ"
+3 ; QUINIT^HMPDJFSP: ZTRTN="DQINIT^HMPDJFSQ"
+4 ; DQINIT^HMPDJFSP
+5 ; QUINIT^HMPMETA
+6 ; expects:
+7 ; HMPBATCH, HMPFDFN, HMPFDOM, ZTSK
+8 ;
+9 NEW COUNT,HMPFDOMI,HMPFSYS,HMPFZTSK
+10 ;cpc 9/18/2015 In case job running too quickly
FOR COUNT=1:1:10
if $DATA(^XTMP(HMPBATCH,0,"task",ZTSK))
QUIT
HANG .5
+11 ; extract was superceded
IF '$DATA(^XTMP(HMPBATCH,0,"task",ZTSK))
QUIT
+12 KILL ^TMP("HMPERR",$JOB)
+13 SET HMPFSYS=$$SYS^HMPUTILS
+14 ; just in case the unexpected happens to ZTSK
SET HMPFZTSK=ZTSK
+15 SET ^XTMP(HMPBATCH,0,"task",ZTSK,"job")=$JOB
+16 SET ^XTMP(HMPBATCH,0,"task",ZTSK,"wait")=$$HDIFF^XLFDT($HOROLOG,$GET(^XTMP(HMPBATCH,0,"time")),2)
+17 ;
+18 ; S68 check space
+19 ; US8228
DO CHKSP^HMPUTILS($PIECE(HMPBATCH,"~",2))
+20 ; US6734
NEW HMPMETA
+21 ;
FOR HMPMETA=$SELECT(HMPSVERS:2,1:1):-1:0
Begin DoDot:1
+22 ; US6734
IF HMPMETA=0
IF +HMPFDFN
DO SETMARK^HMPDJFSP("Start",HMPFDFN,HMPBATCH)
+23 SET HMPFDOMI=""
+24 FOR
SET HMPFDOMI=$ORDER(HMPFDOM(HMPFDOMI))
if 'HMPFDOMI
QUIT
Begin DoDot:2
+25 ; cpc TA41760
DO SETDOM^HMPDJFSP("status",HMPFDOM(HMPFDOMI),0,HMPMETA)
+26 IF HMPFDFN="OPD"
Begin DoDot:3
+27 DO DOMOPD(HMPFDOM(HMPFDOMI))
+28 ; US6734 - mark OPD domain as complete in metastamp
IF HMPMETA=2
DO UPD^HMPMETA(HMPFDOM(HMPFDOMI))
End DoDot:3
+29 IF +HMPFDFN
DO DOMPT^HMPDJFSP(HMPFDOM(HMPFDOMI))
+30 IF HMPMETA=1
if '$ORDER(HMPFDOM(HMPFDOMI))
DO MERGE^HMPMETA(HMPBATCH)
if HMPFDFN="OPD"
DO UPD^HMPMETA(HMPFDOM(HMPFDOMI))
QUIT
+31 IF HMPMETA=2
Begin DoDot:3
+32 ;US11019 - merge data into metastamp
DO MERGE1^HMPMETA(HMPBATCH,HMPFDOM(HMPFDOMI))
+33 ;US11019 - new freshness entry replacing syncStart
IF +HMPFDFN
DO SETMARK^HMPDJFSP("Meta",HMPFDFN,HMPFDOM(HMPFDOMI))
+34 ; US6734 - merge data into metastamp
IF HMPFDFN="OPD"
if '$ORDER(HMPFDOM(HMPFDOMI))
DO MERGE^HMPMETA(HMPBATCH)
End DoDot:3
+35 ; ready ; cpc TA41760
DO SETDOM^HMPDJFSP("status",HMPFDOM(HMPFDOMI),1,HMPMETA)
+36 ; if superceded, stop processing domains
+37 IF '$DATA(^XTMP(HMPBATCH,0,"task",HMPFZTSK))
SET HMPFDOMI=999
QUIT
+38 ; -- if more domains, check ^XTMP size before continuing; may have to HANG if too big *BEGIN*S68-JCH*
+39 ;; US 5074 - removed
IF +HMPFDFN
IF HMPFDOMI'=+$ORDER(HMPFDOM(""),-1)
DO CHKXTMP^HMPDJFSP(HMPBATCH,HMPFZTSK)
End DoDot:2
End DoDot:1
if HMPMETA=2
QUIT
+40 ; if superceded, remove extracts produced by this task
+41 IF '$DATA(^XTMP(HMPBATCH,0,"task",HMPFZTSK))
KILL ^XTMP(HMPBATCH,HMPFZTSK)
QUIT
+42 ; don't assume initialized, since we may split domains to other tasks
+43 ;US13442 update heartbeat
IF $GET(HMPQREF)'=""
SET @HMPQREF=$PIECE($HOROLOG,",",2)
+44 ; if all domains extracted
IF $$INITDONE^HMPDJFSP(HMPBATCH)
Begin DoDot:1
+45 SET COUNT=$ORDER(^TMP("HMPERR",$JOB,""))
IF COUNT>0
DO POSTERR^HMPDJFSP(COUNT,HMPFDFN)
+46 ; - add updated syncStatus
DO SETMARK^HMPDJFSP("Done",HMPFDFN,HMPBATCH)
+47 ; - move freshness updates over
DO MVFRUPD(HMPBATCH,HMPFDFN)
+48 ;US13442 remove completed entry from queue
IF $GET(HMPQREF)'=""
KILL @HMPQREF
End DoDot:1
+49 ;
+50 ; this task is done
KILL ^XTMP(HMPBATCH,0,"task",HMPFZTSK)
+51 QUIT
+52 ;
DOMOPD(HMPFADOM) ; Load an operational domain in smaller batches
+1 ; called by:
+2 ; DQINIT
+3 ; DOMOPD^HMPDJFSP
+4 ; calls:
+5 ; $$TOTAL
+6 ; GET^HMPEF
+7 ; MOD4STRM^HMPDJFSP
+8 ; POSTSEC^HMPDJFSP
+9 ; expects:
+10 ; HMPBATCH,HMPFZTSK
+11 ;
+12 ; cpc
NEW FILTER,RSLT,NEXTID,DONE,HMPFEST,HMPFSEC,HMPFSIZE,HMPFLDON
+13 ; section size (adjust to taste)
SET HMPFSIZE=1000
+14 ; set estimated domain total
SET HMPFEST=$$TOTAL(HMPFADOM)
+15 ;cpc
SET NEXTID=0
SET HMPFSEC=0
SET DONE=0
SET HMPFLDON=0
+16 SET HMPFADOM=HMPFADOM_"#"_HMPFSEC
+17 FOR
Begin DoDot:1
+18 NEW FILTER,RSLT
+19 SET FILTER("noHead")=1
+20 ; include section for ^XTMP location
SET FILTER("domain")=HMPFADOM
+21 SET FILTER("start")=NEXTID
+22 SET FILTER("limit")=HMPFSIZE
+23 DO GET^HMPEF(.RSLT,.FILTER)
+24 ;US6734 - do not update stream if compiling metastamp
IF $GET(HMPMETA)=1
SET DONE=1
QUIT
+25 ; superceded
IF '$DATA(^XTMP(HMPBATCH,0,"task",HMPFZTSK))
SET DONE=1
QUIT
+26 IF $GET(^XTMP(HMPBATCH,HMPFZTSK,HMPFADOM,"total"),0)=0
IF (HMPFSEC>0)
SET DONE=1
QUIT
+27 IF $GET(^XTMP(HMPBATCH,HMPFZTSK,HMPFADOM,"finished"))
SET DONE=1
+28 DO MOD4STRM^HMPDJFSP(HMPFADOM)
+29 IF DONE
SET HMPFEST=^XTMP(HMPBATCH,0,"count",$PIECE(HMPFADOM,"#"))
if 'HMPFEST
SET HMPFEST=1
+30 DO POSTSEC^HMPDJFSP(HMPFADOM,HMPFEST,HMPFSIZE)
+31 if DONE
QUIT
+32 SET NEXTID=$GET(^XTMP(HMPBATCH,HMPFZTSK,HMPFADOM,"last"),0)
+33 SET HMPFSEC=HMPFSEC+1
+34 SET $PIECE(HMPFADOM,"#",2)=HMPFSEC
End DoDot:1
if DONE
QUIT
+35 ;
+36 QUIT
+37 ;
TOTAL(DOMAIN) ; function, return size total
+1 ; called by:
+2 ; DOMOPD
+3 ; $$TOTAL^HMPDJFSP
+4 ;
+5 NEW I,X,ROOT,SIZE
+6 SET SIZE=0
+7 FOR I=1:1
SET X=$TEXT(OPDOMS+I^HMPDJFSD)
if $PIECE(X,";",3)="zzzzz"
QUIT
Begin DoDot:1
+8 IF $PIECE(X,";",3)'=DOMAIN
QUIT
+9 SET ROOT=$PIECE(X,";",4)
+10 IF ROOT="^HMP(800000.11)"
SET SIZE=$GET(^HMP(800000.11,"ACNT",DOMAIN))
QUIT
+11 IF $LENGTH(ROOT)
SET SIZE=$PIECE($GET(@ROOT@(0)),U,4)
End DoDot:1
if SIZE
QUIT
+12 ;
+13 QUIT $SELECT(SIZE:SIZE,1:9999)
+14 ;
+15 ;
MVFRUPD(HMPBATCH,HMPFDFN) ; Move freshness updates over active stream
+1 ; called by:
+2 ; DQINIT
+3 ; MVFRUPD^HMPDJFSP
+4 ;
+5 NEW ACT,DFN,FROM,HMPSRV,I,ID,TYPE,X
+6 SET HMPSRV=$PIECE(HMPBATCH,"~",2)
+7 ; now initialized
DO UPDSTS^HMPDJFSP(HMPFDFN,HMPSRV,2)
+8 SET FROM="HMPFH~"_HMPSRV_"~"_HMPFDFN
+9 ; move over held updates
SET I=0
FOR
SET I=$ORDER(^XTMP(FROM,I))
if 'I
QUIT
Begin DoDot:1
+10 SET X=^XTMP(FROM,I)
+11 SET DFN=$PIECE(X,U)
SET TYPE=$PIECE(X,U,2)
SET ID=$PIECE(X,U,3)
SET ACT=$PIECE(X,U,4)
+12 DO POST^HMPDJFS(DFN,TYPE,ID,ACT,HMPSRV)
End DoDot:1
+13 KILL ^XTMP(FROM)
QUIT
+14 ;
SAVETASK ; save task request on job queue
+1 ; called by:
+2 ; PUTSUB^HMPDJFSP
+3 ;
+4 NEW HMPQS
+5 SET HMPQS=$ORDER(^XTMP(HMPQBTCH,HMPPRITY,""),-1)+1
+6 SET ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN)=""
+7 MERGE ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"ARGS")=ARGS
+8 MERGE ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"DOMAINS")=DOMAINS
+9 MERGE ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPBATCH")=HMPBATCH
+10 MERGE ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPSRV")=HMPSRV
+11 SET ^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPSVERS")=HMPSVERS
+12 ;check if task manager running if not start one
+13 LOCK +^XTMP(HMPQBTCH,0):1
IF '$TEST
QUIT
+14 DO NEWQMGR
LOCK -^XTMP(HMPQBTCH,0)
QUIT
+15 ;
NEWQMGR ; queuer Start new background queue manager
+1 ; called by:
+2 ; SAVETASK
+3 ;
+4 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
+5 SET ZTRTN="QMGR^HMPDJFSQ"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+6 SET ZTSAVE("HMPQBTCH")=""
+7 SET ZTDESC="HMP patient QMGR"
+8 DO ^%ZTLOAD
+9 IF '$GET(ZTSK)
DO SETERR^HMPDJFS("sync queue manager failed to start")
+10 QUIT
+11 ;
+12 ;
QMGR ; task Manager patient queues
+1 ; called by:
+2 ; NEWQMGR: queues this subroutine as a task
+3 ;
+4 ;prove running
LOCK +^XTMP(HMPQBTCH,0):5
IF '$TEST
QUIT
+5 ;Update deletion times
SET $PIECE(^XTMP(HMPQBTCH,0),U,1)=$$HTFM^XLFDT(+$HOROLOG+5)
+6 NEW HMPQRC,HMPQPC,HMPQNOW,HMPQRUN,HMPQRUNC,HMPQTOTP,HMPQDAT,HMPQUIT,HMPQI,HMPQQ,HMPQREF
+7 SET HMPQUIT=0
FOR
Begin DoDot:1
+8 ;max no of patients to run
SET HMPQTOTP=+$PIECE($GET(^XTMP(HMPQBTCH,0,0)),U)
IF 'HMPQTOTP
SET HMPQTOTP=2
+9 SET HMPQNOW=$PIECE($HOROLOG,",",2)
+10 KILL HMPQRUNC
SET HMPQRUNC=0
+11 ;de4661 First count current running
+12 SET HMPQQ="^XTMP("""_HMPQBTCH_""",0,0)"
+13 FOR HMPQI=0:1
SET HMPQQ=$QUERY(@HMPQQ)
if HMPQQ'[HMPQBTCH
QUIT
if HMPQQ=""
QUIT
IF $QLENGTH(HMPQQ)=4
Begin DoDot:2
+14 SET HMPQDAT=$GET(@HMPQQ)
SET HMPFDFN=$QSUBSCRIPT(HMPQQ,4)
+15 ; DE7401, check timeout on initial run and throttling restart
if HMPQDAT
Begin DoDot:3
+16 ;job static too long go to next
IF (HMPQNOW-HMPQDAT)>300!(HMPQNOW>300&((HMPQNOW-HMPQDAT)<0))
KILL @HMPQQ
QUIT
+17 SET HMPQRUNC=HMPQRUNC+1
SET HMPQRUNC(HMPFDFN)=""
End DoDot:3
End DoDot:2
if HMPQRUNC>=HMPQTOTP
QUIT
+18 if HMPQRUNC>=HMPQTOTP
QUIT
+19 SET HMPQRUN=HMPQRUNC
+20 SET HMPQQ="^XTMP("""_HMPQBTCH_""",0,0)"
+21 FOR HMPQI=0:1
SET HMPQQ=$QUERY(@HMPQQ)
if HMPQQ'[HMPQBTCH
QUIT
if HMPQQ=""
QUIT
IF $QLENGTH(HMPQQ)=4
Begin DoDot:2
+22 SET HMPQDAT=$GET(@HMPQQ)
+23 NEW NEWSUB,HMMPDFN,ARGS,DOMAINS,HMPBATCH,HMPSRV,HMPPRITY,HMPQS,HMPSVERS
+24 SET HMPPRITY=$QSUBSCRIPT(HMPQQ,2)
SET HMPQS=$QSUBSCRIPT(HMPQQ,3)
SET HMPFDFN=$QSUBSCRIPT(HMPQQ,4)
+25 ;task job
IF 'HMPQDAT
Begin DoDot:3
+26 ;restore data
+27 SET NEWSUB=1
+28 MERGE ARGS=^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"ARGS")
+29 MERGE DOMAINS=^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"DOMAINS")
+30 MERGE HMPBATCH=^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPBATCH")
+31 MERGE HMPSRV=^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPSRV")
+32 SET HMPSVERS=^XTMP(HMPQBTCH,HMPPRITY,HMPQS,HMPFDFN,"HMPSVERS")
+33 ;set start time
SET @HMPQQ=$PIECE($HOROLOG,",",2)
+34 SET HMPQREF=HMPQQ
+35 DO NEWTASK
+36 SET HMPQRUN=HMPQRUN+1
End DoDot:3
QUIT
+37 ;de4661 - don't add already counted
IF '$DATA(HMPQRUNC(HMPFDFN))
SET HMPQRUN=HMPQRUN+1
End DoDot:2
if HMPQRUN>=HMPQTOTP
QUIT
+38 ;nothing left to process
IF 'HMPQI
SET HMPQUIT=1
End DoDot:1
HANG 1
if HMPQUIT
QUIT
+39 ;clear lock when ending
LOCK -^XTMP(HMPQBTCH,0)
+40 ;
+41 QUIT
+42 ;
NEWTASK ; Start patient specific extract
+1 ; called by:
+2 ; QMGR
+3 ;
+4 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+5 SET ZTRTN="QREJOIN^HMPDJFSP"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+6 SET ZTSAVE("HMPQBTCH")=""
+7 SET ZTSAVE("HMPBATCH")=""
SET ZTSAVE("HMPFDFN")=""
SET ZTSAVE("DOMAINS(")=""
+8 ; environment information
SET ZTSAVE("HMPENVIR(")=""
SET ZTSAVE("ARGS(")=""
+9 ; Operational data stamptime US6734
SET ZTSAVE("HMPSTMP")=""
+10 ;sync version US11019
SET ZTSAVE("HMPSVERS")=""
+11 SET ZTSAVE("NEWSUB")=""
+12 SET ZTSAVE("HMPSRV")=""
SET ZTSAVE("HMPSRV(")=""
+13 ;US13442
SET ZTSAVE("HMPQREF")=""
+14 SET ZTDESC="HMP patient QMGRTSK"
+15 DO ^%ZTLOAD
+16 IF '$GET(ZTSK)
DO SETERR^HMPDJFS("Task MANAGER TASK not created")
+17 QUIT
+18 ;
