Changeset 601 for ccr

Timestamp:

Nov 11, 2009, 1:04:41 AM (15 years ago)

Author:

George Lilly

Message:

support for incoming CCDs

Location:

ccr/trunk/p

Files:

• C0CACTOR.m (modified) (1 diff)
• C0CCCR0.m (modified) (1 diff)
• C0CMXML.m (modified) (5 diffs)
• C0CVITAL.m (modified) (1 diff)
• C0CXPATH.m (modified) (8 diffs)

ccr/trunk/p/C0CACTOR.m

@@ -109 +109 @@
  X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
  I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
- I MRN'="" D  ; IF MRN IS PRESENT
+ I $G(MRN)'="" D  ; IF MRN IS PRESENT
  . S @AMAP@("ACTORSSN")=MRN
  . S @AMAP@("ACTORSSNTEXT")="MRN"

ccr/trunk/p/C0CCCR0.m

@@ -58 +58 @@
  Q
  ;
-LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
  D ZLOAD(ARY,"C0CCCR0")
  ; ZWR @ARY

ccr/trunk/p/C0CMXML.m

@@ -34 +34 @@
         Q
         ;
+TEST3
+ S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
+ K GARY,GTMP,GIDX
+ K @C0CXMLIN
+ W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
+ D CLEANARY("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
+ K @C0CXMLIN
+ M @C0CXMLIN=GTMP
+ K GTMP
+ D STRIPTXT("GTMP",C0CXMLIN)
+ K @C0CXMLIN
+ M @C0CXMLIN=GTMP
+ K GTMP
+ S C0CDOCID=$$PARSCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
+ S REDUX="//ClinicalDocument/component/structuredBody"
+ D XPATH(1,"/","GIDX","GARY",,REDUX)
+ S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID  ;CALL REGULAR PARSER
+ D XPATH(1,"/","GIDX2","GARY2",,REDUX)
+ Q
+ ;
 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX)      ; RECURSIVE ROUTINE TO POPULATE
         ; THE XPATH INDEX ZXIDX, PASSED BY NAME
@@ -59 +79 @@
         N GNXT S GNXT=$$NXTSIB(ZOID)
         I GNXT'=0 D  ;
-        . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
+        . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
+        . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
+        . . S ZNUM=1 ;
+        . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
+        . E  D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
         Q
         ;
@@ -70 +94 @@
 ISMULT(ZOID)    ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
         N ZN
+        ;I $$TAG(ZOID)["entry" B
         S ZN=$$NXTSIB(ZOID)
         I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
@@ -77 +102 @@
         Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
         ;
+PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
+ Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
+ ;
 TAG(ZOID)       ; RETURNS THE XML TAG FOR THE NODE
         Q $$NAME^MXMLDOM(C0CDOCID,ZOID)
@@ -90 +118 @@
         Q
         ;
+PARSCCD(DOC,OPTION) ; THIS WAS COPIED FROM EN^MXMLDOM TO CUSTIMIZE FOR 
+ ; PROCESSING CCDS 
+ N CBK,SUCCESS,LEVEL,NODE,HANDLE
+ K ^TMP("MXMLERR",$J)
+ L +^TMP("MXMLDOM",$J):5
+ E  Q 0
+ S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
+ L -^TMP("MXMLDOM",$J)
+ S CBK("STARTELEMENT")="STARTELE^C0CMXML" ; ONLY THIS ONE IS CHANGED ;GPL
+ S CBK("ENDELEMENT")="ENDELE^MXMLDOM"
+ S CBK("COMMENT")="COMMENT^MXMLDOM"
+ S CBK("CHARACTERS")="CHAR^MXMLDOM"
+ S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM"
+ S CBK("ERROR")="ERROR^MXMLDOM"
+ S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1")
+ D EN^MXMLPRSE(DOC,.CBK,OPTION)
+ D:'SUCCESS DELETE^MXMLDOM(HANDLE)
+ Q $S(SUCCESS:HANDLE,1:0)
+ ; Start element
+ ; Create new child node and push info on stack
+STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT
+ ; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER
+ N PARENT
+ S PARENT=LEVEL(LEVEL),NODE=NODE+1
+ S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE
+ S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE
+ S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT
+ ;M ^("A")=ATTR
+ N ZI S ZI="" ; INDEX FOR ATTR
+ F  S ZI=$O(ATTR(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
+ . N ELE,TXT ; ABOUT TO RECURSE
+ . S ELE=ZI ; TAG
+ . S TXT=ATTR(ZI) ; DATA
+ . D STARTELE(ELE,"") ; CREATE A NEW SUBNODE
+ . D TXT^MXMLDOM("T") ; INSERT DATA TO TAG
+ . D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL
+ Q
+ ;
+CLEANARY(OUTARY,INARY) ; GOES THROUGH AN ARRAY AND CALLS CLEAN ON EACH NODE
+ ; INARY AND OUTARY PASSED BY NAME
+ N ZI S ZI=""
+ F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ; FOR EACH NODE
+ . S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE
+ Q
+ ;
+CLEAN(STR) ; extrinsic function; returns string
+ ;; Removes all non printable characters from a string.
+ ;; STR by Value
+ N TR,I
+ F I=0:1:31 S TR=$G(TR)_$C(I)
+ S TR=TR_$C(127)
+ QUIT $TR(STR,TR)
+ ;
+STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE
+ ; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE
+ ; THEY DO NOT WORK RIGHT WITH THE PARSER
+ ;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER
+ S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER
+ D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY
+ F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH LINE OF THE ARRAY
+ . I $O(@ZARY@(ZI))="" D  Q  ; AT THE END 
+ . . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY
+ . I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE
+ . I @ZARY@(ZI)["<text" D C0CEND("ZWRK",ZI-1) ;PREV LINE IS AN END
+ . I @ZARY@(ZI)["</text>" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN
+ S ZI=""
+ F  S ZI=$O(ZWRK(ZI)) Q:ZI=""  D  ; MAKE A BUILD LIST FROM THE WORK ARRAY
+ . D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2))
+ D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS
+ K @OUTARY@(0) ; GET RID OF THE LINE COUNT
+ Q
+ ;
+C0CBEGIN(ZA,LN) ; INSERTS A BEGIN LINE LN INTO ARRAY ZWRK, PASSED BY NAME
+ N ZI
+ S ZI=$O(@ZA@(""),-1)
+ I ZI="" S ZI=1
+ E  S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY
+ S $P(@ZA@(ZI),"^",1)=LN
+ Q
+ ;
+C0CEND(ZB,LN) ; INSERTS AN END LINE LN INTO ARRAY ZWRK, PASSED BY NAME
+ N ZI
+ S ZI=$O(@ZB@(""),-1)
+ I ZI="" S ZI=1
+ S $P(@ZB@(ZI),"^",2)=LN
+ Q
+ ;
+FINDTID ; FIND TEMPLATE IDS IN DOM 1
+ S C0CDOCID=1
+ S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
+ S ZN=""
+ S CURSEC=""
+ S TID=""
+ F  S ZN=$O(@ZD@(ZN)) Q:ZN=""  D  ;
+ . I $$TAG(ZN)="root" D  ;
+ . . I $$TAG($$PARENT(ZN))="templateId" D  ; ONLY LOOKING FOR TEMPLATES
+ . . . S ZG=$$PARENT($$PARENT(ZN))
+ . . . S CMT=$G(@ZD@(ZG,"X",1))
+ . . . I $$TAG(ZG)="section" D  ;START OF A SECTION
+ . . . . S CURSEC=ZG
+ . . . . S SECCMT=$G(@ZD@(CURSEC,"X",1))
+ . . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID
+ . . . I CURSEC'="" D  ; IF WE ARE IN A SECTION
+ . . . . S CCDDIR(CURSEC,SECCMT,ZG,$$TAG(ZG),CMT)=TID
+ . . . W !,$$TAG(ZG)," ",$G(@ZD@(ZG,"X",1))
+ . . . W " root ",ZN," ",@ZD@(ZN,"T",1)
+ Q
+ ;
+GENXDS(ZD) ; GENERATE THE XDS PROTOTYPE RECORDS FROM A CCDDIR ARRAY
+ ; ARRAY ELEMENTS LOOK LIKE:
+ ; CCDDIR(1634," Vital signs section template ",1659,"observation"," Result observaion template ")="2.16.840.1.113883.10.20.1.31"
+ ;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId
+ S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
+ S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
+ S DONE=0
+ F  Q:DONE  D  ;
+ . W @ZI,!
+ . S ZJ=$QS(ZI,5)
+ . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
+ . S C0CFDA(ZF,"?+1,",.01)=ZJ
+ . S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
+ . S C0CFDA(ZF,"?+1,",1)=@ZI
+ . D UPDIE
+ . S ZI=$Q(@ZI)
+ . I ZI="" S DONE=1
+ Q
+ ;
+UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+ K ZERR
+ D CLEAN^DILF
+ D UPDATE^DIE("","C0CFDA","","ZERR")
+ I $D(ZERR) D  ;
+ . W "ERROR",!
+ . ZWR ZERR
+ . B
+ K C0CFDA
+ Q
+ ;

ccr/trunk/p/C0CVITAL.m

@@ -40 +40 @@
  ;
 VITVISTA ; EXTRACT VITALS FROM VISTA INTO PROVIDED XML TEMPLATE
- D VITALS^ORQQVI(.VITRSLT,DFN,C0CSDT,C0CEDT)
+ D VITALS^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT)
+ ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CSDT,C0CEDT)
  ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CVSTRT,C0CVLMT) ; GPL LET GMR HANDLE THE DATES
  I '$D(VITRSLT(1)) S @VITOUTXML@(0)=0 Q  ; RETURN NOT FOUND AND QUIT

ccr/trunk/p/C0CXPATH.m

@@ -386 +386 @@
  . N J,ATMP
  . S ATMP=$$ARRAY(@BLIST@(I))
- . I DEBUG W "ATMP=",ATMP,!
- . I DEBUG W @BLIST@(I),!
+ . I $G(DEBUG) W "ATMP=",ATMP,!
+ . I $G(DEBUG) W @BLIST@(I),!
  . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
  . . ; FOR EACH LINE IN THIS INSTR
- . . I DEBUG W "BDEST= ",BDEST,!
- . . I DEBUG W "ATMP= ",@ATMP@(J),!
+ . . I $G(DEBUG) W "BDEST= ",BDEST,!
+ . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
  . . D PUSH(BDEST,@ATMP@(J))
  Q
@@ -404 +404 @@
  ; KILLS CPDEST FIRST
  N CPINSTR
- I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
+ I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,!
  I @CPSRC@(0)<1 D  ; BAD LENGTH
  . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
@@ -420 +420 @@
  . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
  . Q
- I DEBUG W "DOING QOPEN",!
+ I $G(DEBUG) W "DOING QOPEN",!
  N S1,E1,QOT,QOTMP
  S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
@@ -440 +440 @@
  I @QCXML@(0)<1 D  ; MALFORMED XML
  . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
- I DEBUG W "GOING TO CLOSE",!
+ I $G(DEBUG) W "GOING TO CLOSE",!
  N S1,E1,QCT,QCTMP
  S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
@@ -459 +459 @@
  ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
  N INSBLD,INSTMP
- I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
- I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
+ I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
+ I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
  I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
  . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
@@ -466 +466 @@
  . I $D(INSXPATH) D  ; XPATH PROVIDED
  . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
- . . I DEBUG D PARY^C0CXPATH("INSBLD")
+ . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD")
  . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
  . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
@@ -506 +506 @@
  D BUILD("XBLD","XTMP") ; BUILD THE RESULT
  D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
- I DEBUG D PARY("XDEST")
+ I $G(DEBUG) D PARY("XDEST")
  Q
  ;
@@ -526 +526 @@
  . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
  . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
- I DEBUG W "REPLACE PREBUILD",!
- I DEBUG D PARY("REBLD")
+ I $G(DEBUG) W "REPLACE PREBUILD",!
+ I $G(DEBUG) D PARY("REBLD")
  D BUILD("REBLD","RTMP")
  K @REXML ; KILL WHAT WAS THERE