Changeset 1330 for ccr/branches/ohum/p/C0CCCR.m
- Timestamp:
- Jan 3, 2012, 11:45:29 PM (12 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CCCR.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CCCR.m
r1329 r1330 1 C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 2 ;;1.0;C0C;;May 19, 2009;Build 38 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. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 ; EXPORT A CCR 22 ; 23 EXPORT ; EXPORT ENTRY POINT FOR CCR 24 ; Select a patient. 25 S DIC=2,DIC(0)="AEMQ" D ^DIC 26 I Y<1 Q ; EXIT 27 S DFN=$P(Y,U,1) ; SET THE PATIENT 28 D XPAT(DFN) ; EXPORT TO A FILE 29 Q 30 ; 31 XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 32 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR") 33 ; FN IS FILE NAME, DEFAULTS IF NULL 34 N CCRGLO,UDIR,UFN 35 S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC 36 I '$D(DIR) S UDIR="" 37 E S UDIR=DIR 38 I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED 39 E S UFN=FN 40 I '$D(XPARMS) S XPARMS="" 41 N C0CRTN ; RETURN ARRAY 42 D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR") 43 S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1)) 44 S ONAM=UFN 45 I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml" 46 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR")) 47 S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE 48 I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR") 49 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET 50 . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q 51 . ;S @ODIRGLB="/home/glilly/CCROUT" 52 . ;S @ODIRGLB="/home/cedwards/" 53 . S @ODIRGLB="/opt/wv/p/" 54 S ODIR=UDIR 55 I UDIR="" S ODIR=@ODIRGLB 56 N ZY 57 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) 58 W !,$P(ZY,U,2),! 59 Q 60 ; 61 DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED 62 ; 63 N G1 64 S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) 65 I $D(@G1@(0)) D ; CCR EXISTS 66 . D PARY^C0CXPATH(G1) 67 E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",! 68 Q 69 ; 70 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT 71 ; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE 72 ; DFN IS PATIENT IEN 73 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 74 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 75 ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION 76 ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2" 77 ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS 78 ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS 79 K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT 80 M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS 81 K ^TMP($J) ; START CLEAN 82 I '$D(DEBUG) S DEBUG=0 83 S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD 84 I '$D(CCRPARMS) S CCRPARMS="" 85 I '$D(CCRPART) S CCRPART="CCR" 86 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)="" 87 D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES 88 I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS 89 I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION 90 I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION 91 I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION 92 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 93 S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 94 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 95 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 96 ;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL 97 D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 98 D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 99 ; 100 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 101 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 102 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 103 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") 104 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") 105 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments") 106 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! 107 ; 108 D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES 109 ; 110 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 111 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 112 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 113 N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 114 F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 115 . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE 116 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 117 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 118 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 119 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 120 . S IXML="INXML" 121 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 122 . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY 123 . ; W OXML,! 124 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 125 . W "RUNNING ",CALL,! 126 . X CALL 127 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 128 . I $G(@OXML@(0))>0 D ; THERE IS A RESULT 129 . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") 130 . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),! 131 N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING 132 D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST 133 D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 134 D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2") 135 D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 136 K ACTT,ACTT2 137 ;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT") 138 ;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2") 139 ;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments") 140 ; gpl - turned off Comments for Certification 141 K CMTT,CMTT2 142 N TRIMI,J,DONE S DONE=0 143 F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 144 . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS 145 . I DEBUG W "TRIMMED",J,! 146 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE 147 ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL 148 I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR 149 E M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART 150 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))="" 151 K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP 152 K ^TMP($J) ; REALLY CLEAN UP 153 M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J 154 Q 155 ; 156 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 157 ; TAB IS PASSED BY NAME 158 I DEBUG W "TAB= ",TAB,! 159 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS 160 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") 161 I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")") 162 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")") 163 D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")") 164 I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 165 E D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 166 D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")") 167 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")") 168 ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 169 ; gpl - turned off Encounters for Certification 170 Q 171 ; 172 HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT 173 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) 174 ; K @VMAP 175 S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT") 176 ; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 177 D ; ALWAYS MAP THESE VARIABLES 178 . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR 179 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 180 . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER 181 . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ??? 182 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM 183 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES 184 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES 185 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES 186 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 187 ;I IHDR'="" D ; HEADER VALUES ARE PROVIDED 188 ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 189 N CTMP 190 D MAP^C0CXPATH(CXML,VMAP,"CTMP") 191 D CP^C0CXPATH("CTMP",CXML) 192 N HRIMVARS ; 193 S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS 194 M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE 195 S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT 196 Q 197 ; 198 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 199 ; AXML AND ACTRTN ARE PASSED BY NAME 200 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 201 ; P1= OBJECTID - ACTORPATIENT_2 202 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE 203 ;OR INSTITUTION 204 ; OR PERSON(IN PATIENT FILE IE NOK) 205 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 206 N I,J,K,L 207 K @ACTRTN ; CLEAR RETURN ARRAY 208 F I=1:1:@AXML@(0) D ; FIRST FIX MISSING LINKS 209 . I @AXML@(I)?.E1"_<".E D ; 210 . . N ZA,ZB 211 . . S ZA=$P(@AXML@(I),">",1)_">" 212 . . S ZB="<"_$P(@AXML@(I),"<",3) 213 . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB 214 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 215 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE 216 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 217 . . I $G(LINKDEBUG) W "<ActorID>=>",J,! 218 . . I J'="" S K(J)="" ; HASHING ACTOR 219 . I @AXML@(I)?.E1"<LinkID>".E D ; THERE IS AN ACTOR THIS LINE 220 . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1) 221 . . I $G(LINKDEBUG) W "<LinkID>=>",J,! 222 . . I J'="" S K(J)="" ; HASHING ACTOR 223 . . ; TO GET RID OF DUPLICATES 224 S I="" ; GOING TO $O THROUGH THE HASH 225 F J=0:0 D Q:$O(K(I))="" 226 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 227 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 228 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 229 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 230 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 231 Q 232 ; 233 TEST ; RUN ALL THE TEST CASES 234 D TESTALL^C0CUNIT("C0CCCR") 235 Q 236 ; 237 ZTEST(WHICH) ; RUN ONE SET OF TESTS 238 N ZTMP 239 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 240 D ZTEST^C0CUNIT(.ZTMP,WHICH) 241 Q 242 ; 243 TLIST ; LIST THE TESTS 244 N ZTMP 245 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 246 D TLIST^C0CUNIT(.ZTMP) 247 Q 248 ; 249 ;;><TEST> 250 ;;><PROBLEMS> 251 ;;>>>K C0C S C0C="" 252 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","") 253 ;;>>?@C0C@(@C0C@(0))["</Problems>" 254 ;;><VITALS> 255 ;;>>>K C0C S C0C="" 256 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","") 257 ;;>>?@C0C@(@C0C@(0))["</VitalSigns>" 258 ;;><CCR> 259 ;;>>>K C0C S C0C="" 260 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") 261 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>" 262 ;;><ACTLST> 263 ;;>>>K C0C S C0C="" 264 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") 265 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST") 266 ;;><ACTORS> 267 ;;>>>D ZTEST^C0CCCR("ACTLST") 268 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") 269 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3") 270 ;;>>?G3(G3(0))["</Actors>" 271 ;;><TRIM> 272 ;;>>>D ZTEST^C0CCCR("CCR") 273 ;;>>>W $$TRIM^C0CXPATH(CCRGLO) 274 ;;><ALERTS> 275 ;;>>>S TESTALERT=1 276 ;;>>>K C0C S C0C="" 277 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","") 278 ;;>>?@C0C@(@C0C@(0))["</Alerts>" 279 280 1 C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 2 ;;1.0;C0C;;May 19, 2009;Build 1 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. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 ; EXPORT A CCR 22 ; 23 EXPORT ; EXPORT ENTRY POINT FOR CCR 24 ; Select a patient. 25 S DIC=2,DIC(0)="AEMQ" D ^DIC 26 I Y<1 Q ; EXIT 27 S DFN=$P(Y,U,1) ; SET THE PATIENT 28 ;OHUM/RUT 3120102 To take inputs from user for date limits and notes 29 D ^C0CVALID 30 ;OHUM/RUT 31 D XPAT(DFN) ; EXPORT TO A FILE 32 Q 33 ; 34 XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 35 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR") 36 ; FN IS FILE NAME, DEFAULTS IF NULL 37 N CCRGLO,UDIR,UFN 38 S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC 39 I '$D(DIR) S UDIR="" 40 E S UDIR=DIR 41 I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED 42 E S UFN=FN 43 I '$D(XPARMS) S XPARMS="" 44 N C0CRTN ; RETURN ARRAY 45 D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR") 46 S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1)) 47 S ONAM=UFN 48 I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml" 49 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR")) 50 S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE 51 I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR") 52 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET 53 . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q 54 . ;S @ODIRGLB="/home/glilly/CCROUT" 55 . ;S @ODIRGLB="/home/cedwards/" 56 . S @ODIRGLB="/opt/wv/p/" 57 S ODIR=UDIR 58 I UDIR="" S ODIR=@ODIRGLB 59 N ZY 60 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR) 61 W !,$P(ZY,U,2),! 62 Q 63 ; 64 DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED 65 ; 66 N G1 67 S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) 68 I $D(@G1@(0)) D ; CCR EXISTS 69 . D PARY^C0CXPATH(G1) 70 E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",! 71 Q 72 ; 73 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT 74 ; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE 75 ; DFN IS PATIENT IEN 76 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 77 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 78 ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION 79 ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2" 80 ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS 81 ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS 82 K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT 83 M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS 84 K ^TMP($J) ; START CLEAN 85 I '$D(DEBUG) S DEBUG=0 86 S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD 87 I '$D(CCRPARMS) S CCRPARMS="" 88 I '$D(CCRPART) S CCRPART="CCR" 89 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)="" 90 D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES 91 I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS 92 I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION 93 I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION 94 I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION 95 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 96 S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 97 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 98 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 99 ;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL 100 D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 101 D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 102 ; 103 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 104 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 105 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 106 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") 107 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") 108 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments") 109 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! 110 ; 111 D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES 112 ; 113 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 114 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 115 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 116 N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 117 F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 118 . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE 119 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 120 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 121 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 122 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 123 . S IXML="INXML" 124 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 125 . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY 126 . ; W OXML,! 127 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 128 . W "RUNNING ",CALL,! 129 . X CALL 130 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 131 . I $G(@OXML@(0))>0 D ; THERE IS A RESULT 132 . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") 133 . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),! 134 N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING 135 D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST 136 D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 137 D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2") 138 D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 139 K ACTT,ACTT2 140 ;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT") 141 ;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2") 142 ;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments") 143 ; gpl - turned off Comments for Certification 144 K CMTT,CMTT2 145 N TRIMI,J,DONE S DONE=0 146 F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 147 . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS 148 . I DEBUG W "TRIMMED",J,! 149 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE 150 ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL 151 I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR 152 E M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART 153 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))="" 154 K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP 155 K ^TMP($J) ; REALLY CLEAN UP 156 M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J 157 Q 158 ; 159 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 160 ; TAB IS PASSED BY NAME 161 I DEBUG W "TAB= ",TAB,! 162 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS 163 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")") 164 I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")") 165 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")") 166 D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")") 167 I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 168 E D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")") 169 D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")") 170 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")") 171 ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 172 ; gpl - turned off Encounters for Certification 173 ;OHUM/RUT 3111228 Condition for Notes ; It should be included or not 174 I ^TMP("C0CCCR","TIULIMIT")'="" D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")") 175 ;OHUM/RUT 176 Q 177 ; 178 HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT 179 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER")) 180 ; K @VMAP 181 S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT") 182 ; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 183 D ; ALWAYS MAP THESE VARIABLES 184 . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR 185 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 186 . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER 187 . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ??? 188 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM 189 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES 190 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES 191 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES 192 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 193 ;I IHDR'="" D ; HEADER VALUES ARE PROVIDED 194 ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 195 N CTMP 196 D MAP^C0CXPATH(CXML,VMAP,"CTMP") 197 D CP^C0CXPATH("CTMP",CXML) 198 N HRIMVARS ; 199 S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS 200 M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE 201 S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT 202 Q 203 ; 204 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 205 ; AXML AND ACTRTN ARE PASSED BY NAME 206 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 207 ; P1= OBJECTID - ACTORPATIENT_2 208 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE 209 ;OR INSTITUTION 210 ; OR PERSON(IN PATIENT FILE IE NOK) 211 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 212 N I,J,K,L 213 K @ACTRTN ; CLEAR RETURN ARRAY 214 F I=1:1:@AXML@(0) D ; FIRST FIX MISSING LINKS 215 . I @AXML@(I)?.E1"_<".E D ; 216 . . N ZA,ZB 217 . . S ZA=$P(@AXML@(I),">",1)_">" 218 . . S ZB="<"_$P(@AXML@(I),"<",3) 219 . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB 220 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 221 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE 222 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 223 . . I $G(LINKDEBUG) W "<ActorID>=>",J,! 224 . . I J'="" S K(J)="" ; HASHING ACTOR 225 . I @AXML@(I)?.E1"<LinkID>".E D ; THERE IS AN ACTOR THIS LINE 226 . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1) 227 . . I $G(LINKDEBUG) W "<LinkID>=>",J,! 228 . . I J'="" S K(J)="" ; HASHING ACTOR 229 . . ; TO GET RID OF DUPLICATES 230 S I="" ; GOING TO $O THROUGH THE HASH 231 F J=0:0 D Q:$O(K(I))="" 232 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 233 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 234 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 235 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 236 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 237 Q 238 ; 239 TEST ; RUN ALL THE TEST CASES 240 D TESTALL^C0CUNIT("C0CCCR") 241 Q 242 ; 243 ZTEST(WHICH) ; RUN ONE SET OF TESTS 244 N ZTMP 245 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 246 D ZTEST^C0CUNIT(.ZTMP,WHICH) 247 Q 248 ; 249 TLIST ; LIST THE TESTS 250 N ZTMP 251 D ZLOAD^C0CUNIT("ZTMP","C0CCCR") 252 D TLIST^C0CUNIT(.ZTMP) 253 Q 254 ; 255 ;;><TEST> 256 ;;><PROBLEMS> 257 ;;>>>K C0C S C0C="" 258 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","") 259 ;;>>?@C0C@(@C0C@(0))["</Problems>" 260 ;;><VITALS> 261 ;;>>>K C0C S C0C="" 262 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","") 263 ;;>>?@C0C@(@C0C@(0))["</VitalSigns>" 264 ;;><CCR> 265 ;;>>>K C0C S C0C="" 266 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") 267 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>" 268 ;;><ACTLST> 269 ;;>>>K C0C S C0C="" 270 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","") 271 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST") 272 ;;><ACTORS> 273 ;;>>>D ZTEST^C0CCCR("ACTLST") 274 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2") 275 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3") 276 ;;>>?G3(G3(0))["</Actors>" 277 ;;><TRIM> 278 ;;>>>D ZTEST^C0CCCR("CCR") 279 ;;>>>W $$TRIM^C0CXPATH(CCRGLO) 280 ;;><ALERTS> 281 ;;>>>S TESTALERT=1 282 ;;>>>K C0C S C0C="" 283 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","") 284 ;;>>?@C0C@(@C0C@(0))["</Alerts>" 285 286
Note:
See TracChangeset
for help on using the changeset viewer.
