- 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 Feb 18, 2025@23:20:49 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