Changeset 391
- Timestamp:
- Mar 14, 2009, 6:23:22 PM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 13 added
- 13 deleted
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLCCD.m
r134 r391 1 GPLCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/081 C0CCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08 2 2 ;;0.1;CCDCCR;nopatch;noreleasedate 3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 3 ;Copyright 2008,2009 George Lilly, University of Minnesota. 4 ;Licensed under the terms of the GNU General Public License. 5 ;See attached copy of the License. 5 6 ; 6 7 ;This program is free software; you can redistribute it and/or modify … … 29 30 ; 30 31 XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 31 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP(" GPLCCR","ODIR")32 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR") 32 33 ; FN IS FILE NAME, DEFAULTS IF NULL 33 34 ; N CCDGLO 34 35 D CCDRPC(.CCDGLO,DFN,"CCD","","","") 35 S OARY=$NA(^TMP(" GPLCCR",$J,DFN,"CCD",1))36 S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1)) 36 37 S ONAM=FN 37 38 I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml" 38 S ODIRGLB=$NA(^TMP(" GPLCCR","ODIR"))39 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR")) 39 40 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET 40 41 . S @ODIRGLB="/home/glilly/CCROUT" … … 44 45 I DIR="" S ODIR=@ODIRGLB 45 46 N ZY 46 S ZY=$$OUTPUT^ GPLXPATH(OARY,ONAM,ODIR)47 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) 47 48 W $P(ZY,U,2) 48 49 Q … … 62 63 N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD 63 64 I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD 64 S TGLOBAL=$NA(^TMP(" GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE65 I CCD S CCDGLO=$NA(^TMP(" GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD66 E S CCDGLO=$NA(^TMP(" GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR67 S ACTGLO=$NA(^TMP(" GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS65 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 66 I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD 67 E S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 68 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 68 69 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 69 S CCRGRTN=$NA(^TMP(" GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL70 I CCD D LOAD^ GPLCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE71 E D LOAD^ GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE72 D CP^ GPLXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL70 S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL 71 I CCD D LOAD^C0CCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE 72 E D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 73 D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 73 74 N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES 74 75 S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT … … 81 82 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 82 83 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 83 D REPLACE^ GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")84 D REPLACE^ GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")85 I 'CCD D REPLACE^ GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")84 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body") 85 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors") 86 I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures") 86 87 I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),! 87 88 ; … … 89 90 ; MAPPING THE PATIENT PORTION OF THE CDA HEADER 90 91 S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient" 91 D QUERY^ GPLXPATH(CCDGLO,ZZX,"ACTT1")92 D PATIENT^ GPLACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT93 I DEBUG D PARY^ GPLXPATH("ACTT2")94 D REPLACE^ GPLXPATH(CCDGLO,"ACTT2",ZZX)95 I DEBUG D PARY^ GPLXPATH(CCDGLO)92 D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1") 93 D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT 94 I DEBUG D PARY^C0CXPATH("ACTT2") 95 D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX) 96 I DEBUG D PARY^C0CXPATH(CCDGLO) 96 97 K ACTT1 K ACCT2 97 98 ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER 98 99 ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION 99 D ORG^ GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG100 D CP^ GPLXPATH("ACTT2",CCDGLO)101 ; 102 K ^TMP(" GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT103 S CCRXTAB=$NA(^TMP(" GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS100 D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG 101 D CP^C0CXPATH("ACTT2",CCDGLO) 102 ; 103 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 104 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 104 105 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 105 106 N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD … … 109 110 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 110 111 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 111 . D QUERY^ GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS112 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 112 113 . S IXML="INXML" 113 114 . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION … … 118 119 . X CALL 119 120 . I @OXML@(0)'=0 D ; THERE IS A RESULT 120 . . I CCD D QUERY^ GPLXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH121 . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH 121 122 . . I CCD D UNSHAVE("ITMP",OXML) 122 . . I CCD D UNMARK^ GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION123 . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION 123 124 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 124 . D INSERT^ GPLXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")125 . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!125 . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body") 126 . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),! 126 127 ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE 127 ; D ACTLST^ GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST128 ; D QUERY^ GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")129 ; D EXTRACT^ GPLACTOR("ACTT",ACTGLO,"ACTT2")130 ; D INSINNER^ GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")128 ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST 129 ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 130 ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2") 131 ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 131 132 N I,J,DONE S DONE=0 132 133 F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 133 . S J=$$TRIM^ GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS134 . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS 134 135 . W "TRIMMED",J,! 135 136 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE … … 149 150 W "TAB= ",TAB,! 150 151 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS 151 D PUSH^ GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")152 ;D PUSH^ GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")153 I 'CCD D PUSH^ GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")152 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") 153 ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")") 154 I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 154 155 Q 155 156 ; … … 159 160 W SHXML,! 160 161 W @SHXML@(1),! 161 D QUEUE^ GPLXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED162 D QUEUE^ GPLXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART163 D QUEUE^ GPLXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE164 D PARY^ GPLXPATH("SHBLD") ; PRINT BUILD LIST165 D BUILD^ GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION166 D CP^ GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY162 D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED 163 D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART 164 D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE 165 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST 166 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION 167 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY 167 168 Q 168 169 ; … … 172 173 W SHXML,! 173 174 W @SHXML@(1),! 174 D QUEUE^ GPLXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE175 D QUEUE^ GPLXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST176 D QUEUE^ GPLXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP177 D PARY^ GPLXPATH("SHBLD") ; PRINT BUILD LIST178 D BUILD^ GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION179 D CP^ GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY175 D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE 176 D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST 177 D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP 178 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST 179 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION 180 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY 180 181 Q 181 182 ; 182 183 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 183 N VMAP S VMAP=$NA(^TMP(" GPLCCR",$J,DFN,"HEADER"))184 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) 184 185 ; K @VMAP 185 186 S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT") … … 193 194 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 194 195 I IHDR'="" D ; HEADER VALUES ARE PROVIDED 195 . D CP^ GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY196 . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 196 197 N CTMP 197 D MAP^ GPLXPATH(CXML,VMAP,"CTMP")198 D CP^ GPLXPATH("CTMP",CXML)198 D MAP^C0CXPATH(CXML,VMAP,"CTMP") 199 D CP^C0CXPATH("CTMP",CXML) 199 200 Q 200 201 ; … … 221 222 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 222 223 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 223 . D PUSH^ GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY224 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 224 225 Q 225 226 ; 226 227 TEST ; RUN ALL THE TEST CASES 227 D TESTALL^ GPLUNIT("GPLCCR")228 D TESTALL^C0CUNIT("C0CCCR") 228 229 Q 229 230 ; 230 231 ZTEST(WHICH) ; RUN ONE SET OF TESTS 231 232 N ZTMP 232 D ZLOAD^ GPLUNIT("ZTMP","GPLCCR")233 D ZTEST^ GPLUNIT(.ZTMP,WHICH)233 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 234 D ZTEST^C0CUNIT(.ZTMP,WHICH) 234 235 Q 235 236 ; 236 237 TLIST ; LIST THE TESTS 237 238 N ZTMP 238 D ZLOAD^ GPLUNIT("ZTMP","GPLCCR")239 D TLIST^ GPLUNIT(.ZTMP)239 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 240 D TLIST^C0CUNIT(.ZTMP) 240 241 Q 241 242 ; 242 243 ;;><TEST> 243 244 ;;><PROBLEMS> 244 ;;>>>K GPL S GPL=""245 ;;>>>D CCRRPC^ GPLCCR(.GPL,"2","PROBLEMS","","","")246 ;;>>?@ GPL@(@GPL@(0))["</Problems>"245 ;;>>>K C0C S C0C="" 246 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","") 247 ;;>>?@C0C@(@C0C@(0))["</Problems>" 247 248 ;;><VITALS> 248 ;;>>>K GPL S GPL=""249 ;;>>>D CCRRPC^ GPLCCR(.GPL,"2","VITALS","","","")250 ;;>>?@ GPL@(@GPL@(0))["</VitalSigns>"249 ;;>>>K C0C S C0C="" 250 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","") 251 ;;>>?@C0C@(@C0C@(0))["</VitalSigns>" 251 252 ;;><CCR> 252 ;;>>>K GPL S GPL=""253 ;;>>>D CCRRPC^ GPLCCR(.GPL,"2","CCR","","","")254 ;;>>?@ GPL@(@GPL@(0))["</ContinuityOfCareRecord>"253 ;;>>>K C0C S C0C="" 254 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","") 255 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>" 255 256 ;;><ACTLST> 256 ;;>>>K GPL S GPL=""257 ;;>>>D CCRRPC^ GPLCCR(.GPL,"2","CCR","","","")258 ;;>>>D ACTLST^ GPLCCR(GPL,"ACTTEST")257 ;;>>>K C0C S C0C="" 258 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","") 259 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST") 259 260 ;;><ACTORS> 260 ;;>>>D ZTEST^ GPLCCR("ACTLST")261 ;;>>>D QUERY^ GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")262 ;;>>>D EXTRACT^ GPLACTOR("G2","ACTTEST","G3")261 ;;>>>D ZTEST^C0CCCR("ACTLST") 262 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") 263 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3") 263 264 ;;>>?G3(G3(0))["</Actors>" 264 265 ;;><TRIM> 265 ;;>>>D ZTEST^ GPLCCR("CCR")266 ;;>>>W $$TRIM^ GPLXPATH(CCDGLO)266 ;;>>>D ZTEST^C0CCCR("CCR") 267 ;;>>>W $$TRIM^C0CXPATH(CCDGLO) 267 268 ;;><CCD> 268 ;;>>>K GPL S GPL=""269 ;;>>>D CCRRPC^ GPLCCR(.GPL,"2","CCD","","","")270 ;;>>?@ GPL@(@GPL@(0))["</ContinuityOfCareRecord>"269 ;;>>>K C0C S C0C="" 270 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","") 271 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>" 271 272 ;;></TEST>
Note:
See TracChangeset
for help on using the changeset viewer.