Changeset 1336 for ccr/trunk/p/C0CMXML.m


Ignore:
Timestamp:
Jan 4, 2012, 9:39:08 PM (12 years ago)
Author:
George Lilly
Message:

removed tabs

File:
1 edited

Legend:

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

    r1331 r1336  
    1 C0CMXML   ; GPL - MXML based XPath utilities;10/13/09  17:05
    2         ;;0.1;C0C;nopatch;noreleasedate;Build 38
    3         ;Copyright 2009 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         Q
    21         ; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER
    22         ; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM
    23         ; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD
    24         ; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP
    25         ;
    26 TEST    ;
    27         S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
    28         K GARY
    29         W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3)
    30         S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID
    31         S REDUX="//ContinuityOfCareRecord/Body"
    32         D XPATH(1,"/","GIDX","GARY",,REDUX)
    33         D SEPARATE^C0CMCCD("GARY2","GARY")
    34         S ZI=""
    35         F  S ZI=$O(GARY2(ZI)) Q:ZI=""  D  ;
    36         . N GTMP,G2
    37         . M G2=GARY2(ZI)
    38         . D DEMUX2^C0CMXP("GTMP","G2",2)
    39         . M GARY3(ZI)=GTMP
    40         Q
    41         ;
    42 TEST2   ;
    43         S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
    44         D XPATH(1,"/","GIDX","GARY","",REDUX)
    45         Q
    46         ;
    47 TEST3   
    48         S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
    49         K GARY,GTMP,GIDX
    50         K @C0CXMLIN
    51         W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
    52         D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
    53         K @C0CXMLIN
    54         M @C0CXMLIN=GTMP
    55         K GTMP
    56         D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
    57         K @C0CXMLIN
    58         M @C0CXMLIN=GTMP
    59         K GTMP
    60         S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
    61         S REDUX="//ClinicalDocument/component/structuredBody"
    62         D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
    63         D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
    64         D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
    65         D XPATH(1,"/","GIDX","GARY",,REDUX)
    66         K C0CCBK("TAG")
    67         D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
    68         D TEST3A
    69         Q
    70         ;
    71 TEST3A  ; INTERNAL ROUTINE
    72         S ZI=""
    73         F  S ZI=$O(GARY2(ZI)) Q:ZI=""  D  ;
    74         . N GTMP,G2
    75         . M G2=GARY2(ZI)
    76         . D DEMUX2^C0CMXP("GTMP","G2",2)
    77         . M GARY4(ZI)=GTMP
    78         Q
    79         ;
    80 TESTQ   ; TEST OF THE QRDA TEMPLATE GPL 7/8/2010
    81         S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
    82         K GARY,GTMP,GIDX
    83         K @C0CXMLIN
    84         W $$FTG^%ZISH("/home/vademo2/","QRDA_CategoryI_WorldVistA1.xml",$NA(@C0CXMLIN@(1)),3)
    85         D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
    86         K @C0CXMLIN
    87         S GTMP(1)="<"_$P(GTMP(1),"<",2)
    88         M @C0CXMLIN=GTMP
    89         K GTMP
    90         D TESTQ2
    91         Q
    92         ;
    93 TESTQ2  ; SECOND PART OF TESTQ
    94         D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
    95         K @C0CXMLIN
    96         M @C0CXMLIN=GTMP
    97         K GTMP
    98         S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
    99         S REDUX="//ClinicalDocument/component/structuredBody"
    100         D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
    101         D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
    102         D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
    103         D XPATH(1,"/","GIDX","GARY",,REDUX)
    104         K C0CCBK("TAG")
    105         D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
    106         D TEST3A
    107         Q
    108         ;
    109 TEST4   ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR
    110         ;
    111         D TEST ; SET UP THE DOM
    112         D START^C0CMXMLB($$TAG(1),,"G")
    113         D NDOUT($$FIRST(1))
    114         D END^C0CMXMLB ;END THE DOCUMENT
    115         M ZCCR=^TMP("MXMLBLD",$J)
    116         ZWR ZCCR
    117         Q
    118         ;
    119 TEST5   ; SAME AS TEST4, BUT THIS TIME THE CCD
    120         S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
    121         K GARY,GTMP,GIDX
    122         K @C0CXMLIN
    123         W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
    124         D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
    125         K @C0CXMLIN
    126         M @C0CXMLIN=GTMP
    127         K GTMP
    128         D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
    129         K @C0CXMLIN
    130         M @C0CXMLIN=GTMP
    131         K GTMP
    132         S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID  ;CALL REGULAR PARSER
    133         ;D XPATH(1,"/","GIDX2","GARY2",,REDUX)
    134         D OUTXML("ZCCD",C0CDOCID)
    135         ;D START^C0CMXMLB($$TAG(1),,"G")
    136         ;D NDOUT($$FIRST(1))
    137         ;D END^C0CMXMLB ;EOND THE DOCUMENT
    138         ;M ZCCD=^TMP("MXMLBLD",$J)
    139         ZWR ZCCD(1:30)
    140         Q
    141         ;
    142 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX)      ; RECURSIVE ROUTINE TO POPULATE
    143         ; THE XPATH INDEX ZXIDX, PASSED BY NAME
    144         ; THE XPATH ARRAY XPARY, PASSED BY NAME
    145         ; ZOID IS THE STARTING OID
    146         ; ZPATH IS THE STARTING XPATH, USUALLY "/"
    147         ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
    148         ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
    149         I $G(ZREDUX)="" S ZREDUX=""
    150         N NEWPATH
    151         N NEWNUM S NEWNUM=""
    152         I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
    153         S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
    154         I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
    155         . N GT S GT=$P(NEWPATH,ZREDUX,2)
    156         . I GT'="" S NEWPATH=GT
    157         S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
    158         N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
    159         I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
    160         E  I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
    161         N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
    162         I ZFRST'=0 D  ; THERE IS A CHILD
    163         . N ZNUM
    164         . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
    165         . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
    166         N GNXT S GNXT=$$NXTSIB(ZOID)
    167         I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
    168         I GNXT'=0 D  ;
    169         . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
    170         . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
    171         . . N ZNUM S ZNUM=1 ;
    172         . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
    173         . E  D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
    174         Q
    175         ;
    176 PARSE(INXML,INDOC)      ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
    177         ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
    178         ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
    179         ;Q $$EN^MXMLDOM(INXML)
    180         Q $$EN^MXMLDOM(INXML,"W")
    181         ;
    182 ISMULT(ZOID)    ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
    183         N ZN
    184         ;I $$TAG(ZOID)["entry" B
    185         S ZN=$$NXTSIB(ZOID)
    186         I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
    187         Q 0
    188         ;
    189 FIRST(ZOID)     ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
    190         Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
    191         ;
    192 PARENT(ZOID)    ;RETURNS THE OID OF THE PARENT OF ZOID
    193         Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
    194         ;
    195 ATT(RTN,NODE)   ;GET ATTRIBUTES FOR ZOID
    196         S HANDLE=C0CDOCID
    197         K @RTN
    198         D GETTXT^MXMLDOM("A")
    199         Q
    200         ;
    201 TAG(ZOID)       ; RETURNS THE XML TAG FOR THE NODE
    202         ;I ZOID=149 B ;GPLTEST
    203         N X,Y
    204         S Y=""
    205         S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
    206         I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
    207         I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
    208         Q Y
    209         ;
    210 NXTSIB(ZOID)    ; RETURNS THE NEXT SIBLING
    211         Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
    212         ;
    213 DATA(ZT,ZOID)   ; RETURNS DATA FOR THE NODE
    214         ;N ZT,ZN S ZT=""
    215         ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
    216         ;Q $G(@C0CDOM@(ZOID,"T",1))
    217         S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
    218         Q
    219         ;
    220 OUTXML(ZRTN,INID)       ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
    221         ;
    222         S C0CDOCID=INID
    223         D START^C0CMXMLB($$TAG(1),,"G")
    224         D NDOUT($$FIRST(1))
    225         D END^C0CMXMLB ;END THE DOCUMENT
    226         M @ZRTN=^TMP("MXMLBLD",$J)
    227         K ^TMP("MXMLBLD",$J)
    228         Q
    229         ;
    230 NDOUT(ZOID)     ;CALLBACK ROUTINE - IT IS RECURSIVE
    231         N ZI S ZI=$$FIRST(ZOID)
    232         I ZI'=0 D  ; THERE IS A CHILD
    233         . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
    234         . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
    235         E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
    236         . ;W "DOING",ZOID,!
    237         . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
    238         . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
    239         . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
    240         I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
    241         . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
    242         Q
    243         ;
    244 UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
    245         K ZERR
    246         D CLEAN^DILF
    247         D UPDATE^DIE("","C0CFDA","","ZERR")
    248         I $D(ZERR) D  ;
    249         . W "ERROR",!
    250         . ZWR ZERR
    251         . B
    252         K C0CFDA
    253         Q
    254         ;
     1C0CMXML   ; GPL - MXML based XPath utilities;10/13/09  17:05
     2 ;;0.1;C0C;nopatch;noreleasedate;Build 38
     3 ;Copyright 2009 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 Q
     21 ; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER
     22 ; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM
     23 ; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD
     24 ; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP
     25 ;
     26TEST ;
     27 S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
     28 K GARY
     29 W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3)
     30 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID
     31 S REDUX="//ContinuityOfCareRecord/Body"
     32 D XPATH(1,"/","GIDX","GARY",,REDUX)
     33 D SEPARATE^C0CMCCD("GARY2","GARY")
     34 S ZI=""
     35 F  S ZI=$O(GARY2(ZI)) Q:ZI=""  D  ;
     36 . N GTMP,G2
     37 . M G2=GARY2(ZI)
     38 . D DEMUX2^C0CMXP("GTMP","G2",2)
     39 . M GARY3(ZI)=GTMP
     40 Q
     41 ;
     42TEST2 ;
     43 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
     44 D XPATH(1,"/","GIDX","GARY","",REDUX)
     45 Q
     46 ;
     47TEST3 
     48 S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
     49 K GARY,GTMP,GIDX
     50 K @C0CXMLIN
     51 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
     52 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
     53 K @C0CXMLIN
     54 M @C0CXMLIN=GTMP
     55 K GTMP
     56 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
     57 K @C0CXMLIN
     58 M @C0CXMLIN=GTMP
     59 K GTMP
     60 S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
     61 S REDUX="//ClinicalDocument/component/structuredBody"
     62 D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
     63 D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
     64 D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
     65 D XPATH(1,"/","GIDX","GARY",,REDUX)
     66 K C0CCBK("TAG")
     67 D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
     68 D TEST3A
     69 Q
     70 ;
     71TEST3A ; INTERNAL ROUTINE
     72 S ZI=""
     73 F  S ZI=$O(GARY2(ZI)) Q:ZI=""  D  ;
     74 . N GTMP,G2
     75 . M G2=GARY2(ZI)
     76 . D DEMUX2^C0CMXP("GTMP","G2",2)
     77 . M GARY4(ZI)=GTMP
     78 Q
     79 ;
     80TESTQ ; TEST OF THE QRDA TEMPLATE GPL 7/8/2010
     81 S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
     82 K GARY,GTMP,GIDX
     83 K @C0CXMLIN
     84 W $$FTG^%ZISH("/home/vademo2/","QRDA_CategoryI_WorldVistA1.xml",$NA(@C0CXMLIN@(1)),3)
     85 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
     86 K @C0CXMLIN
     87 S GTMP(1)="<"_$P(GTMP(1),"<",2)
     88 M @C0CXMLIN=GTMP
     89 K GTMP
     90 D TESTQ2
     91 Q
     92 ;
     93TESTQ2 ; SECOND PART OF TESTQ
     94 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
     95 K @C0CXMLIN
     96 M @C0CXMLIN=GTMP
     97 K GTMP
     98 S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
     99 S REDUX="//ClinicalDocument/component/structuredBody"
     100 D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
     101 D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
     102 D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
     103 D XPATH(1,"/","GIDX","GARY",,REDUX)
     104 K C0CCBK("TAG")
     105 D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
     106 D TEST3A
     107 Q
     108 ;
     109TEST4 ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR
     110 ;
     111 D TEST ; SET UP THE DOM
     112 D START^C0CMXMLB($$TAG(1),,"G")
     113 D NDOUT($$FIRST(1))
     114 D END^C0CMXMLB ;END THE DOCUMENT
     115 M ZCCR=^TMP("MXMLBLD",$J)
     116 ZWR ZCCR
     117 Q
     118 ;
     119TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD
     120 S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
     121 K GARY,GTMP,GIDX
     122 K @C0CXMLIN
     123 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
     124 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
     125 K @C0CXMLIN
     126 M @C0CXMLIN=GTMP
     127 K GTMP
     128 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
     129 K @C0CXMLIN
     130 M @C0CXMLIN=GTMP
     131 K GTMP
     132 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID  ;CALL REGULAR PARSER
     133 ;D XPATH(1,"/","GIDX2","GARY2",,REDUX)
     134 D OUTXML("ZCCD",C0CDOCID)
     135 ;D START^C0CMXMLB($$TAG(1),,"G")
     136 ;D NDOUT($$FIRST(1))
     137 ;D END^C0CMXMLB ;EOND THE DOCUMENT
     138 ;M ZCCD=^TMP("MXMLBLD",$J)
     139 ZWR ZCCD(1:30)
     140 Q
     141 ;
     142XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
     143 ; THE XPATH INDEX ZXIDX, PASSED BY NAME
     144 ; THE XPATH ARRAY XPARY, PASSED BY NAME
     145 ; ZOID IS THE STARTING OID
     146 ; ZPATH IS THE STARTING XPATH, USUALLY "/"
     147 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
     148 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
     149 I $G(ZREDUX)="" S ZREDUX=""
     150 N NEWPATH
     151 N NEWNUM S NEWNUM=""
     152 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
     153 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
     154 I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
     155 . N GT S GT=$P(NEWPATH,ZREDUX,2)
     156 . I GT'="" S NEWPATH=GT
     157 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
     158 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
     159 I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
     160 E  I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
     161 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
     162 I ZFRST'=0 D  ; THERE IS A CHILD
     163 . N ZNUM
     164 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
     165 . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
     166 N GNXT S GNXT=$$NXTSIB(ZOID)
     167 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
     168 I GNXT'=0 D  ;
     169 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
     170 . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
     171 . . N ZNUM S ZNUM=1 ;
     172 . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
     173 . E  D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
     174 Q
     175 ;
     176PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
     177 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
     178 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
     179 ;Q $$EN^MXMLDOM(INXML)
     180 Q $$EN^MXMLDOM(INXML,"W")
     181 ;
     182ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
     183 N ZN
     184 ;I $$TAG(ZOID)["entry" B
     185 S ZN=$$NXTSIB(ZOID)
     186 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
     187 Q 0
     188 ;
     189FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
     190 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
     191 ;
     192PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
     193 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
     194 ;
     195ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
     196 S HANDLE=C0CDOCID
     197 K @RTN
     198 D GETTXT^MXMLDOM("A")
     199 Q
     200 ;
     201TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
     202 ;I ZOID=149 B ;GPLTEST
     203 N X,Y
     204 S Y=""
     205 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
     206 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
     207 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
     208 Q Y
     209 ;
     210NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
     211 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
     212 ;
     213DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
     214 ;N ZT,ZN S ZT=""
     215 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
     216 ;Q $G(@C0CDOM@(ZOID,"T",1))
     217 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
     218 Q
     219 ;
     220OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
     221 ;
     222 S C0CDOCID=INID
     223 D START^C0CMXMLB($$TAG(1),,"G")
     224 D NDOUT($$FIRST(1))
     225 D END^C0CMXMLB ;END THE DOCUMENT
     226 M @ZRTN=^TMP("MXMLBLD",$J)
     227 K ^TMP("MXMLBLD",$J)
     228 Q
     229 ;
     230NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
     231 N ZI S ZI=$$FIRST(ZOID)
     232 I ZI'=0 D  ; THERE IS A CHILD
     233 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
     234 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
     235 E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
     236 . ;W "DOING",ZOID,!
     237 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
     238 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
     239 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
     240 I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
     241 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
     242 Q
     243 ;
     244UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
     245 K ZERR
     246 D CLEAN^DILF
     247 D UPDATE^DIE("","C0CFDA","","ZERR")
     248 I $D(ZERR) D  ;
     249 . W "ERROR",!
     250 . ZWR ZERR
     251 . B
     252 K C0CFDA
     253 Q
     254 ;
Note: See TracChangeset for help on using the changeset viewer.