Index: ccr/trunk/p/GPLCCR.m =================================================================== --- ccr/trunk/p/GPLCCR.m (revision 37) +++ ccr/trunk/p/GPLCCR.m (revision 38) @@ -1,153 +1,153 @@ -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 - ; 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 - D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE - D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL - ; - ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL - ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH 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 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;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")") - D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")") - Q - ; -HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT - N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER")) - ; K @VMAP - S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$FMTHL7^XLFDT($$NOW^XLFDT),"DT") - 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 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"".E D ; THERE IS AN ACTOR THIS LINE - . . S J=$P($P(@AXML@(I),"",2),"",1) - . . W "=>",J,! - . . I 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 - . 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") - 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 - ; -;;> -;;> -;;>>>K GPL S GPL="" -;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","") -;;>>?@GPL@(@GPL@(0))["" -;;> -;;>>>K GPL S GPL="" -;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","") -;;>>?@GPL@(@GPL@(0))["" -;;> -;;>>>K GPL S GPL="" -;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") -;;>>?@GPL@(@GPL@(0))["" -;;> -;;>>>K GPL S GPL="" -;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") -;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST") -;;> +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 + ; 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 + D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE + D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL + ; + ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL + ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH 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 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;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")") + D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")") + Q + ; +HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT + N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER")) + ; K @VMAP + S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$FMTHL7^XLFDT($$NOW^XLFDT),"DT") + 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 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"".E D ; THERE IS AN ACTOR THIS LINE + . . S J=$P($P(@AXML@(I),"",2),"",1) + . . W "=>",J,! + . . I 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 + . 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") + 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 + ; +;;> +;;> +;;>>>K GPL S GPL="" +;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","") +;;>>?@GPL@(@GPL@(0))["" +;;> +;;>>>K GPL S GPL="" +;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","") +;;>>?@GPL@(@GPL@(0))["" +;;> +;;>>>K GPL S GPL="" +;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") +;;>>?@GPL@(@GPL@(0))["" +;;> +;;>>>K GPL S GPL="" +;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","") +;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST") +;;> Index: ccr/trunk/p/GPLXPATH.m =================================================================== --- ccr/trunk/p/GPLXPATH.m (revision 37) +++ ccr/trunk/p/GPLXPATH.m (revision 38) @@ -1,365 +1,365 @@ -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 - ; +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 - ; + ; + 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 - ; + ; 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 - ; + ; 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 - ; + ; 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 - ; AND 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 - . 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 - ; + ; AND 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 + . 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) 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, NOT A MULTIPLE - . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST - . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK - . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END - . . I LINE?.E1"") 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, NOT A MULTIPLE - . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX - S @ZXML@("INDEXED")="" - S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH - Q - ; + ; 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) 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, NOT A MULTIPLE + . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST + . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK + . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END + . . I LINE?.E1"") 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, 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 - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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 - ; + ; 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 - ; + ; + 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, INIT - D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY - D BUILD("CPINSTR",CPDEST) - Q - ; + ; 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, INIT + 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 - 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 - ; + ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD + ; QOXPATH IS OPTIONAL - 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 - ; + ; 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 - ; + ; 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 - . 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 - ; + ; 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 + . 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 - ; + ; 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 - ; + ; 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) - W "MAPPED",! - Q - ; + ; 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) + W "MAPPED",! + Q + ; PARY(GLO) ;PRINT AN ARRAY - N I - F I=1:1:@GLO@(0) W @GLO@(I),! - Q - ; + N I + F I=1:1:@GLO@(0) W @GLO@(I),! + Q + ; TEST ; Run all the test cases - D TESTALL^GPLUNIT("GPLXPATH") - Q - ; + 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 - ; + 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 - ; + 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 - ; + N ZTMP + D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") + D TLIST^GPLUNIT(.ZTMP) + Q + ; ;;> ;;>