- Timestamp:
- Jul 2, 2008, 12:34:15 PM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 4 edited
-
GPLCCR.m (modified) (1 diff)
-
GPLCCR0.m (modified) (1 diff)
-
GPLVITALS.m (modified) (1 diff)
-
GPLXPATH.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLCCR.m
r33 r34 1 GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 2 ;;0.1;CCDCCR;nopatch;noreleasedate 3 ; 4 ; EXPORT A CCR 5 ; 6 EXPORT ; EXPORT ENTRY POINT FOR CCR 7 ; Select a patient. 8 S DIC=2,DIC(0)="AEMQ" D ^DIC 9 I Y<1 Q ; EXIT 10 S DFN=$P(Y,U,1) ; SET THE PATIENT 11 N CCRGLO 12 D CCRRPC(.CCRGLO,DFN,"CCR","","","") 13 S OARY=$NA(^TMP($J,DFN,"CCR",1)) 14 S ONAM="PAT_"_DFN_"_CCR_V1.xml" 15 S ODIR="/home/glilly/CCROUT" 16 D OUTPUT^GPLXPATH(OARY,ONAM,ODIR) 17 Q 18 ; 19 CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ; RPC ENTRY POINT FOR CCR OUTPUT 20 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME 21 ; DFN IS PATIENT IEN 22 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART OF THE 23 ; CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 24 ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL 25 ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME - NULL MEANS NOW 26 ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND "TO" VARIABLES 27 ; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN 28 S DEBUG=1 29 S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 30 S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 31 S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS IN CCR 32 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 33 S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL OF CCR 34 D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 35 D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO THE CCR GLOBAL 36 ; 37 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM THE CCR GLOBAL 38 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH PROCESSING ROUTINES 39 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 40 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") 41 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") 42 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! 43 ; 44 D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES 45 ; 46 S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR PROCESSING STEPS 47 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 48 N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 49 F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 50 . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE 51 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 52 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 53 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 54 . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 55 . S IXML="INXML" 56 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 57 . ; W OXML,! 58 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 59 . W "RUNNING ",CALL,! 60 . X CALL 61 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 62 . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") 63 . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! 64 D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST 65 Q 66 ; 67 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 68 ; TAB IS PASSED BY NAME 69 ; W "TAB= ",TAB,! 70 ; D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")") 71 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")") 72 Q 73 ; 74 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 75 N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER")) 76 ; K @VMAP 77 I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 78 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 79 . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ??? 80 . S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED A BETTER WAY 81 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES, 82 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 83 I IHDR'="" D ; HEADER VALUES ARE PROVIDED 84 . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 85 N CTMP 86 D MAP^GPLXPATH(CXML,VMAP,"CTMP") 87 D CP^GPLXPATH("CTMP",CXML) 88 Q 89 ; 90 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 91 ; AXML AND ACTRTN ARE PASSED BY NAME 92 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 93 ; P1= OBJECTID - ACTORPATIENT_2 94 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE OR INSTITUTION 95 ; OR PERSON(IN PATIENT FILE IE NOK) 96 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 97 N I,J,K,L 98 K @ACTRTN ; CLEAR RETURN ARRAY 99 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 100 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR ON THIS LINE 101 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 102 . . W "<ActorID>=>",J,! 103 . . S K(J)="" ; HASHING ACTOR TO GET RID OF DUPLICATES 104 S I="" ; GOING TO $O THROUGH THE HASH 105 F J=0:0 D Q:$O(K(I))="" 106 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 107 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 108 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE: PATIENT/PROVIDER 109 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 110 . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 111 Q 112 ; 113 TEST ; RUN ALL THE TEST CASES 114 ;D TESTALL^GPLUNIT("GPLCCR") 115 D ZTEST^GPLCCR("PROBLEMS") 116 W "TESTING RETURNED FROM PROBLMES",! 117 D ZTEST^GPLCCR("CCR") 118 Q 119 ; 120 ZTEST(WHICH) ; RUN ONE SET OF TESTS 121 N ZTMP 122 D ZLOAD^GPLUNIT("ZTMP","GPLCCR") 123 D ZTEST^GPLUNIT(.ZTMP,WHICH) 124 Q 125 ; 126 TLIST ; LIST THE TESTS 127 N ZTMP 128 D ZLOAD^GPLUNIT("ZTMP","GPLCCR") 129 D TLIST^GPLUNIT(.ZTMP) 130 Q 131 ; 132 ;;><TEST> 133 ;;><PROBLEMS> 134 ;;>>>K GPL S GPL="" 135 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","") 136 ;;>>?@GPL@(@GPL@(0))="</Problems>" 137 ;;><CCR> 138 ;;>>>D ^%ZTER 139 ;;>>>K GPL S GPL="" 140 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") 141 ;;>>?@GPL@(@GPL@(0))="</ContinutiyOfCareRecord>" 142 ;;><ACTLST> 143 ;;>>>N TCCR 144 ;;>>>D CCRRPC^GPLCCR(.TCCR,"2","CCR","","","") 145 ;;>>>D ACTLST^GPLCCR("TCCR","ACTTEST") 146 ;;></TEST> 1 GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 2 ;;0.1;CCDCCR;nopatch;noreleasedate 3 ; 4 ; EXPORT A CCR 5 ; 6 EXPORT ; EXPORT ENTRY POINT FOR CCR 7 ; Select a patient. 8 S DIC=2,DIC(0)="AEMQ" D ^DIC 9 I Y<1 Q ; EXIT 10 S DFN=$P(Y,U,1) ; SET THE PATIENT 11 N CCRGLO 12 D CCRRPC(.CCRGLO,DFN,"CCR","","","") 13 S OARY=$NA(^TMP($J,DFN,"CCR",1)) 14 S ONAM="PAT_"_DFN_"_CCR_V1.xml" 15 S ODIR="/home/glilly/CCROUT" 16 ;S ODIR="/home/cedwards/" 17 D OUTPUT^GPLXPATH(OARY,ONAM,ODIR) 18 Q 19 ; 20 CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ; RPC ENTRY POINT FOR CCR OUTPUT 21 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME 22 ; DFN IS PATIENT IEN 23 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART OF THE 24 ; CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC 25 ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL 26 ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME - NULL MEANS NOW 27 ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND "TO" VARIABLES 28 ; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN 29 S DEBUG=0 30 S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE 31 S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR 32 S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS IN CCR 33 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC 34 S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL OF CCR 35 D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE 36 D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO THE CCR GLOBAL 37 ; 38 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM THE CCR GLOBAL 39 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH PROCESSING ROUTINES 40 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") 41 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") 42 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") 43 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! 44 ; 45 D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES 46 ; 47 K ^TMP($J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT 48 S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR PROCESSING STEPS 49 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS 50 N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD 51 F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS 52 . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE 53 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL 54 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL 55 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE 56 . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS 57 . S IXML="INXML" 58 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES 59 . ; W OXML,! 60 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL 61 . W "RUNNING ",CALL,! 62 . X CALL 63 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER 64 . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") 65 . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! 66 D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST 67 Q 68 ; 69 INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS 70 ; TAB IS PASSED BY NAME 71 ; W "TAB= ",TAB,! 72 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")") 73 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")") 74 Q 75 ; 76 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT 77 N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER")) 78 ; K @VMAP 79 I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS 80 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN 81 . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ??? 82 . S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED A BETTER WAY 83 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES, 84 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT 85 I IHDR'="" D ; HEADER VALUES ARE PROVIDED 86 . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY 87 N CTMP 88 D MAP^GPLXPATH(CXML,VMAP,"CTMP") 89 D CP^GPLXPATH("CTMP",CXML) 90 Q 91 ; 92 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML 93 ; AXML AND ACTRTN ARE PASSED BY NAME 94 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2 95 ; P1= OBJECTID - ACTORPATIENT_2 96 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE OR INSTITUTION 97 ; OR PERSON(IN PATIENT FILE IE NOK) 98 ; P3= IEN RECORD NUMBER FOR ACTOR - 2 99 N I,J,K,L 100 K @ACTRTN ; CLEAR RETURN ARRAY 101 F I=1:1:@AXML@(0) D ; SCAN ALL LINES 102 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR ON THIS LINE 103 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1) 104 . . ;W "<ActorID>=>",J,! 105 . . S K(J)="" ; HASHING ACTOR TO GET RID OF DUPLICATES 106 S I="" ; GOING TO $O THROUGH THE HASH 107 F J=0:0 D Q:$O(K(I))="" 108 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS 109 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID 110 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE: PATIENT/PROVIDER 111 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR 112 . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY 113 Q 114 ; 115 TEST ; RUN ALL THE TEST CASES 116 ;D TESTALL^GPLUNIT("GPLCCR") 117 D ZTEST^GPLCCR("PROBLEMS") 118 W "TESTING RETURNED FROM PROBLMES",! 119 D ZTEST^GPLCCR("CCR") 120 Q 121 ; 122 ZTEST(WHICH) ; RUN ONE SET OF TESTS 123 N ZTMP 124 D ZLOAD^GPLUNIT("ZTMP","GPLCCR") 125 D ZTEST^GPLUNIT(.ZTMP,WHICH) 126 Q 127 ; 128 TLIST ; LIST THE TESTS 129 N ZTMP 130 D ZLOAD^GPLUNIT("ZTMP","GPLCCR") 131 D TLIST^GPLUNIT(.ZTMP) 132 Q 133 ; 134 ;;><TEST> 135 ;;><PROBLEMS> 136 ;;>>>K GPL S GPL="" 137 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","") 138 ;;>>?@GPL@(@GPL@(0))="</Problems>" 139 ;;><CCR> 140 ;;>>>D ^%ZTER 141 ;;>>>K GPL S GPL="" 142 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") 143 ;;>>?@GPL@(@GPL@(0))="</ContinutiyOfCareRecord>" 144 ;;><ACTLST> 145 ;;>>>N TCCR 146 ;;>>>D CCRRPC^GPLCCR(.TCCR,"2","CCR","","","") 147 ;;>>>D ACTLST^GPLCCR("TCCR","ACTTEST") 148 ;;></TEST> -
ccr/trunk/p/GPLCCR0.m
r25 r34 1 GPLCCR0 2 3 4 5 6 7 ZT(ZARY,BAT,LINE) 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 ZLOAD(ZARY,ROUTINE) 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 LOAD(ARY) 43 44 45 46 47 ;<TEMPLATE> 48 ;;<?xml 49 ;;<?xml-stylesheet 50 ;;<ContinuityOfCareRecord 51 ;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID> 52 ;;<Language> 53 ;;<Text>English</Text> 54 ;;</Language> 55 ;;<Version>V1.0</Version> 56 ;;<DateTime> 57 ;;<ExactDateTime>@@DATETIME@@2008-03-18T23:10:58Z</ExactDateTime> 58 ;;</DateTime> 59 ;;<Patient> 60 ;;<ActorID>@@ACTORPATIENT@@</ActorID> 61 ;;</Patient> 62 ;;<From> 63 ;;<ActorLink> 64 ;;<ActorID>@@ACTORFROM@@</ActorID> 65 ;;</ActorLink> 66 ;;<ActorLink> 67 ;;<ActorID>@@ACTORFROM2@@</ActorID> 68 ;;</ActorLink> 69 ;;</From> 70 ;;<To> 71 ;;<ActorLink> 72 ;;<ActorID>@@ACTORTO@@</ActorID> 73 ;;<ActorRole> 74 ;;<Text>Primary 75 ;;</ActorRole> 76 ;;</ActorLink> 77 ;;</To> 78 ;;<Purpose> 79 ;;<Description> 80 ;;<Text>@@PURPOSEDESCRIPTION@@CEND 81 ;;</Description> 82 ;;</Purpose> 83 ;;<Body> 84 ;;<Problems> 85 ;;<Problem> 86 ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID> 87 ;;<Type> 88 ;;<Text>Problem</Text> 89 ;;</Type> 90 ;;<Description> 91 ;;<Text>@@PROBLEMDESCRIPTION@@</Text> 92 ;;<Code> 93 ;;<Value>@@PROBLEMCODEVALUE@@</Value> 94 ;;<CodingSystem>ICD9CM</CodingSystem> 95 ;;<Version>@@PROBLEMCODINGVERSION@@</Version> 96 ;;</Code> 97 ;;</Description> 98 ;;<Source> 99 ;;<Actor> 100 ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID> 101 ;;</Actor> 102 ;;</Source> 103 ;;</Problem> 104 ;;</Problems> 105 ;;<FamilyHistory> 106 ;;<FamilyProblemHistory> 107 ;;<CCRDataObjectID></CCRDataObjectID> 108 ;;<Source> 109 ;;<Actor> 110 ;;<ActorID>AA0001</ActorID> 111 ;;</Actor> 112 ;;</Source> 113 ;;<FamilyMember> 114 ;;<ActorID>AA0003</ActorID> 115 ;;<ActorRole> 116 ;;<Text>Father</Text> 117 ;;</ActorRole> 118 ;;<Source> 119 ;;<Actor> 120 ;;<ActorID>AA0001</ActorID> 121 ;;</Actor> 122 ;;</Source> 123 ;;</FamilyMember> 124 ;;<Problem> 125 ;;<Type> 126 ;;<Text>Problem</Text> 127 ;;</Type> 128 ;;<Description> 129 ;;<Text>Heart 130 ;;<Code> 131 ;;<Value>C0018799</Value> 132 ;;<CodingSystem>UMLS 133 ;;<Version>2006</Version> 134 ;;</Code> 135 ;;<Code> 136 ;;<Value>429.9</Value> 137 ;;<CodingSystem>ICD9CM</CodingSystem> 138 ;;<Version>2006</Version> 139 ;;</Code> 140 ;;<Code> 141 ;;<Value>56265001</Value> 142 ;;<CodingSystem>SNOMEDCT</CodingSystem> 143 ;;<Version>2006</Version> 144 ;;</Code> 145 ;;</Description> 146 ;;<Source> 147 ;;<Actor> 148 ;;<ActorID>AA0001</ActorID> 149 ;;</Actor> 150 ;;</Source> 151 ;;</Problem> 152 ;;</FamilyProblemHistory> 153 ;;<FamilyProblemHistory> 154 ;;<CCRDataObjectID>BB0003</CCRDataObjectID> 155 ;;<Source> 156 ;;<Actor> 157 ;;<ActorID>AA0001</ActorID> 158 ;;</Actor> 159 ;;</Source> 160 ;;<FamilyMember> 161 ;;<ActorID>AA0004</ActorID> 162 ;;<ActorRole> 163 ;;<Text>Grandparents</Text> 164 ;;</ActorRole> 165 ;;<Source> 166 ;;<Actor> 167 ;;<ActorID>AA0001</ActorID> 168 ;;</Actor> 169 ;;</Source> 170 ;;</FamilyMember> 171 ;;<Problem> 172 ;;<Type> 173 ;;<Text>Problem</Text> 174 ;;</Type> 175 ;;<Description> 176 ;;<Text>Arthritis</Text> 177 ;;<Code> 178 ;;<Value>C0003873</Value> 179 ;;<CodingSystem>UMLS 180 ;;<Version>2006</Version> 181 ;;</Code> 182 ;;<Code> 183 ;;<Value>714.0</Value> 184 ;;<CodingSystem>ICD9CM</CodingSystem> 185 ;;<Version>2006</Version> 186 ;;</Code> 187 ;;<Code> 188 ;;<Value>69896004</Value> 189 ;;<CodingSystem>SNOMEDCT</CodingSystem> 190 ;;<Version>2006</Version> 191 ;;</Code> 192 ;;</Description> 193 ;;<Source> 194 ;;<Actor> 195 ;;<ActorID>AA0001</ActorID> 196 ;;</Actor> 197 ;;</Source> 198 ;;</Problem> 199 ;;<Problem> 200 ;;<Type> 201 ;;<Text>Problem</Text> 202 ;;</Type> 203 ;;<Description> 204 ;;<Text>Diabetes 205 ;;<Code> 206 ;;<Value>C0375113</Value> 207 ;;<CodingSystem>UMLS 208 ;;<Version>2006</Version> 209 ;;</Code> 210 ;;<Code> 211 ;;<Value>250.00</Value> 212 ;;<CodingSystem>ICD9CM</CodingSystem> 213 ;;<Version>2006</Version> 214 ;;</Code> 215 ;;</Description> 216 ;;<Source> 217 ;;<Actor> 218 ;;<ActorID>AA0001</ActorID> 219 ;;</Actor> 220 ;;</Source> 221 ;;</Problem> 222 ;;<Problem> 223 ;;<Type> 224 ;;<Text>Problem</Text> 225 ;;</Type> 226 ;;<Description> 227 ;;<Text>Parkinson's 228 ;;<Code> 229 ;;<Value>332.0</Value> 230 ;;<CodingSystem>ICD9CM</CodingSystem> 231 ;;<Version>2007</Version> 232 ;;</Code> 233 ;;</Description> 234 ;;<Source> 235 ;;<Actor> 236 ;;<ActorID>AA0001</ActorID> 237 ;;</Actor> 238 ;;</Source> 239 ;;</Problem> 240 ;;</FamilyProblemHistory> 241 ;;</FamilyHistory> 242 ;;<SocialHistory> 243 ;;<SocialHistoryElement> 244 ;;<CCRDataObjectID>BB0004</CCRDataObjectID> 245 ;;<Type> 246 ;;<Text>Marital 247 ;;</Type> 248 ;;<Description> 249 ;;<Text>Married</Text> 250 ;;</Description> 251 ;;<Source> 252 ;;<Actor> 253 ;;<ActorID>AA0001</ActorID> 254 ;;</Actor> 255 ;;</Source> 256 ;;</SocialHistoryElement> 257 ;;<SocialHistoryElement> 258 ;;<CCRDataObjectID>BB0005</CCRDataObjectID> 259 ;;<Type> 260 ;;<Text>Ethnic 261 ;;</Type> 262 ;;<Description> 263 ;;<Text>Not 264 ;;</Description> 265 ;;<Source> 266 ;;<Actor> 267 ;;<ActorID>AA0001</ActorID> 268 ;;</Actor> 269 ;;</Source> 270 ;;</SocialHistoryElement> 271 ;;<SocialHistoryElement> 272 ;;<CCRDataObjectID>BB0006</CCRDataObjectID> 273 ;;<Type> 274 ;;<Text>Race</Text> 275 ;;</Type> 276 ;;<Description> 277 ;;<Text>White</Text> 278 ;;</Description> 279 ;;<Source> 280 ;;<Actor> 281 ;;<ActorID>AA0001</ActorID> 282 ;;</Actor> 283 ;;</Source> 284 ;;</SocialHistoryElement> 285 ;;<SocialHistoryElement> 286 ;;<CCRDataObjectID>BB0007</CCRDataObjectID> 287 ;;<Type> 288 ;;<Text>Occupation</Text> 289 ;;</Type> 290 ;;<Description> 291 ;;<Text>Physician</Text> 292 ;;</Description> 293 ;;<Source> 294 ;;<Actor> 295 ;;<ActorID>AA0001</ActorID> 296 ;;</Actor> 297 ;;</Source> 298 ;;</SocialHistoryElement> 299 ;;</SocialHistory> 300 ;;<Medications> 301 ;;<Medication> 302 ;;<CCRDataObjectID>BB0008</CCRDataObjectID> 303 ;;<DateTime> 304 ;;<Type> 305 ;;<Text>Begin 306 ;;</Type> 307 ;;<Age> 308 ;;<Value>42</Value> 309 ;;<Units> 310 ;;<Unit>Years</Unit> 311 ;;</Units> 312 ;;</Age> 313 ;;</DateTime> 314 ;;<Type> 315 ;;<Text>Medication</Text> 316 ;;</Type> 317 ;;<Status> 318 ;;<Text>Active</Text> 319 ;;</Status> 320 ;;<Source> 321 ;;<Actor> 322 ;;<ActorID>AA0001</ActorID> 323 ;;</Actor> 324 ;;</Source> 325 ;;<Product> 326 ;;<ProductName> 327 ;;<Text>simvastatin</Text> 328 ;;<Code> 329 ;;<Value>36567</Value> 330 ;;<CodingSystem>RXNORM</CodingSystem> 331 ;;<Version>2005</Version> 332 ;;</Code> 333 ;;</ProductName> 334 ;;<BrandName> 335 ;;<Text>Simvastatin</Text> 336 ;;<Code> 337 ;;<Value>00093715510</Value> 338 ;;<CodingSystem>NDC</CodingSystem> 339 ;;<Version>2005</Version> 340 ;;</Code> 341 ;;</BrandName> 342 ;;<Strength> 343 ;;<Value>40</Value> 344 ;;<Units> 345 ;;<Unit>mg</Unit> 346 ;;</Units> 347 ;;</Strength> 348 ;;<Form> 349 ;;<Text>tablet</Text> 350 ;;</Form> 351 ;;</Product> 352 ;;<Directions> 353 ;;<Direction> 354 ;;<Description> 355 ;;<Text>1 356 ;;</Description> 357 ;;<Dose> 358 ;;<Value>1</Value> 359 ;;</Dose> 360 ;;<Route> 361 ;;<Text>PO</Text> 362 ;;</Route> 363 ;;<Frequency> 364 ;;<Value>1 365 ;;</Frequency> 366 ;;</Direction> 367 ;;</Directions> 368 ;;</Medication> 369 ;;</Medications> 370 ;;<VitalSigns> 371 ;;<Result> 372 ;;<CCRDataObjectID>@@DATAOBJECTID@@ BB0009</CCRDataObjectID>373 ;;<DateTime> 374 ;;<Type> 375 ;;<Text>Assessment 376 ;;</Type> 377 ;;<ExactDateTime>@@HEIGHTWEIGHTDATATIME@@ 2008-03-18</ExactDateTime>378 ;;</DateTime> 379 ;;<Description> 380 ;;<Text>Height 381 ;;</Description> 382 ;;<Source> 383 ;;<Actor> 384 ;;<ActorID>@@HEIGHTWEIGHTSOURCE@@ AA0001</ActorID>385 ;;</Actor> 386 ;;</Source> 387 ;;<Test> 388 ;;<CCRDataObjectID>@@DATAOBJECTID@@ BB0010</CCRDataObjectID>389 ;;<Type> 390 ;;<Text>Observation</Text> 391 ;;</Type> 392 ;;<Description> 393 ;;<Text>Height</Text> 394 ;;<Code> 395 ;;<Value>50373000</Value> 396 ;;<CodingSystem>SNOMED</CodingSystem> 397 ;;<Version>2006</Version> 398 ;;</Code> 399 ;;</Description> 400 ;;<Source> 401 ;;<Actor> 402 ;;<ActorID>@@HEIGHTSOURCEID@@ AA0002</ActorID>403 ;;</Actor> 404 ;;</Source> 405 ;;<TestResult> 406 ;;<Value>@@HEIGHTINCHES@@ 68</Value>407 ;;<Units> 408 ;;<Unit>in</Unit> 409 ;;</Units> 410 ;;</TestResult> 411 ;;</Test> 412 ;;<Test> 413 ;;<CCRDataObjectID>@@DATAOBJECTID@@ BB0011</CCRDataObjectID>414 ;;<Type> 415 ;;<Text>Observation</Text> 416 ;;</Type> 417 ;;<Description> 418 ;;<Text>Weight</Text> 419 ;;<Code> 420 ;;<Value>363808001</Value> 421 ;;<CodingSystem>SNOMED</CodingSystem> 422 ;;<Version>2006</Version> 423 ;;</Code> 424 ;;</Description> 425 ;;<Source> 426 ;;<Actor> 427 ;;<ActorID>@@WEIGHTSOURCEID@@ AA0002</ActorID>428 ;;</Actor> 429 ;;</Source> 430 ;;<TestResult> 431 ;;<Value>@@WEIGHTLBS@@ 180</Value>432 ;;<Units> 433 ;;<Unit>lb</Unit> 434 ;;</Units> 435 ;;</TestResult> 436 ;;</Test> 437 ;;</Result> 438 ;;<Result> 439 ;;<CCRDataObjectID>@@DATAOBJECTID@@ BB0012</CCRDataObjectID>440 ;;<Description> 441 ;;<Text>Blood 442 ;;</Description> 443 ;;<Source> 444 ;;<Actor> 445 ;;<ActorID>@@BLOODTYPESOURCEID@@ AA0001</ActorID>446 ;;</Actor> 447 ;;</Source> 448 ;;<Test> 449 ;;<CCRDataObjectID>@@DATAOBJECTID@@ BB0013</CCRDataObjectID>450 ;;<Type> 451 ;;<Text>Result</Text> 452 ;;</Type> 453 ;;<Description> 454 ;;<Text>Blood 455 ;;<Code> 456 ;;<Value>278149003</Value> 457 ;;<CodingSystem>SNOMED</CodingSystem> 458 ;;<Version>2005</Version> 459 ;;</Code> 460 ;;</Description> 461 ;;<Source> 462 ;;<Actor> 463 ;;<ActorID>@@BLOODTYPESOURCEID2@@ AA0002</ActorID>464 ;;</Actor> 465 ;;</Source> 466 ;;<TestResult> 467 ;;<Value>@@BLOODTYPERESULT@@ A+</Value>468 ;;</TestResult> 469 ;;</Test> 470 ;;</Result> 471 ;;</VitalSigns> 472 ;;<HealthCareProviders> 473 ;;<Provider> 474 ;;<ActorID>AA0005</ActorID> 475 ;;<ActorRole> 476 ;;<Text>Primary 477 ;;</ActorRole> 478 ;;</Provider> 479 ;;</HealthCareProviders> 480 ;;</Body> 481 ;;<Actors> 482 ;;<Actor> 483 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 484 ;;<Person> 485 ;;<Name> 486 ;;<CurrentName> 487 ;;<Given>@@ACTORGIVENNAME@@</Given> 488 ;;<Middle>@@ACTORMIDDLENAME@@</Middle> 489 ;;<Family>@@ACTORFAMILYNAME@@</Family> 490 ;;</CurrentName> 491 ;;</Name> 492 ;;<DateOfBirth> 493 ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime> 494 ;;</DateOfBirth> 495 ;;<Gender> 496 ;;<Text>@@ACTORGENDER@@</Text> 497 ;;</Gender> 498 ;;</Person> 499 ;;<IDs> 500 ;;<Type> 501 ;;<Text>SSN</Text> 502 ;;</Type> 503 ;;<ID>@@ACTORSSN@@</ID> 504 ;;<Source> 505 ;;<Actor> 506 ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID> 507 ;;</Actor> 508 ;;</Source> 509 ;;</IDs> 510 ;;<Address> 511 ;;<Type> 512 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 513 ;;</Type> 514 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 515 ;;<Line2>@@ACTORADDRESSLINE2@@</Line2> 516 ;;<City>@@ACTORADDRESSCITY@@</City> 517 ;;<State>@@ACTORADDRESSSTATE@@</State> 518 ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode> 519 ;;</Address> 520 ;;<Telephone> 521 ;;<Value>@@ACTORTELEPHONE@@</Value> 522 ;;<Type> 523 ;;<Text>@@ACTORTELEPHONETYPE@@</Text> 524 ;;</Type> 525 ;;</Telephone> 526 ;;<EMail> 527 ;;<Value>@@ACTOREMAIL@@</Value> 528 ;;</EMail> 529 ;;<Source> 530 ;;<Actor> 531 ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID> 532 ;;</Actor> 533 ;;</Source> 534 ;;</Actor> 535 ;;<Actor> 536 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 537 ;;<InformationSystem> 538 ;;<Name>@@ACTORINFOSYSNAME@@</Name> 539 ;;<Version>@@ACTORINFOSYSVER@@</Version> 540 ;;</InformationSystem> 541 ;;<Source> 542 ;;<Actor> 543 ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID> 544 ;;</Actor> 545 ;;</Source> 546 ;;</Actor> 547 ;;<Actor> 548 ;;<ActorObjectID>AA0003</ActorObjectID> 549 ;;<Person> 550 ;;<Name> 551 ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName> 552 ;;</Name> 553 ;;</Person> 554 ;;<Relation> 555 ;;<Text>@@ACTORRELATION@@</Text> 556 ;;</Relation> 557 ;;<Source> 558 ;;<Actor> 559 ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID> 560 ;;</Actor> 561 ;;</Source> 562 ;;</Actor> 563 ;;<Actor> 564 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 565 ;;<Person> 566 ;;<Name> 567 ;;<CurrentName> 568 ;;<Given>@@ACTORGIVENNAME@@</Given> 569 ;;<Family>@@ACTORFAMILYNAME@@</Family> 570 ;;</CurrentName> 571 ;;</Name> 572 ;;</Person> 573 ;;<Specialty> 574 ;;<Text>@@ACTORSPECIALITY@@</Text> 575 ;;</Specialty> 576 ;;<Address> 577 ;;<Type> 578 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 579 ;;</Type> 580 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 581 ;;<City>@@ACTORADDRESSLINE2@@</City> 582 ;;<State>@@ACTORADDRESSSTATE@@</State> 583 ;;</Address> 584 ;;<Source> 585 ;;<Actor> 586 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 587 ;;</Actor> 588 ;;</Source> 589 ;;</Actor> 590 ;;</Actors> 591 ;;<Signatures> 592 ;;<CCRSignature> 593 ;;<SignatureObjectID>S0001</SignatureObjectID> 594 ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime> 595 ;;<Source> 596 ;;<ActorID>AA0001</ActorID> 597 ;;</Source> 598 ;;<Signature> 599 ;;<Signature 600 ;;<SignedInfo> 601 ;;<CanonicalizationMethod 602 ;;<SignatureMethod 603 ;;<Reference 604 ;;<Transforms> 605 ;;<Transform 606 ;;</Transforms> 607 ;;<DigestMethod 608 ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue> 609 ;;</Reference> 610 ;;</SignedInfo> 611 ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue> 612 ;;<KeyInfo> 613 ;;<KeyValue> 614 ;;<RSAKeyValue> 615 ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus> 616 ;;<Exponent>AQAB</Exponent> 617 ;;</RSAKeyValue> 618 ;;</KeyValue> 619 ;;</KeyInfo> 620 ;;</Signature> 621 ;;</Signature> 622 ;;</CCRSignature> 623 ;;</Signatures> 624 ;;</ContinuityOfCareRecord> 625 ;</TEMPLATE> 1 GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08 2 ;;0.1;CCDCCR;nopatch;noreleasedate 3 W "This is a CCR TEMPLATE with processing routines",! 4 W ! 5 Q 6 ; 7 ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array 8 ; ZARY IS PASSED BY NAME 9 ; BAT is a string identifying the section 10 ; LINE is a test which will evaluate to true or false 11 ; I '$G(@ZARY) D 12 . S @ZARY@(0)=0 ; initially there are no elements 13 . W "GOT HERE LOADING "_LINE,! 14 N CNT ; count of array elements 15 S CNT=@ZARY@(0) ; contains array count 16 S CNT=CNT+1 ; increment count 17 S @ZARY@(CNT)=LINE ; put the line in the array 18 ; S @ZARY@(BAT,CNT)="" ; index the test by battery 19 S @ZARY@(0)=CNT ; update the array counter 20 Q 21 ; 22 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference 23 ; ZARY IS PASSED BY NAME 24 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") 25 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE 26 K @ZARY S @ZARY="" 27 S @ZARY@(0)=0 ; initialize array count 28 N LINE,LABEL,BODY 29 N INTEST S INTEST=0 ; switch for in the TEMPLATE section 30 N SECTION S SECTION="[anonymous]" ; NO section LABEL 31 ; 32 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D 33 . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section 34 . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section 35 . I INTEST D ; within the section 36 . . I LINE?." "1";><".E D ; sub-section name found 37 . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name 38 . . I LINE?." "1";;".E D ; line found 39 . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array 40 Q 41 ; 42 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME 43 D ZLOAD(ARY,"GPLCCR0") 44 ; ZWR @ARY 45 Q 46 ; 47 ;<TEMPLATE> 48 ;;<?xml version="1.0" encoding="UTF-8"?> 49 ;;<?xml-stylesheet type="text/xsl" href="ccr_20060420.xsl"?> 50 ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR"> 51 ;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID> 52 ;;<Language> 53 ;;<Text>English</Text> 54 ;;</Language> 55 ;;<Version>V1.0</Version> 56 ;;<DateTime> 57 ;;<ExactDateTime>@@DATETIME@@2008-03-18T23:10:58Z</ExactDateTime> 58 ;;</DateTime> 59 ;;<Patient> 60 ;;<ActorID>@@ACTORPATIENT@@</ActorID> 61 ;;</Patient> 62 ;;<From> 63 ;;<ActorLink> 64 ;;<ActorID>@@ACTORFROM@@</ActorID> 65 ;;</ActorLink> 66 ;;<ActorLink> 67 ;;<ActorID>@@ACTORFROM2@@</ActorID> 68 ;;</ActorLink> 69 ;;</From> 70 ;;<To> 71 ;;<ActorLink> 72 ;;<ActorID>@@ACTORTO@@</ActorID> 73 ;;<ActorRole> 74 ;;<Text>Primary Provider</Text> 75 ;;</ActorRole> 76 ;;</ActorLink> 77 ;;</To> 78 ;;<Purpose> 79 ;;<Description> 80 ;;<Text>@@PURPOSEDESCRIPTION@@CEND PHR</Text> 81 ;;</Description> 82 ;;</Purpose> 83 ;;<Body> 84 ;;<Problems> 85 ;;<Problem> 86 ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID> 87 ;;<Type> 88 ;;<Text>Problem</Text> 89 ;;</Type> 90 ;;<Description> 91 ;;<Text>@@PROBLEMDESCRIPTION@@</Text> 92 ;;<Code> 93 ;;<Value>@@PROBLEMCODEVALUE@@</Value> 94 ;;<CodingSystem>ICD9CM</CodingSystem> 95 ;;<Version>@@PROBLEMCODINGVERSION@@</Version> 96 ;;</Code> 97 ;;</Description> 98 ;;<Source> 99 ;;<Actor> 100 ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID> 101 ;;</Actor> 102 ;;</Source> 103 ;;</Problem> 104 ;;</Problems> 105 ;;<FamilyHistory> 106 ;;<FamilyProblemHistory> 107 ;;<CCRDataObjectID></CCRDataObjectID> 108 ;;<Source> 109 ;;<Actor> 110 ;;<ActorID>AA0001</ActorID> 111 ;;</Actor> 112 ;;</Source> 113 ;;<FamilyMember> 114 ;;<ActorID>AA0003</ActorID> 115 ;;<ActorRole> 116 ;;<Text>Father</Text> 117 ;;</ActorRole> 118 ;;<Source> 119 ;;<Actor> 120 ;;<ActorID>AA0001</ActorID> 121 ;;</Actor> 122 ;;</Source> 123 ;;</FamilyMember> 124 ;;<Problem> 125 ;;<Type> 126 ;;<Text>Problem</Text> 127 ;;</Type> 128 ;;<Description> 129 ;;<Text>Heart Disease</Text> 130 ;;<Code> 131 ;;<Value>C0018799</Value> 132 ;;<CodingSystem>UMLS Concept</CodingSystem> 133 ;;<Version>2006</Version> 134 ;;</Code> 135 ;;<Code> 136 ;;<Value>429.9</Value> 137 ;;<CodingSystem>ICD9CM</CodingSystem> 138 ;;<Version>2006</Version> 139 ;;</Code> 140 ;;<Code> 141 ;;<Value>56265001</Value> 142 ;;<CodingSystem>SNOMEDCT</CodingSystem> 143 ;;<Version>2006</Version> 144 ;;</Code> 145 ;;</Description> 146 ;;<Source> 147 ;;<Actor> 148 ;;<ActorID>AA0001</ActorID> 149 ;;</Actor> 150 ;;</Source> 151 ;;</Problem> 152 ;;</FamilyProblemHistory> 153 ;;<FamilyProblemHistory> 154 ;;<CCRDataObjectID>BB0003</CCRDataObjectID> 155 ;;<Source> 156 ;;<Actor> 157 ;;<ActorID>AA0001</ActorID> 158 ;;</Actor> 159 ;;</Source> 160 ;;<FamilyMember> 161 ;;<ActorID>AA0004</ActorID> 162 ;;<ActorRole> 163 ;;<Text>Grandparents</Text> 164 ;;</ActorRole> 165 ;;<Source> 166 ;;<Actor> 167 ;;<ActorID>AA0001</ActorID> 168 ;;</Actor> 169 ;;</Source> 170 ;;</FamilyMember> 171 ;;<Problem> 172 ;;<Type> 173 ;;<Text>Problem</Text> 174 ;;</Type> 175 ;;<Description> 176 ;;<Text>Arthritis</Text> 177 ;;<Code> 178 ;;<Value>C0003873</Value> 179 ;;<CodingSystem>UMLS Concept</CodingSystem> 180 ;;<Version>2006</Version> 181 ;;</Code> 182 ;;<Code> 183 ;;<Value>714.0</Value> 184 ;;<CodingSystem>ICD9CM</CodingSystem> 185 ;;<Version>2006</Version> 186 ;;</Code> 187 ;;<Code> 188 ;;<Value>69896004</Value> 189 ;;<CodingSystem>SNOMEDCT</CodingSystem> 190 ;;<Version>2006</Version> 191 ;;</Code> 192 ;;</Description> 193 ;;<Source> 194 ;;<Actor> 195 ;;<ActorID>AA0001</ActorID> 196 ;;</Actor> 197 ;;</Source> 198 ;;</Problem> 199 ;;<Problem> 200 ;;<Type> 201 ;;<Text>Problem</Text> 202 ;;</Type> 203 ;;<Description> 204 ;;<Text>Diabetes Mellitus</Text> 205 ;;<Code> 206 ;;<Value>C0375113</Value> 207 ;;<CodingSystem>UMLS Concept</CodingSystem> 208 ;;<Version>2006</Version> 209 ;;</Code> 210 ;;<Code> 211 ;;<Value>250.00</Value> 212 ;;<CodingSystem>ICD9CM</CodingSystem> 213 ;;<Version>2006</Version> 214 ;;</Code> 215 ;;</Description> 216 ;;<Source> 217 ;;<Actor> 218 ;;<ActorID>AA0001</ActorID> 219 ;;</Actor> 220 ;;</Source> 221 ;;</Problem> 222 ;;<Problem> 223 ;;<Type> 224 ;;<Text>Problem</Text> 225 ;;</Type> 226 ;;<Description> 227 ;;<Text>Parkinson's disease NOS</Text> 228 ;;<Code> 229 ;;<Value>332.0</Value> 230 ;;<CodingSystem>ICD9CM</CodingSystem> 231 ;;<Version>2007</Version> 232 ;;</Code> 233 ;;</Description> 234 ;;<Source> 235 ;;<Actor> 236 ;;<ActorID>AA0001</ActorID> 237 ;;</Actor> 238 ;;</Source> 239 ;;</Problem> 240 ;;</FamilyProblemHistory> 241 ;;</FamilyHistory> 242 ;;<SocialHistory> 243 ;;<SocialHistoryElement> 244 ;;<CCRDataObjectID>BB0004</CCRDataObjectID> 245 ;;<Type> 246 ;;<Text>Marital Status</Text> 247 ;;</Type> 248 ;;<Description> 249 ;;<Text>Married</Text> 250 ;;</Description> 251 ;;<Source> 252 ;;<Actor> 253 ;;<ActorID>AA0001</ActorID> 254 ;;</Actor> 255 ;;</Source> 256 ;;</SocialHistoryElement> 257 ;;<SocialHistoryElement> 258 ;;<CCRDataObjectID>BB0005</CCRDataObjectID> 259 ;;<Type> 260 ;;<Text>Ethnic Origin</Text> 261 ;;</Type> 262 ;;<Description> 263 ;;<Text>Not Hispanic or Latino</Text> 264 ;;</Description> 265 ;;<Source> 266 ;;<Actor> 267 ;;<ActorID>AA0001</ActorID> 268 ;;</Actor> 269 ;;</Source> 270 ;;</SocialHistoryElement> 271 ;;<SocialHistoryElement> 272 ;;<CCRDataObjectID>BB0006</CCRDataObjectID> 273 ;;<Type> 274 ;;<Text>Race</Text> 275 ;;</Type> 276 ;;<Description> 277 ;;<Text>White</Text> 278 ;;</Description> 279 ;;<Source> 280 ;;<Actor> 281 ;;<ActorID>AA0001</ActorID> 282 ;;</Actor> 283 ;;</Source> 284 ;;</SocialHistoryElement> 285 ;;<SocialHistoryElement> 286 ;;<CCRDataObjectID>BB0007</CCRDataObjectID> 287 ;;<Type> 288 ;;<Text>Occupation</Text> 289 ;;</Type> 290 ;;<Description> 291 ;;<Text>Physician</Text> 292 ;;</Description> 293 ;;<Source> 294 ;;<Actor> 295 ;;<ActorID>AA0001</ActorID> 296 ;;</Actor> 297 ;;</Source> 298 ;;</SocialHistoryElement> 299 ;;</SocialHistory> 300 ;;<Medications> 301 ;;<Medication> 302 ;;<CCRDataObjectID>BB0008</CCRDataObjectID> 303 ;;<DateTime> 304 ;;<Type> 305 ;;<Text>Begin Date</Text> 306 ;;</Type> 307 ;;<Age> 308 ;;<Value>42</Value> 309 ;;<Units> 310 ;;<Unit>Years</Unit> 311 ;;</Units> 312 ;;</Age> 313 ;;</DateTime> 314 ;;<Type> 315 ;;<Text>Medication</Text> 316 ;;</Type> 317 ;;<Status> 318 ;;<Text>Active</Text> 319 ;;</Status> 320 ;;<Source> 321 ;;<Actor> 322 ;;<ActorID>AA0001</ActorID> 323 ;;</Actor> 324 ;;</Source> 325 ;;<Product> 326 ;;<ProductName> 327 ;;<Text>simvastatin</Text> 328 ;;<Code> 329 ;;<Value>36567</Value> 330 ;;<CodingSystem>RXNORM</CodingSystem> 331 ;;<Version>2005</Version> 332 ;;</Code> 333 ;;</ProductName> 334 ;;<BrandName> 335 ;;<Text>Simvastatin</Text> 336 ;;<Code> 337 ;;<Value>00093715510</Value> 338 ;;<CodingSystem>NDC</CodingSystem> 339 ;;<Version>2005</Version> 340 ;;</Code> 341 ;;</BrandName> 342 ;;<Strength> 343 ;;<Value>40</Value> 344 ;;<Units> 345 ;;<Unit>mg</Unit> 346 ;;</Units> 347 ;;</Strength> 348 ;;<Form> 349 ;;<Text>tablet</Text> 350 ;;</Form> 351 ;;</Product> 352 ;;<Directions> 353 ;;<Direction> 354 ;;<Description> 355 ;;<Text>1 PO 1 time per day</Text> 356 ;;</Description> 357 ;;<Dose> 358 ;;<Value>1</Value> 359 ;;</Dose> 360 ;;<Route> 361 ;;<Text>PO</Text> 362 ;;</Route> 363 ;;<Frequency> 364 ;;<Value>1 time per day</Value> 365 ;;</Frequency> 366 ;;</Direction> 367 ;;</Directions> 368 ;;</Medication> 369 ;;</Medications> 370 ;;<VitalSigns> 371 ;;<Result> 372 ;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID> 373 ;;<DateTime> 374 ;;<Type> 375 ;;<Text>Assessment Time</Text> 376 ;;</Type> 377 ;;<ExactDateTime>@@HEIGHTWEIGHTDATATIME@@</ExactDateTime> 378 ;;</DateTime> 379 ;;<Description> 380 ;;<Text>Height & Weight</Text> 381 ;;</Description> 382 ;;<Source> 383 ;;<Actor> 384 ;;<ActorID>@@HEIGHTWEIGHTSOURCE@@</ActorID> 385 ;;</Actor> 386 ;;</Source> 387 ;;<Test> 388 ;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID> 389 ;;<Type> 390 ;;<Text>Observation</Text> 391 ;;</Type> 392 ;;<Description> 393 ;;<Text>Height</Text> 394 ;;<Code> 395 ;;<Value>50373000</Value> 396 ;;<CodingSystem>SNOMED</CodingSystem> 397 ;;<Version>2006</Version> 398 ;;</Code> 399 ;;</Description> 400 ;;<Source> 401 ;;<Actor> 402 ;;<ActorID>@@HEIGHTSOURCEID@@</ActorID> 403 ;;</Actor> 404 ;;</Source> 405 ;;<TestResult> 406 ;;<Value>@@HEIGHTINCHES@@</Value> 407 ;;<Units> 408 ;;<Unit>in</Unit> 409 ;;</Units> 410 ;;</TestResult> 411 ;;</Test> 412 ;;<Test> 413 ;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID> 414 ;;<Type> 415 ;;<Text>Observation</Text> 416 ;;</Type> 417 ;;<Description> 418 ;;<Text>Weight</Text> 419 ;;<Code> 420 ;;<Value>363808001</Value> 421 ;;<CodingSystem>SNOMED</CodingSystem> 422 ;;<Version>2006</Version> 423 ;;</Code> 424 ;;</Description> 425 ;;<Source> 426 ;;<Actor> 427 ;;<ActorID>@@WEIGHTSOURCEID@@</ActorID> 428 ;;</Actor> 429 ;;</Source> 430 ;;<TestResult> 431 ;;<Value>@@WEIGHTLBS@@</Value> 432 ;;<Units> 433 ;;<Unit>lb</Unit> 434 ;;</Units> 435 ;;</TestResult> 436 ;;</Test> 437 ;;</Result> 438 ;;<Result> 439 ;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID> 440 ;;<Description> 441 ;;<Text>Blood Type</Text> 442 ;;</Description> 443 ;;<Source> 444 ;;<Actor> 445 ;;<ActorID>@@BLOODTYPESOURCEID@@</ActorID> 446 ;;</Actor> 447 ;;</Source> 448 ;;<Test> 449 ;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID> 450 ;;<Type> 451 ;;<Text>Result</Text> 452 ;;</Type> 453 ;;<Description> 454 ;;<Text>Blood Type</Text> 455 ;;<Code> 456 ;;<Value>278149003</Value> 457 ;;<CodingSystem>SNOMED</CodingSystem> 458 ;;<Version>2005</Version> 459 ;;</Code> 460 ;;</Description> 461 ;;<Source> 462 ;;<Actor> 463 ;;<ActorID>@@BLOODTYPESOURCEID2@@</ActorID> 464 ;;</Actor> 465 ;;</Source> 466 ;;<TestResult> 467 ;;<Value>@@BLOODTYPERESULT@@</Value> 468 ;;</TestResult> 469 ;;</Test> 470 ;;</Result> 471 ;;</VitalSigns> 472 ;;<HealthCareProviders> 473 ;;<Provider> 474 ;;<ActorID>AA0005</ActorID> 475 ;;<ActorRole> 476 ;;<Text>Primary Provider</Text> 477 ;;</ActorRole> 478 ;;</Provider> 479 ;;</HealthCareProviders> 480 ;;</Body> 481 ;;<Actors> 482 ;;<Actor> 483 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 484 ;;<Person> 485 ;;<Name> 486 ;;<CurrentName> 487 ;;<Given>@@ACTORGIVENNAME@@</Given> 488 ;;<Middle>@@ACTORMIDDLENAME@@</Middle> 489 ;;<Family>@@ACTORFAMILYNAME@@</Family> 490 ;;</CurrentName> 491 ;;</Name> 492 ;;<DateOfBirth> 493 ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime> 494 ;;</DateOfBirth> 495 ;;<Gender> 496 ;;<Text>@@ACTORGENDER@@</Text> 497 ;;</Gender> 498 ;;</Person> 499 ;;<IDs> 500 ;;<Type> 501 ;;<Text>SSN</Text> 502 ;;</Type> 503 ;;<ID>@@ACTORSSN@@</ID> 504 ;;<Source> 505 ;;<Actor> 506 ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID> 507 ;;</Actor> 508 ;;</Source> 509 ;;</IDs> 510 ;;<Address> 511 ;;<Type> 512 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 513 ;;</Type> 514 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 515 ;;<Line2>@@ACTORADDRESSLINE2@@</Line2> 516 ;;<City>@@ACTORADDRESSCITY@@</City> 517 ;;<State>@@ACTORADDRESSSTATE@@</State> 518 ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode> 519 ;;</Address> 520 ;;<Telephone> 521 ;;<Value>@@ACTORTELEPHONE@@</Value> 522 ;;<Type> 523 ;;<Text>@@ACTORTELEPHONETYPE@@</Text> 524 ;;</Type> 525 ;;</Telephone> 526 ;;<EMail> 527 ;;<Value>@@ACTOREMAIL@@</Value> 528 ;;</EMail> 529 ;;<Source> 530 ;;<Actor> 531 ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID> 532 ;;</Actor> 533 ;;</Source> 534 ;;</Actor> 535 ;;<Actor> 536 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 537 ;;<InformationSystem> 538 ;;<Name>@@ACTORINFOSYSNAME@@</Name> 539 ;;<Version>@@ACTORINFOSYSVER@@</Version> 540 ;;</InformationSystem> 541 ;;<Source> 542 ;;<Actor> 543 ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID> 544 ;;</Actor> 545 ;;</Source> 546 ;;</Actor> 547 ;;<Actor> 548 ;;<ActorObjectID>AA0003</ActorObjectID> 549 ;;<Person> 550 ;;<Name> 551 ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName> 552 ;;</Name> 553 ;;</Person> 554 ;;<Relation> 555 ;;<Text>@@ACTORRELATION@@</Text> 556 ;;</Relation> 557 ;;<Source> 558 ;;<Actor> 559 ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID> 560 ;;</Actor> 561 ;;</Source> 562 ;;</Actor> 563 ;;<Actor> 564 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID> 565 ;;<Person> 566 ;;<Name> 567 ;;<CurrentName> 568 ;;<Given>@@ACTORGIVENNAME@@</Given> 569 ;;<Family>@@ACTORFAMILYNAME@@</Family> 570 ;;</CurrentName> 571 ;;</Name> 572 ;;</Person> 573 ;;<Specialty> 574 ;;<Text>@@ACTORSPECIALITY@@</Text> 575 ;;</Specialty> 576 ;;<Address> 577 ;;<Type> 578 ;;<Text>@@ACTORADDRESSTYPE@@</Text> 579 ;;</Type> 580 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 581 ;;<City>@@ACTORADDRESSLINE2@@</City> 582 ;;<State>@@ACTORADDRESSSTATE@@</State> 583 ;;</Address> 584 ;;<Source> 585 ;;<Actor> 586 ;;<ActorID>@@ACTORSOURCEID@@</ActorID> 587 ;;</Actor> 588 ;;</Source> 589 ;;</Actor> 590 ;;</Actors> 591 ;;<Signatures> 592 ;;<CCRSignature> 593 ;;<SignatureObjectID>S0001</SignatureObjectID> 594 ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime> 595 ;;<Source> 596 ;;<ActorID>AA0001</ActorID> 597 ;;</Source> 598 ;;<Signature> 599 ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#"> 600 ;;<SignedInfo> 601 ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315" /> 602 ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1" /> 603 ;;<Reference URI=""> 604 ;;<Transforms> 605 ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature" /> 606 ;;</Transforms> 607 ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1" /> 608 ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue> 609 ;;</Reference> 610 ;;</SignedInfo> 611 ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue> 612 ;;<KeyInfo> 613 ;;<KeyValue> 614 ;;<RSAKeyValue> 615 ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus> 616 ;;<Exponent>AQAB</Exponent> 617 ;;</RSAKeyValue> 618 ;;</KeyValue> 619 ;;</KeyInfo> 620 ;;</Signature> 621 ;;</Signature> 622 ;;</CCRSignature> 623 ;;</Signatures> 624 ;;</ContinuityOfCareRecord> 625 ;</TEMPLATE> -
ccr/trunk/p/GPLVITALS.m
r3 r34 1 GPLVITALS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR VITALS ; 6/6/08 2 ;;0.1;CCDCCR;nopatch;noreleasedate 3 EXTRACT(VITXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE 4 ; 5 ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 6 ; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE 7 ; 8 N VITALSTMP,I 9 S VITALSTMP="^TMP($J,""MISSINGVITALS"")" 10 ; ZWR @VITXML 11 D MISSING^GPLXPATH(VITXML,VITALSTMP) ; SEARCH XML FOR MISSING VARS 12 I @VITALSTMP@(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 13 . W "VITALS MISSING ",! 14 . F I=1:1:@VITALSTMP@(0) W @VITALSTMP@(I),! 15 Q 1 GPLVITALS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR VITALS ; 6/6/08 2 ;;0.1;CCDCCR;nopatch;noreleasedate 3 EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE 4 ; 5 ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED 6 ; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE 7 ; 8 N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF 9 D VITALS^ORQQVI(.VITRSLT,DFN,"","") 10 I '$D(VITRSLT(1)) W "ERROR RUNNINIG VITALS RPC",! Q 11 ;ZWR RPCRSLT 12 S VITTVMAP=$NA(^TMP($J,"VITALS")) 13 S VITTARYTMP=$NA(^TMP($J,"VITALARYTMP")) 14 F J=1:1:VITRSLT(1) D ; FOR EACH VITAL IN THE LIST 15 . I $D(VITRSLT(J)) D 16 . . S VITVMAP=$NA(@VITTVMAP@(J)) 17 . . K @VITVMAP 18 . . I DEBUG W "VMAP= ",VMAP,! 19 . . S VITPTMP=VITRSLT(J) ; PULL OUT VITAL FROM RPC RETURN ARRAY 20 . . S @VITVMAP@("DATAOBJECTID")="VITAL"_J ; UNIQUE OBJID FOR VITAL 21 . . I $P(VITPTMP,U,2)="HT" D 22 . . . S @VITVMAP@("HEIGHTWEIGHTDATATIME")=$P(VITPTMP,U,4) 23 . . . S @VITVMAP@("HEIGHTWEIGHTSOURCE")=$P(VITPTMP,U,7) 24 . . . S @VITVMAP@("HEIGHTSOURCEID")=$P(VITPTMP,U,1) 25 . . . S @VITVMAP@("HEIGHTINCHES")=$P(VITPTMP,U,3) 26 . . I $P(VITPTMP,U,2)="WT" D 27 . . . S @VITVMAP@("WEIGHTSOURCEID")=$P(VITPTMP,U,1) 28 . . . S @VITVMAP@("WEIGHTLBS")=$P(VITPTMP,U,3) 29 . . S VITARYTMP=$NA(@VITTARYTMP@(J)) 30 . . K @VITARYTMP 31 . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP) 32 . . I J=1 D ; FIRST ONE IS JUST A COPY 33 . . . ; W "FIRST ONE",! 34 . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML) 35 . . . ; W "OUTXML ",OUTXML,! 36 . . I J>1 D ; AFTER THE FIRST, INSERT INNER XML 37 . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP) 38 ;ZWR ^TMP($J,"VITALS",*) 39 ;ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS 40 ; W "OUT OF FOR LOOP.",! 41 ;ZWR 42 ; ZWR @OUTXML 43 ; $$HTML^DILF( 44 N VITTMP,I 45 D MISSING^GPLXPATH(VITXML,"VITTMP") ; SEARCH XML FOR MISSING VARS 46 I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ 47 . W "VITALS MISSING ",! 48 . F I=1:1:VITTMP(0) W VITTMP(I),! 49 Q -
ccr/trunk/p/GPLXPATH.m
r27 r34 1 GPLXPATH 2 3 4 5 6 7 OUTPUT(OUTARY,OUTNAME,OUTDIR) 8 9 10 11 12 13 14 15 PUSH(STK,VAL) 16 17 18 19 20 21 22 23 POP(STK,VAL) 24 25 26 27 28 29 30 31 32 33 MKMDX(STK,RTN) 34 35 36 37 38 39 40 41 42 43 44 XNAME(ISTR) 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 INDEX(ZXML) 60 61 62 63 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 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 QUERY(IARY,XPATH,OARY) 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 XF(IDX,XPATH) 138 139 140 141 142 XL(IDX,XPATH) 143 144 145 146 147 START(ISTR) 148 149 150 151 152 FINISH(ISTR) 153 154 155 156 ARRAY(ISTR) 157 158 159 160 BUILD(BLIST,BDEST) 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 QUEUE(BLST,ARRAY,FIRST,LAST) 179 180 181 182 183 184 CP(CPSRC,CPDEST) 185 186 187 188 189 190 191 192 193 194 195 196 QOPEN(QOBLIST,QOXML,QOXPATH) 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 QCLOSE(QCBLIST,QCXML,QCXPATH) 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 INSERT(INSXML,INSNEW,INSXPATH) 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 INSINNER(INNXML,INNNEW,INNXPATH) 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 REPLACE(REXML,RENEW,REXPATH) 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 MISSING(IXML,OARY) 303 304 305 306 307 308 309 310 311 312 313 314 MAP(IXML,INARY,OXML) 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 PARY(GLO) 331 332 333 334 335 TEST 336 337 338 339 OLDTEST 340 341 342 343 344 345 346 347 348 349 350 ZTEST(WHICH) 351 352 353 354 355 356 357 TLIST 358 359 360 361 362 363 ;;><TEST> 364 ;;><INIT> 365 ;;>>>K 366 ;;>>>D 367 ;;>>>D 368 ;;>>>D 369 ;;>>>D 370 ;;>>?GPL(0)=4 371 ;;><INITXML> 372 ;;>>>K 373 ;;>>>D 374 ;;>>>D 375 ;;>>>D 376 ;;>>>D 377 ;;>>>D 378 ;;>>>D 379 ;;>>>D 380 ;;>>>D 381 ;;>>>D 382 ;;>>>D 383 ;;>>>D 384 ;;>>>D 385 ;;>>>D 386 ;;><INITXML2> 387 ;;>>>K 388 ;;>>>D 389 ;;>>>D 390 ;;>>>D 391 ;;>>>D 392 ;;>>>D 393 ;;>>>D 394 ;;>>>D 395 ;;>>>D 396 ;;>>>D 397 ;;>>>D 398 ;;>>>D 399 ;;>>>D 400 ;;>>>D 401 ;;><PUSHPOP> 402 ;;>>>D 403 ;;>>>D 404 ;;>>?GPL(GPL(0))="FOURTH" 405 ;;>>>D 406 ;;>>?GX="FOURTH" 407 ;;>>?GPL(GPL(0))="THIRD" 408 ;;>>>D 409 ;;>>?GX="THIRD" 410 ;;>>?GPL(GPL(0))="SECOND" 411 ;;><MKMDX> 412 ;;>>>D 413 ;;>>>D 414 ;;>>>S 415 ;;>>>D 416 ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH" 417 ;;><XNAME> 418 ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH" 419 ;;>>?$$XNAME^GPLXPATH("<SIXTH 420 ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD" 421 ;;><INDEX> 422 ;;>>>D 423 ;;>>>D 424 ;;>>>D 425 ;;>>?GXML("//FIRST/SECOND")="2^12" 426 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9" 427 ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7" 428 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4" 429 ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8" 430 ;;>>?GXML("//FIRST/SECOND")="2^12" 431 ;;>>?GXML("//FIRST")="1^13" 432 ;;><INDEX2> 433 ;;>>>D 434 ;;>>>D 435 ;;>>?GXML("//FIRST/SECOND")="2^12" 436 ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11" 437 ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10" 438 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8" 439 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7" 440 ;;>>?GXML("//FIRST")="1^13" 441 ;;><MISSING> 442 ;;>>>D 443 ;;>>>S 444 ;;>>>D 445 ;;>>?@OUTARY@(1)="DATA1" 446 ;;>>?@OUTARY@(2)="DATA2" 447 ;;><MAP> 448 ;;>>>D 449 ;;>>>S 450 ;;>>>S 451 ;;>>>S 452 ;;>>>D 453 ;;>>?@OUTARY@(6)="VALUE2" 454 ;;><QUEUE> 455 ;;>>>D 456 ;;>>>D 457 ;;>>?$P(BTLIST(2),";",2)=4 458 ;;><BUILD> 459 ;;>>>D 460 ;;>>>D 461 ;;>>>D 462 ;;>>>D 463 ;;><CP> 464 ;;>>>D 465 ;;>>>D 466 ;;>>?G2(0)=13 467 ;;><QOPEN> 468 ;;>>>K 469 ;;>>>D 470 ;;>>>D 471 ;;>>?$P(GBL(1),";",3)=12 472 ;;>>>D 473 ;;>>?G2(G2(0))="</SECOND>" 474 ;;><QOPEN2> 475 ;;>>>K 476 ;;>>>D 477 ;;>>>D 478 ;;>>?$P(GBL(1),";",3)=11 479 ;;>>>D 480 ;;>>?G2(G2(0))="</SECOND>" 481 ;;><QCLOSE> 482 ;;>>>K 483 ;;>>>D 484 ;;>>>D 485 ;;>>?$P(GBL(1),";",3)=13 486 ;;>>>D 487 ;;>>?G2(G2(0))="</FIRST>" 488 ;;><QCLOSE2> 489 ;;>>>K 490 ;;>>>D 491 ;;>>>D 492 ;;>>?$P(GBL(1),";",3)=13 493 ;;>>>D 494 ;;>>?G2(G2(0))="</FIRST>" 495 ;;>>?G2(1)="</THIRD>" 496 ;;><INSERT> 497 ;;>>>K 498 ;;>>>D 499 ;;>>>D 500 ;;>>>D 501 ;;>>>D 502 ;;>>?G2(1)=GXML(9) 503 ;;><REPLACE> 504 ;;>>>K 505 ;;>>>D 506 ;;>>>D 507 ;;>>>D 508 ;;>>?GXML(3)="<FIFTH>" 509 ;;><INSINNER> 510 ;;>>>K 511 ;;>>>D 512 ;;>>>D 513 ;;>>>D 514 ;;>>?GXML(10)="<FIFTH>" 515 ;;><INSINNER2> 516 ;;>>>K 517 ;;>>>D 518 ;;>>>D 519 ;;>>>D 520 ;;>>?G2(8)="<FIFTH>" 521 ;;></TEST> 1 GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 2 ;;0.2;CCDCCR;nopatch;noreleasedate 3 W "This is an XML XPATH utility library",! 4 W ! 5 Q 6 ; 7 OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE 8 ; 9 N Y 10 S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME) 11 I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,! 12 ; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml") 13 Q 14 ; 15 PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0) 16 ; VAL IS A STRING AND STK IS PASSED BY NAME 17 ; 18 I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE 19 S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH 20 S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY 21 Q 22 ; 23 POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL 24 ; VAL AND STK ARE PASSED BY REFERENCE 25 ; 26 I @STK@(0)<1 S VAL="",@STK@(0)=0 Q ; IF ARRAY IS EMPTY 27 I @STK@(0)>0 D 28 . S VAL=@STK@(@STK@(0)) 29 . K @STK@(@STK@(0)) 30 . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY 31 Q 32 ; 33 MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK 34 ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS 35 S RTN="" 36 N I 37 ; W "STK= ",STK,! 38 I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY 39 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON 40 . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON 41 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I) 42 Q 43 ; 44 XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG 45 ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME 46 ; ISTR IS PASSED BY VALUE 47 N CUR,TMP 48 I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET 49 . S TMP=$P(ISTR,"<",2) 50 I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME> 51 . S TMP=$P(TMP,"/",2) 52 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME 53 ; W "CUR= ",CUR,! 54 I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST> 55 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER 56 ; W "CUR2= ",CUR,! 57 Q CUR 58 ; 59 INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index 60 ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE 61 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE 62 ; XML SECTION 63 ; ZXML IS PASSED BY NAME 64 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND 65 N GPLSTK ; LEAVE OUT FOR DEBUGGING 66 I '$D(@ZXML@(0)) D ; NO XML PASSED 67 . W "ERROR IN XML FILE",! 68 S GPLSTK(0)=0 ; INITIALIZE STACK 69 F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY 70 . S LINE=@ZXML@(I) 71 . ;W LINE,! 72 . S FOUND=0 ; INTIALIZED FOUND FLAG 73 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS 74 . I FOUND'=1 D 75 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D 76 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS ON THE SAME LINE 77 . . . ; W "FOUND ",LINE,! 78 . . . S FOUND=1 ; SET FOUND FLAG 79 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 80 . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK 81 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX 82 . . . ; W "MDX=",MDX,! 83 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 84 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 85 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE 86 . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST LINE 87 . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK 88 . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END OF A SEC 89 . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION 90 . . . ; W "FOUND ",LINE,! 91 . . . S FOUND=1 ; SET FOUND FLAG 92 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 93 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX 94 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 95 . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK 96 . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START 97 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,! 98 . . . . Q 99 . I FOUND'=1 D ; THE LINE MIGHT CONTAIN THE BEGINNING OF A SECTION 100 . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION 101 . . . ; W "FOUND ",LINE,! 102 . . . S FOUND=1 ; SET FOUND FLAG 103 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 104 . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK 105 . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX 106 . . . ; W "MDX=",MDX,! 107 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 108 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 109 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE 110 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX 111 S @ZXML@("INDEXED")="" 112 S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH 113 Q 114 ; 115 QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION 116 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD" 117 ; IARY AND OARY ARE PASSED BY NAME 118 I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY 119 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML 120 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN 121 N TMP,I,J,QXPATH 122 S FIRST=1 123 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT 124 I XPATH'="//" D ; NOT A ROOT QUERY 125 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES 126 . S FIRST=$P(TMP,"^",1) 127 . S LAST=$P(TMP,"^",2) 128 K @OARY 129 S @OARY@(0)=+LAST-FIRST+1 130 S J=1 131 FOR I=FIRST:1:LAST D 132 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY 133 . S J=J+1 134 ; ZWR OARY 135 Q 136 ; 137 XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH 138 ; INDEX WITH TWO PIECES START^FINISH 139 ; IDX IS PASSED BY NAME 140 Q $P(@IDX@(XPATH),"^",1) 141 ; 142 XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH 143 ; INDEX WITH TWO PIECES START^FINISH 144 ; IDX IS PASSED BY NAME 145 Q $P(@IDX@(XPATH),"^",2) 146 ; 147 START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX 148 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 149 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME 150 Q $P(ISTR,";",2) 151 ; 152 FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX 153 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 154 Q $P(ISTR,";",3) 155 ; 156 ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX 157 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 158 Q $P(ISTR,";",1) 159 ; 160 BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST 161 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST 162 ; DEST IS CLEARED TO START 163 ; USES PUSH TO DO THE COPY 164 N I 165 K @BDEST 166 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST 167 . N J,ATMP 168 . S ATMP=$$ARRAY(@BLIST@(I)) 169 . I DEBUG W "ATMP=",ATMP,! 170 . I DEBUG W @BLIST@(I),! 171 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; 172 . . ; FOR EACH LINE IN THIS INSTR 173 . . I DEBUG W "BDEST= ",BDEST,! 174 . . I DEBUG W "ATMP= ",@ATMP@(J),! 175 . . D PUSH(BDEST,@ATMP@(J)) 176 Q 177 ; 178 QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST 179 ; 180 I DEBUG W "QUEUEING ",BLST,! 181 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) 182 Q 183 ; 184 CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME 185 ; KILLS CPDEST FIRST 186 N CPINSTR 187 I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,! 188 I @CPSRC@(0)<1 D ; BAD LENGTH 189 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! 190 . Q 191 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INITIALIZE 192 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY 193 D BUILD("CPINSTR",CPDEST) 194 Q 195 ; 196 QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST 197 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD 198 ; QOXPATH IS OPTIONAL - IF PROVIDED, WILL OPEN INSIDE THE XPATH POINT 199 ; USED TO INSERT CHILDREN NODES 200 I @QOXML@(0)<1 D ; MALFORMED XML 201 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! 202 . Q 203 I DEBUG W "DOING QOPEN",! 204 N S1,E1,QOT,QOTMP 205 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML 206 I $D(QOXPATH) D ; XPATH PROVIDED 207 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX 208 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 209 I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 210 . S E1=@QOXML@(0)-1 211 D QUEUE(QOBLIST,QOXML,S1,E1) 212 ; S QOTMP=QOXML_"^"_S1_"^"_E1 213 ; D PUSH(QOBLIST,QOTMP) 214 Q 215 ; 216 QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN 217 ; ADDS THE LIST LINE OF QCXML TO QCBLIST 218 ; USED TO FINISH INSERTING CHILDERN NODES 219 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END 220 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO 221 I @QCXML@(0)<1 D ; MALFORMED XML 222 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! 223 I DEBUG W "GOING TO CLOSE",! 224 N S1,E1,QCT,QCTMP 225 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML 226 I $D(QCXPATH) D ; XPATH PROVIDED 227 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX 228 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML 229 I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 230 . S S1=@QCXML@(0) 231 D QUEUE(QCBLIST,QCXML,S1,E1) 232 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) 233 Q 234 ; 235 INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE 236 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS 237 ; OMITTED, INSERTION WILL BE AT THE ROOT 238 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW 239 ; XML AT THE END OF THE XPATH POINT 240 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE 241 N INSBLD,INSTMP 242 I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! 243 I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),! 244 I '$D(@INSXML@(0)) D Q ; INSERT INTO AN EMPTY ARRAY 245 . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT 246 I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY 247 . I $D(INSXPATH) D ; XPATH PROVIDED 248 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE 249 . . I DEBUG ZWR INSBLD 250 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 251 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH 252 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML 253 . I $D(INSXPATH) D ; XPATH PROVIDED 254 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH 255 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 256 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH 257 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST 258 . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE 259 Q 260 ; 261 INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW 262 ; INTO INNXML AT THE INNXPATH XPATH POINT 263 ; 264 N INNBLD,UXPATH 265 N INNTBUF 266 S INNTBUF=$NA(^TMP($J,"INNTBUF")) 267 I '$D(INNXPATH) D ; XPATH NOT PASSED 268 . S UXPATH="//" ; USE ROOT XPATH 269 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED 270 I '$D(@INNXML@(0)) D ; INNXML IS EMPTY 271 . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML 272 . D BUILD("INNBLD",INNXML) 273 I @INNXML@(0)>0 D ; NOT EMPTY 274 . D QOPEN("INNBLD",INNXML,UXPATH) ; 275 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML 276 . D QCLOSE("INNBLD",INNXML,UXPATH) 277 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER 278 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST 279 Q 280 ; 281 REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT 282 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE 283 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE 284 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD") 285 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP 286 S OLD=$NA(^TMP($J,"REPLACE_OLD")) 287 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD 288 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS 289 S XFIRST=$P(XNODE,"^",1) 290 S XLAST=$P(XNODE,"^",2) 291 D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE 292 I RENEW'="" D ; NEW XML IS NOT NULL 293 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW 294 D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST 295 I DEBUG W "REPALCE PREBUILD",! 296 I DEBUG ZWR REBLD 297 D BUILD("REBLD","RTMP") 298 K @REXML ; KILL WHAT WAS THERE 299 D CP("RTMP",REXML) ; COPY IN THE RESULT 300 Q 301 ; 302 MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY 303 ; W "Reporting on the missing",! 304 ; W OARY 305 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q 306 N I 307 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT 308 F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY 309 . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE 310 . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY 311 . . Q 312 Q 313 ; 314 MAP(IXML,INARY,OXML) ; SUBSTITUTE @@X@@ VARS IN IXML WITH VALUES IN INARY 315 ; AND PUT THE RESULTS IN OXML 316 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q 317 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q 318 N I,TNAM,TVAL 319 S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT 320 F I=1:1:@OXML@(0) D ; LOOP THROUGH WHOLE ARRAY 321 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT 322 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE? 323 . . S TNAM=$P(@OXML@(I),"@@",2) ; EXTRACT THE VARIABLE NAME 324 . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP? 325 . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE 326 . . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3) ;MAPIT 327 W "MAPPED",! 328 Q 329 ; 330 PARY(GLO) ;PRINT AN ARRAY 331 N I 332 F I=1:1:@GLO@(0) W @GLO@(I),! 333 Q 334 ; 335 TEST ; Run all the test cases 336 D TESTALL^GPLUNIT("GPLXPATH") 337 Q 338 ; 339 OLDTEST ; RUN ALL THE TEST CASES 340 N ZTMP 341 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 342 D ZTEST^GPLUNIT(.ZTMP,"ALL") 343 W "PASSED: ",TPASSED,! 344 W "FAILED: ",TFAILED,! 345 W ! 346 ; W "THE TESTS!",! 347 ; ZWR ZTMP 348 Q 349 ; 350 ZTEST(WHICH) ; RUN ONE SET OF TESTS 351 N ZTMP 352 S DEBUG=1 353 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 354 D ZTEST^GPLUNIT(.ZTMP,WHICH) 355 Q 356 ; 357 TLIST ; LIST THE TESTS 358 N ZTMP 359 D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 360 D TLIST^GPLUNIT(.ZTMP) 361 Q 362 ; 363 ;;><TEST> 364 ;;><INIT> 365 ;;>>>K GPL S GPL="" 366 ;;>>>D PUSH^GPLXPATH("GPL","FIRST") 367 ;;>>>D PUSH^GPLXPATH("GPL","SECOND") 368 ;;>>>D PUSH^GPLXPATH("GPL","THIRD") 369 ;;>>>D PUSH^GPLXPATH("GPL","FOURTH") 370 ;;>>?GPL(0)=4 371 ;;><INITXML> 372 ;;>>>K GXML S GXML="" 373 ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>") 374 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>") 375 ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>") 376 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>") 377 ;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>") 378 ;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@") 379 ;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>") 380 ;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />") 381 ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>") 382 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>") 383 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>") 384 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>") 385 ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>") 386 ;;><INITXML2> 387 ;;>>>K GXML S GXML="" 388 ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>") 389 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>") 390 ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>") 391 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>") 392 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>") 393 ;;>>>D PUSH^GPLXPATH("GXML","DATA2") 394 ;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>") 395 ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>") 396 ;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>") 397 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>") 398 ;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>") 399 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>") 400 ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>") 401 ;;><PUSHPOP> 402 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 403 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT") 404 ;;>>?GPL(GPL(0))="FOURTH" 405 ;;>>>D POP^GPLXPATH("GPL",.GX) 406 ;;>>?GX="FOURTH" 407 ;;>>?GPL(GPL(0))="THIRD" 408 ;;>>>D POP^GPLXPATH("GPL",.GX) 409 ;;>>?GX="THIRD" 410 ;;>>?GPL(GPL(0))="SECOND" 411 ;;><MKMDX> 412 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 413 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT") 414 ;;>>>S GX="" 415 ;;>>>D MKMDX^GPLXPATH("GPL",.GX) 416 ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH" 417 ;;><XNAME> 418 ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH" 419 ;;>>?$$XNAME^GPLXPATH("<SIXTH ID=""SELF"" />")="SIXTH" 420 ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD" 421 ;;><INDEX> 422 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") 423 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML") 424 ;;>>>D INDEX^GPLXPATH("GXML") 425 ;;>>?GXML("//FIRST/SECOND")="2^12" 426 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9" 427 ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7" 428 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4" 429 ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8" 430 ;;>>?GXML("//FIRST/SECOND")="2^12" 431 ;;>>?GXML("//FIRST")="1^13" 432 ;;><INDEX2> 433 ;;>>>D ZTEST^GPLXPATH("INITXML2") 434 ;;>>>D INDEX^GPLXPATH("GXML") 435 ;;>>?GXML("//FIRST/SECOND")="2^12" 436 ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11" 437 ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10" 438 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8" 439 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7" 440 ;;>>?GXML("//FIRST")="1^13" 441 ;;><MISSING> 442 ;;>>>D ZTEST^GPLXPATH("INITXML") 443 ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")" 444 ;;>>>D MISSING^GPLXPATH("GXML",OUTARY) 445 ;;>>?@OUTARY@(1)="DATA1" 446 ;;>>?@OUTARY@(2)="DATA2" 447 ;;><MAP> 448 ;;>>>D ZTEST^GPLXPATH("INITXML") 449 ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")" 450 ;;>>>S OUTARY="^TMP($J,""MAPTEST"")" 451 ;;>>>S @MAPARY@("DATA2")="VALUE2" 452 ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY) 453 ;;>>?@OUTARY@(6)="VALUE2" 454 ;;><QUEUE> 455 ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3) 456 ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5) 457 ;;>>?$P(BTLIST(2),";",2)=4 458 ;;><BUILD> 459 ;;>>>D ZTEST^GPLXPATH("INITXML") 460 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2") 461 ;;>>>D ZTEST^GPLXPATH("QUEUE") 462 ;;>>>D BUILD^GPLXPATH("BTLIST","G3") 463 ;;><CP> 464 ;;>>>D ZTEST^GPLXPATH("INITXML") 465 ;;>>>D CP^GPLXPATH("GXML","G2") 466 ;;>>?G2(0)=13 467 ;;><QOPEN> 468 ;;>>>K G2,GBL 469 ;;>>>D ZTEST^GPLXPATH("INITXML") 470 ;;>>>D QOPEN^GPLXPATH("GBL","GXML") 471 ;;>>?$P(GBL(1),";",3)=12 472 ;;>>>D BUILD^GPLXPATH("GBL","G2") 473 ;;>>?G2(G2(0))="</SECOND>" 474 ;;><QOPEN2> 475 ;;>>>K G2,GBL 476 ;;>>>D ZTEST^GPLXPATH("INITXML") 477 ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND") 478 ;;>>?$P(GBL(1),";",3)=11 479 ;;>>>D BUILD^GPLXPATH("GBL","G2") 480 ;;>>?G2(G2(0))="</SECOND>" 481 ;;><QCLOSE> 482 ;;>>>K G2,GBL 483 ;;>>>D ZTEST^GPLXPATH("INITXML") 484 ;;>>>D QCLOSE^GPLXPATH("GBL","GXML") 485 ;;>>?$P(GBL(1),";",3)=13 486 ;;>>>D BUILD^GPLXPATH("GBL","G2") 487 ;;>>?G2(G2(0))="</FIRST>" 488 ;;><QCLOSE2> 489 ;;>>>K G2,GBL 490 ;;>>>D ZTEST^GPLXPATH("INITXML") 491 ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD") 492 ;;>>?$P(GBL(1),";",3)=13 493 ;;>>>D BUILD^GPLXPATH("GBL","G2") 494 ;;>>?G2(G2(0))="</FIRST>" 495 ;;>>?G2(1)="</THIRD>" 496 ;;><INSERT> 497 ;;>>>K G2,GBL,G3,G4 498 ;;>>>D ZTEST^GPLXPATH("INITXML") 499 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") 500 ;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD") 501 ;;>>>D INSERT^GPLXPATH("G3","G2","//") 502 ;;>>?G2(1)=GXML(9) 503 ;;><REPLACE> 504 ;;>>>K G2,GBL,G3 505 ;;>>>D ZTEST^GPLXPATH("INITXML") 506 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") 507 ;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND") 508 ;;>>?GXML(3)="<FIFTH>" 509 ;;><INSINNER> 510 ;;>>>K GXML,G2,GBL,G3 511 ;;>>>D ZTEST^GPLXPATH("INITXML") 512 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2") 513 ;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD") 514 ;;>>?GXML(10)="<FIFTH>" 515 ;;><INSINNER2> 516 ;;>>>K GXML,G2,GBL,G3 517 ;;>>>D ZTEST^GPLXPATH("INITXML") 518 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2") 519 ;;>>>D INSINNER^GPLXPATH("G2","G2") 520 ;;>>?G2(8)="<FIFTH>" 521 ;;></TEST>
Note:
See TracChangeset
for help on using the changeset viewer.
