- 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 Jan 18, 2025@02:58:34 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