Changeset 1337 for ccr/branches/ohum/p/C0CMCCD.m
- Timestamp:
- Jan 4, 2012, 9:40:24 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CMCCD.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CMCCD.m
r1333 r1337 1 C0CMCCD 2 ;;0.1;C0C;nopatch;noreleasedate;Build 1 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 PARSCCD(DOC,OPTION) 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 STARTELE(ELE,ATTR) 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 ISMULT(ZOID) 61 62 63 64 65 66 67 FIRST(ZOID) 68 69 70 PARENT(ZOID) 71 72 73 ATT(RTN,NODE) 74 75 76 77 78 79 TAG(ZOID) 80 81 82 83 84 85 86 87 88 NXTSIB(ZOID) 89 90 91 DATA(ZT,ZOID) 92 93 94 95 96 97 98 CLEANARY(OUTARY,INARY) 99 100 101 102 103 104 105 CLEAN(STR) 106 107 108 109 110 111 112 113 STRIPTXT(OUTARY,ZARY) 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 C0CBEGIN(ZA,LN) 133 134 135 136 137 138 139 140 C0CEND(ZB,LN) 141 142 143 144 145 146 147 SEPARATE(OUTARY,INARY) 148 149 150 151 152 153 154 155 156 157 158 159 FINDTID 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 FINDALT 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 ALTTAG(NODE) 213 214 215 216 217 SETCBK 218 219 220 221 OUTCCD(GARYIN) 222 223 224 225 226 227 228 229 230 231 232 233 234 235 GENXDS(ZD) 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 WHRUSD(ZD) 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 UPDIE 284 285 286 287 288 289 290 291 292 293 1 C0CMCCD ; GPL - MXML based CCD utilities;12/04/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 ; 22 PARSCCD(DOC,OPTION) ; THIS WAS COPIED FROM EN^MXMLDOM TO CUSTIMIZE FOR 23 ; PROCESSING CCDS 24 N CBK,SUCCESS,LEVEL,NODE,HANDLE 25 K ^TMP("MXMLERR",$J) 26 L +^TMP("MXMLDOM",$J):5 27 E Q 0 28 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" 29 L -^TMP("MXMLDOM",$J) 30 S CBK("STARTELEMENT")="STARTELE^C0CMCCD" ; ONLY THIS ONE IS CHANGED ;GPL 31 S CBK("ENDELEMENT")="ENDELE^MXMLDOM" 32 S CBK("COMMENT")="COMMENT^MXMLDOM" 33 S CBK("CHARACTERS")="CHAR^MXMLDOM" 34 S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM" 35 S CBK("ERROR")="ERROR^MXMLDOM" 36 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1") 37 D EN^MXMLPRSE(DOC,.CBK,OPTION) 38 D:'SUCCESS DELETE^MXMLDOM(HANDLE) 39 Q $S(SUCCESS:HANDLE,1:0) 40 ; Start element 41 ; Create new child node and push info on stack 42 STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT 43 ; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER 44 N PARENT 45 S PARENT=LEVEL(LEVEL),NODE=NODE+1 46 S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE 47 S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE 48 S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT 49 ;M ^("A")=ATTR 50 N ZI S ZI="" ; INDEX FOR ATTR 51 F S ZI=$O(ATTR(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 52 . N ELE,TXT ; ABOUT TO RECURSE 53 . S ELE=ZI ; TAG 54 . S TXT=ATTR(ZI) ; DATA 55 . D STARTELE(ELE,"") ; CREATE A NEW SUBNODE 56 . D TXT^MXMLDOM("T") ; INSERT DATA TO TAG 57 . D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL 58 Q 59 ; 60 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 61 N ZN 62 ;I $$TAG(ZOID)["entry" B 63 S ZN=$$NXTSIB(ZOID) 64 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 65 Q 0 66 ; 67 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 68 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 69 ; 70 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 71 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 72 ; 73 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 74 S HANDLE=C0CDOCID 75 K @RTN 76 D GETTXT^MXMLDOM("A") 77 Q 78 ; 79 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 80 ;I ZOID=149 B ;GPLTEST 81 N X,Y 82 S Y="" 83 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 84 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 85 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID) 86 Q Y 87 ; 88 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 89 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 90 ; 91 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 92 ;N ZT,ZN S ZT="" 93 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 94 ;Q $G(@C0CDOM@(ZOID,"T",1)) 95 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT) 96 Q 97 ; 98 CLEANARY(OUTARY,INARY) ; GOES THROUGH AN ARRAY AND CALLS CLEAN ON EACH NODE 99 ; INARY AND OUTARY PASSED BY NAME 100 N ZI S ZI="" 101 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH NODE 102 . S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE 103 Q 104 ; 105 CLEAN(STR) ; extrinsic function; returns string 106 ;; Removes all non printable characters from a string. 107 ;; STR by Value 108 N TR,I 109 F I=0:1:31 S TR=$G(TR)_$C(I) 110 S TR=TR_$C(127) 111 QUIT $TR(STR,TR) 112 ; 113 STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE 114 ; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE 115 ; THEY DO NOT WORK RIGHT WITH THE PARSER 116 ;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER 117 S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER 118 D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY 119 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH LINE OF THE ARRAY 120 . I $O(@ZARY@(ZI))="" D Q ; AT THE END 121 . . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY 122 . I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE 123 . I @ZARY@(ZI)["<text" D C0CEND("ZWRK",ZI-1) ;PREV LINE IS AN END 124 . I @ZARY@(ZI)["</text>" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN 125 S ZI="" 126 F S ZI=$O(ZWRK(ZI)) Q:ZI="" D ; MAKE A BUILD LIST FROM THE WORK ARRAY 127 . D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2)) 128 D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS 129 K @OUTARY@(0) ; GET RID OF THE LINE COUNT 130 Q 131 ; 132 C0CBEGIN(ZA,LN) ; INSERTS A BEGIN LINE LN INTO ARRAY ZWRK, PASSED BY NAME 133 N ZI 134 S ZI=$O(@ZA@(""),-1) 135 I ZI="" S ZI=1 136 E S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY 137 S $P(@ZA@(ZI),"^",1)=LN 138 Q 139 ; 140 C0CEND(ZB,LN) ; INSERTS AN END LINE LN INTO ARRAY ZWRK, PASSED BY NAME 141 N ZI 142 S ZI=$O(@ZB@(""),-1) 143 I ZI="" S ZI=1 144 S $P(@ZB@(ZI),"^",2)=LN 145 Q 146 ; 147 SEPARATE(OUTARY,INARY) ; SEPARATES XPATH VARIABLES ACCORDING TO THEIR 148 ; ROOT ; /Problems/etc/etc goes to @OUTARY@("Problems","/Problems/etc/etc") 149 S ZI="" 150 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH ELEMENT OF THE ARRAY 151 . I $P(ZI,"//",2)'="" D ; FOR NON-BODY ENTRIES 152 . . S ZJ=$P(ZI,"/",4) ; things like From Patient Actor 153 . E D ; FOR BODY PARTS 154 . . S ZJ=$P(ZI,"/",2) ; 155 . . I ZJ="" S ZJ=$P(ZI,"/",3) ; 156 . S @OUTARY@(ZJ,ZI)=$G(@INARY@(ZI)) ;FIX THIS FOR MULTILINE COMMENTS 157 Q 158 ; 159 FINDTID ; FIND TEMPLATE IDS IN DOM 1 160 S C0CDOCID=1 161 S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 162 S ZN="" 163 S CURSEC="" 164 S TID="" 165 F S ZN=$O(@ZD@(ZN)) Q:ZN="" D ; 166 . I $$TAG(ZN)="root" D ; 167 . . I $$TAG($$PARENT(ZN))="templateId" D ; ONLY LOOKING FOR TEMPLATES 168 . . . S ZG=$$PARENT($$PARENT(ZN)) 169 . . . S ZG2=$$PARENT(ZG) ;COMPONENT THAT HOLDS THIS SECTION 170 . . . S CMT=$G(@ZD@(ZG,"X",1)) 171 . . . I CMT="" S CMT="?" 172 . . . I $$TAG(ZG)="section" D ;START OF A SECTION 173 . . . . S CURSEC=$$PARENT(ZG) 174 . . . . S SECCMT=$G(@ZD@(CURSEC,"X",1)) 175 . . . . I SECCMT="" S SECCMT="?" 176 . . . . S SECTID=$G(@ZD@(ZN,"T",1)) ;SECTION TEMPLATE ID 177 . . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID 178 . . . I CURSEC'="" D ; IF WE ARE IN A SECTION 179 . . . . S CCDDIR(ZG2,CURSEC,$$TAG(ZG2),CMT,SECCMT)=TID 180 . . . . S DOMMAP(ZG2)=CURSEC_U_$$TAG(ZG2)_U_TID_U_SECTID 181 . . . W !,$$TAG(ZG2)," ",$G(@ZD@(ZG,"X",1)) 182 . . . W " root ",ZN," ",@ZD@(ZN,"T",1) 183 Q 184 ; 185 FINDALT ; PROCESS THE DOMMAP AND FIND THE ALT TAGS FOR COMPONENTS 186 ; 187 S ZI="" 188 F S ZI=$O(DOMMAP(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE MAP 189 . S ZJ=DOMMAP(ZI) ; 190 . S PARNODE=$P(ZJ,U,1) ;PARENT NODE 191 . S TAG=$P(ZJ,U,2) ;THIS TAG 192 . S TID=$P(ZJ,U,3) ;THIS TEMPLATE ID 193 . S PARTID=$P(ZJ,U,4) ;PARENT TEMPLATE ID 194 . S ZIEN=$O(^C0CXDS(178.101,"TID",TID,"")) ;THIS NODE IEN 195 . S PARIEN=$O(^C0CXDS(178.101,"TID",PARTID,"")) ;PARENT NODE IEN 196 . I ZI=PARNODE D ; IF THIS IS A SECTION NODE 197 . . S ALTTAG=$$GET1^DIQ(178.101,PARIEN_",",.03) ;ALT TAG FIELD FOR PARENT 198 . . S NAME=$$GET1^DIQ(178.101,ZIEN_",",.01) ;NAME OF THIS NODE'S TEMPLATE 199 . . W ZI," ",TAG," ",ALTTAG," ",NAME,! 200 . . S C0CTAGS(ZI)=ALTTAG 201 . E D ; NOT A SECTION NODE 202 . . N ZJ S ZJ="" 203 . . S ZJ=$O(^C0CXDS(178.101,"D",PARIEN,ZIEN,"")) ;A WHEREUSED POINTER? 204 . . I ZJ'="" D ; THERE IS A NEW LABEL FOR THIS NODE 205 . . . N ZK 206 . . . S ZK=$$GET1^DIQ(178.111,ZJ_","_ZIEN_",",2) 207 . . . I ZK'="" D ; 208 . . . . W "FOUND ",ZK,! 209 . . . . S C0CTAGS(ZI)=ZK ; NEW TAG FOR INTERSECTION 210 Q 211 ; 212 ALTTAG(NODE) ; SET Y EQUAL TO THE ALT TAG FOUND IN C0CTAGS IF NODE IF FOUND 213 ; 214 S Y=$G(C0CTAGS(NODE)) 215 Q 216 ; 217 SETCBK ; SET THE TAG CALLBACK FOR XPATH PROCESSSING OF THE CCD 218 S C0CCBK("TAG")="D ALTTAG^C0CMCCD(ZOID)" 219 Q 220 ; 221 OUTCCD(GARYIN) ; OUTPUT THE PARSED CCD TO A TEXT FILE 222 ;D TEST3^C0CMXML 223 N ZT S ZT=$NA(^TMP("CCDOUT",$J)) 224 N ZI,ZJ 225 S ZI=1 S ZJ="" 226 K @ZT 227 F S ZJ=$O(GARYIN(ZJ)) Q:ZJ="" D ; 228 . S @ZT@(ZI)=ZJ_"^"_GARYIN(ZJ) 229 . S ZI=ZI+1 230 S ONAME=$NA(@ZT@(1)) 231 W $$OUTPUT^C0CXPATH(ONAME,"CCDOUT.txt","/home/vademo2/CCR") 232 K @ZT 233 Q 234 ; 235 GENXDS(ZD) ; GENERATE THE XDS PROTOTYPE RECORDS FROM A CCDDIR ARRAY 236 ; ARRAY ELEMENTS LOOK LIKE: 237 ; CCDDIR(1659,1634,"observation"," Result observaion template "," Vital signs section template ")="2.16.840.1.113883.10.20.1.31" 238 ;or CCDDIR(cur node,section node,cur tag,cur name,sec name)=templateId 239 S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE 240 S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT 241 S DONE=0 242 F Q:DONE D ; 243 . W @ZI,! 244 . S ZJ=$QS(ZI,5) 245 . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE 246 . S C0CFDA(ZF,"?+1,",.01)=ZJ 247 . S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE 248 . S C0CFDA(ZF,"?+1,",1)=@ZI 249 . D UPDIE 250 . S ZI=$Q(@ZI) 251 . I ZI="" S DONE=1 252 Q 253 ; 254 WHRUSD(ZD) ; UPDATE THE C0C XDS FILE WITH WHERE USED DATA FROM 255 ; CCDDIR PASS BY NAME 256 ; ARRAY ELEMENTS LOOK LIKE: 257 ; CCDDIR(1634," Vital signs section template ",1659,"observation"," Result observaion template ")="2.16.840.1.113883.10.20.1.31" 258 ;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId 259 S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE 260 S ZSF=178.111 ; WHERE USED SUBFILE OF C0C XDS PROTOTYPE FILE 261 S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT 262 S DONE=0 263 F Q:DONE D ; 264 . W @ZI 265 . S ZIEN=$O(^C0CXDS(178.101,"TID",@ZI,"")) ; IEN FOR THIS NODE'S TEMPLATE 266 . W " IEN:",ZIEN 267 . S ZJ=$QS(ZI,2) 268 . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE 269 . S ZPIEN=$O(^C0CXDS(178.101,"B",ZJ,"")) ; PARENT IEN 270 . W " PARENT IEN:",ZPIEN 271 . S ZTAG=$QS(ZI,4) ; TAG FOR THIS TEMPLATE 272 . W " TAG:",ZTAG,! 273 . I ZIEN'=ZPIEN D ; ONLY FOR CHILD TEMPLATES 274 . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",.01)=ZPIEN ; NEW SUBFILE ENTRY WITH PAR PTR 275 . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",1)=ZTAG ; TAG FOR NEW ENTRY 276 . . D UPDIE 277 . ;S C0CFDA(ZF,"?+1,",1)=@ZI 278 . ;D UPDIE 279 . S ZI=$Q(@ZI) 280 . I ZI="" S DONE=1 281 Q 282 ; 283 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 284 K ZERR 285 D CLEAN^DILF 286 D UPDATE^DIE("","C0CFDA","","ZERR") 287 I $D(ZERR) D ; 288 . W "ERROR",! 289 . ZWR ZERR 290 . B 291 K C0CFDA 292 Q 293 ;
Note:
See TracChangeset
for help on using the changeset viewer.
