Changeset 601 for ccr/trunk/p/C0CMXML.m
- Timestamp:
- Nov 11, 2009, 1:04:41 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CMXML.m
r575 r601 34 34 Q 35 35 ; 36 TEST3 37 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 38 K GARY,GTMP,GIDX 39 K @C0CXMLIN 40 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3) 41 D CLEANARY("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 42 K @C0CXMLIN 43 M @C0CXMLIN=GTMP 44 K GTMP 45 D STRIPTXT("GTMP",C0CXMLIN) 46 K @C0CXMLIN 47 M @C0CXMLIN=GTMP 48 K GTMP 49 S C0CDOCID=$$PARSCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID 50 S REDUX="//ClinicalDocument/component/structuredBody" 51 D XPATH(1,"/","GIDX","GARY",,REDUX) 52 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID ;CALL REGULAR PARSER 53 D XPATH(1,"/","GIDX2","GARY2",,REDUX) 54 Q 55 ; 36 56 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 37 57 ; THE XPATH INDEX ZXIDX, PASSED BY NAME … … 59 79 N GNXT S GNXT=$$NXTSIB(ZOID) 60 80 I GNXT'=0 D ; 61 . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB 81 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 82 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 83 . . S ZNUM=1 ; 84 . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 85 . E D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB 62 86 Q 63 87 ; … … 70 94 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 71 95 N ZN 96 ;I $$TAG(ZOID)["entry" B 72 97 S ZN=$$NXTSIB(ZOID) 73 98 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG … … 77 102 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 78 103 ; 104 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 105 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 106 ; 79 107 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 80 108 Q $$NAME^MXMLDOM(C0CDOCID,ZOID) … … 90 118 Q 91 119 ; 120 PARSCCD(DOC,OPTION) ; THIS WAS COPIED FROM EN^MXMLDOM TO CUSTIMIZE FOR 121 ; PROCESSING CCDS 122 N CBK,SUCCESS,LEVEL,NODE,HANDLE 123 K ^TMP("MXMLERR",$J) 124 L +^TMP("MXMLDOM",$J):5 125 E Q 0 126 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" 127 L -^TMP("MXMLDOM",$J) 128 S CBK("STARTELEMENT")="STARTELE^C0CMXML" ; ONLY THIS ONE IS CHANGED ;GPL 129 S CBK("ENDELEMENT")="ENDELE^MXMLDOM" 130 S CBK("COMMENT")="COMMENT^MXMLDOM" 131 S CBK("CHARACTERS")="CHAR^MXMLDOM" 132 S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM" 133 S CBK("ERROR")="ERROR^MXMLDOM" 134 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1") 135 D EN^MXMLPRSE(DOC,.CBK,OPTION) 136 D:'SUCCESS DELETE^MXMLDOM(HANDLE) 137 Q $S(SUCCESS:HANDLE,1:0) 138 ; Start element 139 ; Create new child node and push info on stack 140 STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT 141 ; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER 142 N PARENT 143 S PARENT=LEVEL(LEVEL),NODE=NODE+1 144 S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE 145 S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE 146 S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT 147 ;M ^("A")=ATTR 148 N ZI S ZI="" ; INDEX FOR ATTR 149 F S ZI=$O(ATTR(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 150 . N ELE,TXT ; ABOUT TO RECURSE 151 . S ELE=ZI ; TAG 152 . S TXT=ATTR(ZI) ; DATA 153 . D STARTELE(ELE,"") ; CREATE A NEW SUBNODE 154 . D TXT^MXMLDOM("T") ; INSERT DATA TO TAG 155 . D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL 156 Q 157 ; 158 CLEANARY(OUTARY,INARY) ; GOES THROUGH AN ARRAY AND CALLS CLEAN ON EACH NODE 159 ; INARY AND OUTARY PASSED BY NAME 160 N ZI S ZI="" 161 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH NODE 162 . S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE 163 Q 164 ; 165 CLEAN(STR) ; extrinsic function; returns string 166 ;; Removes all non printable characters from a string. 167 ;; STR by Value 168 N TR,I 169 F I=0:1:31 S TR=$G(TR)_$C(I) 170 S TR=TR_$C(127) 171 QUIT $TR(STR,TR) 172 ; 173 STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE 174 ; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE 175 ; THEY DO NOT WORK RIGHT WITH THE PARSER 176 ;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER 177 S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER 178 D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY 179 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH LINE OF THE ARRAY 180 . I $O(@ZARY@(ZI))="" D Q ; AT THE END 181 . . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY 182 . I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE 183 . I @ZARY@(ZI)["<text" D C0CEND("ZWRK",ZI-1) ;PREV LINE IS AN END 184 . I @ZARY@(ZI)["</text>" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN 185 S ZI="" 186 F S ZI=$O(ZWRK(ZI)) Q:ZI="" D ; MAKE A BUILD LIST FROM THE WORK ARRAY 187 . D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2)) 188 D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS 189 K @OUTARY@(0) ; GET RID OF THE LINE COUNT 190 Q 191 ; 192 C0CBEGIN(ZA,LN) ; INSERTS A BEGIN LINE LN INTO ARRAY ZWRK, PASSED BY NAME 193 N ZI 194 S ZI=$O(@ZA@(""),-1) 195 I ZI="" S ZI=1 196 E S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY 197 S $P(@ZA@(ZI),"^",1)=LN 198 Q 199 ; 200 C0CEND(ZB,LN) ; INSERTS AN END LINE LN INTO ARRAY ZWRK, PASSED BY NAME 201 N ZI 202 S ZI=$O(@ZB@(""),-1) 203 I ZI="" S ZI=1 204 S $P(@ZB@(ZI),"^",2)=LN 205 Q 206 ; 207 FINDTID ; FIND TEMPLATE IDS IN DOM 1 208 S C0CDOCID=1 209 S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 210 S ZN="" 211 S CURSEC="" 212 S TID="" 213 F S ZN=$O(@ZD@(ZN)) Q:ZN="" D ; 214 . I $$TAG(ZN)="root" D ; 215 . . I $$TAG($$PARENT(ZN))="templateId" D ; ONLY LOOKING FOR TEMPLATES 216 . . . S ZG=$$PARENT($$PARENT(ZN)) 217 . . . S CMT=$G(@ZD@(ZG,"X",1)) 218 . . . I $$TAG(ZG)="section" D ;START OF A SECTION 219 . . . . S CURSEC=ZG 220 . . . . S SECCMT=$G(@ZD@(CURSEC,"X",1)) 221 . . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID 222 . . . I CURSEC'="" D ; IF WE ARE IN A SECTION 223 . . . . S CCDDIR(CURSEC,SECCMT,ZG,$$TAG(ZG),CMT)=TID 224 . . . W !,$$TAG(ZG)," ",$G(@ZD@(ZG,"X",1)) 225 . . . W " root ",ZN," ",@ZD@(ZN,"T",1) 226 Q 227 ; 228 GENXDS(ZD) ; GENERATE THE XDS PROTOTYPE RECORDS FROM A CCDDIR ARRAY 229 ; ARRAY ELEMENTS LOOK LIKE: 230 ; CCDDIR(1634," Vital signs section template ",1659,"observation"," Result observaion template ")="2.16.840.1.113883.10.20.1.31" 231 ;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId 232 S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE 233 S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT 234 S DONE=0 235 F Q:DONE D ; 236 . W @ZI,! 237 . S ZJ=$QS(ZI,5) 238 . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE 239 . S C0CFDA(ZF,"?+1,",.01)=ZJ 240 . S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE 241 . S C0CFDA(ZF,"?+1,",1)=@ZI 242 . D UPDIE 243 . S ZI=$Q(@ZI) 244 . I ZI="" S DONE=1 245 Q 246 ; 247 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 248 K ZERR 249 D CLEAN^DILF 250 D UPDATE^DIE("","C0CFDA","","ZERR") 251 I $D(ZERR) D ; 252 . W "ERROR",! 253 . ZWR ZERR 254 . B 255 K C0CFDA 256 Q 257 ;
Note:
See TracChangeset
for help on using the changeset viewer.