HMPDCRC ;SLC/MKB,AGP,ASMR/RRB,BL - Compute CRC32 for VistA data;Aug 29, 2016 20:06:27
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,3**;May 15, 2016;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^DPT 10035
; %ZTLOAD 10063
; MPIF001 2701
; XLFCRC 3156
; XLFDT 10103
Q
;
CHECK(HMPCRC,FILTER) ; -- Return CRC32 checksums of VistA data
; RPC = HMP GET CHECKSUM
; where FILTER("system") = name of calling/client system
; FILTER("patientId") = DFN or DFN;ICN
; FILTER("domain") = name of desired data type (see HMPDJ0)
; FILTER("uid") = single item id to return [opt]
; FILTER("start") = start date.time of search [opt]
; FILTER("stop") = stop date.time of search [opt]
; FILTER("queued") = true or false
;
; HMPCRC returns the name of the ^TMP array containing the results
;
N DFN,NODE,QUEUED,SYS,HMPSYS
K ^TMP("HMPDCRC",$J),HMPCRC
S SYS=$G(FILTER("system")) I SYS="" Q
S DFN=$G(FILTER("patientId")) I DFN="" Q
S QUEUED=$G(FILTER("queued"))
S NODE="HMPDCRC "_SYS_"-"_"-"_DFN
S FILTER("node")=NODE
S HMPSYS=$$SYS^HMPUTILS
;
; - if not queued, generate checksums and exit w/values in ^TMP
I QUEUED'="true" D Q
. S ^XTMP(NODE,0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"Checksum for Server "_SYS_" patient "_DFN
. D EN(.FILTER)
. M ^TMP("HMPDCRC",$J)=^XTMP(NODE,"data")
. S HMPCRC=$NA(^TMP("HMPDCRC",$J))
. K ^XTMP(NODE)
;
; - Queue job if not started, else return data if done
I +$G(^XTMP(NODE,"start"))=0 D QUEUED(.FILTER,NODE,SYS,DFN) Q
I +$G(^XTMP(NODE,"stop"))>0 D K ^XTMP(NODE)
. I $G(^XTMP(NODE,"error"))'="" S HMPCRC=^XTMP(NODE,"error") Q
. S HMPCRC=$NA(^TMP("HMPDCRC",$J))
. M ^TMP("HMPDCRC",$J)=^XTMP(NODE,"data")
Q
;
QUEUED(FILTER,NODE,SYS,DFN) ; -- start job to generate checksums
N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
S ^XTMP(NODE,0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"Checksum for Server "_SYS_" patient "_DFN
S ZTRTN="EN1^HMPDCRC",ZTDESC="Patient Checksum Extract for "_DFN
S ZTDTH=$$NOW^XLFDT(),ZTIO="",ZTSAVE("FILTER(")=""
S ^XTMP(NODE,"start")=$$NOW^XLFDT()
D ^%ZTLOAD I +$G(ZTSK)>0 S ^XTMP(NODE,"task")=+$G(ZTSK) Q ;success
S ^XTMP(NODE,"error")="Cannot start a task job"
S ^XTMP(NODE,"stop")=$$NOW^XLFDT()
S ^XTMP(NODE,"task")=ZTSK
Q
;
EN(FILTER) ; -- Return CRC values of requested data in ^XTMP(node,"data") as JSON
EN1 ; [entry point for queued job]
;
N ICN,DFN,NODE,UID,HMPP,TYPE,HMPTN,CRC
N HMPCRC,HMPSTART,HMPSTOP,HMPMAX,HMPI,HMPID,HMPTYPE ;for HMPDJ0
K ^TMP("HMPCRC",$J),^TMP("HMPCRCF",$J)
;
; parse & validate input parameters
S DFN=$G(FILTER("patientId")),HMPCRC=""
S ICN=+$P($G(DFN),";",2),DFN=+$G(DFN)
;DE4496 on next 2 lines, 19 August 2016
I '(DFN>0),ICN S DFN=+$$GETDFN^MPIF001(ICN)
I '(DFN>0)!'$D(^DPT(DFN)) D LOGDPT^HMPLOG(DFN) Q ;ICR 10035 DE 2818 ASF 11/2/15
S NODE=$G(FILTER("node")) I NODE="" S NODE="HMPDCRC"
;
S HMPMAX=9999,HMPI=0 ;for HMPDJ0
S HMPSTART=+$G(FILTER("start"),1410102)
S HMPSTOP=+$G(FILTER("stop"),4141015)
S UID=$G(FILTER("uid")),HMPTYPE=$G(FILTER("domain"))
I $L(UID) S HMPTYPE=$P(UID,":",3),HMPID=$P(UID,":",6)
E S:HMPTYPE="" HMPTYPE=$$ALL
;
F HMPP=1:1:$L(HMPTYPE,";") S TYPE=$P(HMPTYPE,";",HMPP) I $L(TYPE) D
. S HMPTN=$$TAG^HMPDJ(TYPE)_"^HMPDJ0" Q:'$L($T(@HMPTN))
. D @HMPTN
;
I $L(UID) D G ENQ ;single item
. S CRC=$G(^TMP("HMPCRC",$J,HMPTYPE,UID))
. S ^XTMP(NODE,"data",1)=CRC,^XTMP(NODE,"stop")=$$NOW^XLFDT()
; generate checksum for each domain requested
S TYPE="" F S TYPE=$O(^TMP("HMPCRC",$J,TYPE)) Q:TYPE="" D
. S CRC="" D GET($NA(^TMP("HMPCRC",$J,TYPE)),.CRC)
. S ^TMP("HMPCRC",$J,TYPE)=CRC
I $L(HMPTYPE,";")>1 D ;get whole-chart checksum
. S CRC="" D GET($NA(^TMP("HMPCRC",$J)),.CRC)
. S ^TMP("HMPCRC",$J,"patient")=CRC
;
ENCODE ; -- return list(s) of checksums as JSON
D PREP
D ENCODE^HMPJSON($NA(^TMP("HMPCRCF",$J)),$NA(^XTMP(NODE,"data")),"ERROR")
S ^XTMP(NODE,"stop")=$$NOW^XLFDT()
;
ENQ K ^TMP("HMPCRC",$J),^TMP("HMPCRCF",$J)
Q
;
PREP ; -- reformat ^TMP("HMPCRC",$J) for JSON utility -> ^TMP("HMPCRCF",$J)
N DCNT,DOMAIN,UID,UCNT
S DOMAIN="",DCNT=0
F S DOMAIN=$O(^TMP("HMPCRC",$J,DOMAIN)) Q:DOMAIN="" D
. S ^TMP("HMPCRCF",$J,DOMAIN,"crc")=^TMP("HMPCRC",$J,DOMAIN)
. S UCNT=0,UID="" F S UID=$O(^TMP("HMPCRC",$J,DOMAIN,UID)) Q:UID="" D
.. S UCNT=UCNT+1,^TMP("HMPCRCF",$J,DOMAIN,"uids",UCNT,UID)=^TMP("HMPCRC",$J,DOMAIN,UID)
Q
;
GET(LIST,CRC) ; -- compute CRC32 value for LIST of strings
N I S CRC=$G(CRC),I=""
F S I=$O(@LIST@(I)) Q:I="" I $G(@LIST@(I))'="" S CRC=$$CRC32^XLFCRC(I_":"_@LIST@(I),CRC)
Q
;
ONE(ARRAY,COLL) ; -- process one data item [save result in ^TMP]
N LIST,UID,ATTR,CRC
S LIST=$$ATTR(COLL),UID=$G(@ARRAY@("uid")) Q:UID=""
S ATTR="" F S ATTR=$O(@ARRAY@(ATTR)) Q:ATTR="" I LIST'[(U_ATTR_U) K @ARRAY@(ATTR)
D GET(ARRAY,.CRC)
S ^TMP("HMPCRC",$J,COLL,UID)=CRC
S HMPI=HMPI+1
Q
;
GET1(ARRAY,COLL) ; -- process one data item [return result]
N LIST,ATTR,ITEM,CRC
S LIST=$$ATTR(COLL)
S ATTR="" F S ATTR=$O(@ARRAY@(ATTR)) Q:ATTR="" I LIST[(U_ATTR_U) S ITEM(ATTR)=@ARRAY@(ATTR)
D GET(ITEM,.CRC)
Q CRC
;
ALL() ; -- return string for all types of data
Q "problem;allergy;consult;vital;lab;procedure;obs;order;treatment;med;ptf;factor;immunization;exam;cpt;education;pov;skin;image;appointment;surgery;document;visit;mh"
;
ATTR(X) ; -- return list of attributes needed for collection X
N Y S Y=""
I X="vital" S Y="^observed^typeName^result^"
I X="problem" S Y="^onset^problemText^statusName^"
I X="allergy" S Y="^entered^summary^"
I X="order" S Y="^start^name^statusName^"
I X="treatment" S Y="^start^name^statusName^"
I X="med" S Y="^overallstart^name^vaStatus^"
I X="consult" S Y="^startDate^typeName^statusName^"
I X="procedure" S Y="^dateTime^name^statusName^"
I X="obs" S Y="^observed^typeName^result^"
I X="lab" S Y="^observed^typeName^"
I X="image" S Y="^dateTime^name^statusName^"
I X="surgery" S Y="^dateTime^typeName^statusName^"
I X="document" S Y="^referenceDateTime^localTitle^statusName^"
I X="mh" S Y="^administeredDateTime^name^"
I X="immunization" S Y="^administeredDateTime^name^"
I X="pov" S Y="^entered^name^"
I X="skin" S Y="^entered^name^result^"
I X="exam" S Y="^entered^name^result^"
I X="cpt" S Y="^entered^name^"
I X="education" S Y="^entered^name^result^"
I X="factor" S Y="^entered^name^"
I X="appointment" S Y="^dateTime^typeName^appointmentStatus^"
I X="visit" S Y="^dateTime^typeName^"
I X="ptf" S Y="^arrivalDateTime^icdCode^"
Q Y
;
;
TEST(FILTER) ;
N DONE,OUT
S DONE=0
F D Q:DONE=1
.D CHECK(.OUT,.FILTER)
.H 1 W !,$D(OUT)
.I $D(OUT)>0 S DONE=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDCRC 7128 printed Apr 09, 2024@20:58:46 Page 2
HMPDCRC ;SLC/MKB,AGP,ASMR/RRB,BL - Compute CRC32 for VistA data;Aug 29, 2016 20:06:27
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,3**;May 15, 2016;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^DPT 10035
+7 ; %ZTLOAD 10063
+8 ; MPIF001 2701
+9 ; XLFCRC 3156
+10 ; XLFDT 10103
+11 QUIT
+12 ;
CHECK(HMPCRC,FILTER) ; -- Return CRC32 checksums of VistA data
+1 ; RPC = HMP GET CHECKSUM
+2 ; where FILTER("system") = name of calling/client system
+3 ; FILTER("patientId") = DFN or DFN;ICN
+4 ; FILTER("domain") = name of desired data type (see HMPDJ0)
+5 ; FILTER("uid") = single item id to return [opt]
+6 ; FILTER("start") = start date.time of search [opt]
+7 ; FILTER("stop") = stop date.time of search [opt]
+8 ; FILTER("queued") = true or false
+9 ;
+10 ; HMPCRC returns the name of the ^TMP array containing the results
+11 ;
+12 NEW DFN,NODE,QUEUED,SYS,HMPSYS
+13 KILL ^TMP("HMPDCRC",$JOB),HMPCRC
+14 SET SYS=$GET(FILTER("system"))
IF SYS=""
QUIT
+15 SET DFN=$GET(FILTER("patientId"))
IF DFN=""
QUIT
+16 SET QUEUED=$GET(FILTER("queued"))
+17 SET NODE="HMPDCRC "_SYS_"-"_"-"_DFN
+18 SET FILTER("node")=NODE
+19 SET HMPSYS=$$SYS^HMPUTILS
+20 ;
+21 ; - if not queued, generate checksums and exit w/values in ^TMP
+22 IF QUEUED'="true"
Begin DoDot:1
+23 SET ^XTMP(NODE,0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"Checksum for Server "_SYS_" patient "_DFN
+24 DO EN(.FILTER)
+25 MERGE ^TMP("HMPDCRC",$JOB)=^XTMP(NODE,"data")
+26 SET HMPCRC=$NAME(^TMP("HMPDCRC",$JOB))
+27 KILL ^XTMP(NODE)
End DoDot:1
QUIT
+28 ;
+29 ; - Queue job if not started, else return data if done
+30 IF +$GET(^XTMP(NODE,"start"))=0
DO QUEUED(.FILTER,NODE,SYS,DFN)
QUIT
+31 IF +$GET(^XTMP(NODE,"stop"))>0
Begin DoDot:1
+32 IF $GET(^XTMP(NODE,"error"))'=""
SET HMPCRC=^XTMP(NODE,"error")
QUIT
+33 SET HMPCRC=$NAME(^TMP("HMPDCRC",$JOB))
+34 MERGE ^TMP("HMPDCRC",$JOB)=^XTMP(NODE,"data")
End DoDot:1
KILL ^XTMP(NODE)
+35 QUIT
+36 ;
QUEUED(FILTER,NODE,SYS,DFN) ; -- start job to generate checksums
+1 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
+2 SET ^XTMP(NODE,0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"Checksum for Server "_SYS_" patient "_DFN
+3 SET ZTRTN="EN1^HMPDCRC"
SET ZTDESC="Patient Checksum Extract for "_DFN
+4 SET ZTDTH=$$NOW^XLFDT()
SET ZTIO=""
SET ZTSAVE("FILTER(")=""
+5 SET ^XTMP(NODE,"start")=$$NOW^XLFDT()
+6 ;success
DO ^%ZTLOAD
IF +$GET(ZTSK)>0
SET ^XTMP(NODE,"task")=+$GET(ZTSK)
QUIT
+7 SET ^XTMP(NODE,"error")="Cannot start a task job"
+8 SET ^XTMP(NODE,"stop")=$$NOW^XLFDT()
+9 SET ^XTMP(NODE,"task")=ZTSK
+10 QUIT
+11 ;
EN(FILTER) ; -- Return CRC values of requested data in ^XTMP(node,"data") as JSON
EN1 ; [entry point for queued job]
+1 ;
+2 NEW ICN,DFN,NODE,UID,HMPP,TYPE,HMPTN,CRC
+3 ;for HMPDJ0
NEW HMPCRC,HMPSTART,HMPSTOP,HMPMAX,HMPI,HMPID,HMPTYPE
+4 KILL ^TMP("HMPCRC",$JOB),^TMP("HMPCRCF",$JOB)
+5 ;
+6 ; parse & validate input parameters
+7 SET DFN=$GET(FILTER("patientId"))
SET HMPCRC=""
+8 SET ICN=+$PIECE($GET(DFN),";",2)
SET DFN=+$GET(DFN)
+9 ;DE4496 on next 2 lines, 19 August 2016
+10 IF '(DFN>0)
IF ICN
SET DFN=+$$GETDFN^MPIF001(ICN)
+11 ;ICR 10035 DE 2818 ASF 11/2/15
IF '(DFN>0)!'$DATA(^DPT(DFN))
DO LOGDPT^HMPLOG(DFN)
QUIT
+12 SET NODE=$GET(FILTER("node"))
IF NODE=""
SET NODE="HMPDCRC"
+13 ;
+14 ;for HMPDJ0
SET HMPMAX=9999
SET HMPI=0
+15 SET HMPSTART=+$GET(FILTER("start"),1410102)
+16 SET HMPSTOP=+$GET(FILTER("stop"),4141015)
+17 SET UID=$GET(FILTER("uid"))
SET HMPTYPE=$GET(FILTER("domain"))
+18 IF $LENGTH(UID)
SET HMPTYPE=$PIECE(UID,":",3)
SET HMPID=$PIECE(UID,":",6)
+19 IF '$TEST
if HMPTYPE=""
SET HMPTYPE=$$ALL
+20 ;
+21 FOR HMPP=1:1:$LENGTH(HMPTYPE,";")
SET TYPE=$PIECE(HMPTYPE,";",HMPP)
IF $LENGTH(TYPE)
Begin DoDot:1
+22 SET HMPTN=$$TAG^HMPDJ(TYPE)_"^HMPDJ0"
if '$LENGTH($TEXT(@HMPTN))
QUIT
+23 DO @HMPTN
End DoDot:1
+24 ;
+25 ;single item
IF $LENGTH(UID)
Begin DoDot:1
+26 SET CRC=$GET(^TMP("HMPCRC",$JOB,HMPTYPE,UID))
+27 SET ^XTMP(NODE,"data",1)=CRC
SET ^XTMP(NODE,"stop")=$$NOW^XLFDT()
End DoDot:1
GOTO ENQ
+28 ; generate checksum for each domain requested
+29 SET TYPE=""
FOR
SET TYPE=$ORDER(^TMP("HMPCRC",$JOB,TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+30 SET CRC=""
DO GET($NAME(^TMP("HMPCRC",$JOB,TYPE)),.CRC)
+31 SET ^TMP("HMPCRC",$JOB,TYPE)=CRC
End DoDot:1
+32 ;get whole-chart checksum
IF $LENGTH(HMPTYPE,";")>1
Begin DoDot:1
+33 SET CRC=""
DO GET($NAME(^TMP("HMPCRC",$JOB)),.CRC)
+34 SET ^TMP("HMPCRC",$JOB,"patient")=CRC
End DoDot:1
+35 ;
ENCODE ; -- return list(s) of checksums as JSON
+1 DO PREP
+2 DO ENCODE^HMPJSON($NAME(^TMP("HMPCRCF",$JOB)),$NAME(^XTMP(NODE,"data")),"ERROR")
+3 SET ^XTMP(NODE,"stop")=$$NOW^XLFDT()
+4 ;
ENQ KILL ^TMP("HMPCRC",$JOB),^TMP("HMPCRCF",$JOB)
+1 QUIT
+2 ;
PREP ; -- reformat ^TMP("HMPCRC",$J) for JSON utility -> ^TMP("HMPCRCF",$J)
+1 NEW DCNT,DOMAIN,UID,UCNT
+2 SET DOMAIN=""
SET DCNT=0
+3 FOR
SET DOMAIN=$ORDER(^TMP("HMPCRC",$JOB,DOMAIN))
if DOMAIN=""
QUIT
Begin DoDot:1
+4 SET ^TMP("HMPCRCF",$JOB,DOMAIN,"crc")=^TMP("HMPCRC",$JOB,DOMAIN)
+5 SET UCNT=0
SET UID=""
FOR
SET UID=$ORDER(^TMP("HMPCRC",$JOB,DOMAIN,UID))
if UID=""
QUIT
Begin DoDot:2
+6 SET UCNT=UCNT+1
SET ^TMP("HMPCRCF",$JOB,DOMAIN,"uids",UCNT,UID)=^TMP("HMPCRC",$JOB,DOMAIN,UID)
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
GET(LIST,CRC) ; -- compute CRC32 value for LIST of strings
+1 NEW I
SET CRC=$GET(CRC)
SET I=""
+2 FOR
SET I=$ORDER(@LIST@(I))
if I=""
QUIT
IF $GET(@LIST@(I))'=""
SET CRC=$$CRC32^XLFCRC(I_":"_@LIST@(I),CRC)
+3 QUIT
+4 ;
ONE(ARRAY,COLL) ; -- process one data item [save result in ^TMP]
+1 NEW LIST,UID,ATTR,CRC
+2 SET LIST=$$ATTR(COLL)
SET UID=$GET(@ARRAY@("uid"))
if UID=""
QUIT
+3 SET ATTR=""
FOR
SET ATTR=$ORDER(@ARRAY@(ATTR))
if ATTR=""
QUIT
IF LIST'[(U_ATTR_U)
KILL @ARRAY@(ATTR)
+4 DO GET(ARRAY,.CRC)
+5 SET ^TMP("HMPCRC",$JOB,COLL,UID)=CRC
+6 SET HMPI=HMPI+1
+7 QUIT
+8 ;
GET1(ARRAY,COLL) ; -- process one data item [return result]
+1 NEW LIST,ATTR,ITEM,CRC
+2 SET LIST=$$ATTR(COLL)
+3 SET ATTR=""
FOR
SET ATTR=$ORDER(@ARRAY@(ATTR))
if ATTR=""
QUIT
IF LIST[(U_ATTR_U)
SET ITEM(ATTR)=@ARRAY@(ATTR)
+4 DO GET(ITEM,.CRC)
+5 QUIT CRC
+6 ;
ALL() ; -- return string for all types of data
+1 QUIT "problem;allergy;consult;vital;lab;procedure;obs;order;treatment;med;ptf;factor;immunization;exam;cpt;education;pov;skin;image;appointment;surgery;document;visit;mh"
+2 ;
ATTR(X) ; -- return list of attributes needed for collection X
+1 NEW Y
SET Y=""
+2 IF X="vital"
SET Y="^observed^typeName^result^"
+3 IF X="problem"
SET Y="^onset^problemText^statusName^"
+4 IF X="allergy"
SET Y="^entered^summary^"
+5 IF X="order"
SET Y="^start^name^statusName^"
+6 IF X="treatment"
SET Y="^start^name^statusName^"
+7 IF X="med"
SET Y="^overallstart^name^vaStatus^"
+8 IF X="consult"
SET Y="^startDate^typeName^statusName^"
+9 IF X="procedure"
SET Y="^dateTime^name^statusName^"
+10 IF X="obs"
SET Y="^observed^typeName^result^"
+11 IF X="lab"
SET Y="^observed^typeName^"
+12 IF X="image"
SET Y="^dateTime^name^statusName^"
+13 IF X="surgery"
SET Y="^dateTime^typeName^statusName^"
+14 IF X="document"
SET Y="^referenceDateTime^localTitle^statusName^"
+15 IF X="mh"
SET Y="^administeredDateTime^name^"
+16 IF X="immunization"
SET Y="^administeredDateTime^name^"
+17 IF X="pov"
SET Y="^entered^name^"
+18 IF X="skin"
SET Y="^entered^name^result^"
+19 IF X="exam"
SET Y="^entered^name^result^"
+20 IF X="cpt"
SET Y="^entered^name^"
+21 IF X="education"
SET Y="^entered^name^result^"
+22 IF X="factor"
SET Y="^entered^name^"
+23 IF X="appointment"
SET Y="^dateTime^typeName^appointmentStatus^"
+24 IF X="visit"
SET Y="^dateTime^typeName^"
+25 IF X="ptf"
SET Y="^arrivalDateTime^icdCode^"
+26 QUIT Y
+27 ;
+28 ;
TEST(FILTER) ;
+1 NEW DONE,OUT
+2 SET DONE=0
+3 FOR
Begin DoDot:1
+4 DO CHECK(.OUT,.FILTER)
+5 HANG 1
WRITE !,$DATA(OUT)
+6 IF $DATA(OUT)>0
SET DONE=1
End DoDot:1
if DONE=1
QUIT
+7 QUIT
