XHDPTREE ; SLC/JER - Configurator Server Calls ; 08 Oct 2003 11:00
;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
GETTREE(XHDCY,XHDMOD) ; Control Branching
N XHDCI,XHDCDA,X S X="ONERROR^XHDPTREE",@^%ZOSF("TRAP")
S XHDCI=0,XHDCDA=+$O(^XHD(8935.91,"AMROOT",XHDMOD,0))
S XHDCY=$NA(^TMP("XHDPTREE",$J)) K @XHDCY
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<?xml version=""1.0"" encoding=""UTF-8""?>"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<getConfigurationCallResult"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="xsi:noNamespaceSchemaLocation=""C:\reeng\main\modules\config\src\gov\va\med\hds\cd\config\xml\getConfigurationCallResult.xsd"">"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<configTree>"
D GETCAT(XHDCY,XHDCDA,.XHDCI)
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</configTree>"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</getConfigurationCallResult>"
S XHDCY=$NA(^TMP("XHDPTREE",$J,"XMLDOC"))
Q
FLDS() ; Get field string
Q ".01:1"
GETCAT(XHDCY,XHDCDA,XHDCI) ; Loads Top-level Fields
N XHDCF,XHDKI,PCATAG S XHDCF=0
S PCATAG=$S($$ISROOT(XHDCDA):"pluginParameterCategory",1:"parameterCategory")
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<"_PCATAG_">"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<id>"_XHDCDA_"</id>"
D GETS^DIQ(8935.91,XHDCDA_",",$$FLDS,"IE",XHDCY)
F S XHDCF=$O(@XHDCY@(8935.91,XHDCDA_",",XHDCF)) Q:XHDCF'>0 D
. N TAG,VAL
. S TAG=$TR($$FLDNAME(XHDCF,8935.91)," /","")
. S VAL=$G(@XHDCY@(8935.91,XHDCDA_",",XHDCF,$S(XHDCF=.04:"I",1:"E")))
. I XHDCF=.04 S VAL=+VAL
. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<"_TAG_">"_VAL_"</"_TAG_">"
K @XHDCY@(8935.91)
;** get parameters **
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<parameters>"
D GETPARAM(XHDCY,XHDCDA,.XHDCI)
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</parameters>"
S XHDKI=0
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<children>"
F S XHDKI=$O(^XHD(8935.91,XHDCDA,3,XHDKI)) Q:+XHDKI'>0 D
. N XHDKID S XHDKID=$P($G(^XHD(8935.91,XHDCDA,3,XHDKI,0)),U,2)
. D GETCAT(XHDCY,XHDKID,.XHDCI)
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</children>"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</"_PCATAG_">"
Q
ISROOT(XHDCDA) ; Boolean - is record plugin root?
Q +$P($G(^XHD(8935.91,XHDCDA,0)),U,5)
FLDNAME(XHDCFN,FILENUM) ; Resolve field names
Q $$MIXED($P($G(^DD(FILENUM,XHDCFN,0)),U))
MIXED(X) ; Return Mixed Case X
N XHDI,WORD,TMP
S TMP="" F XHDI=1:1:$L(X," ") S WORD=$$LOW^XLFSTR($P(X," ",XHDI)),$E(WORD)=$S(XHDI=1:$E(WORD),1:$$UP^XLFSTR($E(WORD))),TMP=$S(TMP="":WORD,1:TMP_WORD)
Q TMP
GETPARAM(XHDCY,XHDCDA,XHDCI) ; Loads Parameters
N XHDI S XHDI=0
F S XHDI=$O(^XHD(8935.91,XHDCDA,2,XHDI)) Q:+XHDI'>0 D
. N PNODE,FULLNAME,MULTIVAL,WORDPROC,PAR,PARDEF0,PARDEF1,DNAME,VDTYPE,READONLY
. S PNODE=$G(^XHD(8935.91,XHDCDA,2,XHDI,0))
. Q:PNODE']""
. S PAR=$P(PNODE,U,2),PARDEF0=$G(^XTV(8989.51,PAR,0)),PARDEF1=$G(^(1))
. S FULLNAME=$P(PARDEF0,U),DNAME=$P(PARDEF0,U,2),VDTYPE=$P(PARDEF1,U)
. S READONLY=$S(+$P(PARDEF0,U,6):"true",1:"false")
. S MULTIVAL=$S(+$P(PARDEF0,U,3):"true",1:"false")
. S WORDPROC=$S(VDTYPE="W":"true",1:"false")
. N PLIST,ERR
. D GETLST^XPAR(.PLIST,"ALL^"_DUZ_";VA(200,^"_$$GETSRV_";DIC(49,",PAR,$S(VDTYPE="D":"Q",1:"E"),.ERR)
. I ERR Q
. I PLIST=0 D Q
. . N KEY,ENT,INST,NAME,VAL,EXTENT
. . S NAME=$$ESCAPE^XHDLXM(DNAME)
. . S INST=$S(FULLNAME="ORWOR TIMEOUT CHART":1,1:"")
. . S VAL=$S(FULLNAME="ORWOR TIMEOUT CHART":DTIME,1:"")
. . S:(MULTIVAL="true") NAME=NAME_" "_INST
. . S ENT=DUZ_";VA(200,",EXTENT=$$ENTNAME^XPARLIST(ENT)
. . S KEY=NAME_U_ENT_U_PAR_U_INST
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<parameter>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<id>"_PAR_"</id>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<name>"_NAME_"</name>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<fullName>"_$$ESCAPE^XHDLXM(FULLNAME)_"</fullName>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<key>"_KEY_"</key>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<readOnly>"_READONLY_"</readOnly>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<extEntity>"_EXTENT_"</extEntity>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<multiValued>"_MULTIVAL_"</multiValued>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<wordProcessing>"_WORDPROC_"</wordProcessing>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=$S(VAL="":"<value/>",1:"<value>"_VAL_"</value>")
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<defaultValue/>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</parameter>"
. N XHDJ S XHDJ=0
. F S XHDJ=$O(PLIST(XHDJ)) Q:+XHDJ'>0 D
. . N KEY,ENT,INST,VAL,NAME,EXTENT
. . S NAME=$$ESCAPE^XHDLXM(DNAME)
. . S INST=$P(PLIST(XHDJ),U),VAL=$P(PLIST(XHDJ),U,2)
. . S:(MULTIVAL="true") NAME=NAME_" "_INST
. . S ENT=$$GETENT(PAR,INST,VAL),EXTENT=$$ENTNAME^XPARLIST(ENT)
. . S KEY=NAME_U_ENT_U_PAR_U_INST
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<parameter>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<id>"_PAR_"</id>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<name>"_NAME_"</name>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<fullName>"_$$ESCAPE^XHDLXM(FULLNAME)_"</fullName>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<key>"_KEY_"</key>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<readOnly>"_READONLY_"</readOnly>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<extEntity>"_EXTENT_"</extEntity>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<multiValued>"_MULTIVAL_"</multiValued>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<wordProcessing>"_WORDPROC_"</wordProcessing>"
. . ; If wp, call for wp result
. . I (WORDPROC="true") D
. . . N VALIST,ERR
. . . D GETWP^XPAR(.VALIST,"ALL^"_$P(KEY,U,2),PAR,INST,.ERR)
. . . I 'ERR D
. . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<value>"
. . . . N XHDK S XHDK=0
. . . . F S XHDK=$O(VALIST(XHDK)) Q:+XHDK'>0 D
. . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=$$ESCAPE^XHDLXM($G(VALIST(XHDK,0)))
. . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</value>"
. . . N DFLIST,ERR
. . . D GETWP^XPAR(.DFLIST,"PKG",PAR,INST,.ERR)
. . . I 'ERR D
. . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<defaultValue>"
. . . . N XHDK S XHDK=0
. . . . F S XHDK=$O(VALIST(XHDK)) Q:+XHDK'>0 D
. . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=$$ESCAPE^XHDLXM($G(VALIST(XHDK,0)))
. . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</defaultValue>"
. . E D
. . . N DVAL S DVAL=$$GET^XPAR("PKG",PAR,INST,$S(VDTYPE="D":"Q",1:"E"))
. . . S VAL=$$XFORM(VAL,VDTYPE)
. . . S DVAL=$$XFORM(DVAL,VDTYPE)
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<value>"_$$ESCAPE^XHDLXM(VAL)_"</value>"
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<defaultValue>"_$$ESCAPE^XHDLXM(DVAL)_"</defaultValue>"
. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</parameter>"
Q
GETSRV() ; Get user's Service/Section
Q $P($G(^VA(200,DUZ,5)),U)
XFORM(VAL,VDTYPE) ; Transform values for select data types
N XHDY S XHDY=VAL
I VDTYPE="D" S XHDY=$$FMTHL7^XLFDT(VAL) G XFORMX
I VDTYPE="Y" S XHDY=$S(VAL="YES":"true",VAL="NO":"false",1:VAL)
XFORMX Q XHDY
GETENT(PAR,INST,VAL) ; Find entity, given parameter, instance, and value
N VLIST,ERR,ENTITY S ENTITY=0
D ENVAL^XPAR(.VLIST,PAR,INST,.ERR)
I 'ERR D
. N XHDENT S XHDENT=0
. F S XHDENT=$O(VLIST(XHDENT)) Q:+XHDENT'>0!+ENTITY D
. . I $P(XHDENT,";",2)="VA(200,",(+XHDENT'=DUZ) Q
. . I ($G(VLIST(XHDENT,INST))=VAL) S ENTITY=XHDENT
S:'+ENTITY ENTITY=DUZ_";VA(200,"
Q ENTITY
ONERROR ; Trap errors
N XHDCI S XHDCI=4
; remove remnant of DIQ1 call result
K @XHDCY@(8935.91)
; remove partial configTree node
F S XHDCI=$O(@XHDCY@("XMLDOC",XHDCI)) Q:+XHDCI'>0 K @XHDCY@("XMLDOC",XHDCI)
; append error node to call result
S XHDCI=4
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<error>"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<![CDATA["_$$EC^%ZOSV_"]]>"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</error>"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</getConfigurationCallResult>"
S XHDCY=$NA(^TMP("XHDPTREE",$J,"XMLDOC"))
D ^%ZTER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXHDPTREE 8168 printed Oct 16, 2024@17:58:11 Page 2
XHDPTREE ; SLC/JER - Configurator Server Calls ; 08 Oct 2003 11:00
+1 ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
GETTREE(XHDCY,XHDMOD) ; Control Branching
+1 NEW XHDCI,XHDCDA,X
SET X="ONERROR^XHDPTREE"
SET @^%ZOSF("TRAP")
+2 SET XHDCI=0
SET XHDCDA=+$ORDER(^XHD(8935.91,"AMROOT",XHDMOD,0))
+3 SET XHDCY=$NAME(^TMP("XHDPTREE",$JOB))
KILL @XHDCY
+4 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<?xml version=""1.0"" encoding=""UTF-8""?>"
+5 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<getConfigurationCallResult"
+6 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
+7 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="xsi:noNamespaceSchemaLocation=""C:\reeng\main\modules\config\src\gov\va\med\hds\cd\config\xml\getConfigurationCallResult.xsd"">"
+8 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<configTree>"
+9 DO GETCAT(XHDCY,XHDCDA,.XHDCI)
+10 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</configTree>"
+11 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</getConfigurationCallResult>"
+12 SET XHDCY=$NAME(^TMP("XHDPTREE",$JOB,"XMLDOC"))
+13 QUIT
FLDS() ; Get field string
+1 QUIT ".01:1"
GETCAT(XHDCY,XHDCDA,XHDCI) ; Loads Top-level Fields
+1 NEW XHDCF,XHDKI,PCATAG
SET XHDCF=0
+2 SET PCATAG=$SELECT($$ISROOT(XHDCDA):"pluginParameterCategory",1:"parameterCategory")
+3 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<"_PCATAG_">"
+4 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<id>"_XHDCDA_"</id>"
+5 DO GETS^DIQ(8935.91,XHDCDA_",",$$FLDS,"IE",XHDCY)
+6 FOR
SET XHDCF=$ORDER(@XHDCY@(8935.91,XHDCDA_",",XHDCF))
if XHDCF'>0
QUIT
Begin DoDot:1
+7 NEW TAG,VAL
+8 SET TAG=$TRANSLATE($$FLDNAME(XHDCF,8935.91)," /","")
+9 SET VAL=$GET(@XHDCY@(8935.91,XHDCDA_",",XHDCF,$SELECT(XHDCF=.04:"I",1:"E")))
+10 IF XHDCF=.04
SET VAL=+VAL
+11 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<"_TAG_">"_VAL_"</"_TAG_">"
End DoDot:1
+12 KILL @XHDCY@(8935.91)
+13 ;** get parameters **
+14 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<parameters>"
+15 DO GETPARAM(XHDCY,XHDCDA,.XHDCI)
+16 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</parameters>"
+17 SET XHDKI=0
+18 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<children>"
+19 FOR
SET XHDKI=$ORDER(^XHD(8935.91,XHDCDA,3,XHDKI))
if +XHDKI'>0
QUIT
Begin DoDot:1
+20 NEW XHDKID
SET XHDKID=$PIECE($GET(^XHD(8935.91,XHDCDA,3,XHDKI,0)),U,2)
+21 DO GETCAT(XHDCY,XHDKID,.XHDCI)
End DoDot:1
+22 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</children>"
+23 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</"_PCATAG_">"
+24 QUIT
ISROOT(XHDCDA) ; Boolean - is record plugin root?
+1 QUIT +$PIECE($GET(^XHD(8935.91,XHDCDA,0)),U,5)
FLDNAME(XHDCFN,FILENUM) ; Resolve field names
+1 QUIT $$MIXED($PIECE($GET(^DD(FILENUM,XHDCFN,0)),U))
MIXED(X) ; Return Mixed Case X
+1 NEW XHDI,WORD,TMP
+2 SET TMP=""
FOR XHDI=1:1:$LENGTH(X," ")
SET WORD=$$LOW^XLFSTR($PIECE(X," ",XHDI))
SET $EXTRACT(WORD)=$SELECT(XHDI=1:$EXTRACT(WORD),1:$$UP^XLFSTR($EXTRACT(WORD)))
SET TMP=$SELECT(TMP="":WORD,1:TMP_WORD)
+3 QUIT TMP
GETPARAM(XHDCY,XHDCDA,XHDCI) ; Loads Parameters
+1 NEW XHDI
SET XHDI=0
+2 FOR
SET XHDI=$ORDER(^XHD(8935.91,XHDCDA,2,XHDI))
if +XHDI'>0
QUIT
Begin DoDot:1
+3 NEW PNODE,FULLNAME,MULTIVAL,WORDPROC,PAR,PARDEF0,PARDEF1,DNAME,VDTYPE,READONLY
+4 SET PNODE=$GET(^XHD(8935.91,XHDCDA,2,XHDI,0))
+5 if PNODE']""
QUIT
+6 SET PAR=$PIECE(PNODE,U,2)
SET PARDEF0=$GET(^XTV(8989.51,PAR,0))
SET PARDEF1=$GET(^(1))
+7 SET FULLNAME=$PIECE(PARDEF0,U)
SET DNAME=$PIECE(PARDEF0,U,2)
SET VDTYPE=$PIECE(PARDEF1,U)
+8 SET READONLY=$SELECT(+$PIECE(PARDEF0,U,6):"true",1:"false")
+9 SET MULTIVAL=$SELECT(+$PIECE(PARDEF0,U,3):"true",1:"false")
+10 SET WORDPROC=$SELECT(VDTYPE="W":"true",1:"false")
+11 NEW PLIST,ERR
+12 DO GETLST^XPAR(.PLIST,"ALL^"_DUZ_";VA(200,^"_$$GETSRV_";DIC(49,",PAR,$S(VDTYPE="D":"Q",1:"E"),.ERR)
+13 IF ERR
QUIT
+14 IF PLIST=0
Begin DoDot:2
+15 NEW KEY,ENT,INST,NAME,VAL,EXTENT
+16 SET NAME=$$ESCAPE^XHDLXM(DNAME)
+17 SET INST=$SELECT(FULLNAME="ORWOR TIMEOUT CHART":1,1:"")
+18 SET VAL=$SELECT(FULLNAME="ORWOR TIMEOUT CHART":DTIME,1:"")
+19 if (MULTIVAL="true")
SET NAME=NAME_" "_INST
+20 SET ENT=DUZ_";VA(200,"
SET EXTENT=$$ENTNAME^XPARLIST(ENT)
+21 SET KEY=NAME_U_ENT_U_PAR_U_INST
+22 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<parameter>"
+23 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<id>"_PAR_"</id>"
+24 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<name>"_NAME_"</name>"
+25 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<fullName>"_$$ESCAPE^XHDLXM(FULLNAME)_"</fullName>"
+26 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<key>"_KEY_"</key>"
+27 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<readOnly>"_READONLY_"</readOnly>"
+28 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<extEntity>"_EXTENT_"</extEntity>"
+29 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<multiValued>"_MULTIVAL_"</multiValued>"
+30 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<wordProcessing>"_WORDPROC_"</wordProcessing>"
+31 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)=$SELECT(VAL="":"<value/>",1:"<value>"_VAL_"</value>")
+32 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<defaultValue/>"
+33 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</parameter>"
End DoDot:2
QUIT
+34 NEW XHDJ
SET XHDJ=0
+35 FOR
SET XHDJ=$ORDER(PLIST(XHDJ))
if +XHDJ'>0
QUIT
Begin DoDot:2
+36 NEW KEY,ENT,INST,VAL,NAME,EXTENT
+37 SET NAME=$$ESCAPE^XHDLXM(DNAME)
+38 SET INST=$PIECE(PLIST(XHDJ),U)
SET VAL=$PIECE(PLIST(XHDJ),U,2)
+39 if (MULTIVAL="true")
SET NAME=NAME_" "_INST
+40 SET ENT=$$GETENT(PAR,INST,VAL)
SET EXTENT=$$ENTNAME^XPARLIST(ENT)
+41 SET KEY=NAME_U_ENT_U_PAR_U_INST
+42 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<parameter>"
+43 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<id>"_PAR_"</id>"
+44 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<name>"_NAME_"</name>"
+45 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<fullName>"_$$ESCAPE^XHDLXM(FULLNAME)_"</fullName>"
+46 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<key>"_KEY_"</key>"
+47 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<readOnly>"_READONLY_"</readOnly>"
+48 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<extEntity>"_EXTENT_"</extEntity>"
+49 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<multiValued>"_MULTIVAL_"</multiValued>"
+50 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<wordProcessing>"_WORDPROC_"</wordProcessing>"
+51 ; If wp, call for wp result
+52 IF (WORDPROC="true")
Begin DoDot:3
+53 NEW VALIST,ERR
+54 DO GETWP^XPAR(.VALIST,"ALL^"_$PIECE(KEY,U,2),PAR,INST,.ERR)
+55 IF 'ERR
Begin DoDot:4
+56 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<value>"
+57 NEW XHDK
SET XHDK=0
+58 FOR
SET XHDK=$ORDER(VALIST(XHDK))
if +XHDK'>0
QUIT
Begin DoDot:5
+59 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)=$$ESCAPE^XHDLXM($GET(VALIST(XHDK,0)))
End DoDot:5
+60 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</value>"
End DoDot:4
+61 NEW DFLIST,ERR
+62 DO GETWP^XPAR(.DFLIST,"PKG",PAR,INST,.ERR)
+63 IF 'ERR
Begin DoDot:4
+64 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<defaultValue>"
+65 NEW XHDK
SET XHDK=0
+66 FOR
SET XHDK=$ORDER(VALIST(XHDK))
if +XHDK'>0
QUIT
Begin DoDot:5
+67 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)=$$ESCAPE^XHDLXM($GET(VALIST(XHDK,0)))
End DoDot:5
+68 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</defaultValue>"
End DoDot:4
End DoDot:3
+69 IF '$TEST
Begin DoDot:3
+70 NEW DVAL
SET DVAL=$$GET^XPAR("PKG",PAR,INST,$SELECT(VDTYPE="D":"Q",1:"E"))
+71 SET VAL=$$XFORM(VAL,VDTYPE)
+72 SET DVAL=$$XFORM(DVAL,VDTYPE)
+73 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<value>"_$$ESCAPE^XHDLXM(VAL)_"</value>"
+74 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<defaultValue>"_$$ESCAPE^XHDLXM(DVAL)_"</defaultValue>"
End DoDot:3
+75 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</parameter>"
End DoDot:2
End DoDot:1
+76 QUIT
GETSRV() ; Get user's Service/Section
+1 QUIT $PIECE($GET(^VA(200,DUZ,5)),U)
XFORM(VAL,VDTYPE) ; Transform values for select data types
+1 NEW XHDY
SET XHDY=VAL
+2 IF VDTYPE="D"
SET XHDY=$$FMTHL7^XLFDT(VAL)
GOTO XFORMX
+3 IF VDTYPE="Y"
SET XHDY=$SELECT(VAL="YES":"true",VAL="NO":"false",1:VAL)
XFORMX QUIT XHDY
GETENT(PAR,INST,VAL) ; Find entity, given parameter, instance, and value
+1 NEW VLIST,ERR,ENTITY
SET ENTITY=0
+2 DO ENVAL^XPAR(.VLIST,PAR,INST,.ERR)
+3 IF 'ERR
Begin DoDot:1
+4 NEW XHDENT
SET XHDENT=0
+5 FOR
SET XHDENT=$ORDER(VLIST(XHDENT))
if +XHDENT'>0!+ENTITY
QUIT
Begin DoDot:2
+6 IF $PIECE(XHDENT,";",2)="VA(200,"
IF (+XHDENT'=DUZ)
QUIT
+7 IF ($GET(VLIST(XHDENT,INST))=VAL)
SET ENTITY=XHDENT
End DoDot:2
End DoDot:1
+8 if '+ENTITY
SET ENTITY=DUZ_";VA(200,"
+9 QUIT ENTITY
ONERROR ; Trap errors
+1 NEW XHDCI
SET XHDCI=4
+2 ; remove remnant of DIQ1 call result
+3 KILL @XHDCY@(8935.91)
+4 ; remove partial configTree node
+5 FOR
SET XHDCI=$ORDER(@XHDCY@("XMLDOC",XHDCI))
if +XHDCI'>0
QUIT
KILL @XHDCY@("XMLDOC",XHDCI)
+6 ; append error node to call result
+7 SET XHDCI=4
+8 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<error>"
+9 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="<![CDATA["_$$EC^%ZOSV_"]]>"
+10 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</error>"
+11 SET XHDCI=XHDCI+1
SET @XHDCY@("XMLDOC",XHDCI)="</getConfigurationCallResult>"
+12 SET XHDCY=$NAME(^TMP("XHDPTREE",$JOB,"XMLDOC"))
+13 DO ^%ZTER
+14 QUIT
