iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Enabled Vitals processing in GPLCCR.m 

Fixed bug where if you ran EXPORT^GPLCCR more than once body tags would still get added (added  K ^TMP($J,"CCRSTEP") before setting it 	by INITSTPS)
Added code to start processing Vitals for selected patient
Cleaned up some of the template CCR so information in CCR would be correct
This commit is contained in:
cje 2008-07-02 16:34:15 +00:00
parent a26fb0b883
commit f6fe8898bf
4 changed files with 1343 additions and 1307 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

280
p/GPLCCR.m
View File

@ -1,146 +1,148 @@
GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
;;0.1;CCDCCR;nopatch;noreleasedate
;
; EXPORT A CCR
;
EXPORT ; EXPORT ENTRY POINT FOR CCR
; Select a patient.
S DIC=2,DIC(0)="AEMQ" D ^DIC
I Y<1 Q ; EXIT
S DFN=$P(Y,U,1) ; SET THE PATIENT
N CCRGLO
D CCRRPC(.CCRGLO,DFN,"CCR","","","")
S OARY=$NA(^TMP($J,DFN,"CCR",1))
S ONAM="PAT_"_DFN_"_CCR_V1.xml"
S ODIR="/home/glilly/CCROUT"
D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
Q
;
CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ; RPC ENTRY POINT FOR CCR OUTPUT
; CCRGRTN IS RETURN ARRAY PASSED BY NAME
; DFN IS PATIENT IEN
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART OF THE
; CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME - NULL MEANS NOW
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND "TO" VARIABLES
; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
S DEBUG=1
S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS IN CCR
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL OF CCR
D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO THE CCR GLOBAL
;
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM THE CCR GLOBAL
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH PROCESSING ROUTINES
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
;
D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
;
S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR PROCESSING STEPS
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
. S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
. S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
. S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
. S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
. D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
. S IXML="INXML"
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
. ; W OXML,!
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
. W "RUNNING ",CALL,!
. X CALL
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
. D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
. I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
Q
;
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
; TAB IS PASSED BY NAME
; W "TAB= ",TAB,!
; D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")")
D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")")
Q
;
HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER"))
; K @VMAP
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
. S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ???
. S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED A BETTER WAY
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES,
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
I IHDR'="" D ; HEADER VALUES ARE PROVIDED
. D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
N CTMP
D MAP^GPLXPATH(CXML,VMAP,"CTMP")
D CP^GPLXPATH("CTMP",CXML)
Q
;
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
; AXML AND ACTRTN ARE PASSED BY NAME
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
; P1= OBJECTID - ACTORPATIENT_2
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE OR INSTITUTION
; OR PERSON(IN PATIENT FILE IE NOK)
; P3= IEN RECORD NUMBER FOR ACTOR - 2
N I,J,K,L
K @ACTRTN ; CLEAR RETURN ARRAY
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR ON THIS LINE
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
. . W "<ActorID>=>",J,!
. . S K(J)="" ; HASHING ACTOR TO GET RID OF DUPLICATES
S I="" ; GOING TO $O THROUGH THE HASH
F J=0:0 D Q:$O(K(I))=""
. S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
. S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
. S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE: PATIENT/PROVIDER
. S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
. D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
Q
;
TEST ; RUN ALL THE TEST CASES
;D TESTALL^GPLUNIT("GPLCCR")
D ZTEST^GPLCCR("PROBLEMS")
W "TESTING RETURNED FROM PROBLMES",!
D ZTEST^GPLCCR("CCR")
Q
;
ZTEST(WHICH) ; RUN ONE SET OF TESTS
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
D ZTEST^GPLUNIT(.ZTMP,WHICH)
Q
;
TLIST ; LIST THE TESTS
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
D TLIST^GPLUNIT(.ZTMP)
Q
;
GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
;;0.1;CCDCCR;nopatch;noreleasedate
;
; EXPORT A CCR
;
EXPORT ; EXPORT ENTRY POINT FOR CCR
; Select a patient.
S DIC=2,DIC(0)="AEMQ" D ^DIC
I Y<1 Q ; EXIT
S DFN=$P(Y,U,1) ; SET THE PATIENT
N CCRGLO
D CCRRPC(.CCRGLO,DFN,"CCR","","","")
S OARY=$NA(^TMP($J,DFN,"CCR",1))
S ONAM="PAT_"_DFN_"_CCR_V1.xml"
S ODIR="/home/glilly/CCROUT"
;S ODIR="/home/cedwards/"
D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
Q
;
CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ; RPC ENTRY POINT FOR CCR OUTPUT
; CCRGRTN IS RETURN ARRAY PASSED BY NAME
; DFN IS PATIENT IEN
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART OF THE
; CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME - NULL MEANS NOW
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND "TO" VARIABLES
; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
S DEBUG=0
S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS IN CCR
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL OF CCR
D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO THE CCR GLOBAL
;
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM THE CCR GLOBAL
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH PROCESSING ROUTINES
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
;
D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
;
K ^TMP($J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR PROCESSING STEPS
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
. S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
. S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
. S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
. S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
. D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
. S IXML="INXML"
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
. ; W OXML,!
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
. W "RUNNING ",CALL,!
. X CALL
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
. D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
. I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
Q
;
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
; TAB IS PASSED BY NAME
; W "TAB= ",TAB,!
D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")")
D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")")
Q
;
HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER"))
; K @VMAP
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
. S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ???
. S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED A BETTER WAY
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES,
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
I IHDR'="" D ; HEADER VALUES ARE PROVIDED
. D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
N CTMP
D MAP^GPLXPATH(CXML,VMAP,"CTMP")
D CP^GPLXPATH("CTMP",CXML)
Q
;
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
; AXML AND ACTRTN ARE PASSED BY NAME
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
; P1= OBJECTID - ACTORPATIENT_2
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE OR INSTITUTION
; OR PERSON(IN PATIENT FILE IE NOK)
; P3= IEN RECORD NUMBER FOR ACTOR - 2
N I,J,K,L
K @ACTRTN ; CLEAR RETURN ARRAY
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR ON THIS LINE
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
. . ;W "<ActorID>=>",J,!
. . S K(J)="" ; HASHING ACTOR TO GET RID OF DUPLICATES
S I="" ; GOING TO $O THROUGH THE HASH
F J=0:0 D Q:$O(K(I))=""
. S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
. S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
. S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE: PATIENT/PROVIDER
. S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
. D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
Q
;
TEST ; RUN ALL THE TEST CASES
;D TESTALL^GPLUNIT("GPLCCR")
D ZTEST^GPLCCR("PROBLEMS")
W "TESTING RETURNED FROM PROBLMES",!
D ZTEST^GPLCCR("CCR")
Q
;
ZTEST(WHICH) ; RUN ONE SET OF TESTS
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
D ZTEST^GPLUNIT(.ZTMP,WHICH)
Q
;
TLIST ; LIST THE TESTS
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
D TLIST^GPLUNIT(.ZTMP)
Q
;
;;><TEST>
;;><PROBLEMS>
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
;;>>?@GPL@(@GPL@(0))="</Problems>"
;;><CCR>
;;>>>D ^%ZTER
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
;;>>>D ^%ZTER
;;>>>K GPL S GPL=""
;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
;;>>?@GPL@(@GPL@(0))="</ContinutiyOfCareRecord>"
;;><ACTLST>
;;>>>N TCCR
;;>>>D CCRRPC^GPLCCR(.TCCR,"2","CCR","","","")
;;>>>D ACTLST^GPLCCR("TCCR","ACTTEST")
;;>>>N TCCR
;;>>>D CCRRPC^GPLCCR(.TCCR,"2","CCR","","","")
;;>>>D ACTLST^GPLCCR("TCCR","ACTTEST")
;;></TEST>

176
p/GPLCCR0.m
View File

@ -1,53 +1,53 @@
GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
;;0.1;CCDCCR;nopatch;noreleasedate
W "This is a CCR TEMPLATE with processing routines",!
W !
Q
;
ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
; ZARY IS PASSED BY NAME
; BAT is a string identifying the section
; LINE is a test which will evaluate to true or false
; I '$G(@ZARY) D
. S @ZARY@(0)=0 ; initially there are no elements
. W "GOT HERE LOADING "_LINE,!
N CNT ; count of array elements
S CNT=@ZARY@(0) ; contains array count
S CNT=CNT+1 ; increment count
S @ZARY@(CNT)=LINE ; put the line in the array
; S @ZARY@(BAT,CNT)="" ; index the test by battery
S @ZARY@(0)=CNT ; update the array counter
Q
;
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
; ZARY IS PASSED BY NAME
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
K @ZARY S @ZARY=""
S @ZARY@(0)=0 ; initialize array count
N LINE,LABEL,BODY
N INTEST S INTEST=0 ; switch for in the TEMPLATE section
N SECTION S SECTION="[anonymous]" ; NO section LABEL
;
N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
. I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
. I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
. I INTEST D ; within the section
. . I LINE?." "1";><".E D ; sub-section name found
. . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
. . I LINE?." "1";;".E D ; line found
. . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
Q
;
LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
D ZLOAD(ARY,"GPLCCR0")
; ZWR @ARY
Q
;
GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
;;0.1;CCDCCR;nopatch;noreleasedate
W "This is a CCR TEMPLATE with processing routines",!
W !
Q
;
ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
; ZARY IS PASSED BY NAME
; BAT is a string identifying the section
; LINE is a test which will evaluate to true or false
; I '$G(@ZARY) D
. S @ZARY@(0)=0 ; initially there are no elements
. W "GOT HERE LOADING "_LINE,!
N CNT ; count of array elements
S CNT=@ZARY@(0) ; contains array count
S CNT=CNT+1 ; increment count
S @ZARY@(CNT)=LINE ; put the line in the array
; S @ZARY@(BAT,CNT)="" ; index the test by battery
S @ZARY@(0)=CNT ; update the array counter
Q
;
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
; ZARY IS PASSED BY NAME
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
K @ZARY S @ZARY=""
S @ZARY@(0)=0 ; initialize array count
N LINE,LABEL,BODY
N INTEST S INTEST=0 ; switch for in the TEMPLATE section
N SECTION S SECTION="[anonymous]" ; NO section LABEL
;
N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
. I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
. I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
. I INTEST D ; within the section
. . I LINE?." "1";><".E D ; sub-section name found
. . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
. . I LINE?." "1";;".E D ; line found
. . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
Q
;
LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
D ZLOAD(ARY,"GPLCCR0")
; ZWR @ARY
Q
;
;<TEMPLATE>
;;<?xml version="1.0" encoding="UTF-8"?>
;;<?xml-stylesheet type="text/xsl" href="ccr_20060420.xsl"?>
;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
;;<?xml version="1.0" encoding="UTF-8"?>
;;<?xml-stylesheet type="text/xsl" href="ccr_20060420.xsl"?>
;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID>
;;<Language>
;;<Text>English</Text>
@ -71,13 +71,13 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<ActorLink>
;;<ActorID>@@ACTORTO@@</ActorID>
;;<ActorRole>
;;<Text>Primary Provider</Text>
;;<Text>Primary Provider</Text>
;;</ActorRole>
;;</ActorLink>
;;</To>
;;<Purpose>
;;<Description>
;;<Text>@@PURPOSEDESCRIPTION@@CEND PHR</Text>
;;<Text>@@PURPOSEDESCRIPTION@@CEND PHR</Text>
;;</Description>
;;</Purpose>
;;<Body>
@ -126,10 +126,10 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Text>Problem</Text>
;;</Type>
;;<Description>
;;<Text>Heart Disease</Text>
;;<Text>Heart Disease</Text>
;;<Code>
;;<Value>C0018799</Value>
;;<CodingSystem>UMLS Concept</CodingSystem>
;;<CodingSystem>UMLS Concept</CodingSystem>
;;<Version>2006</Version>
;;</Code>
;;<Code>
@ -176,7 +176,7 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Text>Arthritis</Text>
;;<Code>
;;<Value>C0003873</Value>
;;<CodingSystem>UMLS Concept</CodingSystem>
;;<CodingSystem>UMLS Concept</CodingSystem>
;;<Version>2006</Version>
;;</Code>
;;<Code>
@ -201,10 +201,10 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Text>Problem</Text>
;;</Type>
;;<Description>
;;<Text>Diabetes Mellitus</Text>
;;<Text>Diabetes Mellitus</Text>
;;<Code>
;;<Value>C0375113</Value>
;;<CodingSystem>UMLS Concept</CodingSystem>
;;<CodingSystem>UMLS Concept</CodingSystem>
;;<Version>2006</Version>
;;</Code>
;;<Code>
@ -224,7 +224,7 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Text>Problem</Text>
;;</Type>
;;<Description>
;;<Text>Parkinson's disease NOS</Text>
;;<Text>Parkinson's disease NOS</Text>
;;<Code>
;;<Value>332.0</Value>
;;<CodingSystem>ICD9CM</CodingSystem>
@ -243,7 +243,7 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<SocialHistoryElement>
;;<CCRDataObjectID>BB0004</CCRDataObjectID>
;;<Type>
;;<Text>Marital Status</Text>
;;<Text>Marital Status</Text>
;;</Type>
;;<Description>
;;<Text>Married</Text>
@ -257,10 +257,10 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<SocialHistoryElement>
;;<CCRDataObjectID>BB0005</CCRDataObjectID>
;;<Type>
;;<Text>Ethnic Origin</Text>
;;<Text>Ethnic Origin</Text>
;;</Type>
;;<Description>
;;<Text>Not Hispanic or Latino</Text>
;;<Text>Not Hispanic or Latino</Text>
;;</Description>
;;<Source>
;;<Actor>
@ -302,7 +302,7 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<CCRDataObjectID>BB0008</CCRDataObjectID>
;;<DateTime>
;;<Type>
;;<Text>Begin Date</Text>
;;<Text>Begin Date</Text>
;;</Type>
;;<Age>
;;<Value>42</Value>
@ -352,7 +352,7 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Directions>
;;<Direction>
;;<Description>
;;<Text>1 PO 1 time per day</Text>
;;<Text>1 PO 1 time per day</Text>
;;</Description>
;;<Dose>
;;<Value>1</Value>
@ -361,7 +361,7 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Text>PO</Text>
;;</Route>
;;<Frequency>
;;<Value>1 time per day</Value>
;;<Value>1 time per day</Value>
;;</Frequency>
;;</Direction>
;;</Directions>
@ -369,23 +369,23 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;</Medications>
;;<VitalSigns>
;;<Result>
;;<CCRDataObjectID>@@DATAOBJECTID@@BB0009</CCRDataObjectID>
;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID>
;;<DateTime>
;;<Type>
;;<Text>Assessment Time</Text>
;;<Text>Assessment Time</Text>
;;</Type>
;;<ExactDateTime>@@HEIGHTWEIGHTDATATIME@@2008-03-18</ExactDateTime>
;;<ExactDateTime>@@HEIGHTWEIGHTDATATIME@@</ExactDateTime>
;;</DateTime>
;;<Description>
;;<Text>Height &amp; Weight</Text>
;;<Text>Height &amp; Weight</Text>
;;</Description>
;;<Source>
;;<Actor>
;;<ActorID>@@HEIGHTWEIGHTSOURCE@@AA0001</ActorID>
;;<ActorID>@@HEIGHTWEIGHTSOURCE@@</ActorID>
;;</Actor>
;;</Source>
;;<Test>
;;<CCRDataObjectID>@@DATAOBJECTID@@BB0010</CCRDataObjectID>
;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID>
;;<Type>
;;<Text>Observation</Text>
;;</Type>
@ -399,18 +399,18 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;</Description>
;;<Source>
;;<Actor>
;;<ActorID>@@HEIGHTSOURCEID@@AA0002</ActorID>
;;<ActorID>@@HEIGHTSOURCEID@@</ActorID>
;;</Actor>
;;</Source>
;;<TestResult>
;;<Value>@@HEIGHTINCHES@@68</Value>
;;<Value>@@HEIGHTINCHES@@</Value>
;;<Units>
;;<Unit>in</Unit>
;;</Units>
;;</TestResult>
;;</Test>
;;<Test>
;;<CCRDataObjectID>@@DATAOBJECTID@@BB0011</CCRDataObjectID>
;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID>
;;<Type>
;;<Text>Observation</Text>
;;</Type>
@ -424,11 +424,11 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;</Description>
;;<Source>
;;<Actor>
;;<ActorID>@@WEIGHTSOURCEID@@AA0002</ActorID>
;;<ActorID>@@WEIGHTSOURCEID@@</ActorID>
;;</Actor>
;;</Source>
;;<TestResult>
;;<Value>@@WEIGHTLBS@@180</Value>
;;<Value>@@WEIGHTLBS@@</Value>
;;<Units>
;;<Unit>lb</Unit>
;;</Units>
@ -436,22 +436,22 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;</Test>
;;</Result>
;;<Result>
;;<CCRDataObjectID>@@DATAOBJECTID@@BB0012</CCRDataObjectID>
;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID>
;;<Description>
;;<Text>Blood Type</Text>
;;<Text>Blood Type</Text>
;;</Description>
;;<Source>
;;<Actor>
;;<ActorID>@@BLOODTYPESOURCEID@@AA0001</ActorID>
;;<ActorID>@@BLOODTYPESOURCEID@@</ActorID>
;;</Actor>
;;</Source>
;;<Test>
;;<CCRDataObjectID>@@DATAOBJECTID@@BB0013</CCRDataObjectID>
;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID>
;;<Type>
;;<Text>Result</Text>
;;</Type>
;;<Description>
;;<Text>Blood Type</Text>
;;<Text>Blood Type</Text>
;;<Code>
;;<Value>278149003</Value>
;;<CodingSystem>SNOMED</CodingSystem>
@ -460,11 +460,11 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;</Description>
;;<Source>
;;<Actor>
;;<ActorID>@@BLOODTYPESOURCEID2@@AA0002</ActorID>
;;<ActorID>@@BLOODTYPESOURCEID2@@</ActorID>
;;</Actor>
;;</Source>
;;<TestResult>
;;<Value>@@BLOODTYPERESULT@@A+</Value>
;;<Value>@@BLOODTYPERESULT@@</Value>
;;</TestResult>
;;</Test>
;;</Result>
@ -473,7 +473,7 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Provider>
;;<ActorID>AA0005</ActorID>
;;<ActorRole>
;;<Text>Primary Provider</Text>
;;<Text>Primary Provider</Text>
;;</ActorRole>
;;</Provider>
;;</HealthCareProviders>
@ -596,15 +596,15 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<ActorID>AA0001</ActorID>
;;</Source>
;;<Signature>
;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
;;<SignedInfo>
;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315" />
;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1" />
;;<Reference URI="">
;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315" />
;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1" />
;;<Reference URI="">
;;<Transforms>
;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature" />
;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature" />
;;</Transforms>
;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1" />
;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1" />
;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
;;</Reference>
;;</SignedInfo>

64
p/GPLVITALS.m
View File

@ -1,15 +1,49 @@
GPLVITALS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR VITALS ; 6/6/08
;;0.1;CCDCCR;nopatch;noreleasedate
EXTRACT(VITXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
;
; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
;
N VITALSTMP,I
S VITALSTMP="^TMP($J,""MISSINGVITALS"")"
; ZWR @VITXML
D MISSING^GPLXPATH(VITXML,VITALSTMP) ; SEARCH XML FOR MISSING VARS
I @VITALSTMP@(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
. W "VITALS MISSING ",!
. F I=1:1:@VITALSTMP@(0) W @VITALSTMP@(I),!
Q
GPLVITALS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR VITALS ; 6/6/08
;;0.1;CCDCCR;nopatch;noreleasedate
EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
;
; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
;
N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF
D VITALS^ORQQVI(.VITRSLT,DFN,"","")
I '$D(VITRSLT(1)) W "ERROR RUNNINIG VITALS RPC",! Q
;ZWR RPCRSLT
S VITTVMAP=$NA(^TMP($J,"VITALS"))
S VITTARYTMP=$NA(^TMP($J,"VITALARYTMP"))
F J=1:1:VITRSLT(1) D ; FOR EACH VITAL IN THE LIST
. I $D(VITRSLT(J)) D
. . S VITVMAP=$NA(@VITTVMAP@(J))
. . K @VITVMAP
. . I DEBUG W "VMAP= ",VMAP,!
. . S VITPTMP=VITRSLT(J) ; PULL OUT VITAL FROM RPC RETURN ARRAY
. . S @VITVMAP@("DATAOBJECTID")="VITAL"_J ; UNIQUE OBJID FOR VITAL
. . I $P(VITPTMP,U,2)="HT" D
. . . S @VITVMAP@("HEIGHTWEIGHTDATATIME")=$P(VITPTMP,U,4)
. . . S @VITVMAP@("HEIGHTWEIGHTSOURCE")=$P(VITPTMP,U,7)
. . . S @VITVMAP@("HEIGHTSOURCEID")=$P(VITPTMP,U,1)
. . . S @VITVMAP@("HEIGHTINCHES")=$P(VITPTMP,U,3)
. . I $P(VITPTMP,U,2)="WT" D
. . . S @VITVMAP@("WEIGHTSOURCEID")=$P(VITPTMP,U,1)
. . . S @VITVMAP@("WEIGHTLBS")=$P(VITPTMP,U,3)
. . S VITARYTMP=$NA(@VITTARYTMP@(J))
. . K @VITARYTMP
. . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
. . I J=1 D ; FIRST ONE IS JUST A COPY
. . . ; W "FIRST ONE",!
. . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
. . . ; W "OUTXML ",OUTXML,!
. . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
. . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
;ZWR ^TMP($J,"VITALS",*)
;ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
; W "OUT OF FOR LOOP.",!
;ZWR
; ZWR @OUTXML
; $$HTML^DILF(
N VITTMP,I
D MISSING^GPLXPATH(VITXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
. W "VITALS MISSING ",!
. F I=1:1:VITTMP(0) W VITTMP(I),!
Q

916
p/GPLXPATH.m
View File

@ -1,427 +1,427 @@
GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
;;0.2;CCDCCR;nopatch;noreleasedate
W "This is an XML XPATH utility library",!
W !
Q
;
OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE
;
N Y
S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,!
; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml")
Q
;
PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0)
; VAL IS A STRING AND STK IS PASSED BY NAME
;
I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
Q
;
POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
; VAL AND STK ARE PASSED BY REFERENCE
;
I @STK@(0)<1 S VAL="",@STK@(0)=0 Q ; IF ARRAY IS EMPTY
I @STK@(0)>0 D
. S VAL=@STK@(@STK@(0))
. K @STK@(@STK@(0))
. S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
Q
;
MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK
; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
S RTN=""
N I
; W "STK= ",STK,!
I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY
. S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
. I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
. . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
Q
;
XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
; ISTR IS PASSED BY VALUE
N CUR,TMP
I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET
. S TMP=$P(ISTR,"<",2)
I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
. S TMP=$P(TMP,"/",2)
S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
; W "CUR= ",CUR,!
I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST>
. S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
; W "CUR2= ",CUR,!
Q CUR
;
INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index
; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
; XML SECTION
; ZXML IS PASSED BY NAME
N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
N GPLSTK ; LEAVE OUT FOR DEBUGGING
I '$D(@ZXML@(0)) D ; NO XML PASSED
. W "ERROR IN XML FILE",!
S GPLSTK(0)=0 ; INITIALIZE STACK
F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY
. S LINE=@ZXML@(I)
. ;W LINE,!
. S FOUND=0 ; INTIALIZED FOUND FLAG
. I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
. I FOUND'=1 D
. . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D
. . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS ON THE SAME LINE
. . . ; W "FOUND ",LINE,!
. . . S FOUND=1 ; SET FOUND FLAG
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
. . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
. . . ; W "MDX=",MDX,!
. . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
. . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
. . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE
. . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST LINE
. . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
. I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END OF A SEC
. . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION
. . . ; W "FOUND ",LINE,!
. . . S FOUND=1 ; SET FOUND FLAG
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
. . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
. . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
. . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
. . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
. . . . Q
. I FOUND'=1 D ; THE LINE MIGHT CONTAIN THE BEGINNING OF A SECTION
. . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION
. . . ; W "FOUND ",LINE,!
. . . S FOUND=1 ; SET FOUND FLAG
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
. . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
. . . ; W "MDX=",MDX,!
. . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
. . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
. . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE
. . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
S @ZXML@("INDEXED")=""
S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
Q
;
QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
; IARY AND OARY ARE PASSED BY NAME
I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY
. D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
N TMP,I,J,QXPATH
S FIRST=1
S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
I XPATH'="//" D ; NOT A ROOT QUERY
. S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
. S FIRST=$P(TMP,"^",1)
. S LAST=$P(TMP,"^",2)
K @OARY
S @OARY@(0)=+LAST-FIRST+1
S J=1
FOR I=FIRST:1:LAST D
. S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
. S J=J+1
; ZWR OARY
Q
;
XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
; INDEX WITH TWO PIECES START^FINISH
; IDX IS PASSED BY NAME
Q $P(@IDX@(XPATH),"^",1)
;
XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
; INDEX WITH TWO PIECES START^FINISH
; IDX IS PASSED BY NAME
Q $P(@IDX@(XPATH),"^",2)
;
START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
; COMPANION TO FINISH ; IDX IS PASSED BY NAME
Q $P(ISTR,";",2)
;
FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
Q $P(ISTR,";",3)
;
ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
Q $P(ISTR,";",1)
;
BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
; DEST IS CLEARED TO START
; USES PUSH TO DO THE COPY
N I
K @BDEST
F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
. N J,ATMP
. S ATMP=$$ARRAY(@BLIST@(I))
. I DEBUG W "ATMP=",ATMP,!
. I DEBUG W @BLIST@(I),!
. F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ;
. . ; FOR EACH LINE IN THIS INSTR
. . I DEBUG W "BDEST= ",BDEST,!
. . I DEBUG W "ATMP= ",@ATMP@(J),!
. . D PUSH(BDEST,@ATMP@(J))
Q
;
QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST
;
I DEBUG W "QUEUEING ",BLST,!
D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
Q
;
CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
; KILLS CPDEST FIRST
N CPINSTR
I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
I @CPSRC@(0)<1 D ; BAD LENGTH
. W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
. Q
; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INITIALIZE
D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
D BUILD("CPINSTR",CPDEST)
Q
;
QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
; QOXPATH IS OPTIONAL - IF PROVIDED, WILL OPEN INSIDE THE XPATH POINT
; USED TO INSERT CHILDREN NODES
I @QOXML@(0)<1 D ; MALFORMED XML
. W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
. Q
I DEBUG W "DOING QOPEN",!
N S1,E1,QOT,QOTMP
S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
I $D(QOXPATH) D ; XPATH PROVIDED
. D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
. S E1=$P(@QOXML@(QOXPATH),"^",2)-1
I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
. S E1=@QOXML@(0)-1
D QUEUE(QOBLIST,QOXML,S1,E1)
; S QOTMP=QOXML_"^"_S1_"^"_E1
; D PUSH(QOBLIST,QOTMP)
Q
;
QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
; ADDS THE LIST LINE OF QCXML TO QCBLIST
; USED TO FINISH INSERTING CHILDERN NODES
; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
I @QCXML@(0)<1 D ; MALFORMED XML
. W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
I DEBUG W "GOING TO CLOSE",!
N S1,E1,QCT,QCTMP
S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
I $D(QCXPATH) D ; XPATH PROVIDED
. D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
. S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
. S S1=@QCXML@(0)
D QUEUE(QCBLIST,QCXML,S1,E1)
; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
Q
;
INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
; OMITTED, INSERTION WILL BE AT THE ROOT
; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
; XML AT THE END OF THE XPATH POINT
; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
N INSBLD,INSTMP
I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
I '$D(@INSXML@(0)) D Q ; INSERT INTO AN EMPTY ARRAY
. D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
. I $D(INSXPATH) D ; XPATH PROVIDED
. . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
. . I DEBUG ZWR INSBLD
. I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
. . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
. D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
. I $D(INSXPATH) D ; XPATH PROVIDED
. . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
. I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
. . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
. D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
. D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
Q
;
INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
; INTO INNXML AT THE INNXPATH XPATH POINT
;
N INNBLD,UXPATH
N INNTBUF
S INNTBUF=$NA(^TMP($J,"INNTBUF"))
I '$D(INNXPATH) D ; XPATH NOT PASSED
. S UXPATH="//" ; USE ROOT XPATH
I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
I '$D(@INNXML@(0)) D ; INNXML IS EMPTY
. D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
. D BUILD("INNBLD",INNXML)
I @INNXML@(0)>0 D ; NOT EMPTY
. D QOPEN("INNBLD",INNXML,UXPATH) ;
. D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
. D QCLOSE("INNBLD",INNXML,UXPATH)
. D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
. D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
Q
;
REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
S OLD=$NA(^TMP($J,"REPLACE_OLD"))
D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
S XFIRST=$P(XNODE,"^",1)
S XLAST=$P(XNODE,"^",2)
D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
I RENEW'="" D ; NEW XML IS NOT NULL
. D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
I DEBUG W "REPALCE PREBUILD",!
I DEBUG ZWR REBLD
D BUILD("REBLD","RTMP")
K @REXML ; KILL WHAT WAS THERE
D CP("RTMP",REXML) ; COPY IN THE RESULT
Q
;
MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
; W "Reporting on the missing",!
; W OARY
I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
N I
S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY
. I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE
. . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
. . Q
Q
;
MAP(IXML,INARY,OXML) ; SUBSTITUTE @@X@@ VARS IN IXML WITH VALUES IN INARY
; AND PUT THE RESULTS IN OXML
I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
N I,TNAM,TVAL
S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
F I=1:1:@OXML@(0) D ; LOOP THROUGH WHOLE ARRAY
. S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
. I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
. . S TNAM=$P(@OXML@(I),"@@",2) ; EXTRACT THE VARIABLE NAME
. . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
. . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
. . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3) ;MAPIT
W "MAPPED",!
Q
;
PARY(GLO) ;PRINT AN ARRAY
N I
F I=1:1:@GLO@(0) W @GLO@(I),!
Q
;
TEST ; Run all the test cases
D TESTALL^GPLUNIT("GPLXPATH")
Q
;
OLDTEST ; RUN ALL THE TEST CASES
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
D ZTEST^GPLUNIT(.ZTMP,"ALL")
W "PASSED: ",TPASSED,!
W "FAILED: ",TFAILED,!
W !
; W "THE TESTS!",!
; ZWR ZTMP
Q
;
ZTEST(WHICH) ; RUN ONE SET OF TESTS
N ZTMP
S DEBUG=1
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
D ZTEST^GPLUNIT(.ZTMP,WHICH)
Q
;
TLIST ; LIST THE TESTS
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
D TLIST^GPLUNIT(.ZTMP)
Q
;
GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
;;0.2;CCDCCR;nopatch;noreleasedate
W "This is an XML XPATH utility library",!
W !
Q
;
OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE
;
N Y
S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,!
; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml")
Q
;
PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0)
; VAL IS A STRING AND STK IS PASSED BY NAME
;
I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
Q
;
POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
; VAL AND STK ARE PASSED BY REFERENCE
;
I @STK@(0)<1 S VAL="",@STK@(0)=0 Q ; IF ARRAY IS EMPTY
I @STK@(0)>0 D
. S VAL=@STK@(@STK@(0))
. K @STK@(@STK@(0))
. S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
Q
;
MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK
; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
S RTN=""
N I
; W "STK= ",STK,!
I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY
. S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
. I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
. . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
Q
;
XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
; ISTR IS PASSED BY VALUE
N CUR,TMP
I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET
. S TMP=$P(ISTR,"<",2)
I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
. S TMP=$P(TMP,"/",2)
S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
; W "CUR= ",CUR,!
I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST>
. S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
; W "CUR2= ",CUR,!
Q CUR
;
INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index
; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
; XML SECTION
; ZXML IS PASSED BY NAME
N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
N GPLSTK ; LEAVE OUT FOR DEBUGGING
I '$D(@ZXML@(0)) D ; NO XML PASSED
. W "ERROR IN XML FILE",!
S GPLSTK(0)=0 ; INITIALIZE STACK
F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY
. S LINE=@ZXML@(I)
. ;W LINE,!
. S FOUND=0 ; INTIALIZED FOUND FLAG
. I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
. I FOUND'=1 D
. . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D
. . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS ON THE SAME LINE
. . . ; W "FOUND ",LINE,!
. . . S FOUND=1 ; SET FOUND FLAG
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
. . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
. . . ; W "MDX=",MDX,!
. . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
. . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
. . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE
. . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST LINE
. . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
. I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END OF A SEC
. . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION
. . . ; W "FOUND ",LINE,!
. . . S FOUND=1 ; SET FOUND FLAG
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
. . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
. . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
. . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
. . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
. . . . Q
. I FOUND'=1 D ; THE LINE MIGHT CONTAIN THE BEGINNING OF A SECTION
. . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION
. . . ; W "FOUND ",LINE,!
. . . S FOUND=1 ; SET FOUND FLAG
. . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
. . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
. . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
. . . ; W "MDX=",MDX,!
. . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
. . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
. . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE
. . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
S @ZXML@("INDEXED")=""
S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
Q
;
QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
; IARY AND OARY ARE PASSED BY NAME
I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY
. D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
N TMP,I,J,QXPATH
S FIRST=1
S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
I XPATH'="//" D ; NOT A ROOT QUERY
. S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
. S FIRST=$P(TMP,"^",1)
. S LAST=$P(TMP,"^",2)
K @OARY
S @OARY@(0)=+LAST-FIRST+1
S J=1
FOR I=FIRST:1:LAST D
. S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
. S J=J+1
; ZWR OARY
Q
;
XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
; INDEX WITH TWO PIECES START^FINISH
; IDX IS PASSED BY NAME
Q $P(@IDX@(XPATH),"^",1)
;
XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
; INDEX WITH TWO PIECES START^FINISH
; IDX IS PASSED BY NAME
Q $P(@IDX@(XPATH),"^",2)
;
START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
; COMPANION TO FINISH ; IDX IS PASSED BY NAME
Q $P(ISTR,";",2)
;
FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
Q $P(ISTR,";",3)
;
ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
Q $P(ISTR,";",1)
;
BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
; DEST IS CLEARED TO START
; USES PUSH TO DO THE COPY
N I
K @BDEST
F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
. N J,ATMP
. S ATMP=$$ARRAY(@BLIST@(I))
. I DEBUG W "ATMP=",ATMP,!
. I DEBUG W @BLIST@(I),!
. F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ;
. . ; FOR EACH LINE IN THIS INSTR
. . I DEBUG W "BDEST= ",BDEST,!
. . I DEBUG W "ATMP= ",@ATMP@(J),!
. . D PUSH(BDEST,@ATMP@(J))
Q
;
QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST
;
I DEBUG W "QUEUEING ",BLST,!
D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
Q
;
CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
; KILLS CPDEST FIRST
N CPINSTR
I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
I @CPSRC@(0)<1 D ; BAD LENGTH
. W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
. Q
; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INITIALIZE
D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
D BUILD("CPINSTR",CPDEST)
Q
;
QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
; QOXPATH IS OPTIONAL - IF PROVIDED, WILL OPEN INSIDE THE XPATH POINT
; USED TO INSERT CHILDREN NODES
I @QOXML@(0)<1 D ; MALFORMED XML
. W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
. Q
I DEBUG W "DOING QOPEN",!
N S1,E1,QOT,QOTMP
S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
I $D(QOXPATH) D ; XPATH PROVIDED
. D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
. S E1=$P(@QOXML@(QOXPATH),"^",2)-1
I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
. S E1=@QOXML@(0)-1
D QUEUE(QOBLIST,QOXML,S1,E1)
; S QOTMP=QOXML_"^"_S1_"^"_E1
; D PUSH(QOBLIST,QOTMP)
Q
;
QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
; ADDS THE LIST LINE OF QCXML TO QCBLIST
; USED TO FINISH INSERTING CHILDERN NODES
; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
I @QCXML@(0)<1 D ; MALFORMED XML
. W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
I DEBUG W "GOING TO CLOSE",!
N S1,E1,QCT,QCTMP
S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
I $D(QCXPATH) D ; XPATH PROVIDED
. D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
. S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
. S S1=@QCXML@(0)
D QUEUE(QCBLIST,QCXML,S1,E1)
; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
Q
;
INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
; OMITTED, INSERTION WILL BE AT THE ROOT
; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
; XML AT THE END OF THE XPATH POINT
; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
N INSBLD,INSTMP
I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
I '$D(@INSXML@(0)) D Q ; INSERT INTO AN EMPTY ARRAY
. D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
. I $D(INSXPATH) D ; XPATH PROVIDED
. . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
. . I DEBUG ZWR INSBLD
. I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
. . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
. D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
. I $D(INSXPATH) D ; XPATH PROVIDED
. . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
. I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
. . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
. D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
. D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
Q
;
INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
; INTO INNXML AT THE INNXPATH XPATH POINT
;
N INNBLD,UXPATH
N INNTBUF
S INNTBUF=$NA(^TMP($J,"INNTBUF"))
I '$D(INNXPATH) D ; XPATH NOT PASSED
. S UXPATH="//" ; USE ROOT XPATH
I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
I '$D(@INNXML@(0)) D ; INNXML IS EMPTY
. D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
. D BUILD("INNBLD",INNXML)
I @INNXML@(0)>0 D ; NOT EMPTY
. D QOPEN("INNBLD",INNXML,UXPATH) ;
. D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
. D QCLOSE("INNBLD",INNXML,UXPATH)
. D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
. D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
Q
;
REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
S OLD=$NA(^TMP($J,"REPLACE_OLD"))
D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
S XFIRST=$P(XNODE,"^",1)
S XLAST=$P(XNODE,"^",2)
D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
I RENEW'="" D ; NEW XML IS NOT NULL
. D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
I DEBUG W "REPALCE PREBUILD",!
I DEBUG ZWR REBLD
D BUILD("REBLD","RTMP")
K @REXML ; KILL WHAT WAS THERE
D CP("RTMP",REXML) ; COPY IN THE RESULT
Q
;
MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
; W "Reporting on the missing",!
; W OARY
I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
N I
S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY
. I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE
. . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
. . Q
Q
;
MAP(IXML,INARY,OXML) ; SUBSTITUTE @@X@@ VARS IN IXML WITH VALUES IN INARY
; AND PUT THE RESULTS IN OXML
I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
N I,TNAM,TVAL
S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
F I=1:1:@OXML@(0) D ; LOOP THROUGH WHOLE ARRAY
. S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
. I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
. . S TNAM=$P(@OXML@(I),"@@",2) ; EXTRACT THE VARIABLE NAME
. . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
. . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
. . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3) ;MAPIT
W "MAPPED",!
Q
;
PARY(GLO) ;PRINT AN ARRAY
N I
F I=1:1:@GLO@(0) W @GLO@(I),!
Q
;
TEST ; Run all the test cases
D TESTALL^GPLUNIT("GPLXPATH")
Q
;
OLDTEST ; RUN ALL THE TEST CASES
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
D ZTEST^GPLUNIT(.ZTMP,"ALL")
W "PASSED: ",TPASSED,!
W "FAILED: ",TFAILED,!
W !
; W "THE TESTS!",!
; ZWR ZTMP
Q
;
ZTEST(WHICH) ; RUN ONE SET OF TESTS
N ZTMP
S DEBUG=1
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
D ZTEST^GPLUNIT(.ZTMP,WHICH)
Q
;
TLIST ; LIST THE TESTS
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
D TLIST^GPLUNIT(.ZTMP)
Q
;
;;><TEST>
;;><INIT>
;;>>>K GPL S GPL=""
;;>>>D PUSH^GPLXPATH("GPL","FIRST")
;;>>>D PUSH^GPLXPATH("GPL","SECOND")
;;>>>D PUSH^GPLXPATH("GPL","THIRD")
;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
;;>>>K GPL S GPL=""
;;>>>D PUSH^GPLXPATH("GPL","FIRST")
;;>>>D PUSH^GPLXPATH("GPL","SECOND")
;;>>>D PUSH^GPLXPATH("GPL","THIRD")
;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
;;>>?GPL(0)=4
;;><INITXML>
;;>>>K GXML S GXML=""
;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
;;>>>K GXML S GXML=""
;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
;;><INITXML2>
;;>>>K GXML S GXML=""
;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","DATA2")
;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
;;>>>K GXML S GXML=""
;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","DATA2")
;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
;;><PUSHPOP>
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
;;>>?GPL(GPL(0))="FOURTH"
;;>>>D POP^GPLXPATH("GPL",.GX)
;;>>>D POP^GPLXPATH("GPL",.GX)
;;>>?GX="FOURTH"
;;>>?GPL(GPL(0))="THIRD"
;;>>>D POP^GPLXPATH("GPL",.GX)
;;>>>D POP^GPLXPATH("GPL",.GX)
;;>>?GX="THIRD"
;;>>?GPL(GPL(0))="SECOND"
;;><MKMDX>
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
;;>>>S GX=""
;;>>>D MKMDX^GPLXPATH("GPL",.GX)
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
;;>>>S GX=""
;;>>>D MKMDX^GPLXPATH("GPL",.GX)
;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
;;><XNAME>
;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
;;>>?$$XNAME^GPLXPATH("<SIXTH ID=""SELF"" />")="SIXTH"
;;>>?$$XNAME^GPLXPATH("<SIXTH ID=""SELF"" />")="SIXTH"
;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
;;><INDEX>
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
;;>>>D INDEX^GPLXPATH("GXML")
;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
;;>>>D INDEX^GPLXPATH("GXML")
;;>>?GXML("//FIRST/SECOND")="2^12"
;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
@ -430,8 +430,8 @@ TLIST ; LIST THE TESTS
;;>>?GXML("//FIRST/SECOND")="2^12"
;;>>?GXML("//FIRST")="1^13"
;;><INDEX2>
;;>>>D ZTEST^GPLXPATH("INITXML2")
;;>>>D INDEX^GPLXPATH("GXML")
;;>>>D ZTEST^GPLXPATH("INITXML2")
;;>>>D INDEX^GPLXPATH("GXML")
;;>>?GXML("//FIRST/SECOND")="2^12"
;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"
@ -439,83 +439,83 @@ TLIST ; LIST THE TESTS
;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7"
;;>>?GXML("//FIRST")="1^13"
;;><MISSING>
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
;;>>?@OUTARY@(1)="DATA1"
;;>>?@OUTARY@(2)="DATA2"
;;><MAP>
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
;;>>>S @MAPARY@("DATA2")="VALUE2"
;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
;;>>>S @MAPARY@("DATA2")="VALUE2"
;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
;;>>?@OUTARY@(6)="VALUE2"
;;><QUEUE>
;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
;;>>?$P(BTLIST(2),";",2)=4
;;><BUILD>
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
;;>>>D ZTEST^GPLXPATH("QUEUE")
;;>>>D BUILD^GPLXPATH("BTLIST","G3")
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
;;>>>D ZTEST^GPLXPATH("QUEUE")
;;>>>D BUILD^GPLXPATH("BTLIST","G3")
;;><CP>
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D CP^GPLXPATH("GXML","G2")
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D CP^GPLXPATH("GXML","G2")
;;>>?G2(0)=13
;;><QOPEN>
;;>>>K G2,GBL
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QOPEN^GPLXPATH("GBL","GXML")
;;>>>K G2,GBL
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QOPEN^GPLXPATH("GBL","GXML")
;;>>?$P(GBL(1),";",3)=12
;;>>>D BUILD^GPLXPATH("GBL","G2")
;;>>>D BUILD^GPLXPATH("GBL","G2")
;;>>?G2(G2(0))="</SECOND>"
;;><QOPEN2>
;;>>>K G2,GBL
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
;;>>>K G2,GBL
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
;;>>?$P(GBL(1),";",3)=11
;;>>>D BUILD^GPLXPATH("GBL","G2")
;;>>>D BUILD^GPLXPATH("GBL","G2")
;;>>?G2(G2(0))="</SECOND>"
;;><QCLOSE>
;;>>>K G2,GBL
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
;;>>>K G2,GBL
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
;;>>?$P(GBL(1),";",3)=13
;;>>>D BUILD^GPLXPATH("GBL","G2")
;;>>>D BUILD^GPLXPATH("GBL","G2")
;;>>?G2(G2(0))="</FIRST>"
;;><QCLOSE2>
;;>>>K G2,GBL
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
;;>>>K G2,GBL
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
;;>>?$P(GBL(1),";",3)=13
;;>>>D BUILD^GPLXPATH("GBL","G2")
;;>>>D BUILD^GPLXPATH("GBL","G2")
;;>>?G2(G2(0))="</FIRST>"
;;>>?G2(1)="</THIRD>"
;;><INSERT>
;;>>>K G2,GBL,G3,G4
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
;;>>>D INSERT^GPLXPATH("G3","G2","//")
;;>>>K G2,GBL,G3,G4
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
;;>>>D INSERT^GPLXPATH("G3","G2","//")
;;>>?G2(1)=GXML(9)
;;><REPLACE>
;;>>>K G2,GBL,G3
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
;;>>>K G2,GBL,G3
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
;;>>?GXML(3)="<FIFTH>"
;;><INSINNER>
;;>>>K GXML,G2,GBL,G3
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
;;>>>K GXML,G2,GBL,G3
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
;;>>?GXML(10)="<FIFTH>"
;;><INSINNER2>
;;>>>K GXML,G2,GBL,G3
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
;;>>>D INSINNER^GPLXPATH("G2","G2")
;;>>>K GXML,G2,GBL,G3
;;>>>D ZTEST^GPLXPATH("INITXML")
;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
;;>>>D INSINNER^GPLXPATH("G2","G2")
;;>>?G2(8)="<FIFTH>"
;;></TEST>