HMPUTIL2 ; Agilex/hrubovcak -- HMP utilities routine ;Jun 10, 2015@15:13:03
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
ADHOC(HMPDMN,HMPFCNT,DFN,UID,STMPTM,DLTFLG) ; Add syncStart metastamp and syncStatus to unsolicited updates
; HMPDMN,HMPFCNT,DFN,UID,STMPTM - all required
; DLTFLG - boolean 1 to delete, zero otherwise (optional)
; requires HMPFSTRM and ARGS in symbol table
Q:($G(HMPDMN)="")!($G(DFN)="")!($G(UID)="")!($G(STMPTM)="")
; set error trap
N $ES,$ET,ERRPAT
S $EC="",$ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
;
S DLTFLG=+$G(DLTFLG) ; optional parameter
;Build SyncStart
N H,HMPDAT,HMPID,HMPJSN,HMPSUB,HMPTOT,HMPVAR,HMPX,HMPZ,JSNERR,STS,STSJSON,X,Y
S HMPSUB=$O(^TMP("HMP",$J,0)) Q:'HMPSUB
S HMPID=$$SYS^HMPUTILS
S HMPZ=0,HMPFCNT=$G(HMPFCNT)+1
D ; start of JSON, based on DFN
.I DFN'="OPD" S HMPJSN="{""collection"":"""_"syncStart"_$C(34)_$$PIDS^HMPDJFS(DFN)_"," Q
.;operational data synch
.S HMPJSN="{""collection"":"""_"OPDsyncStart"_$C(34)_","""_"systemId"":"""_$P(HMPID,";")_$C(34)_","
.Q:'DLTFLG ; deletion logic follows
.S H=$$FMTH^XLFDT($P($G(HMPFSTRM),"~",3)) ; days in $H format
.S X=$$HTFM^XLFDT($P(H,",")_","_(+$G(ARGS("hmp-fst")))) ; add $H seconds or zero, get FileMan date
.S HMPVAR("JSON DEL DATE/TIME")=$$JSONDT^HMPUTILS(X) ; delete date/time into JSON format
.S X=$P($G(UID),":",4)_";"_$P(UID,":",5) ; UID pieces needed below
.S HMPVAR("REMOVED JSON")="{""pid"":"""_X_""",""removed"":""true"",""stampTime"":"_HMPVAR("JSON DEL DATE/TIME")_",""uid"":"""_UID_"""}"
;
S:HMPFCNT>1 HMPJSN="},"_HMPJSN
S HMPJSN=HMPJSN_"""metaStamp"":"_"{"
I DFN'="OPD" S HMPJSN=HMPJSN_$E($$PIDS^HMPDJFS(DFN),2,$L($$PIDS^HMPDJFS(DFN)))_","
S HMPJSN=HMPJSN_"""stampTime"":"""_STMPTM_$C(34)_",""sourceMetaStamp"":"_"{"
S HMPJSN=HMPJSN_$C(34)_$P(HMPID,";")_$C(34)_":{"
I DFN'="OPD" S HMPJSN=HMPJSN_$E($$PIDS^HMPDJFS(DFN),2,$L($$PIDS^HMPDJFS(DFN)))_","
S HMPJSN=HMPJSN_"""stampTime"":"""_STMPTM_$C(34)_","
S HMPJSN=HMPJSN_"""domainMetaStamp"""_":"_"{"
; transform the domain name for quick orders to match the uid
S HMPVAR("DOMAIN")=HMPDMN S:HMPVAR("DOMAIN")="quick" HMPVAR("DOMAIN")="qo"
S HMPTOT=1
S HMPJSN=HMPJSN_$C(34)_HMPVAR("DOMAIN")_$C(34)_":{"
S HMPJSN=HMPJSN_"""domain"":"""_HMPVAR("DOMAIN")_$C(34)_","
S HMPJSN=HMPJSN_"""stampTime"":"""_STMPTM_$C(34)_","
I DFN="OPD" S HMPJSN=HMPJSN_"""itemMetaStamp"""_":"_"{"
E S HMPJSN=HMPJSN_"""eventMetaStamp"""_":"_"{"
;
I $L(HMPJSN)>1000 S HMPZ=HMPZ+1,^TMP("HMPF",$J,HMPFCNT,.3,HMPZ)=HMPJSN,HMPJSN=""
S HMPVAR("DATETIME")=$P(UID,":",4,99)
;I DLTFLG S HMPVAR("DATETIME")=$P(UID,":",4,99))
S HMPJSN=HMPJSN_$C(34)_UID_":"_HMPVAR("DOMAIN")_":"_HMPVAR("DATETIME")_$C(34)_":{"
; determine date/time to use
S Y=STMPTM S:$G(HMPVAR("JSON DEL DATE/TIME")) Y=HMPVAR("JSON DEL DATE/TIME")
S HMPJSN=HMPJSN_"""stampTime"":"""_Y_$C(34)_"}}}," ; put date/time into JSON array
;
I $L(HMPJSN)>1000 S HMPZ=HMPZ+1,^TMP("HMPF",$J,HMPFCNT,.3,HMPZ)=HMPJSN,HMPJSN=""
S HMPZ=HMPZ+1
S HMPJSN=$E(HMPJSN,1,$L(HMPJSN)-1)_"}}}}},"
;Save syncStart
S ^TMP("HMPF",$J,HMPFCNT,.3,HMPZ)=HMPJSN
;Merge in data section from FRESHITM^HMPDJFSG
S HMPSUB=""
F S HMPSUB=$O(^TMP("HMP",$J,HMPSUB)) Q:'HMPSUB D
.S HMPFCNT=HMPFCNT+1
.I DFN'="OPD" S ^TMP("HMPF",$J,HMPFCNT,.3)="{""collection"":"""_HMPVAR("DOMAIN")_$C(34)_$$PIDS^HMPDJFS(DFN)_",""seq"":1,""total"":1,""object"":"
.I DFN="OPD",DLTFLG S ^TMP("HMPF",$J,HMPFCNT,.3)="{""collection"":"""_HMPVAR("DOMAIN")_""",""seq"":1,""total"":1,""object"":"_HMPVAR("REMOVED JSON") ;;US5647
.I DFN="OPD",'DLTFLG D ;US5859
..S ^TMP("HMPF",$J,HMPFCNT,.3)="{""collection"":"""_HMPVAR("DOMAIN")_""",""seq"":1,""total"":1,""object"":"
..S HMPX="""stampTime"":"_$C(34)_STMPTM_$C(34)_","
..S HMPDAT=$G(^TMP("HMP",$J,HMPSUB,1))
..S ^TMP("HMP",$J,HMPSUB,1)="{"_HMPX_$P(HMPDAT,"{",2,999) ; add stamp time to start of data
.; merge into "HMPF" subscript
.M ^TMP("HMPF",$J,HMPFCNT,1)=^TMP("HMP",$J,HMPSUB,1)
;
; Build and add syncStatus
S STS("uid")="urn:va:syncStatus:"_HMPVAR("DATETIME"),STS("initialized")="true"
S STS("domainTotals",HMPVAR("DOMAIN"))=1
D ENCODE^HMPJSON("STS","STSJSON","JSNERR")
I $D(JSNERR) S $EC=",JSON encode error in routine "_$T(+0)_"," Q
S HMPFCNT=HMPFCNT+1
M ^TMP("HMPF",$J,HMPFCNT)=STSJSON
S ^TMP("HMPF",$J,HMPFCNT,.3)=$$WRAP("syncStatus",$$PIDS^HMPDJFS(DFN),1,1)
;
Q
;
WRAP(DOMAIN,PIDS,OFFSET,DOMSIZE) ; function, JSON wrapper
N X S X=""
S:$G(DOMAIN)'="syncStart" X="},{""collection"":"""_$P(DOMAIN,"#")_$C(34)_PIDS
S X=X_","
S:$G(OFFSET)>-1 X=X_"""seq"":"_OFFSET_","
S:$G(DOMSIZE)>-1 X=X_"""total"":"_DOMSIZE_","
S:$G(OFFSET)>-1 X=X_"""object"":"
Q X
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPUTIL2 4805 printed Apr 09, 2024@20:58:51 Page 2
HMPUTIL2 ; Agilex/hrubovcak -- HMP utilities routine ;Jun 10, 2015@15:13:03
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
ADHOC(HMPDMN,HMPFCNT,DFN,UID,STMPTM,DLTFLG) ; Add syncStart metastamp and syncStatus to unsolicited updates
+1 ; HMPDMN,HMPFCNT,DFN,UID,STMPTM - all required
+2 ; DLTFLG - boolean 1 to delete, zero otherwise (optional)
+3 ; requires HMPFSTRM and ARGS in symbol table
+4 if ($GET(HMPDMN)="")!($GET(DFN)="")!($GET(UID)="")!($GET(STMPTM)="")
QUIT
+5 ; set error trap
+6 NEW $ESTACK,$ETRAP,ERRPAT
+7 SET $ECODE=""
SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+8 ;
+9 ; optional parameter
SET DLTFLG=+$GET(DLTFLG)
+10 ;Build SyncStart
+11 NEW H,HMPDAT,HMPID,HMPJSN,HMPSUB,HMPTOT,HMPVAR,HMPX,HMPZ,JSNERR,STS,STSJSON,X,Y
+12 SET HMPSUB=$ORDER(^TMP("HMP",$JOB,0))
if 'HMPSUB
QUIT
+13 SET HMPID=$$SYS^HMPUTILS
+14 SET HMPZ=0
SET HMPFCNT=$GET(HMPFCNT)+1
+15 ; start of JSON, based on DFN
Begin DoDot:1
+16 IF DFN'="OPD"
SET HMPJSN="{""collection"":"""_"syncStart"_$CHAR(34)_$$PIDS^HMPDJFS(DFN)_","
QUIT
+17 ;operational data synch
+18 SET HMPJSN="{""collection"":"""_"OPDsyncStart"_$CHAR(34)_","""_"systemId"":"""_$PIECE(HMPID,";")_$CHAR(34)_","
+19 ; deletion logic follows
if 'DLTFLG
QUIT
+20 ; days in $H format
SET H=$$FMTH^XLFDT($PIECE($GET(HMPFSTRM),"~",3))
+21 ; add $H seconds or zero, get FileMan date
SET X=$$HTFM^XLFDT($PIECE(H,",")_","_(+$GET(ARGS("hmp-fst"))))
+22 ; delete date/time into JSON format
SET HMPVAR("JSON DEL DATE/TIME")=$$JSONDT^HMPUTILS(X)
+23 ; UID pieces needed below
SET X=$PIECE($GET(UID),":",4)_";"_$PIECE(UID,":",5)
+24 SET HMPVAR("REMOVED JSON")="{""pid"":"""_X_""",""removed"":""true"",""stampTime"":"_HMPVAR("JSON DEL DATE/TIME")_",""uid"":"""_UID_"""}"
End DoDot:1
+25 ;
+26 if HMPFCNT>1
SET HMPJSN="},"_HMPJSN
+27 SET HMPJSN=HMPJSN_"""metaStamp"":"_"{"
+28 IF DFN'="OPD"
SET HMPJSN=HMPJSN_$EXTRACT($$PIDS^HMPDJFS(DFN),2,$LENGTH($$PIDS^HMPDJFS(DFN)))_","
+29 SET HMPJSN=HMPJSN_"""stampTime"":"""_STMPTM_$CHAR(34)_",""sourceMetaStamp"":"_"{"
+30 SET HMPJSN=HMPJSN_$CHAR(34)_$PIECE(HMPID,";")_$CHAR(34)_":{"
+31 IF DFN'="OPD"
SET HMPJSN=HMPJSN_$EXTRACT($$PIDS^HMPDJFS(DFN),2,$LENGTH($$PIDS^HMPDJFS(DFN)))_","
+32 SET HMPJSN=HMPJSN_"""stampTime"":"""_STMPTM_$CHAR(34)_","
+33 SET HMPJSN=HMPJSN_"""domainMetaStamp"""_":"_"{"
+34 ; transform the domain name for quick orders to match the uid
+35 SET HMPVAR("DOMAIN")=HMPDMN
if HMPVAR("DOMAIN")="quick"
SET HMPVAR("DOMAIN")="qo"
+36 SET HMPTOT=1
+37 SET HMPJSN=HMPJSN_$CHAR(34)_HMPVAR("DOMAIN")_$CHAR(34)_":{"
+38 SET HMPJSN=HMPJSN_"""domain"":"""_HMPVAR("DOMAIN")_$CHAR(34)_","
+39 SET HMPJSN=HMPJSN_"""stampTime"":"""_STMPTM_$CHAR(34)_","
+40 IF DFN="OPD"
SET HMPJSN=HMPJSN_"""itemMetaStamp"""_":"_"{"
+41 IF '$TEST
SET HMPJSN=HMPJSN_"""eventMetaStamp"""_":"_"{"
+42 ;
+43 IF $LENGTH(HMPJSN)>1000
SET HMPZ=HMPZ+1
SET ^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)=HMPJSN
SET HMPJSN=""
+44 SET HMPVAR("DATETIME")=$PIECE(UID,":",4,99)
+45 ;I DLTFLG S HMPVAR("DATETIME")=$P(UID,":",4,99))
+46 SET HMPJSN=HMPJSN_$CHAR(34)_UID_":"_HMPVAR("DOMAIN")_":"_HMPVAR("DATETIME")_$CHAR(34)_":{"
+47 ; determine date/time to use
+48 SET Y=STMPTM
if $GET(HMPVAR("JSON DEL DATE/TIME"))
SET Y=HMPVAR("JSON DEL DATE/TIME")
+49 ; put date/time into JSON array
SET HMPJSN=HMPJSN_"""stampTime"":"""_Y_$CHAR(34)_"}}},"
+50 ;
+51 IF $LENGTH(HMPJSN)>1000
SET HMPZ=HMPZ+1
SET ^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)=HMPJSN
SET HMPJSN=""
+52 SET HMPZ=HMPZ+1
+53 SET HMPJSN=$EXTRACT(HMPJSN,1,$LENGTH(HMPJSN)-1)_"}}}}},"
+54 ;Save syncStart
+55 SET ^TMP("HMPF",$JOB,HMPFCNT,.3,HMPZ)=HMPJSN
+56 ;Merge in data section from FRESHITM^HMPDJFSG
+57 SET HMPSUB=""
+58 FOR
SET HMPSUB=$ORDER(^TMP("HMP",$JOB,HMPSUB))
if 'HMPSUB
QUIT
Begin DoDot:1
+59 SET HMPFCNT=HMPFCNT+1
+60 IF DFN'="OPD"
SET ^TMP("HMPF",$JOB,HMPFCNT,.3)="{""collection"":"""_HMPVAR("DOMAIN")_$CHAR(34)_$$PIDS^HMPDJFS(DFN)_",""seq"":1,""total"":1,""object"":"
+61 ;;US5647
IF DFN="OPD"
IF DLTFLG
SET ^TMP("HMPF",$JOB,HMPFCNT,.3)="{""collection"":"""_HMPVAR("DOMAIN")_""",""seq"":1,""total"":1,""object"":"_HMPVAR("REMOVED JSON")
+62 ;US5859
IF DFN="OPD"
IF 'DLTFLG
Begin DoDot:2
+63 SET ^TMP("HMPF",$JOB,HMPFCNT,.3)="{""collection"":"""_HMPVAR("DOMAIN")_""",""seq"":1,""total"":1,""object"":"
+64 SET HMPX="""stampTime"":"_$CHAR(34)_STMPTM_$CHAR(34)_","
+65 SET HMPDAT=$GET(^TMP("HMP",$JOB,HMPSUB,1))
+66 ; add stamp time to start of data
SET ^TMP("HMP",$JOB,HMPSUB,1)="{"_HMPX_$PIECE(HMPDAT,"{",2,999)
End DoDot:2
+67 ; merge into "HMPF" subscript
+68 MERGE ^TMP("HMPF",$JOB,HMPFCNT,1)=^TMP("HMP",$JOB,HMPSUB,1)
End DoDot:1
+69 ;
+70 ; Build and add syncStatus
+71 SET STS("uid")="urn:va:syncStatus:"_HMPVAR("DATETIME")
SET STS("initialized")="true"
+72 SET STS("domainTotals",HMPVAR("DOMAIN"))=1
+73 DO ENCODE^HMPJSON("STS","STSJSON","JSNERR")
+74 IF $DATA(JSNERR)
SET $ECODE=",JSON encode error in routine "_$TEXT(+0)_","
QUIT
+75 SET HMPFCNT=HMPFCNT+1
+76 MERGE ^TMP("HMPF",$JOB,HMPFCNT)=STSJSON
+77 SET ^TMP("HMPF",$JOB,HMPFCNT,.3)=$$WRAP("syncStatus",$$PIDS^HMPDJFS(DFN),1,1)
+78 ;
+79 QUIT
+80 ;
WRAP(DOMAIN,PIDS,OFFSET,DOMSIZE) ; function, JSON wrapper
+1 NEW X
SET X=""
+2 if $GET(DOMAIN)'="syncStart"
SET X="},{""collection"":"""_$PIECE(DOMAIN,"#")_$CHAR(34)_PIDS
+3 SET X=X_","
+4 if $GET(OFFSET)>-1
SET X=X_"""seq"":"_OFFSET_","
+5 if $GET(DOMSIZE)>-1
SET X=X_"""total"":"_DOMSIZE_","
+6 if $GET(OFFSET)>-1
SET X=X_"""object"":"
+7 QUIT X
+8 ;
