HMPDJX ;SLC/MKB,ASMR/RRB,BL - New data update;Aug 29, 2016 20:06:27
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^DPT 10035
; MPIF001 2701
; XLFSTR 10104
Q
;
EN(LAST,MAX) ; -- get data from ^XTMP("HMP-<date>",n)
; Expects HMP=$NA(^TMP("HMP",$J))
;
N SYS,X,Y,HMPTOTL,DFN,PATCNT,ICN,DOMCNT,TYPE,RTN,HMPLASTI,HMPID,DATA,DELETE,UID,CNT,TSTART,TSTOP
S TSTART=$$NOW^XLFDT()
S LAST=$G(LAST),SYS=$G(FILTER("systemID")) Q:SYS=""
S MAX=$G(MAX,999)
D GETLIST(LAST,SYS,MAX)
;
S (DFN,PATCNT,HMPTOTL)=0 F S DFN=$O(^TMP("HMPX",$J,DFN)) Q:'(DFN>0) D ;DE4496 19 August 2016
. K ^TMP($J,"HMP ERROR")
. S PATCNT=PATCNT+1,ICN=+$$GETICN^MPIF001(DFN),ERRPAT=DFN
. S DOMCNT=0 K DATA,DELETE
. S TYPE="" F S TYPE=$O(^TMP("HMPX",$J,DFN,TYPE)) Q:TYPE="" D
.. S RTN=$$TAG^HMPDJ(TYPE)_"^HMPDJ0" Q:'$L($T(@RTN))
.. S DOMCNT=DOMCNT+1
.. ;
.. N HMP S HMP=$NA(^TMP("HMP",$J,PATCNT,DOMCNT)),HMPI=0,HMPID=""
.. F S HMPID=$O(^TMP("HMPX",$J,DFN,TYPE,HMPID)) Q:HMPID="" S X=$G(^(HMPID)) D
... N $ES,$ET,ERRPAT,ERRMSG
... S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
... S ERRMSG="A problem occurred when trying to refresh patient data from an API."
... ;
... I X="@" D DELETE(TYPE,DFN,HMPID) Q
... S HMPLASTI=HMPI D @RTN ;creates @HMP@(HMPI+1)
... ;
... ; if no new item, assume the record has been deleted
... I HMPI'>HMPLASTI D DELETE(TYPE,DFN,HMPID) Q
... S HMPTOTL=HMPTOTL+1,DATA=1
.. I 'HMPI S DOMCNT=DOMCNT-1 Q ;no data, or error
.. ;
.. S:DOMCNT>1 @HMP@(.3)=","
.. S @HMP@(.5)="{""domainName"":"""_TYPE_""",""total"":"_HMPI_",""items"":["
.. S HMPI=HMPI+1,@HMP@(HMPI)="]}"
. ;
A . ; HMP=$NA(^TMP("HMP",$J)) again
. S:PATCNT>1 @HMP@(PATCNT,.3)=","
. S @HMP@(PATCNT,.5)="{""patientDfn"":"_DFN_",""patientIcn"":"""_ICN_""""
. I DOMCNT D
.. S @HMP@(PATCNT,.6)=",""domains"":["
.. S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT)="]"
. ;
. I $D(DELETE) D
.. S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT,.5)=",""deletes"":["
.. S HMPI=0,UID="" F S UID=$O(DELETE(UID)) Q:UID="" D
... S TYPE=DELETE(UID),HMPI=HMPI+1
... S:HMPI>1 @HMP@(PATCNT,DOMCNT,HMPI,.3)=","
... S @HMP@(PATCNT,DOMCNT,HMPI,1)="{""uid"":"""_UID_""",""domainName"":"""_TYPE_"""}"
.. S HMPI=HMPI+1,@HMP@(PATCNT,DOMCNT,HMPI)="]"
. ;
. I $D(^TMP($J,"HMP ERROR")) D
.. N ERROR D BUILDERR^HMPDJ(.ERROR)
.. S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT,.3)=","
.. M @HMP@(PATCNT,DOMCNT)=ERROR
.. K ^TMP($J,"HMP ERROR")
. ;
. S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT)="}"
;
S Y=$G(^TMP("HMPX",$J,0)) S:Y="" Y=LAST
S T=$$NOW^XLFDT()
S @HMP@(.5)="{""apiVersion"":""1.01"",""data"":{""lastUpdate"":"""_Y_""",""startDateTime"":"""_TSTART_""",""totalPatients"":"_PATCNT
S:PATCNT @HMP@(.6)=",""patients"":[",PATCNT=PATCNT+1,@HMP@(PATCNT)="]"
;
B ;
I $D(^TMP("HMPX",$J,"OP")) D ;operational data
. S (HMPTOTL,DOMCNT)=0,PATCNT=PATCNT+1 K DATA,DELETE
. S TYPE="" F S TYPE=$O(^TMP("HMPX",$J,"OP",TYPE)) Q:TYPE="" D
.. S RTN=$$TAG^HMPEF(TYPE)_"^HMPEF" Q:'$L($T(@RTN))
.. S DOMCNT=DOMCNT+1,DFN=""
.. ;
.. N HMP S HMP=$NA(^TMP("HMP",$J,PATCNT,DOMCNT)),HMPI=0,HMPID=""
.. F S HMPID=$O(^TMP("HMPX",$J,"OP",TYPE,HMPID)) Q:HMPID="" S X=$G(^(HMPID)) D
... I X="@" D DELETE(TYPE,DFN,HMPID) Q
... S HMPLASTI=HMPI D @RTN ;creates @HMP@(HMPI+1)
... ; if no new item, assume the record has been deleted
... I HMPI'>HMPLASTI D DELETE(TYPE,DFN,HMPID) Q
... S HMPTOTL=HMPTOTL+1,DATA=1
.. I 'HMPI S DOMCNT=DOMCNT-1 Q ;no data, or error
.. ;
.. S:DOMCNT>1 @HMP@(.3)=","
.. S @HMP@(.5)="{""domainName"":"""_TYPE_""",""total"":"_HMPI_",""items"":["
.. S HMPI=HMPI+1,@HMP@(HMPI)="]}"
. ;
C . ; HMP=$NA(^TMP("HMP",$J)) again
. I 'DOMCNT,'$D(DELETE) Q ;no data, or error
. S @HMP@(PATCNT,.5)=",""operational"":{"
. I DOMCNT D
.. S @HMP@(PATCNT,.6)="""domains"":["
.. S DOMCNT=DOMCNT+1 S @HMP@(PATCNT,DOMCNT)="]"
. ;
. I $D(DELETE) D
.. S DOMCNT=DOMCNT+1 S:DOMCNT>1 @HMP@(PATCNT,DOMCNT,.3)=","
.. S @HMP@(PATCNT,DOMCNT,.5)="""deletes"":["
.. S HMPI=0,UID="" F S UID=$O(DELETE(UID)) Q:UID="" D
... S TYPE=DELETE(UID),HMPI=HMPI+1
... S:HMPI>1 @HMP@(PATCNT,DOMCNT,HMPI,.3)=","
... S @HMP@(PATCNT,DOMCNT,HMPI,1)="{""uid"":"""_UID_""",""domainName"":"""_TYPE_"""}"
.. S HMPI=HMPI+1,@HMP@(PATCNT,DOMCNT,HMPI)="]"
. ;
. S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT)="}"
;
S TSTOP=$$NOW^XLFDT()
S PATCNT=PATCNT+1,@HMP@(PATCNT)=",""endDateTime"":"""_TSTOP_"""}}" ;close JSON
K ^TMP("HMPX",$J),^TMP("HMPTEXT",$J)
Q
;
DELETE(NAME,DFN,ID) ; -- set DELETE nodes
N UID
S UID=$$SETUID^HMPUTILS(NAME,DFN,ID)
S DELETE(UID)=NAME
Q
;
GETLIST(LAST,SYS,MAX) ; -- build list of updates for client
; Returns ^TMP("HMPX",$J,0) = last DATE:SEQ included
; ^TMP("HMPX",$J,DFN,TYPE,ID)=ACT
N DATE,SEQ,DA,END,IDX,X0,DFN,TYPE,ID,ACT,D,N,CNT
K ^TMP("HMPX",$J)
S DATE=+LAST,SEQ=+$P(LAST,":",2),CNT=0
S DA=$$FIND^HMPPATS(SYS) Q:'DA
;
; generate list ID, and end point
S D=DT,N=+$O(^XTMP("HMP-"_DT,"A"),-1) ;last entry, as of now
I DATE=DT,SEQ=N S ^TMP("HMPX",$J,0)=LAST Q ;no new items
;
S IDX=$NA(^XTMP("HMP-"_DATE,SEQ)),END=N ;init loop where left off
F S IDX=$Q(@IDX) Q:$$DONE D Q:CNT'<MAX
. S D=+$P(IDX,"-",2),N=+$P(IDX,",",2)
. S X0=@IDX,DFN=$P(X0,U) S:DFN="" DFN="OP"
. I DFN,'$D(^HMP(800000,"ADFN",DFN,DA)) Q
. S TYPE=$P(X0,U,2),ID=$P(X0,U,3),ACT=$P(X0,U,4)
. I TYPE=""!(ID="") Q ;error
. I TYPE="ROSTER",'$D(^HMP(800000,"AROS",ID,DA)) Q
. S:'$D(^TMP("HMPX",$J,DFN,TYPE,ID)) CNT=CNT+1
. S ^TMP("HMPX",$J,DFN,TYPE,ID)=ACT
S ^TMP("HMPX",$J,0)=D_":"_N ;final date:seq
Q
;
DONE() ; -- Return 1 or 0, if loop has finished
I IDX'?1"^XTMP(""HMP-"7N.E Q 1 ;end of ^XTMP("HMP")
N D,N S D=+$P(IDX,"-",2),N=+$P(IDX,",",2)
; check HMP-DATE subscript
I D<DT Q 0 ;prior day: keep going
I D>DT Q 1 ;next day: stop loop
; D=DT: check sequence# subscript
I N>END Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJX 6260 printed Apr 09, 2024@20:58:58 Page 2
HMPDJX ;SLC/MKB,ASMR/RRB,BL - New data update;Aug 29, 2016 20:06:27
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^DPT 10035
+7 ; MPIF001 2701
+8 ; XLFSTR 10104
+9 QUIT
+10 ;
EN(LAST,MAX) ; -- get data from ^XTMP("HMP-<date>",n)
+1 ; Expects HMP=$NA(^TMP("HMP",$J))
+2 ;
+3 NEW SYS,X,Y,HMPTOTL,DFN,PATCNT,ICN,DOMCNT,TYPE,RTN,HMPLASTI,HMPID,DATA,DELETE,UID,CNT,TSTART,TSTOP
+4 SET TSTART=$$NOW^XLFDT()
+5 SET LAST=$GET(LAST)
SET SYS=$GET(FILTER("systemID"))
if SYS=""
QUIT
+6 SET MAX=$GET(MAX,999)
+7 DO GETLIST(LAST,SYS,MAX)
+8 ;
+9 ;DE4496 19 August 2016
SET (DFN,PATCNT,HMPTOTL)=0
FOR
SET DFN=$ORDER(^TMP("HMPX",$JOB,DFN))
if '(DFN>0)
QUIT
Begin DoDot:1
+10 KILL ^TMP($JOB,"HMP ERROR")
+11 SET PATCNT=PATCNT+1
SET ICN=+$$GETICN^MPIF001(DFN)
SET ERRPAT=DFN
+12 SET DOMCNT=0
KILL DATA,DELETE
+13 SET TYPE=""
FOR
SET TYPE=$ORDER(^TMP("HMPX",$JOB,DFN,TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+14 SET RTN=$$TAG^HMPDJ(TYPE)_"^HMPDJ0"
if '$LENGTH($TEXT(@RTN))
QUIT
+15 SET DOMCNT=DOMCNT+1
+16 ;
+17 NEW HMP
SET HMP=$NAME(^TMP("HMP",$JOB,PATCNT,DOMCNT))
SET HMPI=0
SET HMPID=""
+18 FOR
SET HMPID=$ORDER(^TMP("HMPX",$JOB,DFN,TYPE,HMPID))
if HMPID=""
QUIT
SET X=$GET(^(HMPID))
Begin DoDot:3
+19 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+20 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+21 SET ERRMSG="A problem occurred when trying to refresh patient data from an API."
+22 ;
+23 IF X="@"
DO DELETE(TYPE,DFN,HMPID)
QUIT
+24 ;creates @HMP@(HMPI+1)
SET HMPLASTI=HMPI
DO @RTN
+25 ;
+26 ; if no new item, assume the record has been deleted
+27 IF HMPI'>HMPLASTI
DO DELETE(TYPE,DFN,HMPID)
QUIT
+28 SET HMPTOTL=HMPTOTL+1
SET DATA=1
End DoDot:3
+29 ;no data, or error
IF 'HMPI
SET DOMCNT=DOMCNT-1
QUIT
+30 ;
+31 if DOMCNT>1
SET @HMP@(.3)=","
+32 SET @HMP@(.5)="{""domainName"":"""_TYPE_""",""total"":"_HMPI_",""items"":["
+33 SET HMPI=HMPI+1
SET @HMP@(HMPI)="]}"
End DoDot:2
+34 ;
A ; HMP=$NA(^TMP("HMP",$J)) again
+1 if PATCNT>1
SET @HMP@(PATCNT,.3)=","
+2 SET @HMP@(PATCNT,.5)="{""patientDfn"":"_DFN_",""patientIcn"":"""_ICN_""""
+3 IF DOMCNT
Begin DoDot:2
+4 SET @HMP@(PATCNT,.6)=",""domains"":["
+5 SET DOMCNT=DOMCNT+1
SET @HMP@(PATCNT,DOMCNT)="]"
End DoDot:2
+6 ;
+7 IF $DATA(DELETE)
Begin DoDot:2
+8 SET DOMCNT=DOMCNT+1
SET @HMP@(PATCNT,DOMCNT,.5)=",""deletes"":["
+9 SET HMPI=0
SET UID=""
FOR
SET UID=$ORDER(DELETE(UID))
if UID=""
QUIT
Begin DoDot:3
+10 SET TYPE=DELETE(UID)
SET HMPI=HMPI+1
+11 if HMPI>1
SET @HMP@(PATCNT,DOMCNT,HMPI,.3)=","
+12 SET @HMP@(PATCNT,DOMCNT,HMPI,1)="{""uid"":"""_UID_""",""domainName"":"""_TYPE_"""}"
End DoDot:3
+13 SET HMPI=HMPI+1
SET @HMP@(PATCNT,DOMCNT,HMPI)="]"
End DoDot:2
+14 ;
+15 IF $DATA(^TMP($JOB,"HMP ERROR"))
Begin DoDot:2
+16 NEW ERROR
DO BUILDERR^HMPDJ(.ERROR)
+17 SET DOMCNT=DOMCNT+1
SET @HMP@(PATCNT,DOMCNT,.3)=","
+18 MERGE @HMP@(PATCNT,DOMCNT)=ERROR
+19 KILL ^TMP($JOB,"HMP ERROR")
End DoDot:2
+20 ;
+21 SET DOMCNT=DOMCNT+1
SET @HMP@(PATCNT,DOMCNT)="}"
End DoDot:1
+22 ;
+23 SET Y=$GET(^TMP("HMPX",$JOB,0))
if Y=""
SET Y=LAST
+24 SET T=$$NOW^XLFDT()
+25 SET @HMP@(.5)="{""apiVersion"":""1.01"",""data"":{""lastUpdate"":"""_Y_""",""startDateTime"":"""_TSTART_""",""totalPatients"":"_PATCNT
+26 if PATCNT
SET @HMP@(.6)=",""patients"":["
SET PATCNT=PATCNT+1
SET @HMP@(PATCNT)="]"
+27 ;
B ;
+1 ;operational data
IF $DATA(^TMP("HMPX",$JOB,"OP"))
Begin DoDot:1
+2 SET (HMPTOTL,DOMCNT)=0
SET PATCNT=PATCNT+1
KILL DATA,DELETE
+3 SET TYPE=""
FOR
SET TYPE=$ORDER(^TMP("HMPX",$JOB,"OP",TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+4 SET RTN=$$TAG^HMPEF(TYPE)_"^HMPEF"
if '$LENGTH($TEXT(@RTN))
QUIT
+5 SET DOMCNT=DOMCNT+1
SET DFN=""
+6 ;
+7 NEW HMP
SET HMP=$NAME(^TMP("HMP",$JOB,PATCNT,DOMCNT))
SET HMPI=0
SET HMPID=""
+8 FOR
SET HMPID=$ORDER(^TMP("HMPX",$JOB,"OP",TYPE,HMPID))
if HMPID=""
QUIT
SET X=$GET(^(HMPID))
Begin DoDot:3
+9 IF X="@"
DO DELETE(TYPE,DFN,HMPID)
QUIT
+10 ;creates @HMP@(HMPI+1)
SET HMPLASTI=HMPI
DO @RTN
+11 ; if no new item, assume the record has been deleted
+12 IF HMPI'>HMPLASTI
DO DELETE(TYPE,DFN,HMPID)
QUIT
+13 SET HMPTOTL=HMPTOTL+1
SET DATA=1
End DoDot:3
+14 ;no data, or error
IF 'HMPI
SET DOMCNT=DOMCNT-1
QUIT
+15 ;
+16 if DOMCNT>1
SET @HMP@(.3)=","
+17 SET @HMP@(.5)="{""domainName"":"""_TYPE_""",""total"":"_HMPI_",""items"":["
+18 SET HMPI=HMPI+1
SET @HMP@(HMPI)="]}"
End DoDot:2
+19 ;
C ; HMP=$NA(^TMP("HMP",$J)) again
+1 ;no data, or error
IF 'DOMCNT
IF '$DATA(DELETE)
QUIT
+2 SET @HMP@(PATCNT,.5)=",""operational"":{"
+3 IF DOMCNT
Begin DoDot:2
+4 SET @HMP@(PATCNT,.6)="""domains"":["
+5 SET DOMCNT=DOMCNT+1
SET @HMP@(PATCNT,DOMCNT)="]"
End DoDot:2
+6 ;
+7 IF $DATA(DELETE)
Begin DoDot:2
+8 SET DOMCNT=DOMCNT+1
if DOMCNT>1
SET @HMP@(PATCNT,DOMCNT,.3)=","
+9 SET @HMP@(PATCNT,DOMCNT,.5)="""deletes"":["
+10 SET HMPI=0
SET UID=""
FOR
SET UID=$ORDER(DELETE(UID))
if UID=""
QUIT
Begin DoDot:3
+11 SET TYPE=DELETE(UID)
SET HMPI=HMPI+1
+12 if HMPI>1
SET @HMP@(PATCNT,DOMCNT,HMPI,.3)=","
+13 SET @HMP@(PATCNT,DOMCNT,HMPI,1)="{""uid"":"""_UID_""",""domainName"":"""_TYPE_"""}"
End DoDot:3
+14 SET HMPI=HMPI+1
SET @HMP@(PATCNT,DOMCNT,HMPI)="]"
End DoDot:2
+15 ;
+16 SET DOMCNT=DOMCNT+1
SET @HMP@(PATCNT,DOMCNT)="}"
End DoDot:1
+17 ;
+18 SET TSTOP=$$NOW^XLFDT()
+19 ;close JSON
SET PATCNT=PATCNT+1
SET @HMP@(PATCNT)=",""endDateTime"":"""_TSTOP_"""}}"
+20 KILL ^TMP("HMPX",$JOB),^TMP("HMPTEXT",$JOB)
+21 QUIT
+22 ;
DELETE(NAME,DFN,ID) ; -- set DELETE nodes
+1 NEW UID
+2 SET UID=$$SETUID^HMPUTILS(NAME,DFN,ID)
+3 SET DELETE(UID)=NAME
+4 QUIT
+5 ;
GETLIST(LAST,SYS,MAX) ; -- build list of updates for client
+1 ; Returns ^TMP("HMPX",$J,0) = last DATE:SEQ included
+2 ; ^TMP("HMPX",$J,DFN,TYPE,ID)=ACT
+3 NEW DATE,SEQ,DA,END,IDX,X0,DFN,TYPE,ID,ACT,D,N,CNT
+4 KILL ^TMP("HMPX",$JOB)
+5 SET DATE=+LAST
SET SEQ=+$PIECE(LAST,":",2)
SET CNT=0
+6 SET DA=$$FIND^HMPPATS(SYS)
if 'DA
QUIT
+7 ;
+8 ; generate list ID, and end point
+9 ;last entry, as of now
SET D=DT
SET N=+$ORDER(^XTMP("HMP-"_DT,"A"),-1)
+10 ;no new items
IF DATE=DT
IF SEQ=N
SET ^TMP("HMPX",$JOB,0)=LAST
QUIT
+11 ;
+12 ;init loop where left off
SET IDX=$NAME(^XTMP("HMP-"_DATE,SEQ))
SET END=N
+13 FOR
SET IDX=$QUERY(@IDX)
if $$DONE
QUIT
Begin DoDot:1
+14 SET D=+$PIECE(IDX,"-",2)
SET N=+$PIECE(IDX,",",2)
+15 SET X0=@IDX
SET DFN=$PIECE(X0,U)
if DFN=""
SET DFN="OP"
+16 IF DFN
IF '$DATA(^HMP(800000,"ADFN",DFN,DA))
QUIT
+17 SET TYPE=$PIECE(X0,U,2)
SET ID=$PIECE(X0,U,3)
SET ACT=$PIECE(X0,U,4)
+18 ;error
IF TYPE=""!(ID="")
QUIT
+19 IF TYPE="ROSTER"
IF '$DATA(^HMP(800000,"AROS",ID,DA))
QUIT
+20 if '$DATA(^TMP("HMPX",$JOB,DFN,TYPE,ID))
SET CNT=CNT+1
+21 SET ^TMP("HMPX",$JOB,DFN,TYPE,ID)=ACT
End DoDot:1
if CNT'<MAX
QUIT
+22 ;final date:seq
SET ^TMP("HMPX",$JOB,0)=D_":"_N
+23 QUIT
+24 ;
DONE() ; -- Return 1 or 0, if loop has finished
+1 ;end of ^XTMP("HMP")
IF IDX'?1"^XTMP(""HMP-"7N.E
QUIT 1
+2 NEW D,N
SET D=+$PIECE(IDX,"-",2)
SET N=+$PIECE(IDX,",",2)
+3 ; check HMP-DATE subscript
+4 ;prior day: keep going
IF D<DT
QUIT 0
+5 ;next day: stop loop
IF D>DT
QUIT 1
+6 ; D=DT: check sequence# subscript
+7 IF N>END
QUIT 1
+8 QUIT 0
