[1571] | 1 | C0SXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 ; 9/26/12 10:45am
|
---|
| 2 | ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
|
---|
| 3 | ;Copyright 2008-2012 George Lilly. Licensed under the terms of the GNU
|
---|
| 4 | ;General Public License See attached copy of the License.
|
---|
| 5 | ;
|
---|
| 6 | ;This program is free software; you can redistribute it and/or modify
|
---|
| 7 | ;it under the terms of the GNU General Public License as published by
|
---|
| 8 | ;the Free Software Foundation; either version 2 of the License, or
|
---|
| 9 | ;(at your option) any later version.
|
---|
| 10 | ;
|
---|
| 11 | ;This program is distributed in the hope that it will be useful,
|
---|
| 12 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
| 13 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
| 14 | ;GNU General Public License for more details.
|
---|
| 15 | ;
|
---|
| 16 | ;You should have received a copy of the GNU General Public License along
|
---|
| 17 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
---|
| 18 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
---|
| 19 | ;
|
---|
| 20 | W "This is an XML XPATH utility library",!
|
---|
| 21 | W !
|
---|
| 22 | Q
|
---|
| 23 | ;
|
---|
| 24 | OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE
|
---|
| 25 | ;
|
---|
| 26 | N Y
|
---|
| 27 | S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
|
---|
| 28 | I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
|
---|
| 29 | I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
|
---|
| 30 | Q
|
---|
| 31 | ;
|
---|
| 32 | PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0)
|
---|
| 33 | ; VAL IS A STRING AND STK IS PASSED BY NAME
|
---|
| 34 | ;
|
---|
| 35 | I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
|
---|
| 36 | S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
|
---|
| 37 | S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
|
---|
| 38 | Q
|
---|
| 39 | ;
|
---|
| 40 | POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
|
---|
| 41 | ; VAL AND STK ARE PASSED BY REFERENCE
|
---|
| 42 | ;
|
---|
| 43 | I @STK@(0)<1 D ; IF ARRAY IS EMPTY
|
---|
| 44 | . S VAL=""
|
---|
| 45 | . S @STK@(0)=0
|
---|
| 46 | I @STK@(0)>0 D ;
|
---|
| 47 | . S VAL=@STK@(@STK@(0))
|
---|
| 48 | . K @STK@(@STK@(0))
|
---|
| 49 | . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
|
---|
| 50 | Q
|
---|
| 51 | ;
|
---|
| 52 | PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
|
---|
| 53 | ;
|
---|
| 54 | N ZGI
|
---|
| 55 | F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY
|
---|
| 56 | . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
|
---|
| 57 | Q
|
---|
| 58 | ;
|
---|
| 59 | MKMDX(STK,RTN,INREDUX) ; MAKES A MUMPS INDEX FROM THE ARRAY STK
|
---|
| 60 | ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
|
---|
| 61 | ; REDUX IS A STRING TO REMOVE FROM THE RESULT
|
---|
| 62 | S RTN=""
|
---|
| 63 | N I
|
---|
| 64 | ; W "STK= ",STK,!
|
---|
| 65 | I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY
|
---|
| 66 | . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
|
---|
| 67 | . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
|
---|
| 68 | . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
|
---|
| 69 | I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2)
|
---|
| 70 | Q
|
---|
| 71 | ;
|
---|
| 72 | XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
|
---|
| 73 | ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
|
---|
| 74 | ; ISTR IS PASSED BY VALUE
|
---|
| 75 | N CUR,TMP
|
---|
| 76 | I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET
|
---|
| 77 | . S TMP=$P(ISTR,"<",2)
|
---|
| 78 | I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
|
---|
| 79 | . S TMP=$P(TMP,"/",2)
|
---|
| 80 | S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
|
---|
| 81 | ; W "CUR= ",CUR,!
|
---|
| 82 | I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST>
|
---|
| 83 | . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
|
---|
| 84 | ; W "CUR2= ",CUR,!
|
---|
| 85 | Q CUR
|
---|
| 86 | ;
|
---|
| 87 | XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML
|
---|
| 88 | ; <NAME>VALUE</NAME> WILL RETURN VALUE
|
---|
| 89 | N G
|
---|
| 90 | S G=$P(ISTR,">",2) ;STRIP OFF <NAME>
|
---|
| 91 | Q $P(G,"<",1) ; STRIP OFF </NAME> LEAVING VALUE
|
---|
| 92 | ;
|
---|
| 93 | VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV
|
---|
| 94 | ; VDX: @INVDX@(XPATH)=VALUE
|
---|
| 95 | ; VDV: @OUTVDV@(X1X2X3X4)=VALUE
|
---|
| 96 | ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE
|
---|
| 97 | ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS
|
---|
| 98 | ; @VDV@("XPATH",X1X2X3X4)="XPATH"
|
---|
| 99 | N ZA,ZI,ZW
|
---|
| 100 | S ZI=""
|
---|
| 101 | F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ;
|
---|
| 102 | . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME
|
---|
| 103 | . W ZW,!
|
---|
| 104 | . S @OUTVDV@(ZW)=@INVDX@(ZI)
|
---|
| 105 | . S @OUTVDV@("XPATH",ZW)=ZI
|
---|
| 106 | Q
|
---|
| 107 | ;
|
---|
| 108 | VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG
|
---|
| 109 | ; VDX: @VDX@(XPATH)=VALUE
|
---|
| 110 | ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE
|
---|
| 111 | ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX
|
---|
| 112 | N ZA,ZI,ZW
|
---|
| 113 | S ZI=""
|
---|
| 114 | F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ;
|
---|
| 115 | . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL //
|
---|
| 116 | . S ZW2=$P(ZW,"/",1)
|
---|
| 117 | . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK))
|
---|
| 118 | . ;ZWR ZA
|
---|
| 119 | . S ZW2=ZA(1)
|
---|
| 120 | . F ZK=2:1:ZA(0) D ;
|
---|
| 121 | . . S ZW2=ZW2_""","""_ZA(ZK)
|
---|
| 122 | . K ZA
|
---|
| 123 | . S ZW2=""""_ZW2_""""
|
---|
| 124 | . W ZW2,!
|
---|
| 125 | . S ZN=OUTXPG_"("_ZW2_")"
|
---|
| 126 | . S @ZN=@INVDX@(ZI)
|
---|
| 127 | Q
|
---|
| 128 | ;
|
---|
| 129 | XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY
|
---|
| 130 | ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE
|
---|
| 131 | ;
|
---|
| 132 | ;N G1
|
---|
| 133 | D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED
|
---|
| 134 | D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM
|
---|
| 135 | Q
|
---|
| 136 | ;
|
---|
| 137 | DO
|
---|
| 138 | D XPG2XML("^GPL2B","^GPL2A")
|
---|
| 139 | Q
|
---|
| 140 | ;
|
---|
| 141 | T1 ; TEST OUT THESE ROUTINES
|
---|
| 142 | D XML2XPG("G2","^GPL")
|
---|
| 143 | D XPG2XML("G3","G2")
|
---|
| 144 | K ^GPLOUT
|
---|
| 145 | M ^GPLOUT=G3
|
---|
| 146 | W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p")
|
---|
| 147 | Q
|
---|
| 148 | ;
|
---|
| 149 | XPG2XML(OUTXML,INXPG) ;
|
---|
| 150 | N C0CN,FWD,ZA,G,GA,ZQ
|
---|
| 151 | S ZQ=0 ; QUIT FLAG
|
---|
| 152 | F Q:ZQ=1 D ; LOOP THROUGH EVERYTHING
|
---|
| 153 | . I '$D(C0CN) D ; FIRST TIME THROUGH
|
---|
| 154 | . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR
|
---|
| 155 | . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS
|
---|
| 156 | . . S G=$Q(@INXPG) ; THIS ONE
|
---|
| 157 | . . S GN=$Q(@G) ; NEXT ONE
|
---|
| 158 | . . S C0CN=1 ; SUBSCRIPT COUNT
|
---|
| 159 | . . S ZQ=0 ; QUIT FLAG
|
---|
| 160 | . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML
|
---|
| 161 | . . I $QS(G,1)="ContinuityOfCareRecord" D ;
|
---|
| 162 | . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK
|
---|
| 163 | . I FWD D ; GOING FORWARDS
|
---|
| 164 | . . I C0CN<$QL(G) D ; NOT A DATA NODE
|
---|
| 165 | . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
|
---|
| 166 | . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT
|
---|
| 167 | . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D ;
|
---|
| 168 | . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">"
|
---|
| 169 | . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE
|
---|
| 170 | . . E D ; AT THE DATA NODE
|
---|
| 171 | . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
|
---|
| 172 | . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE
|
---|
| 173 | . . . S FWD=0 ; GO BACKWARDS
|
---|
| 174 | . I 'FWD D ;GOING BACKWARDS
|
---|
| 175 | . . S GN=$Q(@G) ;NEXT XPATH
|
---|
| 176 | . . ;W "NEXT!",GN,!
|
---|
| 177 | . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT
|
---|
| 178 | . . I GN'="" D ;
|
---|
| 179 | . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D ; NEED TO CLOSE OFF ELEMENT
|
---|
| 180 | . . . . D ZXC($QS(G,C0CN)) ;
|
---|
| 181 | . . . E I GN'="" D ; MORE ELEMENTS AT THIS LEVEL
|
---|
| 182 | . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH
|
---|
| 183 | . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT
|
---|
| 184 | . . . . S FWD=1 ; GOING FORWARD NOW
|
---|
| 185 | . I (GN="")&(C0CN=1) D Q ; WHEN WE ARE ALL DONE
|
---|
| 186 | . . D ZXC($QS(G,C0CN)) ; LAST ONE
|
---|
| 187 | . . S ZQ=1 ; QUIT NOW
|
---|
| 188 | Q
|
---|
| 189 | ;
|
---|
| 190 | ZXO(WHAT)
|
---|
| 191 | D PUSH("GA",WHAT)
|
---|
| 192 | D PUSH(OUTXML,"<"_WHAT_">")
|
---|
| 193 | Q
|
---|
| 194 | ;
|
---|
| 195 | ZXC(WHAT)
|
---|
| 196 | D POP("GA",.TMP)
|
---|
| 197 | D PUSH(OUTXML,"</"_WHAT_">")
|
---|
| 198 | Q
|
---|
| 199 | ;
|
---|
| 200 | ZXVAL(WHAT,VAL)
|
---|
| 201 | D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">")
|
---|
| 202 | Q
|
---|
| 203 | ;
|
---|
| 204 | INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce
|
---|
| 205 | ; an XPATH index; REDUX is a string to be removed from each xpath
|
---|
| 206 | ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME
|
---|
| 207 | ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE
|
---|
| 208 | ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG
|
---|
| 209 | ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME
|
---|
| 210 | ; @VDX@("XPATH")=VALUE
|
---|
| 211 | ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE
|
---|
| 212 | ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
|
---|
| 213 | ; XML SECTION
|
---|
| 214 | ; IZXML IS PASSED BY NAME
|
---|
| 215 | ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE
|
---|
| 216 | N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT
|
---|
| 217 | N C0CSTK ; LEAVE OUT FOR DEBUGGING
|
---|
| 218 | I '$D(REDUX) S REDUX=""
|
---|
| 219 | I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX
|
---|
| 220 | N ZXML
|
---|
| 221 | I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD
|
---|
| 222 | E S ZXML=IZXML ; PLACE FOR INDEX TO KEEP
|
---|
| 223 | I '$D(@IZXML@(0)) D ; IF COUNT NOT IN NODE 0 COUNT THEM
|
---|
| 224 | . S I="",LCNT=0
|
---|
| 225 | . F S I=$O(@IZXML@(I)) Q:I="" S LCNT=LCNT+1
|
---|
| 226 | E S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY
|
---|
| 227 | I LCNT=0 D Q ; NO XML PASSED
|
---|
| 228 | . W "ERROR IN XML FILE",!
|
---|
| 229 | S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX
|
---|
| 230 | I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX
|
---|
| 231 | S C0CSTK(0)=0 ; INITIALIZE STACK
|
---|
| 232 | K LKASD ; KILL LOOKASIDE ARRAY
|
---|
| 233 | D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES
|
---|
| 234 | F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY
|
---|
| 235 | . S LINE=@IZXML@(I)
|
---|
| 236 | . I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED
|
---|
| 237 | . . S @TEMPLATE@(I)=$$CLEAN(LINE)
|
---|
| 238 | . ;W LINE,!
|
---|
| 239 | . S FOUND=0 ; INTIALIZED FOUND FLAG
|
---|
| 240 | . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
|
---|
| 241 | . I FOUND'=1 D
|
---|
| 242 | . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D
|
---|
| 243 | . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
|
---|
| 244 | . . . ; ON THE SAME LINE
|
---|
| 245 | . . . ; W "FOUND ",LINE,!
|
---|
| 246 | . . . S FOUND=1 ; SET FOUND FLAG
|
---|
| 247 | . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
---|
| 248 | . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
|
---|
| 249 | . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
|
---|
| 250 | . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX
|
---|
| 251 | . . . ; W "MDX=",MDX,!
|
---|
| 252 | . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
|
---|
| 253 | . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2
|
---|
| 254 | . . . . ;E S ZDUP(MDX)=ZDUP(MDX)+1
|
---|
| 255 | . . . . ;W "DUP:",MDX,!
|
---|
| 256 | . . . . ;I '$D(CURVAL) S CURVAL=""
|
---|
| 257 | . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL
|
---|
| 258 | . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
---|
| 259 | . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
|
---|
| 260 | . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST
|
---|
| 261 | . . . . S CURVAL=$$XVAL(LINE) ; VALUE
|
---|
| 262 | . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE
|
---|
| 263 | . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED
|
---|
| 264 | . . . . I $D(TEMPLATE) D ; IF TEMPLATE IS REQUESTED
|
---|
| 265 | . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS
|
---|
| 266 | . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@</"_$P(LINE,"</",2)
|
---|
| 267 | . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
|
---|
| 268 | . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END
|
---|
| 269 | . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION
|
---|
| 270 | . . . ; W "FOUND ",LINE,!
|
---|
| 271 | . . . S FOUND=1 ; SET FOUND FLAG
|
---|
| 272 | . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
---|
| 273 | . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
|
---|
| 274 | . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
---|
| 275 | . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
|
---|
| 276 | . . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE
|
---|
| 277 | . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
|
---|
| 278 | . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
|
---|
| 279 | . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING
|
---|
| 280 | . . . . Q
|
---|
| 281 | . I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
|
---|
| 282 | . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION
|
---|
| 283 | . . . ; W "FOUND ",LINE,!
|
---|
| 284 | . . . S FOUND=1 ; SET FOUND FLAG
|
---|
| 285 | . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
|
---|
| 286 | . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
|
---|
| 287 | . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
|
---|
| 288 | . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
|
---|
| 289 | . . . ; W "MDX=",MDX,!
|
---|
| 290 | . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
|
---|
| 291 | . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
|
---|
| 292 | . . . . ;B
|
---|
| 293 | . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
|
---|
| 294 | . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
|
---|
| 295 | S @ZXML@("INDEXED")=""
|
---|
| 296 | S @ZXML@("//")="1^"_LCNT ; ROOT XPATH
|
---|
| 297 | I NOINX K @ZXML ; DELETE UNWANTED INDEX
|
---|
| 298 | Q
|
---|
| 299 | ;
|
---|
| 300 | MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES
|
---|
| 301 | ;
|
---|
| 302 | N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2
|
---|
| 303 | F ZI=1:1:LCNT-1 D ; PROCESS THE ENTIRE ARRAY
|
---|
| 304 | . S ZLINE=@IZXML@(ZI)
|
---|
| 305 | . I ZI<LCNT S ZLINE2=@IZXML@(ZI+1)
|
---|
| 306 | . I ZLINE?.E1"</"1.E D ; NEXT LINE CONTAINS END OF A SECTION
|
---|
| 307 | . . S CUR=$$XNAME(ZLINE) ; EXTRACT THE NAME
|
---|
| 308 | . . I (ZLINE2?.E1"<"1.E)&(ZLINE'["?>") D ; BEGINNING OF A SECTION
|
---|
| 309 | . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME
|
---|
| 310 | . . . I CUR=CUR2 D ; IF THIS IS A MULTIPLE
|
---|
| 311 | . . . . S OUTBUF(CUR,ZI+1)=""
|
---|
| 312 | ;ZWR OUTBUF
|
---|
| 313 | S ZI=""
|
---|
| 314 | F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE
|
---|
| 315 | . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE
|
---|
| 316 | . F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q ;
|
---|
| 317 | . S OUTBUF(ZI,ZN)=""
|
---|
| 318 | S ZA=1,ZI="",ZN=""
|
---|
| 319 | F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x]
|
---|
| 320 | . S ZN="",ZA=1
|
---|
| 321 | . F S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN="" D ;
|
---|
| 322 | . . S OUTBUF(ZI,ZN)="["_ZA_"]"
|
---|
| 323 | . . S ZA=ZA+1
|
---|
| 324 | Q
|
---|
| 325 | ;
|
---|
| 326 | CLEAN(STR,TR) ; extrinsic function; returns string
|
---|
| 327 | ;; Removes all non printable characters from a string.
|
---|
| 328 | ;; STR by Value
|
---|
| 329 | ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE
|
---|
| 330 | N TR,I
|
---|
| 331 | I '$D(TR) D ;
|
---|
| 332 | . F I=0:1:31 S TR=$G(TR)_$C(I)
|
---|
| 333 | . S TR=TR_$C(127)
|
---|
| 334 | QUIT $TR(STR,TR)
|
---|
| 335 | ;
|
---|
| 336 | QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
|
---|
| 337 | ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
|
---|
| 338 | ; IARY AND OARY ARE PASSED BY NAME
|
---|
| 339 | I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY
|
---|
| 340 | . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
|
---|
| 341 | N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
|
---|
| 342 | N TMP,I,J,QXPATH
|
---|
| 343 | S FIRST=1
|
---|
| 344 | I '$D(@IARY@(0)) D ; LINE COUNT NOT IN ZERO NODE
|
---|
| 345 | . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK
|
---|
| 346 | S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
|
---|
| 347 | I XPATH'="//" D ; NOT A ROOT QUERY
|
---|
| 348 | . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
|
---|
| 349 | . S FIRST=$P(TMP,"^",1)
|
---|
| 350 | . S LAST=$P(TMP,"^",2)
|
---|
| 351 | K @OARY
|
---|
| 352 | S @OARY@(0)=+LAST-FIRST+1
|
---|
| 353 | S J=1
|
---|
| 354 | FOR I=FIRST:1:LAST D
|
---|
| 355 | . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
|
---|
| 356 | . S J=J+1
|
---|
| 357 | ; ZWR OARY
|
---|
| 358 | Q
|
---|
| 359 | ;
|
---|
| 360 | XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
|
---|
| 361 | ; INDEX WITH TWO PIECES START^FINISH
|
---|
| 362 | ; IDX IS PASSED BY NAME
|
---|
| 363 | Q $P(@IDX@(XPATH),"^",1)
|
---|
| 364 | ;
|
---|
| 365 | XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
|
---|
| 366 | ; INDEX WITH TWO PIECES START^FINISH
|
---|
| 367 | ; IDX IS PASSED BY NAME
|
---|
| 368 | Q $P(@IDX@(XPATH),"^",2)
|
---|
| 369 | ;
|
---|
| 370 | START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
|
---|
| 371 | ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
---|
| 372 | ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
|
---|
| 373 | Q $P(ISTR,";",2)
|
---|
| 374 | ;
|
---|
| 375 | FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
|
---|
| 376 | ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
---|
| 377 | Q $P(ISTR,";",3)
|
---|
| 378 | ;
|
---|
| 379 | ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
|
---|
| 380 | ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
|
---|
| 381 | Q $P(ISTR,";",1)
|
---|
| 382 | ;
|
---|
| 383 | BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
|
---|
| 384 | ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
|
---|
| 385 | ; DEST IS CLEARED TO START
|
---|
| 386 | ; USES PUSH TO DO THE COPY
|
---|
| 387 | N I
|
---|
| 388 | K @BDEST
|
---|
| 389 | F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
|
---|
| 390 | . N J,ATMP
|
---|
| 391 | . S ATMP=$$ARRAY(@BLIST@(I))
|
---|
| 392 | . I $G(DEBUG) W "ATMP=",ATMP,!
|
---|
| 393 | . I $G(DEBUG) W @BLIST@(I),!
|
---|
| 394 | . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ;
|
---|
| 395 | . . ; FOR EACH LINE IN THIS INSTR
|
---|
| 396 | . . I $G(DEBUG) W "BDEST= ",BDEST,!
|
---|
| 397 | . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
|
---|
| 398 | . . D PUSH(BDEST,@ATMP@(J))
|
---|
| 399 | Q
|
---|
| 400 | ;
|
---|
| 401 | QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST
|
---|
| 402 | ;
|
---|
| 403 | I $G(DEBUG) W "QUEUEING ",BLST,!
|
---|
| 404 | D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
|
---|
| 405 | Q
|
---|
| 406 | ;
|
---|
| 407 | CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
|
---|
| 408 | ; KILLS CPDEST FIRST
|
---|
| 409 | N CPINSTR
|
---|
| 410 | I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,!
|
---|
| 411 | I @CPSRC@(0)<1 D ; BAD LENGTH
|
---|
| 412 | . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
|
---|
| 413 | . Q
|
---|
| 414 | ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
|
---|
| 415 | D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
|
---|
| 416 | D BUILD("CPINSTR",CPDEST)
|
---|
| 417 | Q
|
---|
| 418 | ;
|
---|
| 419 | QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
|
---|
| 420 | ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
|
---|
| 421 | ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
|
---|
| 422 | ; USED TO INSERT CHILDREN NODES
|
---|
| 423 | I @QOXML@(0)<1 D ; MALFORMED XML
|
---|
| 424 | . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
|
---|
| 425 | . Q
|
---|
| 426 | I $G(DEBUG) W "DOING QOPEN",!
|
---|
| 427 | N S1,E1,QOT,QOTMP
|
---|
| 428 | S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
|
---|
| 429 | I $D(QOXPATH) D ; XPATH PROVIDED
|
---|
| 430 | . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
|
---|
| 431 | . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
|
---|
| 432 | I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
|
---|
| 433 | . S E1=@QOXML@(0)-1
|
---|
| 434 | D QUEUE(QOBLIST,QOXML,S1,E1)
|
---|
| 435 | ; S QOTMP=QOXML_"^"_S1_"^"_E1
|
---|
| 436 | ; D PUSH(QOBLIST,QOTMP)
|
---|
| 437 | Q
|
---|
| 438 | ;
|
---|
| 439 | QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
|
---|
| 440 | ; ADDS THE LIST LINE OF QCXML TO QCBLIST
|
---|
| 441 | ; USED TO FINISH INSERTING CHILDERN NODES
|
---|
| 442 | ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
|
---|
| 443 | ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
|
---|
| 444 | I @QCXML@(0)<1 D ; MALFORMED XML
|
---|
| 445 | . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
|
---|
| 446 | I $G(DEBUG) W "GOING TO CLOSE",!
|
---|
| 447 | N S1,E1,QCT,QCTMP
|
---|
| 448 | S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
|
---|
| 449 | I $D(QCXPATH) D ; XPATH PROVIDED
|
---|
| 450 | . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
|
---|
| 451 | . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
|
---|
| 452 | I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
|
---|
| 453 | . S S1=@QCXML@(0)
|
---|
| 454 | D QUEUE(QCBLIST,QCXML,S1,E1)
|
---|
| 455 | ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
|
---|
| 456 | Q
|
---|
| 457 | ;
|
---|
| 458 | INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
|
---|
| 459 | ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
|
---|
| 460 | ; OMITTED, INSERTION WILL BE AT THE ROOT
|
---|
| 461 | ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
|
---|
| 462 | ; XML AT THE END OF THE XPATH POINT
|
---|
| 463 | ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
|
---|
| 464 | N INSBLD,INSTMP
|
---|
| 465 | I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
|
---|
| 466 | I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
|
---|
| 467 | I '$D(@INSXML@(1)) D ; INSERT INTO AN EMPTY ARRAY
|
---|
| 468 | . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
|
---|
| 469 | I $D(@INSXML@(1)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
|
---|
| 470 | . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH
|
---|
| 471 | . I $D(INSXPATH) D ; XPATH PROVIDED
|
---|
| 472 | . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
|
---|
| 473 | . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD")
|
---|
| 474 | . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
|
---|
| 475 | . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
|
---|
| 476 | . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML
|
---|
| 477 | . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
|
---|
| 478 | . I $D(INSXPATH) D ; XPATH PROVIDED
|
---|
| 479 | . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
|
---|
| 480 | . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
|
---|
| 481 | . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
|
---|
| 482 | . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
|
---|
| 483 | . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
|
---|
| 484 | Q
|
---|
| 485 | ;
|
---|
| 486 | INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
|
---|
| 487 | ; INTO INNXML AT THE INNXPATH XPATH POINT
|
---|
| 488 | ;
|
---|
| 489 | N INNBLD,UXPATH
|
---|
| 490 | N INNTBUF
|
---|
| 491 | S INNTBUF=$NA(^TMP($J,"INNTBUF"))
|
---|
| 492 | I '$D(INNXPATH) D ; XPATH NOT PASSED
|
---|
| 493 | . S UXPATH="//" ; USE ROOT XPATH
|
---|
| 494 | I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
|
---|
| 495 | I '$D(@INNXML@(0)) D ; INNXML IS EMPTY
|
---|
| 496 | . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
|
---|
| 497 | . D BUILD("INNBLD",INNXML)
|
---|
| 498 | I @INNXML@(0)>0 D ; NOT EMPTY
|
---|
| 499 | . D QOPEN("INNBLD",INNXML,UXPATH) ;
|
---|
| 500 | . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
|
---|
| 501 | . D QCLOSE("INNBLD",INNXML,UXPATH)
|
---|
| 502 | . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
|
---|
| 503 | . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
|
---|
| 504 | Q
|
---|
| 505 | ;
|
---|
| 506 | INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
|
---|
| 507 | ; BUT XDEST AN XNEW ARE PASSED BY NAME
|
---|
| 508 | N XBLD,XTMP
|
---|
| 509 | D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
|
---|
| 510 | D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
|
---|
| 511 | D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
|
---|
| 512 | D BUILD("XBLD","XTMP") ; BUILD THE RESULT
|
---|
| 513 | D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
|
---|
| 514 | I $G(DEBUG) D PARY("XDEST")
|
---|
| 515 | Q
|
---|
| 516 | ;
|
---|
| 517 | REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
|
---|
| 518 | ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
|
---|
| 519 | ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
|
---|
| 520 | ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
|
---|
| 521 | N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
|
---|
| 522 | S OLD=$NA(^TMP($J,"REPLACE_OLD"))
|
---|
| 523 | D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
|
---|
| 524 | S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
|
---|
| 525 | S XFIRST=$P(XNODE,"^",1)
|
---|
| 526 | S XLAST=$P(XNODE,"^",2)
|
---|
| 527 | I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
|
---|
| 528 | . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
|
---|
| 529 | . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
|
---|
| 530 | I RENEW'="" D ; NEW XML IS NOT NULL
|
---|
| 531 | . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
|
---|
| 532 | . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
|
---|
| 533 | . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
|
---|
| 534 | I $G(DEBUG) W "REPLACE PREBUILD",!
|
---|
| 535 | I $G(DEBUG) D PARY("REBLD")
|
---|
| 536 | D BUILD("REBLD","RTMP")
|
---|
| 537 | K @REXML ; KILL WHAT WAS THERE
|
---|
| 538 | D CP("RTMP",REXML) ; COPY IN THE RESULT
|
---|
| 539 | Q
|
---|
| 540 | ;
|
---|
| 541 | DELETE(REXML,REXPATH) ; DELETE THE XML AT THE XPATH POINT
|
---|
| 542 | ; REXML IS PASSED BY NAME XPATH IS A VALUE
|
---|
| 543 | N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
|
---|
| 544 | S OLD=$NA(^TMP($J,"REPLACE_OLD"))
|
---|
| 545 | D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
|
---|
| 546 | S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
|
---|
| 547 | S XFIRST=$P(XNODE,"^",1)
|
---|
| 548 | S XLAST=$P(XNODE,"^",2)
|
---|
| 549 | D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
|
---|
| 550 | D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
|
---|
| 551 | I $G(DEBUG) D PARY("REBLD")
|
---|
| 552 | D BUILD("REBLD","RTMP")
|
---|
| 553 | K @REXML ; KILL WHAT WAS THERE
|
---|
| 554 | D CP("RTMP",REXML) ; COPY IN THE RESULT
|
---|
| 555 | Q
|
---|
| 556 | ;
|
---|
| 557 | MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
|
---|
| 558 | ; W "Reporting on the missing",!
|
---|
| 559 | ; W OARY
|
---|
| 560 | I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
|
---|
| 561 | N I
|
---|
| 562 | S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
|
---|
| 563 | F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY
|
---|
| 564 | . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE
|
---|
| 565 | . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
|
---|
| 566 | . . Q
|
---|
| 567 | Q
|
---|
| 568 | ;
|
---|
| 569 | MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
|
---|
| 570 | ; AND PUT THE RESULTS IN OXML
|
---|
| 571 | N XCNT
|
---|
| 572 | I '$D(DEBUG) S DEBUG=0
|
---|
| 573 | I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q
|
---|
| 574 | I '$D(@IXML@(0)) D ; INITIALIZE COUNT
|
---|
| 575 | . S XCNT=$O(@IXML@(""),-1)
|
---|
| 576 | E S XCNT=@IXML@(0) ;COUNT
|
---|
| 577 | I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
|
---|
| 578 | N I,J,TNAM,TVAL,TSTR
|
---|
| 579 | S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT
|
---|
| 580 | F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY
|
---|
| 581 | . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
|
---|
| 582 | . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
|
---|
| 583 | . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
|
---|
| 584 | . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
|
---|
| 585 | . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
|
---|
| 586 | . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
|
---|
| 587 | . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
|
---|
| 588 | . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
|
---|
| 589 | . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD
|
---|
| 590 | . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
|
---|
| 591 | . . . . E D DOFLD ; PROCESS A FIELD
|
---|
| 592 | . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
|
---|
| 593 | . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
|
---|
| 594 | . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
|
---|
| 595 | . . I DEBUG W TSTR
|
---|
| 596 | I DEBUG W "MAPPED",!
|
---|
| 597 | Q
|
---|
| 598 | ;
|
---|
| 599 | DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
|
---|
| 600 | ;
|
---|
| 601 | Q
|
---|
| 602 | ;
|
---|
| 603 | TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
|
---|
| 604 | ; THEXML IS PASSED BY NAME
|
---|
| 605 | N I,J,TMPXML,DEL,FOUND,INTXT
|
---|
| 606 | S FOUND=0
|
---|
| 607 | S INTXT=0
|
---|
| 608 | I $G(DEBUG) W "DELETING EMPTY ELEMENTS",!
|
---|
| 609 | F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY
|
---|
| 610 | . S J=@THEXML@(I)
|
---|
| 611 | . I J["<text>" D
|
---|
| 612 | . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
|
---|
| 613 | . . I $G(DEBUG) W "IN HTML SECTION",!
|
---|
| 614 | . N JM,JP,JPX ; JMINUS AND JPLUS
|
---|
| 615 | . S JM=@THEXML@(I-1) ; LINE BEFORE
|
---|
| 616 | . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
|
---|
| 617 | . S JP=@THEXML@(I+1) ; LINE AFTER
|
---|
| 618 | . I INTXT=0 D ; IF NOT IN AN HTML SECTION
|
---|
| 619 | . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
|
---|
| 620 | . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES
|
---|
| 621 | . . . I $G(DEBUG) W I,J,JP,!
|
---|
| 622 | . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
|
---|
| 623 | . . . S DEL(I)="" ; SET LINE TO DELETE
|
---|
| 624 | . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
|
---|
| 625 | . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE
|
---|
| 626 | . . . I $G(DEBUG) W I,J,!
|
---|
| 627 | . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
|
---|
| 628 | . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
|
---|
| 629 | . . . I JM=JPX D ;
|
---|
| 630 | . . . . I $G(DEBUG) W I,JM_J_JPX,!
|
---|
| 631 | . . . . S DEL(I-1)=""
|
---|
| 632 | . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
|
---|
| 633 | ; . I J'["><" D PUSH("TMPXML",J)
|
---|
| 634 | I FOUND D ; NEED TO DELETE THINGS
|
---|
| 635 | . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES
|
---|
| 636 | . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED
|
---|
| 637 | . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
|
---|
| 638 | . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
|
---|
| 639 | Q FOUND
|
---|
| 640 | ;
|
---|
| 641 | UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
|
---|
| 642 | ; XSEC IS A SECTION PASSED BY NAME
|
---|
| 643 | N XBLD,XTMP
|
---|
| 644 | D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
|
---|
| 645 | D BUILD("XBLD","XTMP") ; BUILD THE RESULT
|
---|
| 646 | D CP("XTMP",XSEC) ; REPLACE PASSED XML
|
---|
| 647 | Q
|
---|
| 648 | ;
|
---|
| 649 | PARY(GLO,ZN) ;PRINT AN ARRAY
|
---|
| 650 | ; IF ZN=-1 NO LINE NUMBERS
|
---|
| 651 | N I
|
---|
| 652 | F I=1:1:@GLO@(0) D ;
|
---|
| 653 | . I $G(ZN)=-1 W @GLO@(I),!
|
---|
| 654 | . E W I_" "_@GLO@(I),!
|
---|
| 655 | Q
|
---|
| 656 | ;
|
---|
| 657 | H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
|
---|
| 658 | ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
|
---|
| 659 | I '$D(IPRE) S IPRE=""
|
---|
| 660 | N H2I S H2I=""
|
---|
| 661 | ; W $O(@IHASH@(H2I)),!
|
---|
| 662 | F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH
|
---|
| 663 | . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES
|
---|
| 664 | . . ;W H2I_"^"_@IHASH@(H2I),!
|
---|
| 665 | . . N IH,IHI
|
---|
| 666 | . . S IH=$NA(@IHASH@(H2I)) ;
|
---|
| 667 | . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
|
---|
| 668 | . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
|
---|
| 669 | . . S IHI="" ; INDEX INTO "M" MULTIPLES
|
---|
| 670 | . . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE
|
---|
| 671 | . . . ; W @IH@(IHI)
|
---|
| 672 | . . . S IH3=$NA(@IH2@(IHI))
|
---|
| 673 | . . . ; W "HEY",IH3,!
|
---|
| 674 | . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
|
---|
| 675 | . . ; W IH,!
|
---|
| 676 | . . ; W "C0CZZ",!
|
---|
| 677 | . . ; W $NA(@IHASH@(H2I)),!
|
---|
| 678 | . . Q ;
|
---|
| 679 | . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
|
---|
| 680 | . ; W @IARYRTN@(0),!
|
---|
| 681 | Q
|
---|
| 682 | ;
|
---|
| 683 | XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
|
---|
| 684 | ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
|
---|
| 685 | ; XVRTN AND XVIXML ARE PASSED BY NAME
|
---|
| 686 | ;
|
---|
| 687 | N XVI,XVTMP,XVT
|
---|
| 688 | F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML
|
---|
| 689 | . S XVT=@XVIXML@(XVI)
|
---|
| 690 | . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI
|
---|
| 691 | D H2ARY(XVRTN,"XVTMP")
|
---|
| 692 | Q
|
---|
| 693 | ;
|
---|
| 694 | DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
|
---|
| 695 | ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
|
---|
| 696 | ;
|
---|
| 697 | N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
|
---|
| 698 | I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE
|
---|
| 699 | . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
|
---|
| 700 | . S DXUSE="DTMP" ; DXUSE IS NAME
|
---|
| 701 | E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE
|
---|
| 702 | . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
|
---|
| 703 | . S DXUSE="DTMP" ; DXUSE IS NAME
|
---|
| 704 | E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
|
---|
| 705 | N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
|
---|
| 706 | D XVARS("DVARS",DXUSE) ; PULL OUT VARS
|
---|
| 707 | D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM
|
---|
| 708 | Q
|
---|
| 709 | ;
|
---|
| 710 | TEST ; Run all the test cases
|
---|
| 711 | D TESTALL^C0CUNIT("C0CXPAT0")
|
---|
| 712 | Q
|
---|
| 713 | ;
|
---|
| 714 | ZTEST(WHICH) ; RUN ONE SET OF TESTS
|
---|
| 715 | N ZTMP
|
---|
| 716 | S DEBUG=1
|
---|
| 717 | D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
|
---|
| 718 | D ZTEST^C0CUNIT(.ZTMP,WHICH)
|
---|
| 719 | Q
|
---|
| 720 | ;
|
---|
| 721 | TLIST ; LIST THE TESTS
|
---|
| 722 | N ZTMP
|
---|
| 723 | D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
|
---|
| 724 | D TLIST^C0CUNIT(.ZTMP)
|
---|
| 725 | Q
|
---|
| 726 | ;
|
---|