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

HMPUTIL1.m

Go to the documentation of this file. 
  1. HMPUTIL1 ;SLC/AGP,ASMR/RRB,CPC - HMP utilities routine ;May 15, 2016 14:15
  1.  ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,6**;May 15, 2016;Build 3
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1.  ; ADHOC subroutine refactored for DE1788
  1. ADHOC(HMPDMINP,HMPFCNT,DFN) ; Add syncStart metastamp and syncStatus to unsolicited updates
  1.  Q:($G(HMPDMINP)="")!($G(DFN)="")  ; domain and DFN required
  1.  ; HMPFCNT = count of objects, passed by ref.
  1.  ; expects HMPFSTR (set in HMPDJFSG) is ^XTMP freshness stream subscript 
  1.  ; the heading from APIHDR^HMPDJFSG is in ^TMP("HMPF",$J) already
  1.  ; the JSON built here is placed inside a JSON array, with a '[' after the heading
  1.  ;
  1.  N HMPA4JSN,HMPDAT,HMPDMTOT,HMPDOM,HMPID,HMPJSERR,HMPJSON,HMPSUB,I,J,LSTLN,QTE,SUB,X,Y,DELJSON
  1.  N HMPJSNSY
  1.  ; HMPA4JSN, HMPJSON, HMPJSERR - used for JSON encoder
  1.  ; HMPA4JSN - array to encode
  1.  ; HMPJSON - JSON result
  1.  ; HMPJSERR - error text from encoder
  1.  ; QTE - " character
  1.  ; HMPJSNSY - The system id value for the JSON Encoder, If fully numeric it needs a " prepended
  1.  S HMPDAT("DELDATE")="",QTE=$C(34)
  1.  S HMPDMTOT=0  ; domain total
  1.  ; Save delete date/time for later use.
  1.  I $G(ACT)="@" D
  1.  . D  ;DE4307 get from freshness save if available
  1.  ..  I +$G(FILTER("freshnessDateTime")) S HMPDAT("DELDATE")=$$JSONDT^HMPUTILS(FILTER("freshnessDateTime")) Q
  1.  ..  S Y=$$FMTH^XLFDT($P(HMPFSTRM,"~",3))  ; Get the date from fresh stream (HMPFS~<server>~<date>)
  1.  ..  S Y=$$HTFM^XLFDT($P(Y,",")_","_$G(ARGS("hmp-fst"),0))  ; Add delete time stored in ARGS("hmp-fst")
  1.  ..  S HMPDAT("DELDATE")=$$JSONDT^HMPUTILS(Y)  ; delete date/time into JSON format
  1.  . S DELJSON="{""pid"":"""_$$PID^HMPDJFS(DFN)_""",""removed"":""true"",""stampTime"":"_HMPDAT("DELDATE")_",""uid"":"""_$G(HMP97)_"""}"
  1.  ;
  1.  S HMPA4JSN=$NA(^TMP($J,"ARRAY4JSON")) K @HMPA4JSN ; data array for JSON
  1.  S HMPJSON=$NA(^TMP($J,"JSONRESULT")) K @HMPJSON  ; JSON result
  1.  ;
  1.  S HMPDAT("STAMPTIME")=$$EN^HMPSTMP("NOW"),HMPID=$$SYS^HMPUTILS,HMPJSNSY=$S(+HMPID=HMPID:""""_HMPID,1:HMPID)
  1.  ;
  1.  D:DFN'="OPD"  ; get PID data for patient
  1.  .N ITM,VAL  ; $$PIDS returns: ,"pid":"9E4B;3","systemId":"9E4B","localId":"3","icn":"10207V420718"
  1.  .S Y=$$PIDS^HMPDJFS(DFN)  ; parse Y, remove quotes save values in HMPID('item')
  1.  .F J=2:1:$L(Y,",") S X=$P(Y,",",J),ITM=$TR($P(X,":"),QTE),VAL=$TR($P(X,":",2),QTE) S:ITM]"" HMPID(ITM)=VAL
  1.  ;
  1.  ; transform domain name for quick orders to match the uid
  1.  S HMPDOM=HMPDMINP I HMPDOM="quick" S HMPDOM="qo"
  1.  ;
  1.  ; stamp time put into HMPDAT("STAMPTIME")
  1.  S HMPSUB=""
  1.  S HMPDAT("STAMPTIME")=""
  1.  F  S HMPSUB=$O(^TMP("HMP",$J,HMPSUB)) Q:'HMPSUB  D
  1.  .N DONE,HMPN,NEXT,SRCH,HMPDATP ;cpc 2015/10/21
  1.  .S SRCH="""uid"""_":"_""""_"urn:va:"_HMPDOM_":"
  1.  .; Search back from last record - but include start of next to cover crossovers
  1.  .S HMPDAT="" ;cpc 2015/10/21
  1.  .S HMPN="",HMPDAT("UID")="",DONE=""
  1.  .F  S HMPN=$O(^TMP("HMP",$J,HMPSUB,HMPN),-1) Q:'HMPN  D  Q:DONE
  1.  ..S HMPDATP=$E(HMPDAT,1,100) ;cpc 2015/10/21
  1.  ..S HMPDAT=$G(^TMP("HMP",$J,HMPSUB,HMPN)) Q:HMPDAT="null"!'$L(HMPDAT)
  1.  ..S HMPDAT=HMPDAT_HMPDATP ;cpc 2015/10/21 - look for crossover data
  1.  ..;Search for last occurrence of uid in record (this will be parent)
  1.  ..I $G(HMPDAT(HMPSUB,"UID"))="",$F(HMPDAT,SRCH) F I=2:1 S NEXT=$P($P(HMPDAT,SRCH,I),QTE) Q:NEXT=""  S HMPDAT(HMPSUB,"UID")=NEXT ;cpc 2016/09/16
  1.  ..;BL;CPC Extract stamptime if present (patient data ONLY)
  1.  ..;cpc 2015/10/09 - conditionalize tests
  1.  ..I '$G(HMPDAT(HMPSUB,"STAMPTIME")),$F(HMPDAT,"stampTime") D  ;cpc 2015/10/21
  1.  ...S HMPDAT(HMPSUB,"STAMPTIME")=$P($P(HMPDAT,"""stampTime"":",2),",")
  1.  ...;Keep the latest stamptime so that we can use it for the overall metastamp
  1.  ...I HMPDAT(HMPSUB,"STAMPTIME")>HMPDAT("STAMPTIME") S HMPDAT("STAMPTIME")=HMPDAT(HMPSUB,"STAMPTIME")
  1.  ..;Patient data requires both UID and stampTime to be complete
  1.  ..S:$G(HMPDAT(HMPSUB,"UID"))&$G(HMPDAT(HMPSUB,"STAMPTIME")) DONE=1
  1.  ..;cpc 2015/10/09 - end
  1.  ;
  1.  ; HMP97 is uid, SET in FRESHITM^HMPDJFSG
  1.  I $G(ACT)="@" S HMPDAT("UID")=$P($G(HMP97),":",4,99)
  1.  ;
  1.  S @HMPA4JSN@("collection")=$S(DFN="OPD":"OPDsyncStart",1:"syncStart")
  1.  I DFN="OPD" S @HMPA4JSN@("systemId")=$P(HMPID,";") ; set systemId for OPD
  1.  S X="" F  S X=$O(HMPID(X)) Q:X=""  S @HMPA4JSN@(X)=HMPID(X)  ; add pid, systemId, localId, icn
  1.  ;
  1.  ;DE4307 - if stamptime still doesn't exist then get from freshness
  1.  I '+HMPDAT("STAMPTIME"),+$G(FILTER("freshnessDateTime")) S HMPDAT("STAMPTIME")=$$JSONDT^HMPUTILS(FILTER("freshnessDateTime"))
  1.  ; build metastamp components
  1.  S SUB="metaStamp"
  1.  S X="" F  S X=$O(HMPID(X)) Q:X=""  S @HMPA4JSN@(SUB,X)=HMPID(X)  ; add pid, systemId, localId, icn
  1.  S @HMPA4JSN@(SUB,"stampTime")=HMPDAT("STAMPTIME")
  1.  ;
  1.  S SUB(1)="sourceMetaStamp",X=""
  1.  F  S X=$O(HMPID(X)) Q:X=""  S @HMPA4JSN@(SUB,SUB(1),HMPJSNSY,X)=HMPID(X)  ; add pid, systemId, localId, icn ;de4757 use stringed version of system
  1.  S @HMPA4JSN@(SUB,SUB(1),HMPJSNSY,"stampTime")=HMPDAT("STAMPTIME")
  1.  ;
  1.  S SUB(2)="domainMetaStamp"
  1.  S @HMPA4JSN@(SUB,SUB(1),HMPJSNSY,SUB(2),HMPDOM,"domain")=HMPDOM
  1.  S @HMPA4JSN@(SUB,SUB(1),HMPJSNSY,SUB(2),HMPDOM,"stampTime")=$S($L($G(HMPDAT("DELDATE"))):HMPDAT("DELDATE"),1:HMPDAT("STAMPTIME"))
  1.  ;
  1.  ; Loop through HMPSUB to generate the eventMetastamp
  1.  S SUB(3)=$S(DFN="OPD":"itemMetaStamp",1:"eventMetaStamp"),HMPSUB="" ;cpc 2015/10/22
  1.  F  S HMPSUB=$O(HMPDAT(HMPSUB)) Q:'HMPSUB  D
  1.  .S SUB(4)="urn:va:"_HMPDOM_":"_$S($G(ACT)="@":HMPDAT("UID"),1:HMPDAT(HMPSUB,"UID")) ;CPC won't exist for deletion
  1.  .S @HMPA4JSN@(SUB,SUB(1),HMPJSNSY,SUB(2),HMPDOM,SUB(3),SUB(4),"stampTime")=$S($L($G(HMPDAT("DELDATE"))):HMPDAT("DELDATE"),1:HMPDAT(HMPSUB,"STAMPTIME"))
  1.  ;
  1.  D ENCODE^HMPJSON(HMPA4JSN,HMPJSON,"HMPJSERR")
  1.  I $D(HMPJSERR) S $EC=",JSON encode error in unsolicited update," Q
  1.  ; find last line of JSON
  1.  S LSTLN=0 F J=1:1 Q:'$D(@HMPJSON@(J))  S LSTLN=J
  1.  ; Merge in data section from FRESHITM^HMPDJFSG
  1.  ; Add a comma after the syncStart Message for the actual data
  1.  S @HMPJSON@(LSTLN,.3)=","
  1.  S HMPSUB=""
  1.  ;
  1.  ; do the merge
  1.  F  S HMPSUB=$O(^TMP("HMP",$J,HMPSUB)) Q:'HMPSUB  D
  1.  .N HMPX,HMPDATA
  1.  .S LSTLN=LSTLN+1
  1.  .; If it is patient data add the wrapper with pid
  1.  .I DFN'="OPD" S @HMPJSON@(LSTLN,.4)="{""collection"":"""_HMPDOM_""""_$$PIDS^HMPDJFS(DFN)_",""seq"":1,""total"":1,""object"":"_$S($G(ACT)="@":DELJSON,1:"")
  1.  .; If it is operational data add the wrapper without pid
  1.  .I DFN="OPD",$G(ACT)="@" S @HMPJSON@(LSTLN,.4)="{""collection"":"""_HMPDOM_""",""seq"":1,""total"":1,""object"":"_DELJSON ;;US5647
  1.  .; If it is operational data and to be deleted
  1.  .I DFN="OPD",$G(ACT)'="@"  D  ;US5859
  1.  ..S @HMPJSON@(LSTLN,.4)="{""collection"":"""_HMPDOM_""",""seq"":1,""total"":1,""object"":"
  1.  ..S HMPX="""stampTime"":"_QTE_$S($L($G(HMPDAT("DELDATE"))):HMPDAT("DELDATE"),1:HMPDAT("STAMPTIME"))_QTE_","
  1.  ..S HMPDATA=^TMP("HMP",$J,HMPSUB,1)
  1.  ..S ^TMP("HMP",$J,HMPSUB,1)="{"_HMPX_$P(HMPDATA,"{",2,999)
  1.  .M @HMPJSON@(LSTLN)=^TMP("HMP",$J,HMPSUB)
  1.  .; Close the wrapper
  1.  .S HMPCLFLG=1
  1.  .; Add the closing brace for the wrapper
  1.  .S @HMPJSON@(LSTLN+1,.1)="}"
  1.  .; Increment the domain total
  1.  .S HMPDMTOT=HMPDMTOT+1
  1.  ;
  1.  S HMPFCNT=$G(HMPFCNT)+1
  1.  M ^TMP("HMPF",$J,HMPFCNT)=@HMPJSON
  1.  ; need a comma if more than one item
  1.  I HMPFCNT>1 S ^TMP("HMPF",$J,HMPFCNT,.3)=$S(HMPLITEM="SYNC":"},",1:",") S HMPLITEM="FRESH" ; DE3502
  1.  ;
  1.  ; clean up residual data in ^TMP($J), may be quite a lot
  1.  K @HMPA4JSN,@HMPJSON
  1.  Q
  1.  ;