Changeset 630


Ignore:
Timestamp:
Dec 4, 2009, 4:00:21 PM (15 years ago)
Author:
George Lilly
Message:

reorganizing MXML routines

Location:
ccr/trunk/p
Files:
2 added
1 edited

Legend:

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

    r621 r630  
    1 C0CMXML   ; ERX/GPL - MXML based XPath utilities;10/13/09  17:05
    2         ;;0.1;C0P;nopatch;noreleasedate
    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         ;
    22 TEST    ;
    23         S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
    24         K GARY
    25         W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3)
    26         S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID
    27         S REDUX="//ContinuityOfCareRecord/Body"
    28         D XPATH(1,"/","GIDX","GARY",,REDUX)
    29         Q
    30         ;
    31 TEST2   ;
    32         S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
    33         D XPATH(1,"/","GIDX","GARY","",REDUX)
    34         Q
    35         ;
     1C0CMXML   ; GPL - MXML based XPath utilities;10/13/09  17:05
     2 ;;0.1;C0C;nopatch;noreleasedate
     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 Q
     34 ;
     35TEST2 ;
     36 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
     37 D XPATH(1,"/","GIDX","GARY","",REDUX)
     38 Q
     39 ;
    3640TEST3
    3741 S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
     
    9296 Q
    9397 ;
    94 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX)      ; RECURSIVE ROUTINE TO POPULATE
    95         ; THE XPATH INDEX ZXIDX, PASSED BY NAME
    96         ; THE XPATH ARRAY XPARY, PASSED BY NAME
    97         ; ZOID IS THE STARTING OID
    98         ; ZPATH IS THE STARTING XPATH, USUALLY "/"
    99         ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
    100         ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
    101         I $G(ZREDUX)="" S ZREDUX=""
    102         N NEWPATH
    103         N NEWNUM S NEWNUM=""
    104         I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
    105         S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
    106         I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
    107         . N GT S GT=$P(NEWPATH,ZREDUX,2)
    108         . I GT'="" S NEWPATH=GT
    109         S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
    110         N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
    111         I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
    112         E  I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
    113         N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
    114         I ZFRST'=0 D  ; THERE IS A CHILD
    115         . N ZNUM
    116         . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
    117         . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
    118         N GNXT S GNXT=$$NXTSIB(ZOID)
    119         I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
    120         I GNXT'=0 D  ;
    121         . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
    122         . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
    123         . . N ZNUM S ZNUM=1 ;
    124         . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
    125         . E  D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
    126         Q
    127         ;
    128 PARSE(INXML,INDOC)      ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
    129         ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
    130         ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
    131         ;Q $$EN^MXMLDOM(INXML)
    132         Q $$EN^MXMLDOM(INXML,"W")
    133         ;
    134 ISMULT(ZOID)    ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
    135         N ZN
    136         ;I $$TAG(ZOID)["entry" B
    137         S ZN=$$NXTSIB(ZOID)
    138         I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
    139         Q 0
    140         ;
    141 FIRST(ZOID)     ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
    142         Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
    143         ;
     98XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
     99 ; THE XPATH INDEX ZXIDX, PASSED BY NAME
     100 ; THE XPATH ARRAY XPARY, PASSED BY NAME
     101 ; ZOID IS THE STARTING OID
     102 ; ZPATH IS THE STARTING XPATH, USUALLY "/"
     103 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
     104 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
     105 I $G(ZREDUX)="" S ZREDUX=""
     106 N NEWPATH
     107 N NEWNUM S NEWNUM=""
     108 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
     109 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
     110 I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
     111 . N GT S GT=$P(NEWPATH,ZREDUX,2)
     112 . I GT'="" S NEWPATH=GT
     113 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
     114 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
     115 I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
     116 E  I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
     117 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
     118 I ZFRST'=0 D  ; THERE IS A CHILD
     119 . N ZNUM
     120 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
     121 . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
     122 N GNXT S GNXT=$$NXTSIB(ZOID)
     123 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
     124 I GNXT'=0 D  ;
     125 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
     126 . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
     127 . . N ZNUM S ZNUM=1 ;
     128 . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
     129 . E  D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
     130 Q
     131 ;
     132PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
     133 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
     134 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
     135 ;Q $$EN^MXMLDOM(INXML)
     136 Q $$EN^MXMLDOM(INXML,"W")
     137 ;
     138ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
     139 N ZN
     140 ;I $$TAG(ZOID)["entry" B
     141 S ZN=$$NXTSIB(ZOID)
     142 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
     143 Q 0
     144 ;
     145FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
     146 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
     147 ;
    144148PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
    145149 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
     
    151155 Q
    152156 ;
    153 TAG(ZOID)       ; RETURNS THE XML TAG FOR THE NODE
    154         ;I ZOID=149 B ;GPLTEST
    155         N X,Y
    156         S Y=""
    157         S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
    158         I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
    159         I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
    160         Q Y
    161         ;
    162 NXTSIB(ZOID)    ; RETURNS THE NEXT SIBLING
    163         Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
    164         ;
    165 DATA(ZT,ZOID)   ; RETURNS DATA FOR THE NODE
    166         ;N ZT,ZN S ZT=""
    167         ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
    168         ;Q $G(@C0CDOM@(ZOID,"T",1))
    169         S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
    170         Q
    171         ;
     157TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
     158 ;I ZOID=149 B ;GPLTEST
     159 N X,Y
     160 S Y=""
     161 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
     162 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
     163 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
     164 Q Y
     165 ;
     166NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
     167 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
     168 ;
     169DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
     170 ;N ZT,ZN S ZT=""
     171 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
     172 ;Q $G(@C0CDOM@(ZOID,"T",1))
     173 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
     174 Q
     175 ;
    172176OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
    173177 ;
     
    194198 Q
    195199 ;
    196 PARSCCD(DOC,OPTION) ; THIS WAS COPIED FROM EN^MXMLDOM TO CUSTIMIZE FOR
    197  ; PROCESSING CCDS
    198  N CBK,SUCCESS,LEVEL,NODE,HANDLE
    199  K ^TMP("MXMLERR",$J)
    200  L +^TMP("MXMLDOM",$J):5
    201  E  Q 0
    202  S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
    203  L -^TMP("MXMLDOM",$J)
    204  S CBK("STARTELEMENT")="STARTELE^C0CMXML" ; ONLY THIS ONE IS CHANGED ;GPL
    205  S CBK("ENDELEMENT")="ENDELE^MXMLDOM"
    206  S CBK("COMMENT")="COMMENT^MXMLDOM"
    207  S CBK("CHARACTERS")="CHAR^MXMLDOM"
    208  S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM"
    209  S CBK("ERROR")="ERROR^MXMLDOM"
    210  S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1")
    211  D EN^MXMLPRSE(DOC,.CBK,OPTION)
    212  D:'SUCCESS DELETE^MXMLDOM(HANDLE)
    213  Q $S(SUCCESS:HANDLE,1:0)
    214  ; Start element
    215  ; Create new child node and push info on stack
    216 STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT
    217  ; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER
    218  N PARENT
    219  S PARENT=LEVEL(LEVEL),NODE=NODE+1
    220  S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE
    221  S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE
    222  S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT
    223  ;M ^("A")=ATTR
    224  N ZI S ZI="" ; INDEX FOR ATTR
    225  F  S ZI=$O(ATTR(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
    226  . N ELE,TXT ; ABOUT TO RECURSE
    227  . S ELE=ZI ; TAG
    228  . S TXT=ATTR(ZI) ; DATA
    229  . D STARTELE(ELE,"") ; CREATE A NEW SUBNODE
    230  . D TXT^MXMLDOM("T") ; INSERT DATA TO TAG
    231  . D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL
    232  Q
    233  ;
    234 CLEANARY(OUTARY,INARY) ; GOES THROUGH AN ARRAY AND CALLS CLEAN ON EACH NODE
    235  ; INARY AND OUTARY PASSED BY NAME
    236  N ZI S ZI=""
    237  F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ; FOR EACH NODE
    238  . S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE
    239  Q
    240  ;
    241 CLEAN(STR) ; extrinsic function; returns string
    242  ;; Removes all non printable characters from a string.
    243  ;; STR by Value
    244  N TR,I
    245  F I=0:1:31 S TR=$G(TR)_$C(I)
    246  S TR=TR_$C(127)
    247  QUIT $TR(STR,TR)
    248  ;
    249 STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE
    250  ; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE
    251  ; THEY DO NOT WORK RIGHT WITH THE PARSER
    252  ;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER
    253  S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER
    254  D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY
    255  F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH LINE OF THE ARRAY
    256  . I $O(@ZARY@(ZI))="" D  Q  ; AT THE END
    257  . . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY
    258  . I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE
    259  . I @ZARY@(ZI)["<text" D C0CEND("ZWRK",ZI-1) ;PREV LINE IS AN END
    260  . I @ZARY@(ZI)["</text>" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN
    261  S ZI=""
    262  F  S ZI=$O(ZWRK(ZI)) Q:ZI=""  D  ; MAKE A BUILD LIST FROM THE WORK ARRAY
    263  . D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2))
    264  D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS
    265  K @OUTARY@(0) ; GET RID OF THE LINE COUNT
    266  Q
    267  ;
    268 C0CBEGIN(ZA,LN) ; INSERTS A BEGIN LINE LN INTO ARRAY ZWRK, PASSED BY NAME
    269  N ZI
    270  S ZI=$O(@ZA@(""),-1)
    271  I ZI="" S ZI=1
    272  E  S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY
    273  S $P(@ZA@(ZI),"^",1)=LN
    274  Q
    275  ;
    276 C0CEND(ZB,LN) ; INSERTS AN END LINE LN INTO ARRAY ZWRK, PASSED BY NAME
    277  N ZI
    278  S ZI=$O(@ZB@(""),-1)
    279  I ZI="" S ZI=1
    280  S $P(@ZB@(ZI),"^",2)=LN
    281  Q
    282  ;
    283 SEPARATE(OUTARY,INARY) ; SEPARATES XPATH VARIABLES ACCORDING TO THEIR
    284  ; ROOT ; /Problems/etc/etc goes to @OUTARY@("Problems","/Problems/etc/etc")
    285  S ZI=""
    286  F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ; FOR EACH ELEMENT OF THE ARRAY
    287  . S ZJ=$P(ZI,"/",2) ;
    288  . I ZJ="" S ZJ=$P(ZI,"/",3) ;
    289  . S @OUTARY@(ZJ,ZI)=@INARY@(ZI)
    290  Q
    291  ;
    292 FINDTID ; FIND TEMPLATE IDS IN DOM 1
    293  S C0CDOCID=1
    294  S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
    295  S ZN=""
    296  S CURSEC=""
    297  S TID=""
    298  F  S ZN=$O(@ZD@(ZN)) Q:ZN=""  D  ;
    299  . I $$TAG(ZN)="root" D  ;
    300  . . I $$TAG($$PARENT(ZN))="templateId" D  ; ONLY LOOKING FOR TEMPLATES
    301  . . . S ZG=$$PARENT($$PARENT(ZN))
    302  . . . S ZG2=$$PARENT(ZG) ;COMPONENT THAT HOLDS THIS SECTION
    303  . . . S CMT=$G(@ZD@(ZG,"X",1))
    304  . . . I CMT="" S CMT="?"
    305  . . . I $$TAG(ZG)="section" D  ;START OF A SECTION
    306  . . . . S CURSEC=$$PARENT(ZG)
    307  . . . . S SECCMT=$G(@ZD@(CURSEC,"X",1))
    308  . . . . I SECCMT="" S SECCMT="?"
    309  . . . . S SECTID=$G(@ZD@(ZN,"T",1)) ;SECTION TEMPLATE ID
    310  . . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID
    311  . . . I CURSEC'="" D  ; IF WE ARE IN A SECTION
    312  . . . . S CCDDIR(ZG2,CURSEC,$$TAG(ZG2),CMT,SECCMT)=TID
    313  . . . . S DOMMAP(ZG2)=CURSEC_U_$$TAG(ZG2)_U_TID_U_SECTID
    314  . . . W !,$$TAG(ZG2)," ",$G(@ZD@(ZG,"X",1))
    315  . . . W " root ",ZN," ",@ZD@(ZN,"T",1)
    316  Q
    317  ;
    318 FINDALT ; PROCESS THE DOMMAP AND FIND THE ALT TAGS FOR COMPONENTS
    319  ;
    320  S ZI=""
    321  F  S ZI=$O(DOMMAP(ZI)) Q:ZI=""  D  ; FOR EACH NODE IN THE MAP
    322  . S ZJ=DOMMAP(ZI) ;
    323  . S PARNODE=$P(ZJ,U,1) ;PARENT NODE
    324  . S TAG=$P(ZJ,U,2) ;THIS TAG
    325  . S TID=$P(ZJ,U,3) ;THIS TEMPLATE ID
    326  . S PARTID=$P(ZJ,U,4) ;PARENT TEMPLATE ID
    327  . S ZIEN=$O(^C0CXDS(178.101,"TID",TID,"")) ;THIS NODE IEN
    328  . S PARIEN=$O(^C0CXDS(178.101,"TID",PARTID,"")) ;PARENT NODE IEN
    329  . I ZI=PARNODE D  ; IF THIS IS A SECTION NODE
    330  . . S ALTTAG=$$GET1^DIQ(178.101,PARIEN_",",.03) ;ALT TAG FIELD FOR PARENT
    331  . . S NAME=$$GET1^DIQ(178.101,ZIEN_",",.01) ;NAME OF THIS NODE'S TEMPLATE
    332  . . W ZI," ",TAG," ",ALTTAG," ",NAME,!
    333  . . S C0CTAGS(ZI)=ALTTAG
    334  . E  D  ; NOT A SECTION NODE
    335  . . N ZJ S ZJ=""
    336  . . S ZJ=$O(^C0CXDS(178.101,"D",PARIEN,ZIEN,"")) ;A WHEREUSED POINTER?
    337  . . I ZJ'="" D  ; THERE IS A NEW LABEL FOR THIS NODE
    338  . . . N ZK
    339  . . . S ZK=$$GET1^DIQ(178.111,ZJ_","_ZIEN_",",2)
    340  . . . I ZK'="" D  ;
    341  . . . . W "FOUND ",ZK,!
    342  . . . . S C0CTAGS(ZI)=ZK ; NEW TAG FOR INTERSECTION
    343  Q
    344  ;
    345 ALTTAG(NODE) ; SET Y EQUAL TO THE ALT TAG FOUND IN C0CTAGS IF NODE IF FOUND
    346  ;
    347  S Y=$G(C0CTAGS(NODE))
    348  Q
    349  ;
    350 SETCBK ; SET THE TAG CALLBACK FOR XPATH PROCESSSING OF THE CCD
    351  S C0CCBK("TAG")="D ALTTAG(ZOID)"
    352  Q
    353  ;
    354 OUTCCD ; OUTPUT THE PARSED CCD TO A TEXT FILE
    355  D TEST3
    356  N ZT S ZT=$NA(^TMP("CCDOUT",$J))
    357  N ZI,ZJ
    358  S ZI=1 S ZJ=""
    359  K @ZT
    360  F  S ZJ=$O(GARY(ZJ)) Q:ZJ=""  D  ;
    361  . S @ZT@(ZI)=ZJ_"^"_GARY(ZJ)
    362  . S ZI=ZI+1
    363  S ONAME=$NA(@ZT@(1))
    364  W $$OUTPUT^C0CXPATH(ONAME,"CCDOUT.txt","/home/vademo2/CCR")
    365  K @ZT
    366  Q
    367  ;
    368 GENXDS(ZD) ; GENERATE THE XDS PROTOTYPE RECORDS FROM A CCDDIR ARRAY
    369  ; ARRAY ELEMENTS LOOK LIKE:
    370  ; CCDDIR(1659,1634,"observation"," Result observaion template "," Vital signs section template ")="2.16.840.1.113883.10.20.1.31"
    371  ;or CCDDIR(cur node,section node,cur tag,cur name,sec name)=templateId
    372  S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
    373  S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
    374  S DONE=0
    375  F  Q:DONE  D  ;
    376  . W @ZI,!
    377  . S ZJ=$QS(ZI,5)
    378  . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
    379  . S C0CFDA(ZF,"?+1,",.01)=ZJ
    380  . S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
    381  . S C0CFDA(ZF,"?+1,",1)=@ZI
    382  . D UPDIE
    383  . S ZI=$Q(@ZI)
    384  . I ZI="" S DONE=1
    385  Q
    386  ;
    387 WHRUSD(ZD) ; UPDATE THE C0C XDS FILE WITH WHERE USED DATA FROM
    388  ; CCDDIR PASS BY NAME
    389  ; ARRAY ELEMENTS LOOK LIKE:
    390  ; CCDDIR(1634," Vital signs section template ",1659,"observation"," Result observaion template ")="2.16.840.1.113883.10.20.1.31"
    391  ;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId
    392  S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
    393  S ZSF=178.111 ; WHERE USED SUBFILE OF C0C XDS PROTOTYPE FILE
    394  S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
    395  S DONE=0
    396  F  Q:DONE  D  ;
    397  . W @ZI
    398  . S ZIEN=$O(^C0CXDS(178.101,"TID",@ZI,"")) ; IEN FOR THIS NODE'S TEMPLATE
    399  . W " IEN:",ZIEN
    400  . S ZJ=$QS(ZI,2)
    401  . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
    402  . S ZPIEN=$O(^C0CXDS(178.101,"B",ZJ,"")) ; PARENT IEN
    403  . W " PARENT IEN:",ZPIEN
    404  . S ZTAG=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
    405  . W " TAG:",ZTAG,!
    406  . I ZIEN'=ZPIEN D  ; ONLY FOR CHILD TEMPLATES
    407  . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",.01)=ZPIEN ; NEW SUBFILE ENTRY WITH PAR PTR
    408  . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",1)=ZTAG ; TAG FOR NEW ENTRY
    409  . . D UPDIE
    410  . ;S C0CFDA(ZF,"?+1,",1)=@ZI
    411  . ;D UPDIE
    412  . S ZI=$Q(@ZI)
    413  . I ZI="" S DONE=1
    414  Q
    415  ;
    416 MKTPLATE(INXML,OUTT) ;MAKE A TEMPLATE FROM INXML, RETURNED IN OUTT
    417  ; BOTH PASSED BY NAME
    418  ;
    419  S C0CDOCID=$$PARSE(INXML,"C0CMKT")
    420  S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
    421  N ZI S ZI=""
    422  F  S ZI=$O(@C0CDOM@(ZI)) Q:ZI=""  D  ; FOR EACH NODE IN THE DOM
    423  . W !,ZI,$$TAG(ZI)
    424  Q
    425  ;
    426 UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
     200UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
    427201 K ZERR
    428202 D CLEAN^DILF
Note: See TracChangeset for help on using the changeset viewer.