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

HMPDJX.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^DPT 10035
  1. ; MPIF001 2701
  1. ; XLFSTR 10104
  1. Q
  1. ;
  1. EN(LAST,MAX) ; -- get data from ^XTMP("HMP-<date>",n)
  1. ; Expects HMP=$NA(^TMP("HMP",$J))
  1. ;
  1. N SYS,X,Y,HMPTOTL,DFN,PATCNT,ICN,DOMCNT,TYPE,RTN,HMPLASTI,HMPID,DATA,DELETE,UID,CNT,TSTART,TSTOP
  1. S TSTART=$$NOW^XLFDT()
  1. S LAST=$G(LAST),SYS=$G(FILTER("systemID")) Q:SYS=""
  1. S MAX=$G(MAX,999)
  1. D GETLIST(LAST,SYS,MAX)
  1. ;
  1. S (DFN,PATCNT,HMPTOTL)=0 F S DFN=$O(^TMP("HMPX",$J,DFN)) Q:'(DFN>0) D ;DE4496 19 August 2016
  1. . K ^TMP($J,"HMP ERROR")
  1. . S PATCNT=PATCNT+1,ICN=+$$GETICN^MPIF001(DFN),ERRPAT=DFN
  1. . S DOMCNT=0 K DATA,DELETE
  1. . S TYPE="" F S TYPE=$O(^TMP("HMPX",$J,DFN,TYPE)) Q:TYPE="" D
  1. .. S RTN=$$TAG^HMPDJ(TYPE)_"^HMPDJ0" Q:'$L($T(@RTN))
  1. .. S DOMCNT=DOMCNT+1
  1. .. ;
  1. .. N HMP S HMP=$NA(^TMP("HMP",$J,PATCNT,DOMCNT)),HMPI=0,HMPID=""
  1. .. F S HMPID=$O(^TMP("HMPX",$J,DFN,TYPE,HMPID)) Q:HMPID="" S X=$G(^(HMPID)) D
  1. ... N $ES,$ET,ERRPAT,ERRMSG
  1. ... S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
  1. ... S ERRMSG="A problem occurred when trying to refresh patient data from an API."
  1. ... ;
  1. ... I X="@" D DELETE(TYPE,DFN,HMPID) Q
  1. ... S HMPLASTI=HMPI D @RTN ;creates @HMP@(HMPI+1)
  1. ... ;
  1. ... ; if no new item, assume the record has been deleted
  1. ... I HMPI'>HMPLASTI D DELETE(TYPE,DFN,HMPID) Q
  1. ... S HMPTOTL=HMPTOTL+1,DATA=1
  1. .. I 'HMPI S DOMCNT=DOMCNT-1 Q ;no data, or error
  1. .. ;
  1. .. S:DOMCNT>1 @HMP@(.3)=","
  1. .. S @HMP@(.5)="{""domainName"":"""_TYPE_""",""total"":"_HMPI_",""items"":["
  1. .. S HMPI=HMPI+1,@HMP@(HMPI)="]}"
  1. . ;
  1. A . ; HMP=$NA(^TMP("HMP",$J)) again
  1. . S:PATCNT>1 @HMP@(PATCNT,.3)=","
  1. . S @HMP@(PATCNT,.5)="{""patientDfn"":"_DFN_",""patientIcn"":"""_ICN_""""
  1. . I DOMCNT D
  1. .. S @HMP@(PATCNT,.6)=",""domains"":["
  1. .. S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT)="]"
  1. . ;
  1. . I $D(DELETE) D
  1. .. S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT,.5)=",""deletes"":["
  1. .. S HMPI=0,UID="" F S UID=$O(DELETE(UID)) Q:UID="" D
  1. ... S TYPE=DELETE(UID),HMPI=HMPI+1
  1. ... S:HMPI>1 @HMP@(PATCNT,DOMCNT,HMPI,.3)=","
  1. ... S @HMP@(PATCNT,DOMCNT,HMPI,1)="{""uid"":"""_UID_""",""domainName"":"""_TYPE_"""}"
  1. .. S HMPI=HMPI+1,@HMP@(PATCNT,DOMCNT,HMPI)="]"
  1. . ;
  1. . I $D(^TMP($J,"HMP ERROR")) D
  1. .. N ERROR D BUILDERR^HMPDJ(.ERROR)
  1. .. S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT,.3)=","
  1. .. M @HMP@(PATCNT,DOMCNT)=ERROR
  1. .. K ^TMP($J,"HMP ERROR")
  1. . ;
  1. . S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT)="}"
  1. ;
  1. S Y=$G(^TMP("HMPX",$J,0)) S:Y="" Y=LAST
  1. S T=$$NOW^XLFDT()
  1. S @HMP@(.5)="{""apiVersion"":""1.01"",""data"":{""lastUpdate"":"""_Y_""",""startDateTime"":"""_TSTART_""",""totalPatients"":"_PATCNT
  1. S:PATCNT @HMP@(.6)=",""patients"":[",PATCNT=PATCNT+1,@HMP@(PATCNT)="]"
  1. ;
  1. B ;
  1. I $D(^TMP("HMPX",$J,"OP")) D ;operational data
  1. . S (HMPTOTL,DOMCNT)=0,PATCNT=PATCNT+1 K DATA,DELETE
  1. . S TYPE="" F S TYPE=$O(^TMP("HMPX",$J,"OP",TYPE)) Q:TYPE="" D
  1. .. S RTN=$$TAG^HMPEF(TYPE)_"^HMPEF" Q:'$L($T(@RTN))
  1. .. S DOMCNT=DOMCNT+1,DFN=""
  1. .. ;
  1. .. N HMP S HMP=$NA(^TMP("HMP",$J,PATCNT,DOMCNT)),HMPI=0,HMPID=""
  1. .. F S HMPID=$O(^TMP("HMPX",$J,"OP",TYPE,HMPID)) Q:HMPID="" S X=$G(^(HMPID)) D
  1. ... I X="@" D DELETE(TYPE,DFN,HMPID) Q
  1. ... S HMPLASTI=HMPI D @RTN ;creates @HMP@(HMPI+1)
  1. ... ; if no new item, assume the record has been deleted
  1. ... I HMPI'>HMPLASTI D DELETE(TYPE,DFN,HMPID) Q
  1. ... S HMPTOTL=HMPTOTL+1,DATA=1
  1. .. I 'HMPI S DOMCNT=DOMCNT-1 Q ;no data, or error
  1. .. ;
  1. .. S:DOMCNT>1 @HMP@(.3)=","
  1. .. S @HMP@(.5)="{""domainName"":"""_TYPE_""",""total"":"_HMPI_",""items"":["
  1. .. S HMPI=HMPI+1,@HMP@(HMPI)="]}"
  1. . ;
  1. C . ; HMP=$NA(^TMP("HMP",$J)) again
  1. . I 'DOMCNT,'$D(DELETE) Q ;no data, or error
  1. . S @HMP@(PATCNT,.5)=",""operational"":{"
  1. . I DOMCNT D
  1. .. S @HMP@(PATCNT,.6)="""domains"":["
  1. .. S DOMCNT=DOMCNT+1 S @HMP@(PATCNT,DOMCNT)="]"
  1. . ;
  1. . I $D(DELETE) D
  1. .. S DOMCNT=DOMCNT+1 S:DOMCNT>1 @HMP@(PATCNT,DOMCNT,.3)=","
  1. .. S @HMP@(PATCNT,DOMCNT,.5)="""deletes"":["
  1. .. S HMPI=0,UID="" F S UID=$O(DELETE(UID)) Q:UID="" D
  1. ... S TYPE=DELETE(UID),HMPI=HMPI+1
  1. ... S:HMPI>1 @HMP@(PATCNT,DOMCNT,HMPI,.3)=","
  1. ... S @HMP@(PATCNT,DOMCNT,HMPI,1)="{""uid"":"""_UID_""",""domainName"":"""_TYPE_"""}"
  1. .. S HMPI=HMPI+1,@HMP@(PATCNT,DOMCNT,HMPI)="]"
  1. . ;
  1. . S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT)="}"
  1. ;
  1. S TSTOP=$$NOW^XLFDT()
  1. S PATCNT=PATCNT+1,@HMP@(PATCNT)=",""endDateTime"":"""_TSTOP_"""}}" ;close JSON
  1. K ^TMP("HMPX",$J),^TMP("HMPTEXT",$J)
  1. Q
  1. ;
  1. DELETE(NAME,DFN,ID) ; -- set DELETE nodes
  1. N UID
  1. S UID=$$SETUID^HMPUTILS(NAME,DFN,ID)
  1. S DELETE(UID)=NAME
  1. Q
  1. ;
  1. GETLIST(LAST,SYS,MAX) ; -- build list of updates for client
  1. ; Returns ^TMP("HMPX",$J,0) = last DATE:SEQ included
  1. ; ^TMP("HMPX",$J,DFN,TYPE,ID)=ACT
  1. N DATE,SEQ,DA,END,IDX,X0,DFN,TYPE,ID,ACT,D,N,CNT
  1. K ^TMP("HMPX",$J)
  1. S DATE=+LAST,SEQ=+$P(LAST,":",2),CNT=0
  1. S DA=$$FIND^HMPPATS(SYS) Q:'DA
  1. ;
  1. ; generate list ID, and end point
  1. S D=DT,N=+$O(^XTMP("HMP-"_DT,"A"),-1) ;last entry, as of now
  1. I DATE=DT,SEQ=N S ^TMP("HMPX",$J,0)=LAST Q ;no new items
  1. ;
  1. S IDX=$NA(^XTMP("HMP-"_DATE,SEQ)),END=N ;init loop where left off
  1. F S IDX=$Q(@IDX) Q:$$DONE D Q:CNT'<MAX
  1. . S D=+$P(IDX,"-",2),N=+$P(IDX,",",2)
  1. . S X0=@IDX,DFN=$P(X0,U) S:DFN="" DFN="OP"
  1. . I DFN,'$D(^HMP(800000,"ADFN",DFN,DA)) Q
  1. . S TYPE=$P(X0,U,2),ID=$P(X0,U,3),ACT=$P(X0,U,4)
  1. . I TYPE=""!(ID="") Q ;error
  1. . I TYPE="ROSTER",'$D(^HMP(800000,"AROS",ID,DA)) Q
  1. . S:'$D(^TMP("HMPX",$J,DFN,TYPE,ID)) CNT=CNT+1
  1. . S ^TMP("HMPX",$J,DFN,TYPE,ID)=ACT
  1. S ^TMP("HMPX",$J,0)=D_":"_N ;final date:seq
  1. Q
  1. ;
  1. DONE() ; -- Return 1 or 0, if loop has finished
  1. I IDX'?1"^XTMP(""HMP-"7N.E Q 1 ;end of ^XTMP("HMP")
  1. N D,N S D=+$P(IDX,"-",2),N=+$P(IDX,",",2)
  1. ; check HMP-DATE subscript
  1. I D<DT Q 0 ;prior day: keep going
  1. I D>DT Q 1 ;next day: stop loop
  1. ; D=DT: check sequence# subscript
  1. I N>END Q 1
  1. Q 0