Changeset 601


Ignore:
Timestamp:
Nov 11, 2009, 1:04:41 AM (15 years ago)
Author:
George Lilly
Message:

support for incoming CCDs

Location:
ccr/trunk/p
Files:
5 edited

Legend:

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

    r588 r601  
    109109 X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
    110110 I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
    111  I MRN'="" D  ; IF MRN IS PRESENT
     111 I $G(MRN)'="" D  ; IF MRN IS PRESENT
    112112 . S @AMAP@("ACTORSSN")=MRN
    113113 . S @AMAP@("ACTORSSNTEXT")="MRN"
  • ccr/trunk/p/C0CCCR0.m

    r591 r601  
    5858 Q
    5959 ;
    60 LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
     60LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
    6161 D ZLOAD(ARY,"C0CCCR0")
    6262 ; ZWR @ARY
  • ccr/trunk/p/C0CMXML.m

    r575 r601  
    3434        Q
    3535        ;
     36TEST3
     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 ;
    3656XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX)      ; RECURSIVE ROUTINE TO POPULATE
    3757        ; THE XPATH INDEX ZXIDX, PASSED BY NAME
     
    5979        N GNXT S GNXT=$$NXTSIB(ZOID)
    6080        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
    6286        Q
    6387        ;
     
    7094ISMULT(ZOID)    ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
    7195        N ZN
     96        ;I $$TAG(ZOID)["entry" B
    7297        S ZN=$$NXTSIB(ZOID)
    7398        I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
     
    77102        Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
    78103        ;
     104PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
     105 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
     106 ;
    79107TAG(ZOID)       ; RETURNS THE XML TAG FOR THE NODE
    80108        Q $$NAME^MXMLDOM(C0CDOCID,ZOID)
     
    90118        Q
    91119        ;
     120PARSCCD(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
     140STARTELE(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 ;
     158CLEANARY(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 ;
     165CLEAN(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 ;
     173STRIPTXT(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 ;
     192C0CBEGIN(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 ;
     200C0CEND(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 ;
     207FINDTID ; 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 ;
     228GENXDS(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 ;
     247UPDIE   ; 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 ;
  • ccr/trunk/p/C0CVITAL.m

    r599 r601  
    4040 ;
    4141VITVISTA ; EXTRACT VITALS FROM VISTA INTO PROVIDED XML TEMPLATE
    42  D VITALS^ORQQVI(.VITRSLT,DFN,C0CSDT,C0CEDT)
     42 D VITALS^ORQQVI(.VITRSLT,DFN,C0CEDT,C0CSDT)
     43 ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CSDT,C0CEDT)
    4344 ;D VITALS^ORQQVI(.VITRSLT,DFN,C0CVSTRT,C0CVLMT) ; GPL LET GMR HANDLE THE DATES
    4445 I '$D(VITRSLT(1)) S @VITOUTXML@(0)=0 Q  ; RETURN NOT FOUND AND QUIT
  • ccr/trunk/p/C0CXPATH.m

    r570 r601  
    386386 . N J,ATMP
    387387 . S ATMP=$$ARRAY(@BLIST@(I))
    388  . I DEBUG W "ATMP=",ATMP,!
    389  . I DEBUG W @BLIST@(I),!
     388 . I $G(DEBUG) W "ATMP=",ATMP,!
     389 . I $G(DEBUG) W @BLIST@(I),!
    390390 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
    391391 . . ; FOR EACH LINE IN THIS INSTR
    392  . . I DEBUG W "BDEST= ",BDEST,!
    393  . . I DEBUG W "ATMP= ",@ATMP@(J),!
     392 . . I $G(DEBUG) W "BDEST= ",BDEST,!
     393 . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
    394394 . . D PUSH(BDEST,@ATMP@(J))
    395395 Q
     
    404404 ; KILLS CPDEST FIRST
    405405 N CPINSTR
    406  I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
     406 I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,!
    407407 I @CPSRC@(0)<1 D  ; BAD LENGTH
    408408 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
     
    420420 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
    421421 . Q
    422  I DEBUG W "DOING QOPEN",!
     422 I $G(DEBUG) W "DOING QOPEN",!
    423423 N S1,E1,QOT,QOTMP
    424424 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
     
    440440 I @QCXML@(0)<1 D  ; MALFORMED XML
    441441 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
    442  I DEBUG W "GOING TO CLOSE",!
     442 I $G(DEBUG) W "GOING TO CLOSE",!
    443443 N S1,E1,QCT,QCTMP
    444444 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
     
    459459 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
    460460 N INSBLD,INSTMP
    461  I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
    462  I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
     461 I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
     462 I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
    463463 I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
    464464 . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
     
    466466 . I $D(INSXPATH) D  ; XPATH PROVIDED
    467467 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
    468  . . I DEBUG D PARY^C0CXPATH("INSBLD")
     468 . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD")
    469469 . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
    470470 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
     
    506506 D BUILD("XBLD","XTMP") ; BUILD THE RESULT
    507507 D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
    508  I DEBUG D PARY("XDEST")
     508 I $G(DEBUG) D PARY("XDEST")
    509509 Q
    510510 ;
     
    526526 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
    527527 . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
    528  I DEBUG W "REPLACE PREBUILD",!
    529  I DEBUG D PARY("REBLD")
     528 I $G(DEBUG) W "REPLACE PREBUILD",!
     529 I $G(DEBUG) D PARY("REBLD")
    530530 D BUILD("REBLD","RTMP")
    531531 K @REXML ; KILL WHAT WAS THERE
Note: See TracChangeset for help on using the changeset viewer.