Changeset 330 for ccr/trunk/p
- Timestamp:
- Jan 19, 2009, 1:58:36 PM (16 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/GPLCCR.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLCCR.m
r308 r330 21 21 ; 22 22 EXPORT ; EXPORT ENTRY POINT FOR CCR 23 24 25 26 27 28 29 23 ; Select a patient. 24 S DIC=2,DIC(0)="AEMQ" D ^DIC 25 I Y<1 Q ; EXIT 26 S DFN=$P(Y,U,1) ; SET THE PATIENT 27 D XPAT(DFN,"","") ; EXPORT TO A FILE 28 Q 29 ; 30 30 XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE 31 32 33 34 35 36 37 38 39 40 41 I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_10.xml"42 43 44 45 46 47 48 49 50 51 52 53 31 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR") 32 ; FN IS FILE NAME, DEFAULTS IF NULL 33 N CCRGLO,UDIR,UFN 34 I '$D(DIR) S UDIR="" 35 E S UDIR=DIR 36 I '$D(FN) S UFN="" 37 E S UFN=FN 38 D CCRRPC(.CCRGLO,DFN,"CCR","","","") 39 S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1)) 40 S ONAM=UFN 41 I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_12.xml" 42 S ODIRGLB=$NA(^TMP("GPLCCR","ODIR")) 43 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET 44 . ;S @ODIRGLB="/home/glilly/CCROUT" 45 . ;S @ODIRGLB="/home/cedwards/" 46 . S @ODIRGLB="/opt/wv/p/" 47 S ODIR=UDIR 48 I UDIR="" S ODIR=@ODIRGLB 49 N ZY 50 S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR) 51 W !,$P(ZY,U,2),! 52 Q 53 ; 54 54 DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED 55 56 57 58 59 60 61 62 55 ; 56 N G1 57 S G1=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) 58 I $D(@G1@(0)) D ; CCR EXISTS 59 . D PARY^GPLXPATH(G1) 60 E W "CCR NOT CREATED, RUN D XPAT^GPLCCR(DFN,"""","""") FIRST",! 61 Q 62 ; 63 63 CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 F PROCI=1:1:@CCRXTAB@(0)D ; PROCESS THE CCR BODY SECTIONS101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 64 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME 65 ; DFN IS PATIENT IEN 66 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART 67 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 68 ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL 69 ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME 70 ; - NULL MEANS NOW 71 ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND 72 ; "TO" VARIABLES 73 ; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN 74 I '$D(DEBUG) S DEBUG=0 75 S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD 76 I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION 77 I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION 78 I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION 79 S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 80 S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 81 S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS 82 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 83 S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL 84 D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 85 D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL 86 ; 87 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL 88 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES 89 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 90 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") 91 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") 92 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! 93 ; 94 D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES 95 ; 96 K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 97 S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS 98 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 99 N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 100 F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 101 . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE 102 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 103 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 104 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 105 . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 106 . S IXML="INXML" 107 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 108 . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY 109 . ; W OXML,! 110 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 111 . W "RUNNING ",CALL,! 112 . X CALL 113 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 114 . I @OXML@(0)'=0 D ; THERE IS A RESULT 115 . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") 116 . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! 117 N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING 118 D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST 119 D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") 120 D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2") 121 D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors") 122 N TRIMI,J,DONE S DONE=0 123 F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE 124 . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS 125 . I DEBUG W "TRIMMED",J,! 126 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE 127 Q 128 ; 129 129 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 130 131 132 133 134 135 136 137 138 139 140 HDRMAP(CXML,DFN,IHDR) 141 142 143 144 145 146 147 148 149 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN; FOR TEST PURPOSES150 151 152 153 154 155 156 157 158 159 160 161 162 163 130 ; TAB IS PASSED BY NAME 131 I DEBUG W "TAB= ",TAB,! 132 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS 133 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")") 134 D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")") 135 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")") 136 D PUSH^GPLXPATH(TAB,"MAP;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")") 137 I TESTALERT D PUSH^GPLXPATH(TAB,"EXTRACT;GPLALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""GPLCCR"",$J,DFN,""ALERTS"")") 138 Q 139 ; 140 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 141 N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER")) 142 ; K @VMAP 143 S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT") 144 ; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 145 D ; ALWAYS MAP THESE VARIABLES 146 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 147 . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ??? 148 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM 149 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES 150 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES 151 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES 152 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 153 ;I IHDR'="" D ; HEADER VALUES ARE PROVIDED 154 ;. D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 155 N CTMP 156 D MAP^GPLXPATH(CXML,VMAP,"CTMP") 157 D CP^GPLXPATH("CTMP",CXML) 158 N HRIMVARS ; 159 S HRIMVARS=$NA(^TMP("GPLRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS 160 M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE 161 S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT 162 Q 163 ; 164 164 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 165 ; AXML AND ACTRTN ARE PASSED BY NAME 166 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 167 ; P1= OBJECTID - ACTORPATIENT_2 168 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE 169 ;OR INSTITUTION 170 ; OR PERSON(IN PATIENT FILE IE NOK) 171 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 172 N I,J,K,L 173 K @ACTRTN ; CLEAR RETURN ARRAY 174 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 175 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE 176 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 177 . . I DEBUG W "<ActorID>=>",J,! 178 . . I J'="" S K(J)="" ; HASHING ACTOR 179 . . ; TO GET RID OF DUPLICATES 180 S I="" ; GOING TO $O THROUGH THE HASH 181 F J=0:0 D Q:$O(K(I))="" 182 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 183 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 184 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE 185 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 186 . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 187 Q 188 ; 189 189 TEST ; RUN ALL THE TEST CASES 190 191 192 190 D TESTALL^GPLUNIT("GPLCCR") 191 Q 192 ; 193 193 ZTEST(WHICH) ; RUN ONE SET OF TESTS 194 195 196 197 198 194 N ZTMP 195 D ZLOAD^GPLUNIT("ZTMP","GPLCCR") 196 D ZTEST^GPLUNIT(.ZTMP,WHICH) 197 Q 198 ; 199 199 TLIST ; LIST THE TESTS 200 201 202 203 204 200 N ZTMP 201 D ZLOAD^GPLUNIT("ZTMP","GPLCCR") 202 D TLIST^GPLUNIT(.ZTMP) 203 Q 204 ; 205 205 ;;><TEST> 206 206 ;;><PROBLEMS>
Note:
See TracChangeset
for help on using the changeset viewer.
