iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

support for incoming CCDs

This commit is contained in:
george 2009-11-11 06:04:41 +00:00
parent b6c5c14f75
commit 1330ad24b5
7 changed files with 1502 additions and 1335 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
p/C0CACTOR.m
View File

@ -108,7 +108,7 @@ PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
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"
. S @AMAP@("ACTORSSNSOURCEID")=AOID

2
p/C0CCCR0.m
View File

@ -57,7 +57,7 @@ ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
. . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
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
Q

168
p/C0CMXML.m
View File

@ -33,6 +33,26 @@ TEST2 ;
D XPATH(1,"/","GIDX","GARY","",REDUX)
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
; THE XPATH ARRAY XPARY, PASSED BY NAME
@ -58,7 +78,11 @@ XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
. D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
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
;
PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
@ -69,6 +93,7 @@ PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
;
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
Q 0
@ -76,6 +101,9 @@ ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
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)
;
@ -89,3 +117,141 @@ DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
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
;

3
p/C0CVITAL.m
View File

@ -39,7 +39,8 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
Q
;
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
I $P(VITRSLT(1),U,2)="No vitals found." D Q ; NULL RESULT FROM RPC

26
p/C0CXPATH.m
View File

@ -385,12 +385,12 @@ BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
. 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
;
@ -403,7 +403,7 @@ QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST
CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
; 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,!
. Q
@ -419,7 +419,7 @@ QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
I @QOXML@(0)<1 D ; MALFORMED XML
. 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
I $D(QOXPATH) D ; XPATH PROVIDED
@ -439,7 +439,7 @@ QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
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
I $D(QCXPATH) D ; XPATH PROVIDED
@ -458,14 +458,14 @@ INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
; XML AT THE END OF THE XPATH POINT
; 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
I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
. 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
. D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
@ -505,7 +505,7 @@ INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
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
;
REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
@ -525,8 +525,8 @@ REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
. D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
. 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
D CP("RTMP",REXML) ; COPY IN THE RESULT