GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
;;0.2;CCDCCR;nopatch;noreleasedate
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
;General Public License See attached copy of the License.
;
;This program is free software; you can redistribute it and/or modify
;it under the terms of the GNU General Public License as published by
;the Free Software Foundation; either version 2 of the License, or
;(at your option) any later version.
;
;This program is distributed in the hope that it will be useful,
;but WITHOUT ANY WARRANTY; without even the implied warranty of
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;GNU General Public License for more details.
;
;You should have received a copy of the GNU General Public License along
;with this program; if not, write to the Free Software Foundation, Inc.,
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
;
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 Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
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 D ; IF ARRAY IS EMPTY
. S VAL=""
. S @STK@(0)=0
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
;
PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
;
N ZGI
F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY
. D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
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
; 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""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,!
. . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
. . . . Q
. I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
. . 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, 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, 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
;
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 ; 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 D PARY^GPLXPATH("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
;
INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
; BUT XDEST AN XNEW ARE PASSED BY NAME
N XBLD,XTMP
D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
D BUILD("XBLD","XTMP") ; BUILD THE RESULT
D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
I DEBUG D PARY("XDEST")
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)
I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
. D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
. D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
I RENEW'="" D ; NEW XML IS NOT NULL
. D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
. D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
. D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
I DEBUG W "REPLACE PREBUILD",!
I DEBUG D PARY("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 MULTIPLE @@X@@ VARS 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,J,TNAM,TVAL,TSTR
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 TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
. . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
. . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
. . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
. . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
. . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
. . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD
. . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
. . . . E D DOFLD ; PROCESS A FIELD
. . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
. . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
. . I DEBUG W TSTR
I DEBUG W "MAPPED",!
Q
;
DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
;
Q
;
TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
; THEXML IS PASSED BY NAME
N I,J,TMPXML,DEL,FOUND,INTXT
S FOUND=0
S INTXT=0
I DEBUG W "DELETING EMPTY ELEMENTS",!
F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY
. S J=@THEXML@(I)
. I J["" D
. . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
. . I DEBUG W "IN HTML SECTION",!
. N JM,JP,JPX ; JMINUS AND JPLUS
. S JM=@THEXML@(I-1) ; LINE BEFORE
. I JM["" S INTXT=0 ; LEFT HTML SECTION,START TRIM
. S JP=@THEXML@(I+1) ; LINE AFTER
. I INTXT=0 D ; IF NOT IN AN HTML SECTION
. . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
. . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES
. . . I DEBUG W I,J,JP,!
. . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
. . . S DEL(I)="" ; SET LINE TO DELETE
. . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
. . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE
. . . I DEBUG W I,J,!
. . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
. . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
. . . I JM=JPX D ;
. . . . I DEBUG W I,JM_J_JPX,!
. . . . S DEL(I-1)=""
. . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
; . I J'["><" D PUSH("TMPXML",J)
I FOUND D ; NEED TO DELETE THINGS
. F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES
. . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED
. . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
. D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
Q FOUND
;
UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
; XSEC IS A SECTION PASSED BY NAME
N XBLD,XTMP
D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
D BUILD("XBLD","XTMP") ; BUILD THE RESULT
D CP("XTMP",XSEC) ; REPLACE PASSED XML
Q
;
PARY(GLO) ;PRINT AN ARRAY
N I
F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
Q
;
H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
I '$D(IPRE) S IPRE=""
N H2I S H2I=""
; W $O(@IHASH@(H2I)),!
F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH
. I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES
. . ;W H2I_"^"_@IHASH@(H2I),!
. . N IH,IHI
. . S IH=$NA(@IHASH@(H2I)) ;
. . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
. . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
. . S IHI="" ; INDEX INTO "M" MULTIPLES
. . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE
. . . ; W @IH@(IHI)
. . . S IH3=$NA(@IH2@(IHI))
. . . ; W "HEY",IH3,!
. . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
. . ; W IH,!
. . ; W "GPLZZ",!
. . ; W $NA(@IHASH@(H2I)),!
. . Q ;
. D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
. ; W @IARYRTN@(0),!
Q
;
XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
; DEFINED IN INPUT XML XVIXML BY @@VAR@@
; XVRTN AND XVIXML ARE PASSED BY NAME
;
N XVI,XVTMP,XVT
F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML
. S XVT=@XVIXML@(XVI)
. I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI
D H2ARY(XVRTN,"XVTMP")
Q
;
DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
;
N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE
. D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
. S DXUSE="DTMP" ; DXUSE IS NAME
E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE
. D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
. S DXUSE="DTMP" ; DXUSE IS NAME
E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
D XVARS("DVARS",DXUSE) ; PULL OUT VARS
D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM
Q
;
TEST ; Run all the test cases
D TESTALL^GPLUNIT("GPLXPAT0")
Q
;
ZTEST(WHICH) ; RUN ONE SET OF TESTS
N ZTMP
S DEBUG=1
D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
D ZTEST^GPLUNIT(.ZTMP,WHICH)
Q
;
TLIST ; LIST THE TESTS
N ZTMP
D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
D TLIST^GPLUNIT(.ZTMP)
Q
;