Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XHDPTREE

XHDPTREE.m

Go to the documentation of this file.
  1. XHDPTREE ; SLC/JER - Configurator Server Calls ; 08 Oct 2003 11:00
  1. ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
  1. GETTREE(XHDCY,XHDMOD) ; Control Branching
  1. N XHDCI,XHDCDA,X S X="ONERROR^XHDPTREE",@^%ZOSF("TRAP")
  1. S XHDCI=0,XHDCDA=+$O(^XHD(8935.91,"AMROOT",XHDMOD,0))
  1. S XHDCY=$NA(^TMP("XHDPTREE",$J)) K @XHDCY
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<?xml version=""1.0"" encoding=""UTF-8""?>"
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<getConfigurationCallResult"
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="xsi:noNamespaceSchemaLocation=""C:\reeng\main\modules\config\src\gov\va\med\hds\cd\config\xml\getConfigurationCallResult.xsd"">"
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<configTree>"
  1. D GETCAT(XHDCY,XHDCDA,.XHDCI)
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</configTree>"
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</getConfigurationCallResult>"
  1. S XHDCY=$NA(^TMP("XHDPTREE",$J,"XMLDOC"))
  1. Q
  1. FLDS() ; Get field string
  1. Q ".01:1"
  1. GETCAT(XHDCY,XHDCDA,XHDCI) ; Loads Top-level Fields
  1. N XHDCF,XHDKI,PCATAG S XHDCF=0
  1. S PCATAG=$S($$ISROOT(XHDCDA):"pluginParameterCategory",1:"parameterCategory")
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<"_PCATAG_">"
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<id>"_XHDCDA_"</id>"
  1. D GETS^DIQ(8935.91,XHDCDA_",",$$FLDS,"IE",XHDCY)
  1. F S XHDCF=$O(@XHDCY@(8935.91,XHDCDA_",",XHDCF)) Q:XHDCF'>0 D
  1. . N TAG,VAL
  1. . S TAG=$TR($$FLDNAME(XHDCF,8935.91)," /","")
  1. . S VAL=$G(@XHDCY@(8935.91,XHDCDA_",",XHDCF,$S(XHDCF=.04:"I",1:"E")))
  1. . I XHDCF=.04 S VAL=+VAL
  1. . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<"_TAG_">"_VAL_"</"_TAG_">"
  1. K @XHDCY@(8935.91)
  1. ;** get parameters **
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<parameters>"
  1. D GETPARAM(XHDCY,XHDCDA,.XHDCI)
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</parameters>"
  1. S XHDKI=0
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<children>"
  1. F S XHDKI=$O(^XHD(8935.91,XHDCDA,3,XHDKI)) Q:+XHDKI'>0 D
  1. . N XHDKID S XHDKID=$P($G(^XHD(8935.91,XHDCDA,3,XHDKI,0)),U,2)
  1. . D GETCAT(XHDCY,XHDKID,.XHDCI)
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</children>"
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</"_PCATAG_">"
  1. Q
  1. ISROOT(XHDCDA) ; Boolean - is record plugin root?
  1. Q +$P($G(^XHD(8935.91,XHDCDA,0)),U,5)
  1. FLDNAME(XHDCFN,FILENUM) ; Resolve field names
  1. Q $$MIXED($P($G(^DD(FILENUM,XHDCFN,0)),U))
  1. MIXED(X) ; Return Mixed Case X
  1. N XHDI,WORD,TMP
  1. 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)
  1. Q TMP
  1. GETPARAM(XHDCY,XHDCDA,XHDCI) ; Loads Parameters
  1. N XHDI S XHDI=0
  1. F S XHDI=$O(^XHD(8935.91,XHDCDA,2,XHDI)) Q:+XHDI'>0 D
  1. . N PNODE,FULLNAME,MULTIVAL,WORDPROC,PAR,PARDEF0,PARDEF1,DNAME,VDTYPE,READONLY
  1. . S PNODE=$G(^XHD(8935.91,XHDCDA,2,XHDI,0))
  1. . Q:PNODE']""
  1. . S PAR=$P(PNODE,U,2),PARDEF0=$G(^XTV(8989.51,PAR,0)),PARDEF1=$G(^(1))
  1. . S FULLNAME=$P(PARDEF0,U),DNAME=$P(PARDEF0,U,2),VDTYPE=$P(PARDEF1,U)
  1. . S READONLY=$S(+$P(PARDEF0,U,6):"true",1:"false")
  1. . S MULTIVAL=$S(+$P(PARDEF0,U,3):"true",1:"false")
  1. . S WORDPROC=$S(VDTYPE="W":"true",1:"false")
  1. . N PLIST,ERR
  1. . D GETLST^XPAR(.PLIST,"ALL^"_DUZ_";VA(200,^"_$$GETSRV_";DIC(49,",PAR,$S(VDTYPE="D":"Q",1:"E"),.ERR)
  1. . I ERR Q
  1. . I PLIST=0 D Q
  1. . . N KEY,ENT,INST,NAME,VAL,EXTENT
  1. . . S NAME=$$ESCAPE^XHDLXM(DNAME)
  1. . . S INST=$S(FULLNAME="ORWOR TIMEOUT CHART":1,1:"")
  1. . . S VAL=$S(FULLNAME="ORWOR TIMEOUT CHART":DTIME,1:"")
  1. . . S:(MULTIVAL="true") NAME=NAME_" "_INST
  1. . . S ENT=DUZ_";VA(200,",EXTENT=$$ENTNAME^XPARLIST(ENT)
  1. . . S KEY=NAME_U_ENT_U_PAR_U_INST
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<parameter>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<id>"_PAR_"</id>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<name>"_NAME_"</name>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<fullName>"_$$ESCAPE^XHDLXM(FULLNAME)_"</fullName>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<key>"_KEY_"</key>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<readOnly>"_READONLY_"</readOnly>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<extEntity>"_EXTENT_"</extEntity>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<multiValued>"_MULTIVAL_"</multiValued>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<wordProcessing>"_WORDPROC_"</wordProcessing>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=$S(VAL="":"<value/>",1:"<value>"_VAL_"</value>")
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<defaultValue/>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</parameter>"
  1. . N XHDJ S XHDJ=0
  1. . F S XHDJ=$O(PLIST(XHDJ)) Q:+XHDJ'>0 D
  1. . . N KEY,ENT,INST,VAL,NAME,EXTENT
  1. . . S NAME=$$ESCAPE^XHDLXM(DNAME)
  1. . . S INST=$P(PLIST(XHDJ),U),VAL=$P(PLIST(XHDJ),U,2)
  1. . . S:(MULTIVAL="true") NAME=NAME_" "_INST
  1. . . S ENT=$$GETENT(PAR,INST,VAL),EXTENT=$$ENTNAME^XPARLIST(ENT)
  1. . . S KEY=NAME_U_ENT_U_PAR_U_INST
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<parameter>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<id>"_PAR_"</id>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<name>"_NAME_"</name>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<fullName>"_$$ESCAPE^XHDLXM(FULLNAME)_"</fullName>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<key>"_KEY_"</key>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<readOnly>"_READONLY_"</readOnly>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<extEntity>"_EXTENT_"</extEntity>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<multiValued>"_MULTIVAL_"</multiValued>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<wordProcessing>"_WORDPROC_"</wordProcessing>"
  1. . . ; If wp, call for wp result
  1. . . I (WORDPROC="true") D
  1. . . . N VALIST,ERR
  1. . . . D GETWP^XPAR(.VALIST,"ALL^"_$P(KEY,U,2),PAR,INST,.ERR)
  1. . . . I 'ERR D
  1. . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<value>"
  1. . . . . N XHDK S XHDK=0
  1. . . . . F S XHDK=$O(VALIST(XHDK)) Q:+XHDK'>0 D
  1. . . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=$$ESCAPE^XHDLXM($G(VALIST(XHDK,0)))
  1. . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</value>"
  1. . . . N DFLIST,ERR
  1. . . . D GETWP^XPAR(.DFLIST,"PKG",PAR,INST,.ERR)
  1. . . . I 'ERR D
  1. . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<defaultValue>"
  1. . . . . N XHDK S XHDK=0
  1. . . . . F S XHDK=$O(VALIST(XHDK)) Q:+XHDK'>0 D
  1. . . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=$$ESCAPE^XHDLXM($G(VALIST(XHDK,0)))
  1. . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</defaultValue>"
  1. . . E D
  1. . . . N DVAL S DVAL=$$GET^XPAR("PKG",PAR,INST,$S(VDTYPE="D":"Q",1:"E"))
  1. . . . S VAL=$$XFORM(VAL,VDTYPE)
  1. . . . S DVAL=$$XFORM(DVAL,VDTYPE)
  1. . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<value>"_$$ESCAPE^XHDLXM(VAL)_"</value>"
  1. . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<defaultValue>"_$$ESCAPE^XHDLXM(DVAL)_"</defaultValue>"
  1. . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</parameter>"
  1. Q
  1. GETSRV() ; Get user's Service/Section
  1. Q $P($G(^VA(200,DUZ,5)),U)
  1. XFORM(VAL,VDTYPE) ; Transform values for select data types
  1. N XHDY S XHDY=VAL
  1. I VDTYPE="D" S XHDY=$$FMTHL7^XLFDT(VAL) G XFORMX
  1. I VDTYPE="Y" S XHDY=$S(VAL="YES":"true",VAL="NO":"false",1:VAL)
  1. XFORMX Q XHDY
  1. GETENT(PAR,INST,VAL) ; Find entity, given parameter, instance, and value
  1. N VLIST,ERR,ENTITY S ENTITY=0
  1. D ENVAL^XPAR(.VLIST,PAR,INST,.ERR)
  1. I 'ERR D
  1. . N XHDENT S XHDENT=0
  1. . F S XHDENT=$O(VLIST(XHDENT)) Q:+XHDENT'>0!+ENTITY D
  1. . . I $P(XHDENT,";",2)="VA(200,",(+XHDENT'=DUZ) Q
  1. . . I ($G(VLIST(XHDENT,INST))=VAL) S ENTITY=XHDENT
  1. S:'+ENTITY ENTITY=DUZ_";VA(200,"
  1. Q ENTITY
  1. ONERROR ; Trap errors
  1. N XHDCI S XHDCI=4
  1. ; remove remnant of DIQ1 call result
  1. K @XHDCY@(8935.91)
  1. ; remove partial configTree node
  1. F S XHDCI=$O(@XHDCY@("XMLDOC",XHDCI)) Q:+XHDCI'>0 K @XHDCY@("XMLDOC",XHDCI)
  1. ; append error node to call result
  1. S XHDCI=4
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<error>"
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<![CDATA["_$$EC^%ZOSV_"]]>"
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</error>"
  1. S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</getConfigurationCallResult>"
  1. S XHDCY=$NA(^TMP("XHDPTREE",$J,"XMLDOC"))
  1. D ^%ZTER
  1. Q