XHDPEDIT ; SLC/JER - Configuration Editor Server Calls ; 25 Jul 2003 9:42 AM
;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
GETTREE(XHDCY,XHDMOD) ; Control Branching
N XHDCI,XHDCDA
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)=""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
D GETCAT(XHDCY,XHDCDA,.XHDCI)
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
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)=""_XHDCDA_""
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)=""
D GETPARAM(XHDCY,XHDCDA,.XHDCI)
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
S XHDKI=0
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
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 XHDKI=0
;F S XHDKI=$O(^XHD(8935.91,XHDCDA,2,XHDKI)) Q:+XHDKI'>0 D
;. N XHDPARAM S XHDPARAM=$P($G(^XHD(8935.91,XHDCDA,2,XHDKI,0)),U,2)
;. D GETLEAF(XHDCY,XHDPARAM,XHDCDA,.XHDCI)
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_PCATAG_">"
Q
GETLEAF(XHDCY,PAR,PID,XHDCI) ; Build Leafnode categories
N FULLNAME,PLUGINID,NAME,PARAM0,PCAT0
S PARAM0=$G(^XTV(8989.51,PAR,0)),PCAT0=$G(^XHD(8935.91,PID,0))
S FULLNAME=$$ESCAPE^XHDLXM($P(PARAM0,U)),NAME=$$ESCAPE^XHDLXM($P(PARAM0,U,2))
S PLUGINID=$P(PCAT0,U,2)
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_FULLNAME_""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_PLUGINID_""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_NAME_""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_PID_""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="false"
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="true"
;** get parameters **
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
D GETPARAM(XHDCY,XHDCDA,.XHDCI)
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
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 ORI,WORD,TMP
S TMP="" F ORI=1:1:$L(X," ") S WORD=$$LOW^XLFSTR($P(X," ",ORI)),$E(WORD)=$S(ORI=1:$E(WORD),1:$$UP^XLFSTR($E(WORD))),TMP=$S(TMP="":WORD,1:TMP_WORD)
Q TMP
GETPARAM(XHDCY,XHDCDA,XHDCI) ; Loads Parameters
N ORI S ORI=0
F S ORI=$O(^XHD(8935.91,XHDCDA,2,ORI)) Q:+ORI'>0 D
. N PNODE,FULLNAME,MULTIVAL,WORDPROC,PAR,PARDEF0,PARDEF1,DNAME,VDTYPE,READONLY
. S PNODE=$G(^XHD(8935.91,XHDCDA,2,ORI,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^XHDPAR(.PLIST,PAR,.ERR)
. I 'ERR D
. . N ORJ S ORJ=0
. . F S ORJ=$O(PLIST(ORJ)) Q:+ORJ'>0 D
. . . N KEY,ENT,INST,VAL,NAME,EXTENT
. . . S NAME=$$ESCAPE^XHDLXM(DNAME)
. . . S ENT=$P(PLIST(ORJ),U),EXTENT=$P(PLIST(ORJ),U,2)
. . . S INST=$P(PLIST(ORJ),U,3),VAL=$P(PLIST(ORJ),U,4)
. . . S:(MULTIVAL="true") NAME=NAME_" "_INST
. . . S KEY=NAME_U_ENT_U_PAR_U_INST
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_PAR_""
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_NAME_""
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_$$ESCAPE^XHDLXM(FULLNAME)_""
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_KEY_""
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_READONLY_""
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_EXTENT_""
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_MULTIVAL_""
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_WORDPROC_""
. . . ; 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)=""
. . . . . N ORK S ORK=0
. . . . . F S ORK=$O(VALIST(ORK)) Q:+ORK'>0 D
. . . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=$$ESCAPE^XHDLXM($G(VALIST(ORK,0)))
. . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
. . . . N DFLIST,ERR
. . . . D GETWP^XPAR(.DFLIST,"PKG",PAR,INST,.ERR)
. . . . I 'ERR D
. . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
. . . . . N ORK S ORK=0
. . . . . F S ORK=$O(VALIST(ORK)) Q:+ORK'>0 D
. . . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=$$ESCAPE^XHDLXM($G(VALIST(ORK,0)))
. . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
. . . E D
. . . . N DVAL S DVAL=$$GET^XPAR("PKG",PAR,INST,$S(VDTYPE="D":"Q",1:"E"))
. . . . S VAL=$$XFORM^XHDPTREE(VAL,VDTYPE)
. . . . S DVAL=$$XFORM^XHDPTREE(DVAL,VDTYPE)
. . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_$$ESCAPE^XHDLXM(VAL)_""
. . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""_$$ESCAPE^XHDLXM(DVAL)_""
. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=""
Q