HMPYCSO ;SLC/MJK,ASMR/RRB - Convert system objects utility ;8/2/11 15:29
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
;Per VA Directive 6402, this routine should not be modified.
;
; *S68-JCH* This routine introduced with S68
Q
;
CONV(HMPDATA,HMPCNTS) ; -- execute conversion over a system object type
; input: HMPDATA("type") := object type
; - [ OPD - operational (file #800000.11) | PT - HMP (file #800000.1) / default ]
;
; ("collection") := object collection name as it appears in "C" xref
; - ex. "task"
;
; ("callback") := callback code to execute conversion on single object
; - callback should expect decoded array containing object to convert and IEN of object
; - TAG^ROUTINE
; - ex. TASK^HMPP3I
; - callback must return indicator on how to proceed
; - 1 : update converted object
; - 0 : stop processing this object; no conversion needed
;
; HMPCNTS : returns array of counts related to conversion [optional]
; - closed array reference
; - Counts:
; - HMPTALLY("converted") -> conversion performed
; ("errored") -> errored at some point in process
; ("passed") -> no conversion needed
; ("reviewed") -> count of objects reviewed for conversion
;
N HMPTYPE,HMPCOLL,HMPCB,X,HMPFILE,HMPZCNTS
S HMPTYPE=$G(HMPDATA("type"),"PT")
S HMPCOLL=$G(HMPDATA("collection"))
S HMPCB=$G(HMPDATA("callback"))
;
; - collection name and callback must be defined
I HMPCOLL=""!(HMPCB="") Q
;
I HMPTYPE'="PT",HMPTYPE'="OPD" Q
;
; -- currently only supports PT, as OPD has not been tested
I HMPTYPE'="PT" Q
;
; -- initialize counts
F X="reviewed","errored","converted","passed" S HMPZCNTS(X)=0
;
I HMPTYPE="PT" D
. N DFN,IEN
. S HMPFILE=800000.1
. S DFN=0 F S DFN=$O(^HMP(HMPFILE,"C",DFN)) Q:DFN'>0 D
. . S IEN=0 F S IEN=$O(^HMP(HMPFILE,"C",DFN,HMPCOLL,IEN)) Q:IEN'>0 D CONVOBJ(HMPFILE,IEN,HMPCB)
E D
. N IEN
. S HMPFILE=800000.11
. S IEN=0 F S IEN=$O(^HMP(HMPFILE,"C",HMPCOLL,IEN)) Q:IEN'>0 D CONVOBJ(HMPFILE,IEN,HMPCB)
;
I $G(HMPCNTS)]"" M @HMPCNTS=HMPZCNTS
Q
;
CONVOBJ(HMPFILE,IEN,HMPCB) ; -- convert object
N HMPY,HMPTEMP,ERROR,UID,I,HMP0,HMPCOLL
S HMPY=$NA(^TMP($J,"HMPY"))
S HMPTEMP=$NA(^TMP($J,"HMPTEMP"))
K @HMPY,@HMPTEMP
D TALLY("reviewed")
;
S HMP0=$G(^HMP(HMPFILE,IEN,0))
S HMPCOLL=$P(HMP0,U,3)
S UID=$P(HMP0,U)
I UID="" D ERROR("Error: JSON "_HMPCOLL_" Object (IEN: "_IEN_") missing UID") Q
;
S I=0 F S I=$O(^HMP(HMPFILE,IEN,1,I)) Q:I<1 S X=$G(^(I,0)),@HMPY@(I)=X
;
D DECODE^HMPJSON(HMPY,HMPTEMP,"ERROR")
I $D(ERROR) D ERROR("Error in decoding JSON "_HMPCOLL_" Object (IEN: "_IEN_")") Q
;
; -- execute type conversion callback ; quit if object passed w/o needing conversion
I @("'$$"_HMPCB_"(HMPTEMP,IEN)") D TALLY("passed") Q
;
K @HMPY
D ENCODE^HMPJSON(HMPTEMP,HMPY,"ERROR")
I $D(ERROR) D ERROR("Error in encoding JSON "_HMPCOLL_" object (IEN: "_IEN_")") Q
;
D MES^XPDUTL("Updating "_HMPCOLL_" uid: "_UID)
I '$$UPDATE(HMPFILE,IEN,HMPY) D Q
. D ERROR("Error: Unable to obtain lock on DATA node for JSON "_HMPCOLL_" object (IEN: "_IEN_")")
E D
. D TALLY("converted")
;
K @HMPY,@HMPTEMP
;
Q
;
ERROR(MSG) ; -- write out error message and inc error tally
;D EN^DDIOL(MSG)
D BMES^XPDUTL(MSG)
D TALLY("errored")
Q
;
TALLY(CNTYP) ; -- inc counter
S HMPZCNTS(CNTYP)=$G(HMPZCNTS(CNTYP))+1
Q
;
UPDATE(HMPFILE,DA,JSON) ; -- update DATA wp field on patient object
; input: DA - internal entry number in 800000.1
; JSON - closed array reference for M representation of object
; return: 1 - update successful | 0 - update not successful (unable to obtain lock)
L +^HMP(HMPFILE,DA,1):$S($G(DILOCKTM)>0:DILOCKTM,1:5)
I '$T Q 0
;
N CNT,I,HMPSUB
S CNT=0
; -- derive subfile number
S HMPSUB=HMPFILE_$S(HMPFILE=800000.1:"01",1:"1")
K ^HMP(HMPFILE,DA,1) S ^(1,0)="^"_HMPSUB_"^^"
S I="" F S I=$O(@JSON@(I)) Q:I="" S CNT=CNT+1,^HMP(HMPFILE,DA,1,CNT,0)=@JSON@(I)
I CNT S ^HMP(HMPFILE,DA,1,0)="^800000.101^"_CNT_U_CNT
;
L -^HMP(HMPFILE,DA,1)
Q 1
;
TASKCONV ; -- convert patient task objects
; - converts 'pid' property to SYSID;DFN (ex. F484;237)
; - removes 'patientId' property if it exists
;
N HMPAMS,HMPSTATS
S HMPAMS("type")="PT"
S HMPAMS("collection")="task"
S HMPAMS("callback")="TASKCB^HMPYCSO"
D CONV^HMPYCSO(.HMPAMS,"HMPSTATS")
D BMES^XPDUTL("Task object conversion statistics:")
D MES^XPDUTL(" Reviewed: "_$J($G(HMPSTATS("reviewed")),8))
D MES^XPDUTL(" Passed: "_$J($G(HMPSTATS("passed")),8))
D MES^XPDUTL(" Converted: "_$J($G(HMPSTATS("converted")),8))
D MES^XPDUTL(" Errored: "_$J($G(HMPSTATS("errored")),8))
K HMPB4
Q
;
TASKCB(OBJREF,IEN) ; -- callback that converts a 'task' object's if necessary
; - converts 'pid' property to SYSID;DFN (ex. F484;237)
; - removes 'patientId' property if it exists
;
; input: OBJREF := JSON decoded task object for DATA field in 800000.1
; IEN := internal entry number in 800000.1
;
; return: 1 - task was converted | 0 - no conversion required
;
N HMPOK,DFN,PID
S HMPOK=0
S DFN=+$P($G(^HMP(800000.1,+$G(IEN),0)),"^",2)
I 'DFN Q 0
S PID=$$SYS^HMPUTILS_";"_DFN
; -- if pid different, first kill 'pid' to get rid of possible ...,"pid","\s") node
I $G(@OBJREF@("pid"))'=PID K @OBJREF@("pid") S @OBJREF@("pid")=PID,HMPOK=1
I $D(@OBJREF@("patientId")) K @OBJREF@("patientId") S HMPOK=1
Q HMPOK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPYCSO 6003 printed Nov 22, 2024@17:05:05 Page 2
HMPYCSO ;SLC/MJK,ASMR/RRB - Convert system objects utility ;8/2/11 15:29
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; *S68-JCH* This routine introduced with S68
+5 QUIT
+6 ;
CONV(HMPDATA,HMPCNTS) ; -- execute conversion over a system object type
+1 ; input: HMPDATA("type") := object type
+2 ; - [ OPD - operational (file #800000.11) | PT - HMP (file #800000.1) / default ]
+3 ;
+4 ; ("collection") := object collection name as it appears in "C" xref
+5 ; - ex. "task"
+6 ;
+7 ; ("callback") := callback code to execute conversion on single object
+8 ; - callback should expect decoded array containing object to convert and IEN of object
+9 ; - TAG^ROUTINE
+10 ; - ex. TASK^HMPP3I
+11 ; - callback must return indicator on how to proceed
+12 ; - 1 : update converted object
+13 ; - 0 : stop processing this object; no conversion needed
+14 ;
+15 ; HMPCNTS : returns array of counts related to conversion [optional]
+16 ; - closed array reference
+17 ; - Counts:
+18 ; - HMPTALLY("converted") -> conversion performed
+19 ; ("errored") -> errored at some point in process
+20 ; ("passed") -> no conversion needed
+21 ; ("reviewed") -> count of objects reviewed for conversion
+22 ;
+23 NEW HMPTYPE,HMPCOLL,HMPCB,X,HMPFILE,HMPZCNTS
+24 SET HMPTYPE=$GET(HMPDATA("type"),"PT")
+25 SET HMPCOLL=$GET(HMPDATA("collection"))
+26 SET HMPCB=$GET(HMPDATA("callback"))
+27 ;
+28 ; - collection name and callback must be defined
+29 IF HMPCOLL=""!(HMPCB="")
QUIT
+30 ;
+31 IF HMPTYPE'="PT"
IF HMPTYPE'="OPD"
QUIT
+32 ;
+33 ; -- currently only supports PT, as OPD has not been tested
+34 IF HMPTYPE'="PT"
QUIT
+35 ;
+36 ; -- initialize counts
+37 FOR X="reviewed","errored","converted","passed"
SET HMPZCNTS(X)=0
+38 ;
+39 IF HMPTYPE="PT"
Begin DoDot:1
+40 NEW DFN,IEN
+41 SET HMPFILE=800000.1
+42 SET DFN=0
FOR
SET DFN=$ORDER(^HMP(HMPFILE,"C",DFN))
if DFN'>0
QUIT
Begin DoDot:2
+43 SET IEN=0
FOR
SET IEN=$ORDER(^HMP(HMPFILE,"C",DFN,HMPCOLL,IEN))
if IEN'>0
QUIT
DO CONVOBJ(HMPFILE,IEN,HMPCB)
End DoDot:2
End DoDot:1
+44 IF '$TEST
Begin DoDot:1
+45 NEW IEN
+46 SET HMPFILE=800000.11
+47 SET IEN=0
FOR
SET IEN=$ORDER(^HMP(HMPFILE,"C",HMPCOLL,IEN))
if IEN'>0
QUIT
DO CONVOBJ(HMPFILE,IEN,HMPCB)
End DoDot:1
+48 ;
+49 IF $GET(HMPCNTS)]""
MERGE @HMPCNTS=HMPZCNTS
+50 QUIT
+51 ;
CONVOBJ(HMPFILE,IEN,HMPCB) ; -- convert object
+1 NEW HMPY,HMPTEMP,ERROR,UID,I,HMP0,HMPCOLL
+2 SET HMPY=$NAME(^TMP($JOB,"HMPY"))
+3 SET HMPTEMP=$NAME(^TMP($JOB,"HMPTEMP"))
+4 KILL @HMPY,@HMPTEMP
+5 DO TALLY("reviewed")
+6 ;
+7 SET HMP0=$GET(^HMP(HMPFILE,IEN,0))
+8 SET HMPCOLL=$PIECE(HMP0,U,3)
+9 SET UID=$PIECE(HMP0,U)
+10 IF UID=""
DO ERROR("Error: JSON "_HMPCOLL_" Object (IEN: "_IEN_") missing UID")
QUIT
+11 ;
+12 SET I=0
FOR
SET I=$ORDER(^HMP(HMPFILE,IEN,1,I))
if I<1
QUIT
SET X=$GET(^(I,0))
SET @HMPY@(I)=X
+13 ;
+14 DO DECODE^HMPJSON(HMPY,HMPTEMP,"ERROR")
+15 IF $DATA(ERROR)
DO ERROR("Error in decoding JSON "_HMPCOLL_" Object (IEN: "_IEN_")")
QUIT
+16 ;
+17 ; -- execute type conversion callback ; quit if object passed w/o needing conversion
+18 IF @("'$$"_HMPCB_"(HMPTEMP,IEN)")
DO TALLY("passed")
QUIT
+19 ;
+20 KILL @HMPY
+21 DO ENCODE^HMPJSON(HMPTEMP,HMPY,"ERROR")
+22 IF $DATA(ERROR)
DO ERROR("Error in encoding JSON "_HMPCOLL_" object (IEN: "_IEN_")")
QUIT
+23 ;
+24 DO MES^XPDUTL("Updating "_HMPCOLL_" uid: "_UID)
+25 IF '$$UPDATE(HMPFILE,IEN,HMPY)
Begin DoDot:1
+26 DO ERROR("Error: Unable to obtain lock on DATA node for JSON "_HMPCOLL_" object (IEN: "_IEN_")")
End DoDot:1
QUIT
+27 IF '$TEST
Begin DoDot:1
+28 DO TALLY("converted")
End DoDot:1
+29 ;
+30 KILL @HMPY,@HMPTEMP
+31 ;
+32 QUIT
+33 ;
ERROR(MSG) ; -- write out error message and inc error tally
+1 ;D EN^DDIOL(MSG)
+2 DO BMES^XPDUTL(MSG)
+3 DO TALLY("errored")
+4 QUIT
+5 ;
TALLY(CNTYP) ; -- inc counter
+1 SET HMPZCNTS(CNTYP)=$GET(HMPZCNTS(CNTYP))+1
+2 QUIT
+3 ;
UPDATE(HMPFILE,DA,JSON) ; -- update DATA wp field on patient object
+1 ; input: DA - internal entry number in 800000.1
+2 ; JSON - closed array reference for M representation of object
+3 ; return: 1 - update successful | 0 - update not successful (unable to obtain lock)
+4 LOCK +^HMP(HMPFILE,DA,1):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
+5 IF '$TEST
QUIT 0
+6 ;
+7 NEW CNT,I,HMPSUB
+8 SET CNT=0
+9 ; -- derive subfile number
+10 SET HMPSUB=HMPFILE_$SELECT(HMPFILE=800000.1:"01",1:"1")
+11 KILL ^HMP(HMPFILE,DA,1)
SET ^(1,0)="^"_HMPSUB_"^^"
+12 SET I=""
FOR
SET I=$ORDER(@JSON@(I))
if I=""
QUIT
SET CNT=CNT+1
SET ^HMP(HMPFILE,DA,1,CNT,0)=@JSON@(I)
+13 IF CNT
SET ^HMP(HMPFILE,DA,1,0)="^800000.101^"_CNT_U_CNT
+14 ;
+15 LOCK -^HMP(HMPFILE,DA,1)
+16 QUIT 1
+17 ;
TASKCONV ; -- convert patient task objects
+1 ; - converts 'pid' property to SYSID;DFN (ex. F484;237)
+2 ; - removes 'patientId' property if it exists
+3 ;
+4 NEW HMPAMS,HMPSTATS
+5 SET HMPAMS("type")="PT"
+6 SET HMPAMS("collection")="task"
+7 SET HMPAMS("callback")="TASKCB^HMPYCSO"
+8 DO CONV^HMPYCSO(.HMPAMS,"HMPSTATS")
+9 DO BMES^XPDUTL("Task object conversion statistics:")
+10 DO MES^XPDUTL(" Reviewed: "_$JUSTIFY($GET(HMPSTATS("reviewed")),8))
+11 DO MES^XPDUTL(" Passed: "_$JUSTIFY($GET(HMPSTATS("passed")),8))
+12 DO MES^XPDUTL(" Converted: "_$JUSTIFY($GET(HMPSTATS("converted")),8))
+13 DO MES^XPDUTL(" Errored: "_$JUSTIFY($GET(HMPSTATS("errored")),8))
+14 KILL HMPB4
+15 QUIT
+16 ;
TASKCB(OBJREF,IEN) ; -- callback that converts a 'task' object's if necessary
+1 ; - converts 'pid' property to SYSID;DFN (ex. F484;237)
+2 ; - removes 'patientId' property if it exists
+3 ;
+4 ; input: OBJREF := JSON decoded task object for DATA field in 800000.1
+5 ; IEN := internal entry number in 800000.1
+6 ;
+7 ; return: 1 - task was converted | 0 - no conversion required
+8 ;
+9 NEW HMPOK,DFN,PID
+10 SET HMPOK=0
+11 SET DFN=+$PIECE($GET(^HMP(800000.1,+$GET(IEN),0)),"^",2)
+12 IF 'DFN
QUIT 0
+13 SET PID=$$SYS^HMPUTILS_";"_DFN
+14 ; -- if pid different, first kill 'pid' to get rid of possible ...,"pid","\s") node
+15 IF $GET(@OBJREF@("pid"))'=PID
KILL @OBJREF@("pid")
SET @OBJREF@("pid")=PID
SET HMPOK=1
+16 IF $DATA(@OBJREF@("patientId"))
KILL @OBJREF@("patientId")
SET HMPOK=1
+17 QUIT HMPOK
