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

Fixed CCD structure, added Narrative to Problems

This commit is contained in:
george 2008-07-27 20:37:10 +00:00
parent 45cb9f3225
commit 21364dd8fc
4 changed files with 74 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
p/GPLCCD.m
View File

@ -80,9 +80,9 @@ CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
S ZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
D QUERY^GPLXPATH(CCRGLO,ZX,"ACTT1")
D PATIENT^GPLACTORS("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
D PARY^GPLXPATH("ACTT2")
I DEBUG D PARY^GPLXPATH("ACTT2")
D REPLACE^GPLXPATH(CCRGLO,"ACTT2",ZX)
D PARY^GPLXPATH(CCRGLO)
I DEBUG D PARY^GPLXPATH(CCRGLO)
K ACTT1 K ACCT2
; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
@ -108,6 +108,7 @@ CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
. X CALL
. I CCD D QUERY^GPLXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
. I CCD D UNSHAVE("ITMP",OXML)
. I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
. D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
. I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
@ -121,6 +122,13 @@ CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
. S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
. W "TRIMMED",J,!
. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
I CCD D ; TURN THE BODY INTO A CCD COMPONENT
. N I
. F I=1:1:@CCRGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY
. . I @CCRGLO@(I)["<Body>" D ; REPLACE BODY MARKUP
. . . S @CCRGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
. . I @CCRGLO@(I)["</Body>" D ; REPLACE BODY MARKUP
. . . S @CCRGLO@(I)="</structuredBody></component>"
S @CCRGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
S @CCRGLO@(@CCRGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
Q

1
p/GPLCCR.m
View File

@ -49,6 +49,7 @@ CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
; "TO" VARIABLES
; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
S DEBUG=0
S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS

21
p/GPLPROBS.m
View File

@ -72,6 +72,27 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
; ZWR @OUTXML
; $$HTML^DILF(
; GENERATE THE NARITIVE HTML FOR THE CCD
I CCD D ; IF THIS IS FOR A CCD
. N HTMP,I,ZX
. S ZX="<text><table border=""1"" width=""100%""><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>"
. D PUSH^GPLXPATH("HTMP",ZX) ; HEADER OF THE TABLE
. F I=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM
. . S VMAP=$NA(@TVMAP@(I))
. . S ZX="<tr><td>" ; BEGIN ROW AND COL
. . D PUSH^GPLXPATH("HTMP",ZX) ; ADD TO BUFFER
. . S ZX=@VMAP@("PROBLEMDESCRIPTION")
. . I ZX="" S ZX=" " ; SET TO BLANK SO IT DOESN'T GET TRIMMED
. . D PUSH^GPLXPATH("HTMP",ZX)
. . D PUSH^GPLXPATH("HTMP","</td><td>") ; NEXT COL
. . S ZX=@VMAP@("PROBLEMDATEOFONSET")
. . I ZX="" S ZX="Unknown" ; SET TO UNKNOWN
. . D PUSH^GPLXPATH("HTMP",ZX)
. . D PUSH^GPLXPATH("HTMP","</td><td>") ; NEXT COL
. . D PUSH^GPLXPATH("HTMP","Active") ; WE ONLY DO ACTIVE
. . D PUSH^GPLXPATH("HTMP","</td></tr>") ; END OF COL AND ROW
. D PUSH^GPLXPATH("HTMP","</tbody></table></text>") ; END TABLE
. D INSB4^GPLXPATH(OUTXML,"HTMP") ; INSERT AT TOP OF SECTION
N PROBSTMP,I
D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS -

59
p/GPLXPATH.m
View File

@ -298,6 +298,17 @@ INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
. D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
Q
;
INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
; BUT XDEST AN XNEW ARE PASSED BY NAME
N XBLD,XTMP
D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
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")
Q
;
REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
@ -361,41 +372,47 @@ MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
. I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
. . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
. . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
. . . W "IN MAPPING LOOP: ",TSTR,!
. . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
. . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
. . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
. . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
. . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
. . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
. . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
. . W TSTR
. . I DEBUG W TSTR
W "MAPPED",!
Q
;
TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
; THEXML IS PASSED BY NAME
N I,J,TMPXML,DEL,FOUND
N I,J,TMPXML,DEL,FOUND,INTXT
S FOUND=0
S INTXT=0
W "DELETING EMPTY ELEMENTS",!
F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY
. S J=@THEXML@(I)
. I J["<text>" D
. . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
. . W "IN HTML SECTION",!
. N JM,JP ; JMINUS AND JPLUS
. S JM=@THEXML@(I-1) ; LINE BEFORE
. I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
. S JP=@THEXML@(I+1) ; LINE AFTER
. S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
. I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES
. . W I,J,JP,!
. . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
. . S DEL(I)="" ; SET LINE TO DELETE
. . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
. I J["><" D ; AN EMPTY ELEMENT ON ONE LINE
. . W I,J,!
. . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
. . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
. . I JM=JPX D ;
. . . W I,JM_J_JPX,!
. . . S DEL(I-1)=""
. . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
. I INTXT=0 D ; IF NOT IN AN HTML SECTION
. . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
. . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES
. . . W I,J,JP,!
. . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
. . . S DEL(I)="" ; SET LINE TO DELETE
. . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
. . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE
. . . W I,J,!
. . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
. . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
. . . I JM=JPX D ;
. . . . W I,JM_J_JPX,!
. . . . S DEL(I-1)=""
. . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
; . I J'["><" D PUSH("TMPXML",J)
I FOUND D ; NEED TO DELETE THINGS
. F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES
@ -404,6 +421,14 @@ TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
. D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
Q FOUND
;
UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
; XSEC IS A SECTION PASSED BY NAME
N XBLD,XTMP
D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
D BUILD("XBLD","XTMP") ; BUILD THE RESULT
D CP("XTMP",XSEC) ; REPLACE PASSED XML
Q
;
PARY(GLO) ;PRINT AN ARRAY
N I
F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!