Changeset 528 for ccr/trunk/p


Ignore:
Timestamp:
Jun 1, 2009, 2:24:15 PM (15 years ago)
Author:
George Lilly
Message:

updates for XML handling

File:
1 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/C0CXPATH.m

    r515 r528  
    114114 . S ZW2=$P(ZW,"/",1)
    115115 . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK))
    116  . ZWR ZA
     116 . ;ZWR ZA
    117117 . S ZW2=ZA(1)
    118118 . F ZK=2:1:ZA(0) D  ;
     
    129129 ;
    130130 ;N G1
    131  D INDEX(INXML,"G1") ; PRODUCES A VDX ARRAY IN G1
     131 D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED
    132132 D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM
    133133 Q
     
    137137 Q
    138138 ;
    139 XPG2XML(OUTXML,INXPG,NUM) ;
    140  ; OUTPUT XML FROM AN XPG FILE
    141  I '$D(NUM) D  ; FIRST TIME THROUGH
    142  . K @OUTXML
    143  . S NUM=1
    144  . S ZA=""
    145  S G=INXPG
    146  S G=@G I G="" Q  ;
    147  F  D  ; S G=$Q(@G) Q:G=""  D  ;
    148  . F ZI=1:1:$QL(G) D  ;
    149  . . I ZI<$QL(G) D  ;
    150  . . . S ZB=$QS(G,ZI)
    151  . . . I ZA(ZA(0))'=ZB D ZXO(ZB)
    152  . . . E  D ZXC(ZB)
    153  . . S ZV=""
    154  . . S G2=$QS(G,ZI)
    155  . . I ZI=$QL(G) S ZV=@G
    156  . . W G2," ",ZV
    157  . S G=@G I G="" Q  ;
    158  . W !
     139T1 ; TEST OUT THESE ROUTINES
     140 D XML2XPG("G2","^GPL")
     141 D XPG2XML("G3","G2")
     142 K ^GPLOUT
     143 M ^GPLOUT=G3
     144 W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p")
     145 Q
     146 ;
     147XPG2XML(OUTXML,INXPG) ;
     148 N C0CN,FWD,ZA,G,GA,ZQ
     149 S ZQ=0 ; QUIT FLAG
     150 F  Q:ZQ=1  D  ; LOOP THROUGH EVERYTHING
     151 . I '$D(C0CN) D  ; FIRST TIME THROUGH
     152 . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR
     153 . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS
     154 . . S G=$Q(@INXPG) ; THIS ONE
     155 . . S GN=$Q(@G) ; NEXT ONE
     156 . . S C0CN=1 ; SUBSCRIPT COUNT
     157 . . S ZQ=0 ; QUIT FLAG
     158 . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML
     159 . . I $QS(G,1)="ContinuityOfCareRecord" D  ;
     160 . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK
     161 . I FWD D  ; GOING FORWARDS
     162 . . I C0CN<$QL(G) D  ; NOT A DATA NODE
     163 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
     164 . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT
     165 . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D  ;
     166 . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">"
     167 . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE
     168 . . E  D  ; AT THE DATA NODE
     169 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
     170 . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE
     171 . . . S FWD=0 ; GO BACKWARDS
     172 . I 'FWD D  ;GOING BACKWARDS
     173 . . S GN=$Q(@G) ;NEXT XPATH
     174 . . ;W "NEXT!",GN,!
     175 . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT
     176 . . I GN'="" D  ;
     177 . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D  ; NEED TO CLOSE OFF ELEMENT
     178 . . . . D ZXC($QS(G,C0CN)) ;
     179 . . . E  I GN'="" D  ; MORE ELEMENTS AT THIS LEVEL
     180 . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH
     181 . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT
     182 . . . . S FWD=1 ; GOING FORWARD NOW
     183 . I (GN="")&(C0CN=1) D  Q  ; WHEN WE ARE ALL DONE
     184 . . D ZXC($QS(G,C0CN)) ; LAST ONE
     185 . . S ZQ=1 ; QUIT NOW
    159186 Q
    160187 ;
     
    173200 Q
    174201 ;
    175 INDEX(ZXML,VDX)     ; parse the XML in ZXML and produce an XPATH index
     202INDEX(IZXML,VDX,NOINX) ; parse the XML in IZXML and produce an XPATH index
    176203 ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME
    177204 ; @VDX@("XPATH")=VALUE
    178  ; ex. @ZXML@("XPATH")=FIRSTLINE^LASTLINE
     205 ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE
    179206 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
    180207 ; XML SECTION
    181  ; ZXML IS PASSED BY NAME
     208 ; IZXML IS PASSED BY NAME
     209 ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE
    182210 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT
    183211 N C0CSTK ; LEAVE OUT FOR DEBUGGING
    184  I '$D(@ZXML@(0)) D  ; IF COUNT NOT IN NODE 0 COUNT THEM
     212 I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX
     213 N ZXML
     214 I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD
     215 E  S ZXML=IZXML ; PLACE FOR INDEX TO KEEP
     216 I '$D(@IZXML@(0)) D  ; IF COUNT NOT IN NODE 0 COUNT THEM
    185217 . S I="",LCNT=0
    186  . F  S I=$O(@ZXML@(I)) Q:I=""  S LCNT=LCNT+1
    187  E  S LCNT=@ZXML@(0) ; LINE COUNT PASSED IN ARRAY
     218 . F  S I=$O(@IZXML@(I)) Q:I=""  S LCNT=LCNT+1
     219 E  S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY
    188220 I LCNT=0  D  Q  ; NO XML PASSED
    189221 . W "ERROR IN XML FILE",!
     
    192224 S C0CSTK(0)=0 ; INITIALIZE STACK
    193225 F I=1:1:LCNT  D  ; PROCESS THE ENTIRE ARRAY
    194  . S LINE=@ZXML@(I)
     226 . S LINE=@IZXML@(I)
    195227 . ;W LINE,!
    196228 . S FOUND=0  ; INTIALIZED FOUND FLAG
     
    240272 S @ZXML@("INDEXED")=""
    241273 S @ZXML@("//")="1^"_LCNT ; ROOT XPATH
     274 I NOINX K @ZXML ; DELETE UNWANTED INDEX
    242275 Q
    243276 ;
Note: See TracChangeset for help on using the changeset viewer.