source: WorldVistAEHR/trunk/r/HEALTHEVET_DESKTOP-XHD/XHDPEDIT.m@ 648

Last change on this file since 648 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.6 KB
Line 
1XHDPEDIT ; SLC/JER - Configuration Editor Server Calls ; 25 Jul 2003 9:42 AM
2 ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
3GETTREE(XHDCY,XHDMOD) ; Control Branching
4 N XHDCI,XHDCDA
5 S XHDCI=0,XHDCDA=+$O(^XHD(8935.91,"AMROOT",XHDMOD,0))
6 S XHDCY=$NA(^TMP("XHDPTREE",$J)) K @XHDCY
7 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<?xml version=""1.0"" encoding=""UTF-8""?>"
8 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<getConfigurationCallResult"
9 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
10 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="xsi:noNamespaceSchemaLocation=""C:\reeng\main\modules\config\src\gov\va\med\hds\cd\config\xml\configTree.xsd"">"
11 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<configTree>"
12 D GETCAT(XHDCY,XHDCDA,.XHDCI)
13 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</configTree>"
14 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</getConfigurationCallResult>"
15 S XHDCY=$NA(^TMP("XHDPTREE",$J,"XMLDOC"))
16 Q
17FLDS() ; Get field string
18 Q ".01:1"
19GETCAT(XHDCY,XHDCDA,XHDCI) ; Loads Top-level Fields
20 N XHDCF,XHDKI,PCATAG S XHDCF=0
21 S PCATAG=$S($$ISROOT(XHDCDA):"pluginParameterCategory",1:"parameterCategory")
22 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<"_PCATAG_">"
23 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<id>"_XHDCDA_"</id>"
24 D GETS^DIQ(8935.91,XHDCDA_",",$$FLDS,"IE",XHDCY)
25 F S XHDCF=$O(@XHDCY@(8935.91,XHDCDA_",",XHDCF)) Q:XHDCF'>0 D
26 . N TAG,VAL
27 . S TAG=$TR($$FLDNAME(XHDCF,8935.91)," /","")
28 . S VAL=$G(@XHDCY@(8935.91,XHDCDA_",",XHDCF,$S(XHDCF=.04:"I",1:"E")))
29 . I XHDCF=.04 S VAL=+VAL
30 . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<"_TAG_">"_VAL_"</"_TAG_">"
31 K @XHDCY@(8935.91)
32 ;** get parameters **
33 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<parameters>"
34 D GETPARAM(XHDCY,XHDCDA,.XHDCI)
35 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</parameters>"
36 S XHDKI=0
37 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<children>"
38 F S XHDKI=$O(^XHD(8935.91,XHDCDA,3,XHDKI)) Q:+XHDKI'>0 D
39 . N XHDKID S XHDKID=$P($G(^XHD(8935.91,XHDCDA,3,XHDKI,0)),U,2)
40 . D GETCAT(XHDCY,XHDKID,.XHDCI)
41 ;S XHDKI=0
42 ;F S XHDKI=$O(^XHD(8935.91,XHDCDA,2,XHDKI)) Q:+XHDKI'>0 D
43 ;. N XHDPARAM S XHDPARAM=$P($G(^XHD(8935.91,XHDCDA,2,XHDKI,0)),U,2)
44 ;. D GETLEAF(XHDCY,XHDPARAM,XHDCDA,.XHDCI)
45 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</children>"
46 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</"_PCATAG_">"
47 Q
48GETLEAF(XHDCY,PAR,PID,XHDCI) ; Build Leafnode categories
49 N FULLNAME,PLUGINID,NAME,PARAM0,PCAT0
50 S PARAM0=$G(^XTV(8989.51,PAR,0)),PCAT0=$G(^XHD(8935.91,PID,0))
51 S FULLNAME=$$ESCAPE^XHDLXM($P(PARAM0,U)),NAME=$$ESCAPE^XHDLXM($P(PARAM0,U,2))
52 S PLUGINID=$P(PCAT0,U,2)
53 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<parameterCategory>"
54 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<id/>"
55 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<fullName>"_FULLNAME_"</fullName>"
56 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<pluginId>"_PLUGINID_"</pluginId>"
57 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<name/>"_NAME_"</name>"
58 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<parentId/>"_PID_"</parentId>"
59 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<packageRoot/>false</packageRoot>"
60 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<preferencePage/>"
61 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<leaf>true</leaf>"
62 ;** get parameters **
63 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<parameters>"
64 D GETPARAM(XHDCY,XHDCDA,.XHDCI)
65 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</parameters>"
66 S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</parameterCategory>"
67 Q
68ISROOT(XHDCDA) ; Boolean - is record plugin root?
69 Q +$P($G(^XHD(8935.91,XHDCDA,0)),U,5)
70FLDNAME(XHDCFN,FILENUM) ; Resolve field names
71 Q $$MIXED($P($G(^DD(FILENUM,XHDCFN,0)),U))
72MIXED(X) ; Return Mixed Case X
73 N ORI,WORD,TMP
74 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)
75 Q TMP
76GETPARAM(XHDCY,XHDCDA,XHDCI) ; Loads Parameters
77 N ORI S ORI=0
78 F S ORI=$O(^XHD(8935.91,XHDCDA,2,ORI)) Q:+ORI'>0 D
79 . N PNODE,FULLNAME,MULTIVAL,WORDPROC,PAR,PARDEF0,PARDEF1,DNAME,VDTYPE,READONLY
80 . S PNODE=$G(^XHD(8935.91,XHDCDA,2,ORI,0))
81 . Q:PNODE']""
82 . S PAR=$P(PNODE,U,2),PARDEF0=$G(^XTV(8989.51,PAR,0)),PARDEF1=$G(^(1))
83 . S FULLNAME=$P(PARDEF0,U),DNAME=$P(PARDEF0,U,2),VDTYPE=$P(PARDEF1,U)
84 . S READONLY=$S(+$P(PARDEF0,U,6):"true",1:"false")
85 . S MULTIVAL=$S(+$P(PARDEF0,U,3):"true",1:"false")
86 . S WORDPROC=$S(VDTYPE="W":"true",1:"false")
87 . N PLIST,ERR
88 . D GETLST^XHDPAR(.PLIST,PAR,.ERR)
89 . I 'ERR D
90 . . N ORJ S ORJ=0
91 . . F S ORJ=$O(PLIST(ORJ)) Q:+ORJ'>0 D
92 . . . N KEY,ENT,INST,VAL,NAME,EXTENT
93 . . . S NAME=$$ESCAPE^XHDLXM(DNAME)
94 . . . S ENT=$P(PLIST(ORJ),U),EXTENT=$P(PLIST(ORJ),U,2)
95 . . . S INST=$P(PLIST(ORJ),U,3),VAL=$P(PLIST(ORJ),U,4)
96 . . . S:(MULTIVAL="true") NAME=NAME_" "_INST
97 . . . S KEY=NAME_U_ENT_U_PAR_U_INST
98 . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<parameter>"
99 . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<id>"_PAR_"</id>"
100 . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<name>"_NAME_"</name>"
101 . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<fullName>"_$$ESCAPE^XHDLXM(FULLNAME)_"</fullName>"
102 . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<key>"_KEY_"</key>"
103 . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<readOnly>"_READONLY_"</readOnly>"
104 . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<extEntity>"_EXTENT_"</extEntity>"
105 . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<multiValued>"_MULTIVAL_"</multiValued>"
106 . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<wordProcessing>"_WORDPROC_"</wordProcessing>"
107 . . . ; If wp, call for wp result
108 . . . I (WORDPROC="true") D
109 . . . . N VALIST,ERR
110 . . . . D GETWP^XPAR(.VALIST,"ALL^"_$P(KEY,U,2),PAR,INST,.ERR)
111 . . . . I 'ERR D
112 . . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<value>"
113 . . . . . N ORK S ORK=0
114 . . . . . F S ORK=$O(VALIST(ORK)) Q:+ORK'>0 D
115 . . . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=$$ESCAPE^XHDLXM($G(VALIST(ORK,0)))
116 . . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</value>"
117 . . . . N DFLIST,ERR
118 . . . . D GETWP^XPAR(.DFLIST,"PKG",PAR,INST,.ERR)
119 . . . . I 'ERR D
120 . . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<defaultValue>"
121 . . . . . N ORK S ORK=0
122 . . . . . F S ORK=$O(VALIST(ORK)) Q:+ORK'>0 D
123 . . . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)=$$ESCAPE^XHDLXM($G(VALIST(ORK,0)))
124 . . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</defaultValue>"
125 . . . E D
126 . . . . N DVAL S DVAL=$$GET^XPAR("PKG",PAR,INST,$S(VDTYPE="D":"Q",1:"E"))
127 . . . . S VAL=$$XFORM^XHDPTREE(VAL,VDTYPE)
128 . . . . S DVAL=$$XFORM^XHDPTREE(DVAL,VDTYPE)
129 . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<value>"_$$ESCAPE^XHDLXM(VAL)_"</value>"
130 . . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="<defaultValue>"_$$ESCAPE^XHDLXM(DVAL)_"</defaultValue>"
131 . . . S XHDCI=XHDCI+1,@XHDCY@("XMLDOC",XHDCI)="</parameter>"
132 Q
Note: See TracBrowser for help on using the repository browser.