source: ccr/trunk/p/GPLXPATH.m@ 34

Last change on this file since 34 was 34, checked in by Christopher Edwards, 16 years ago

Enabled Vitals processing in GPLCCR.m
Fixed bug where if you ran EXPORTGPLCCR more than once body tags would still get added (added K TMP($J,"CCRSTEP") before setting it by INITSTPS)
Added code to start processing Vitals for selected patient
Cleaned up some of the template CCR so information in CCR would be correct

File size: 19.5 KB
Line 
1GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
2 ;;0.2;CCDCCR;nopatch;noreleasedate
3 W "This is an XML XPATH utility library",!
4 W !
5 Q
6 ;
7OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE
8 ;
9 N Y
10 S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
11 I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,!
12 ; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml")
13 Q
14 ;
15PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0)
16 ; VAL IS A STRING AND STK IS PASSED BY NAME
17 ;
18 I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
19 S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
20 S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
21 Q
22 ;
23POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
24 ; VAL AND STK ARE PASSED BY REFERENCE
25 ;
26 I @STK@(0)<1 S VAL="",@STK@(0)=0 Q ; IF ARRAY IS EMPTY
27 I @STK@(0)>0 D
28 . S VAL=@STK@(@STK@(0))
29 . K @STK@(@STK@(0))
30 . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
31 Q
32 ;
33MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK
34 ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
35 S RTN=""
36 N I
37 ; W "STK= ",STK,!
38 I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY
39 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
40 . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
41 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
42 Q
43 ;
44XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
45 ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
46 ; ISTR IS PASSED BY VALUE
47 N CUR,TMP
48 I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET
49 . S TMP=$P(ISTR,"<",2)
50 I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
51 . S TMP=$P(TMP,"/",2)
52 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
53 ; W "CUR= ",CUR,!
54 I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST>
55 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
56 ; W "CUR2= ",CUR,!
57 Q CUR
58 ;
59INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index
60 ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
61 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
62 ; XML SECTION
63 ; ZXML IS PASSED BY NAME
64 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
65 N GPLSTK ; LEAVE OUT FOR DEBUGGING
66 I '$D(@ZXML@(0)) D ; NO XML PASSED
67 . W "ERROR IN XML FILE",!
68 S GPLSTK(0)=0 ; INITIALIZE STACK
69 F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY
70 . S LINE=@ZXML@(I)
71 . ;W LINE,!
72 . S FOUND=0 ; INTIALIZED FOUND FLAG
73 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
74 . I FOUND'=1 D
75 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D
76 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS ON THE SAME LINE
77 . . . ; W "FOUND ",LINE,!
78 . . . S FOUND=1 ; SET FOUND FLAG
79 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
80 . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
81 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
82 . . . ; W "MDX=",MDX,!
83 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
84 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
85 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE
86 . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST LINE
87 . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
88 . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END OF A SEC
89 . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION
90 . . . ; W "FOUND ",LINE,!
91 . . . S FOUND=1 ; SET FOUND FLAG
92 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
93 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
94 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
95 . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
96 . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
97 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
98 . . . . Q
99 . I FOUND'=1 D ; THE LINE MIGHT CONTAIN THE BEGINNING OF A SECTION
100 . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION
101 . . . ; W "FOUND ",LINE,!
102 . . . S FOUND=1 ; SET FOUND FLAG
103 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
104 . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
105 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
106 . . . ; W "MDX=",MDX,!
107 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
108 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
109 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE
110 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
111 S @ZXML@("INDEXED")=""
112 S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
113 Q
114 ;
115QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
116 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
117 ; IARY AND OARY ARE PASSED BY NAME
118 I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY
119 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
120 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
121 N TMP,I,J,QXPATH
122 S FIRST=1
123 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
124 I XPATH'="//" D ; NOT A ROOT QUERY
125 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
126 . S FIRST=$P(TMP,"^",1)
127 . S LAST=$P(TMP,"^",2)
128 K @OARY
129 S @OARY@(0)=+LAST-FIRST+1
130 S J=1
131 FOR I=FIRST:1:LAST D
132 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
133 . S J=J+1
134 ; ZWR OARY
135 Q
136 ;
137XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
138 ; INDEX WITH TWO PIECES START^FINISH
139 ; IDX IS PASSED BY NAME
140 Q $P(@IDX@(XPATH),"^",1)
141 ;
142XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
143 ; INDEX WITH TWO PIECES START^FINISH
144 ; IDX IS PASSED BY NAME
145 Q $P(@IDX@(XPATH),"^",2)
146 ;
147START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
148 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
149 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
150 Q $P(ISTR,";",2)
151 ;
152FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
153 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
154 Q $P(ISTR,";",3)
155 ;
156ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
157 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
158 Q $P(ISTR,";",1)
159 ;
160BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
161 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
162 ; DEST IS CLEARED TO START
163 ; USES PUSH TO DO THE COPY
164 N I
165 K @BDEST
166 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
167 . N J,ATMP
168 . S ATMP=$$ARRAY(@BLIST@(I))
169 . I DEBUG W "ATMP=",ATMP,!
170 . I DEBUG W @BLIST@(I),!
171 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ;
172 . . ; FOR EACH LINE IN THIS INSTR
173 . . I DEBUG W "BDEST= ",BDEST,!
174 . . I DEBUG W "ATMP= ",@ATMP@(J),!
175 . . D PUSH(BDEST,@ATMP@(J))
176 Q
177 ;
178QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST
179 ;
180 I DEBUG W "QUEUEING ",BLST,!
181 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
182 Q
183 ;
184CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
185 ; KILLS CPDEST FIRST
186 N CPINSTR
187 I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
188 I @CPSRC@(0)<1 D ; BAD LENGTH
189 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
190 . Q
191 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INITIALIZE
192 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
193 D BUILD("CPINSTR",CPDEST)
194 Q
195 ;
196QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
197 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
198 ; QOXPATH IS OPTIONAL - IF PROVIDED, WILL OPEN INSIDE THE XPATH POINT
199 ; USED TO INSERT CHILDREN NODES
200 I @QOXML@(0)<1 D ; MALFORMED XML
201 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
202 . Q
203 I DEBUG W "DOING QOPEN",!
204 N S1,E1,QOT,QOTMP
205 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
206 I $D(QOXPATH) D ; XPATH PROVIDED
207 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
208 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
209 I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
210 . S E1=@QOXML@(0)-1
211 D QUEUE(QOBLIST,QOXML,S1,E1)
212 ; S QOTMP=QOXML_"^"_S1_"^"_E1
213 ; D PUSH(QOBLIST,QOTMP)
214 Q
215 ;
216QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
217 ; ADDS THE LIST LINE OF QCXML TO QCBLIST
218 ; USED TO FINISH INSERTING CHILDERN NODES
219 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
220 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
221 I @QCXML@(0)<1 D ; MALFORMED XML
222 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
223 I DEBUG W "GOING TO CLOSE",!
224 N S1,E1,QCT,QCTMP
225 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
226 I $D(QCXPATH) D ; XPATH PROVIDED
227 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
228 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
229 I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
230 . S S1=@QCXML@(0)
231 D QUEUE(QCBLIST,QCXML,S1,E1)
232 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
233 Q
234 ;
235INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
236 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
237 ; OMITTED, INSERTION WILL BE AT THE ROOT
238 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
239 ; XML AT THE END OF THE XPATH POINT
240 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
241 N INSBLD,INSTMP
242 I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
243 I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
244 I '$D(@INSXML@(0)) D Q ; INSERT INTO AN EMPTY ARRAY
245 . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
246 I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
247 . I $D(INSXPATH) D ; XPATH PROVIDED
248 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
249 . . I DEBUG ZWR INSBLD
250 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
251 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
252 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
253 . I $D(INSXPATH) D ; XPATH PROVIDED
254 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
255 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
256 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
257 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
258 . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
259 Q
260 ;
261INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
262 ; INTO INNXML AT THE INNXPATH XPATH POINT
263 ;
264 N INNBLD,UXPATH
265 N INNTBUF
266 S INNTBUF=$NA(^TMP($J,"INNTBUF"))
267 I '$D(INNXPATH) D ; XPATH NOT PASSED
268 . S UXPATH="//" ; USE ROOT XPATH
269 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
270 I '$D(@INNXML@(0)) D ; INNXML IS EMPTY
271 . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
272 . D BUILD("INNBLD",INNXML)
273 I @INNXML@(0)>0 D ; NOT EMPTY
274 . D QOPEN("INNBLD",INNXML,UXPATH) ;
275 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
276 . D QCLOSE("INNBLD",INNXML,UXPATH)
277 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
278 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
279 Q
280 ;
281REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
282 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
283 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
284 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
285 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
286 S OLD=$NA(^TMP($J,"REPLACE_OLD"))
287 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
288 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
289 S XFIRST=$P(XNODE,"^",1)
290 S XLAST=$P(XNODE,"^",2)
291 D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
292 I RENEW'="" D ; NEW XML IS NOT NULL
293 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
294 D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
295 I DEBUG W "REPALCE PREBUILD",!
296 I DEBUG ZWR REBLD
297 D BUILD("REBLD","RTMP")
298 K @REXML ; KILL WHAT WAS THERE
299 D CP("RTMP",REXML) ; COPY IN THE RESULT
300 Q
301 ;
302MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
303 ; W "Reporting on the missing",!
304 ; W OARY
305 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
306 N I
307 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
308 F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY
309 . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE
310 . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
311 . . Q
312 Q
313 ;
314MAP(IXML,INARY,OXML) ; SUBSTITUTE @@X@@ VARS IN IXML WITH VALUES IN INARY
315 ; AND PUT THE RESULTS IN OXML
316 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
317 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
318 N I,TNAM,TVAL
319 S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
320 F I=1:1:@OXML@(0) D ; LOOP THROUGH WHOLE ARRAY
321 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
322 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
323 . . S TNAM=$P(@OXML@(I),"@@",2) ; EXTRACT THE VARIABLE NAME
324 . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
325 . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
326 . . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3) ;MAPIT
327 W "MAPPED",!
328 Q
329 ;
330PARY(GLO) ;PRINT AN ARRAY
331 N I
332 F I=1:1:@GLO@(0) W @GLO@(I),!
333 Q
334 ;
335TEST ; Run all the test cases
336 D TESTALL^GPLUNIT("GPLXPATH")
337 Q
338 ;
339OLDTEST ; RUN ALL THE TEST CASES
340 N ZTMP
341 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
342 D ZTEST^GPLUNIT(.ZTMP,"ALL")
343 W "PASSED: ",TPASSED,!
344 W "FAILED: ",TFAILED,!
345 W !
346 ; W "THE TESTS!",!
347 ; ZWR ZTMP
348 Q
349 ;
350ZTEST(WHICH) ; RUN ONE SET OF TESTS
351 N ZTMP
352 S DEBUG=1
353 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
354 D ZTEST^GPLUNIT(.ZTMP,WHICH)
355 Q
356 ;
357TLIST ; LIST THE TESTS
358 N ZTMP
359 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
360 D TLIST^GPLUNIT(.ZTMP)
361 Q
362 ;
363;;><TEST>
364;;><INIT>
365;;>>>K GPL S GPL=""
366;;>>>D PUSH^GPLXPATH("GPL","FIRST")
367;;>>>D PUSH^GPLXPATH("GPL","SECOND")
368;;>>>D PUSH^GPLXPATH("GPL","THIRD")
369;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
370;;>>?GPL(0)=4
371;;><INITXML>
372;;>>>K GXML S GXML=""
373;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
374;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
375;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
376;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
377;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
378;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
379;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
380;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
381;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
382;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
383;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
384;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
385;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
386;;><INITXML2>
387;;>>>K GXML S GXML=""
388;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
389;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
390;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
391;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
392;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
393;;>>>D PUSH^GPLXPATH("GXML","DATA2")
394;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
395;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
396;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
397;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
398;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
399;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
400;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
401;;><PUSHPOP>
402;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
403;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
404;;>>?GPL(GPL(0))="FOURTH"
405;;>>>D POP^GPLXPATH("GPL",.GX)
406;;>>?GX="FOURTH"
407;;>>?GPL(GPL(0))="THIRD"
408;;>>>D POP^GPLXPATH("GPL",.GX)
409;;>>?GX="THIRD"
410;;>>?GPL(GPL(0))="SECOND"
411;;><MKMDX>
412;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
413;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
414;;>>>S GX=""
415;;>>>D MKMDX^GPLXPATH("GPL",.GX)
416;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
417;;><XNAME>
418;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
419;;>>?$$XNAME^GPLXPATH("<SIXTH ID=""SELF"" />")="SIXTH"
420;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
421;;><INDEX>
422;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
423;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
424;;>>>D INDEX^GPLXPATH("GXML")
425;;>>?GXML("//FIRST/SECOND")="2^12"
426;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
427;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
428;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4"
429;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8"
430;;>>?GXML("//FIRST/SECOND")="2^12"
431;;>>?GXML("//FIRST")="1^13"
432;;><INDEX2>
433;;>>>D ZTEST^GPLXPATH("INITXML2")
434;;>>>D INDEX^GPLXPATH("GXML")
435;;>>?GXML("//FIRST/SECOND")="2^12"
436;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
437;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"
438;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
439;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7"
440;;>>?GXML("//FIRST")="1^13"
441;;><MISSING>
442;;>>>D ZTEST^GPLXPATH("INITXML")
443;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
444;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
445;;>>?@OUTARY@(1)="DATA1"
446;;>>?@OUTARY@(2)="DATA2"
447;;><MAP>
448;;>>>D ZTEST^GPLXPATH("INITXML")
449;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
450;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
451;;>>>S @MAPARY@("DATA2")="VALUE2"
452;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
453;;>>?@OUTARY@(6)="VALUE2"
454;;><QUEUE>
455;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
456;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
457;;>>?$P(BTLIST(2),";",2)=4
458;;><BUILD>
459;;>>>D ZTEST^GPLXPATH("INITXML")
460;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
461;;>>>D ZTEST^GPLXPATH("QUEUE")
462;;>>>D BUILD^GPLXPATH("BTLIST","G3")
463;;><CP>
464;;>>>D ZTEST^GPLXPATH("INITXML")
465;;>>>D CP^GPLXPATH("GXML","G2")
466;;>>?G2(0)=13
467;;><QOPEN>
468;;>>>K G2,GBL
469;;>>>D ZTEST^GPLXPATH("INITXML")
470;;>>>D QOPEN^GPLXPATH("GBL","GXML")
471;;>>?$P(GBL(1),";",3)=12
472;;>>>D BUILD^GPLXPATH("GBL","G2")
473;;>>?G2(G2(0))="</SECOND>"
474;;><QOPEN2>
475;;>>>K G2,GBL
476;;>>>D ZTEST^GPLXPATH("INITXML")
477;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
478;;>>?$P(GBL(1),";",3)=11
479;;>>>D BUILD^GPLXPATH("GBL","G2")
480;;>>?G2(G2(0))="</SECOND>"
481;;><QCLOSE>
482;;>>>K G2,GBL
483;;>>>D ZTEST^GPLXPATH("INITXML")
484;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
485;;>>?$P(GBL(1),";",3)=13
486;;>>>D BUILD^GPLXPATH("GBL","G2")
487;;>>?G2(G2(0))="</FIRST>"
488;;><QCLOSE2>
489;;>>>K G2,GBL
490;;>>>D ZTEST^GPLXPATH("INITXML")
491;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
492;;>>?$P(GBL(1),";",3)=13
493;;>>>D BUILD^GPLXPATH("GBL","G2")
494;;>>?G2(G2(0))="</FIRST>"
495;;>>?G2(1)="</THIRD>"
496;;><INSERT>
497;;>>>K G2,GBL,G3,G4
498;;>>>D ZTEST^GPLXPATH("INITXML")
499;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
500;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
501;;>>>D INSERT^GPLXPATH("G3","G2","//")
502;;>>?G2(1)=GXML(9)
503;;><REPLACE>
504;;>>>K G2,GBL,G3
505;;>>>D ZTEST^GPLXPATH("INITXML")
506;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
507;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
508;;>>?GXML(3)="<FIFTH>"
509;;><INSINNER>
510;;>>>K GXML,G2,GBL,G3
511;;>>>D ZTEST^GPLXPATH("INITXML")
512;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
513;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
514;;>>?GXML(10)="<FIFTH>"
515;;><INSINNER2>
516;;>>>K GXML,G2,GBL,G3
517;;>>>D ZTEST^GPLXPATH("INITXML")
518;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
519;;>>>D INSINNER^GPLXPATH("G2","G2")
520;;>>?G2(8)="<FIFTH>"
521;;></TEST>
Note: See TracBrowser for help on using the repository browser.