HMPPARAM ;SLC/AGP,ASMR/RRB,CK - Parameter routine;May 15, 2016 14:15
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1**;May 15, 2016;Build 4
;Per VA Directive 6402, this routine should not be modified.
;
; DE2818 - SQA findings. Newed HMPAR in GETPARAM +1. RRB - 10/27/2015
; External References DBIA#
; ------------------- -----
; ^XTV(8989.51 2992
;
Q
;
BLDENT(UID,ENTITY) ;
;urn:va:param:F484:1120:HMP USER PREF
;urn:va:param:F484:1120:HMP ROSTER PREF:13
;urn:va:param:F484:SYS:HMP USER PREF
S ENTITY("uid")=UID
I +$P(UID,":",5)>0 D Q
.S ENTITY("entity")="USR"
.S ENTITY("entityId")=$P(UID,":",5)
S ENTITY("entity")="SYS"
Q
;
BUILDUID(VALUES,TYPE,ID) ;
N DOMAIN
S DOMAIN=$$SYS^HMPUTILS
S VALUES("uid")="urn:va:"_TYPE_":"_DOMAIN_":"_ID
Q
;
DELPARAM(RESULT,UID) ;
N ARRAY,ENT,ENTITY,ENTVALUE,ERR,STR,HMPERR
D BLDENT(UID,.ARRAY)
;delete old parameter
S ENTITY=ARRAY("entity")
S ENTVALUE=ARRAY("entityId")
S ENT=$S($G(ENTVALUE)>0:ENTITY_".`"_ENTVALUE,1:ENTITY)
I $G(ARRAY("uid"))="" Q
I $G(ENT)="" Q
D DEL^XPAR(ENT,"HMP PARAMETERS",ARRAY("uid"),.HMPERR)
Q
;
GETALPAR(JSONRES,ENTITY,ENTVALUE,RETVALUE) ;
N CNT,DECODE,ENT,GETVAL,INST,PARAM,RESULT,HMPERR,HMPLIST
S ENT=$S($G(ENTVALUE)'="":ENTITY_".`"_ENTVALUE,1:ENTITY)
D GETLST^XPAR(.HMPLIST,ENT,"HMP PARAMETERS","I")
I HMPLIST=0 Q
S GETVAL=$S(RETVALUE="true":1,1:0)
I GETVAL=0 D Q
.S CNT=0,INST="" F S INST=$O(HMPLIST(INST)) Q:INST="" S JSONRES(CNT)=INST,CNT=CNT+1
S CNT=0,INST="" F S INST=$O(HMPLIST(INST)) Q:INST="" D
.S CNT=CNT+1
.S RESULT("params",CNT,"uid")=INST
.D GETPARAM(.PARAM,"HMP PARAMETERS",ENTITY,ENTVALUE,INST)
.I '$D(PARAM) Q
.M RESULT("params",CNT,"value",":")=PARAM
.K PARAM
I '$D(RESULT) Q ""
S RESULT("success")="true"
D ENCODE^HMPJSON("RESULT","JSONRES","HMPERR")
I $D(HMPERR) K JSONRES S TXT(1)="Problem encoding results to json format." D SETERROR(.RESULT,.HMPERR,.TXT,.JSONRES) Q
Q
;
GETPARAM(RESULT,NAME,ENTITY,ENTVALUE,INST) ; Get value for a param
N CNT,ENT,FORMAT,IEN,HMPAR,HMPPAR,HMPERR
;S IEN=$O(^XTV(8989.51,"B",NAME,"")) Q:IEN'>0
S FORMAT="I"
;D BLDLST^XPAREDIT(.HMPPAR,IEN
S ENT=$S($G(ENTVALUE)'="":ENTITY_".`"_ENTVALUE,1:ENTITY)
D GETWP^XPAR(.HMPAR,ENT,NAME,INST,.HMPERR)
S CNT=0 F S CNT=$O(HMPAR(CNT)) Q:CNT'>0 D
.S RESULT(CNT)=HMPAR(CNT,0)
Q
;
GETBYUID(RESULT,UID) ;
N ENTITY
D BLDENT(UID,.ENTITY)
D GETPARAM(.RESULT,"HMP PARAMETERS",$G(ENTITY("entity")),$G(ENTITY("entityId")),$G(ENTITY("uid")))
;I $D(RESULT)<10 S RESULT(0)="{}"
Q
;
PARSEJSN(VALUE,ARRAY,ERR) ;
N ERROR,JSON,TXT
D DECODE^HMPJSON("VALUE","ARRAY","ERROR")
I $D(ERR) K ARRAY S TXT(1)="Problem decoding json value." D SETERROR(.VALUE,.ERROR,.TXT,.ERR) Q 0
Q 1
;
PUTPARAM(RESULT,VALUE,ENTARR) ;
N CNT,ENT,ENTITY,ENTVALUE,ERR,STR,HMPERR,X
I $D(ENTARR)<10 I $$PARSEJSN(.VALUE,.ENTARR,.ERR)=0 M RESULT=ERR Q
;delete old parameter
S ENTITY=ENTARR("entity")
S ENTVALUE=ENTARR("entityId")
S ENT=$S($G(ENTVALUE)>0:ENTITY_".`"_ENTVALUE,1:ENTITY)
D DEL^XPAR(ENT,"HMP PARAMETERS",ENTARR("uid"),.HMPERR)
S CNT=$O(VALUE(""),-1) I CNT="" S STR(1,0)=VALUE
I CNT>0 F X=0:1:CNT S STR(X+1,0)=VALUE(X)
D PUT^XPAR(ENT,"HMP PARAMETERS",ENTARR("uid"),.STR,.HMPERR)
S RESULT(0)="{""success"":""true""}"
Q
;
PUTBYUID(RESULT,UID,VALUE) ;
N ENTITY
D BLDENT(UID,.ENTITY)
D PUTPARAM(.RESULT,.VALUE,.ENTITY)
Q
;
SETERROR(INPDATA,ERRORMSG,TXT,OUTPUT) ;
N ERRARR
D SETERROR^HMPUTILS(.ERRARR,.ERRORMSG,.TXT,.INPDATA)
D ENCODE^HMPJSON("ERRARR","OUTPUT","ERROR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPPARAM 3632 printed Apr 09, 2024@20:59:50 Page 2
HMPPARAM ;SLC/AGP,ASMR/RRB,CK - Parameter routine;May 15, 2016 14:15
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1**;May 15, 2016;Build 4
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; DE2818 - SQA findings. Newed HMPAR in GETPARAM +1. RRB - 10/27/2015
+5 ; External References DBIA#
+6 ; ------------------- -----
+7 ; ^XTV(8989.51 2992
+8 ;
+9 QUIT
+10 ;
BLDENT(UID,ENTITY) ;
+1 ;urn:va:param:F484:1120:HMP USER PREF
+2 ;urn:va:param:F484:1120:HMP ROSTER PREF:13
+3 ;urn:va:param:F484:SYS:HMP USER PREF
+4 SET ENTITY("uid")=UID
+5 IF +$PIECE(UID,":",5)>0
Begin DoDot:1
+6 SET ENTITY("entity")="USR"
+7 SET ENTITY("entityId")=$PIECE(UID,":",5)
End DoDot:1
QUIT
+8 SET ENTITY("entity")="SYS"
+9 QUIT
+10 ;
BUILDUID(VALUES,TYPE,ID) ;
+1 NEW DOMAIN
+2 SET DOMAIN=$$SYS^HMPUTILS
+3 SET VALUES("uid")="urn:va:"_TYPE_":"_DOMAIN_":"_ID
+4 QUIT
+5 ;
DELPARAM(RESULT,UID) ;
+1 NEW ARRAY,ENT,ENTITY,ENTVALUE,ERR,STR,HMPERR
+2 DO BLDENT(UID,.ARRAY)
+3 ;delete old parameter
+4 SET ENTITY=ARRAY("entity")
+5 SET ENTVALUE=ARRAY("entityId")
+6 SET ENT=$SELECT($GET(ENTVALUE)>0:ENTITY_".`"_ENTVALUE,1:ENTITY)
+7 IF $GET(ARRAY("uid"))=""
QUIT
+8 IF $GET(ENT)=""
QUIT
+9 DO DEL^XPAR(ENT,"HMP PARAMETERS",ARRAY("uid"),.HMPERR)
+10 QUIT
+11 ;
GETALPAR(JSONRES,ENTITY,ENTVALUE,RETVALUE) ;
+1 NEW CNT,DECODE,ENT,GETVAL,INST,PARAM,RESULT,HMPERR,HMPLIST
+2 SET ENT=$SELECT($GET(ENTVALUE)'="":ENTITY_".`"_ENTVALUE,1:ENTITY)
+3 DO GETLST^XPAR(.HMPLIST,ENT,"HMP PARAMETERS","I")
+4 IF HMPLIST=0
QUIT
+5 SET GETVAL=$SELECT(RETVALUE="true":1,1:0)
+6 IF GETVAL=0
Begin DoDot:1
+7 SET CNT=0
SET INST=""
FOR
SET INST=$ORDER(HMPLIST(INST))
if INST=""
QUIT
SET JSONRES(CNT)=INST
SET CNT=CNT+1
End DoDot:1
QUIT
+8 SET CNT=0
SET INST=""
FOR
SET INST=$ORDER(HMPLIST(INST))
if INST=""
QUIT
Begin DoDot:1
+9 SET CNT=CNT+1
+10 SET RESULT("params",CNT,"uid")=INST
+11 DO GETPARAM(.PARAM,"HMP PARAMETERS",ENTITY,ENTVALUE,INST)
+12 IF '$DATA(PARAM)
QUIT
+13 MERGE RESULT("params",CNT,"value",":")=PARAM
+14 KILL PARAM
End DoDot:1
+15 IF '$DATA(RESULT)
QUIT ""
+16 SET RESULT("success")="true"
+17 DO ENCODE^HMPJSON("RESULT","JSONRES","HMPERR")
+18 IF $DATA(HMPERR)
KILL JSONRES
SET TXT(1)="Problem encoding results to json format."
DO SETERROR(.RESULT,.HMPERR,.TXT,.JSONRES)
QUIT
+19 QUIT
+20 ;
GETPARAM(RESULT,NAME,ENTITY,ENTVALUE,INST) ; Get value for a param
+1 NEW CNT,ENT,FORMAT,IEN,HMPAR,HMPPAR,HMPERR
+2 ;S IEN=$O(^XTV(8989.51,"B",NAME,"")) Q:IEN'>0
+3 SET FORMAT="I"
+4 ;D BLDLST^XPAREDIT(.HMPPAR,IEN
+5 SET ENT=$SELECT($GET(ENTVALUE)'="":ENTITY_".`"_ENTVALUE,1:ENTITY)
+6 DO GETWP^XPAR(.HMPAR,ENT,NAME,INST,.HMPERR)
+7 SET CNT=0
FOR
SET CNT=$ORDER(HMPAR(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+8 SET RESULT(CNT)=HMPAR(CNT,0)
End DoDot:1
+9 QUIT
+10 ;
GETBYUID(RESULT,UID) ;
+1 NEW ENTITY
+2 DO BLDENT(UID,.ENTITY)
+3 DO GETPARAM(.RESULT,"HMP PARAMETERS",$GET(ENTITY("entity")),$GET(ENTITY("entityId")),$GET(ENTITY("uid")))
+4 ;I $D(RESULT)<10 S RESULT(0)="{}"
+5 QUIT
+6 ;
PARSEJSN(VALUE,ARRAY,ERR) ;
+1 NEW ERROR,JSON,TXT
+2 DO DECODE^HMPJSON("VALUE","ARRAY","ERROR")
+3 IF $DATA(ERR)
KILL ARRAY
SET TXT(1)="Problem decoding json value."
DO SETERROR(.VALUE,.ERROR,.TXT,.ERR)
QUIT 0
+4 QUIT 1
+5 ;
PUTPARAM(RESULT,VALUE,ENTARR) ;
+1 NEW CNT,ENT,ENTITY,ENTVALUE,ERR,STR,HMPERR,X
+2 IF $DATA(ENTARR)<10
IF $$PARSEJSN(.VALUE,.ENTARR,.ERR)=0
MERGE RESULT=ERR
QUIT
+3 ;delete old parameter
+4 SET ENTITY=ENTARR("entity")
+5 SET ENTVALUE=ENTARR("entityId")
+6 SET ENT=$SELECT($GET(ENTVALUE)>0:ENTITY_".`"_ENTVALUE,1:ENTITY)
+7 DO DEL^XPAR(ENT,"HMP PARAMETERS",ENTARR("uid"),.HMPERR)
+8 SET CNT=$ORDER(VALUE(""),-1)
IF CNT=""
SET STR(1,0)=VALUE
+9 IF CNT>0
FOR X=0:1:CNT
SET STR(X+1,0)=VALUE(X)
+10 DO PUT^XPAR(ENT,"HMP PARAMETERS",ENTARR("uid"),.STR,.HMPERR)
+11 SET RESULT(0)="{""success"":""true""}"
+12 QUIT
+13 ;
PUTBYUID(RESULT,UID,VALUE) ;
+1 NEW ENTITY
+2 DO BLDENT(UID,.ENTITY)
+3 DO PUTPARAM(.RESULT,.VALUE,.ENTITY)
+4 QUIT
+5 ;
SETERROR(INPDATA,ERRORMSG,TXT,OUTPUT) ;
+1 NEW ERRARR
+2 DO SETERROR^HMPUTILS(.ERRARR,.ERRORMSG,.TXT,.INPDATA)
+3 DO ENCODE^HMPJSON("ERRARR","OUTPUT","ERROR")
+4 QUIT
