Index: /ccr/trunk/p/GPLCCD.m =================================================================== --- /ccr/trunk/p/GPLCCD.m (revision 75) +++ /ccr/trunk/p/GPLCCD.m (revision 76) @@ -81,7 +81,7 @@ 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 @@ -109,4 +109,5 @@ . 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") @@ -122,4 +123,11 @@ . 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)["" D ; REPLACE BODY MARKUP + . . . S @CCRGLO@(I)="" ; WITH CCD EQ + . . I @CCRGLO@(I)["" D ; REPLACE BODY MARKUP + . . . S @CCRGLO@(I)="" S @CCRGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD S @CCRGLO@(@CCRGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE Index: /ccr/trunk/p/GPLCCR.m =================================================================== --- /ccr/trunk/p/GPLCCR.m (revision 75) +++ /ccr/trunk/p/GPLCCR.m (revision 76) @@ -50,4 +50,5 @@ ; 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 Index: /ccr/trunk/p/GPLPROBS.m =================================================================== --- /ccr/trunk/p/GPLPROBS.m (revision 75) +++ /ccr/trunk/p/GPLPROBS.m (revision 76) @@ -73,4 +73,25 @@ ; 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="" + . 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="") ; END OF COL AND ROW + . D PUSH^GPLXPATH("HTMP","
ConditionEffective DatesCondition Status
" ; 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","") ; NEXT COL + . . S ZX=@VMAP@("PROBLEMDATEOFONSET") + . . I ZX="" S ZX="Unknown" ; SET TO UNKNOWN + . . D PUSH^GPLXPATH("HTMP",ZX) + . . D PUSH^GPLXPATH("HTMP","") ; NEXT COL + . . D PUSH^GPLXPATH("HTMP","Active") ; WE ONLY DO ACTIVE + . . D PUSH^GPLXPATH("HTMP","
") ; 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 Index: /ccr/trunk/p/GPLXPATH.m =================================================================== --- /ccr/trunk/p/GPLXPATH.m (revision 75) +++ /ccr/trunk/p/GPLXPATH.m (revision 76) @@ -299,4 +299,15 @@ 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 @@ -362,5 +373,5 @@ . . 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 @@ -369,5 +380,5 @@ . . . 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 @@ -375,26 +386,32 @@ 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["" 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["" 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 @@ -405,4 +422,12 @@ 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