RORTSK10 ;HCIOFO/SG - REPORT RETRIEVING UTILITIES ; 11/14/06 1:11pm
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
;
Q
;
;***** TRACES THE PATH FROM THE ELEMENT TO THE ROOT
;
; IEN IEN of the report element
;
; .STACK Reference to a local variable where the path will
; be stored to.
;
; STACK Number of elements in the path (n)
; STACK(i) Identifiers of the elements (i=1 - the source
; element; i=n - the root element)
; ^1: IEN of the report element
; ^2: Where exactly the rendering process
; has stopped (see $$XMLSTR for details)
; ^3: IEN of the text line
;
PATH(IEN,STACK) ;
K STACK S STACK=0
F D Q:IEN'>0
. S STACK=STACK+1,STACK(STACK)=IEN
. S:'$P(IEN,U,2) $P(STACK(STACK),U,2)=4
. S IEN=$P($G(@RORSRC@(+IEN,0)),U,2)
Q
;
;***** RENDERS THE REPORT INTO XML
;
; ROR8DST Closed root of the destination buffer
;
; TASK Task number
;
; [.SORT] Sort modes for the report
;
; [.FROM] Where to start/continue the rendering process
; ^1: IEN of the report element
; ^2: Where exactly the rendering process has stopped
; (see the $$XMLSTR function for details)
; ^3: IEN of the text line (if the 2nd piece = 3)
;
; You must not make any assumptions about structure of
; this parameter (it can be changed at any time without
; warning). The only exception is the IEN of the report
; element. You can assign a positive value to this
; parameter before the call to start the rendering from
; the corresponding element.
;
; [MAXSIZE] Either the maximum number of lines to retrieve or
; the maximum size of the output in bytes (append the
; "B" to the number). By default (if $G(MAXSIZE)'>0,)
; the whole report (starting from the point indicated
; by the FROM parameter if it is defined) is retrieved.
;
; Examples:
; 500 Retrieve no more than 500 lines
; 4096B Retrieve no more than 4Kb
;
; NOTE: If the "B" suffix is used, the size of the retrieved
; portion of the document can be somewhat bigger than
; MAXSIZE! The last line of the chunk is not truncated
; even if the size will be bigger than MAXSIZE.
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of rendered lines
;
; If the maximum size (MAXSIZE) is reached, the identifiers
; of the last item (it has not been added to the output buffer) are
; returned via the FROM parameter. The next call of the function will
; continue the rendering process starting from that item.
;
XMLREP(ROR8DST,TASK,SORT,FROM,MAXSIZE) ;
N RORNUM ; Number of rendered lines of the report
N RORSIZE ; Size of the output (in bytes)
N RORSORT ; Sort modes for the report
N RORSTACK ; Path from the FROM element to the root
N RORSRC ; Closed root of the source report data
;
N DIR,I,RC,SORTFLD,SORTLST K @ROR8DST
S RORSRC=$$ROOT^DILFD(798.87,","_TASK_",",1)
;--- Setup the size limits
S (RORNUM,RORSIZE)=0
S MAXSIZE=$$UP^XLFSTR($G(MAXSIZE))
I MAXSIZE["B" S RORNUM(1)=0,RORSIZE(1)=+MAXSIZE
E S RORNUM(1)=+MAXSIZE,RORSIZE(1)=0
;--- Setup the starting point
I $G(FROM)>0 D
. S:$P(FROM,U,2)'>0 $P(FROM,U,2)=1
. D PATH(FROM,.RORSTACK)
E S I=$$XMLSTR("<?xml version=""1.0""?>")
;--- Setup the sorting
S (FROM,I)=""
F S I=$O(SORT(I)) Q:I="" D
. S SORTLST=$P(SORT(I),"=") Q:SORTLST=""
. S SORTFLD=$P($P(SORT(I),"=",2),":") Q:SORTFLD=""
. S DIR=$S($P(SORT(I),":",2)?1"D".1"ESC":-1,1:1)
. S RORSORT($$XEC^RORTSK11(SORTLST))=$$XEC^RORTSK11(SORTFLD)_U_DIR
;--- Get the report
S RC=$$XMLREPI(0,0)
S:RC>0 FROM=$P(RC,U,2)_U_$P(RC,U)_U_$P(RC,U,3)
Q $S(RC'<0:RORNUM,1:RC)
;
;***** RECURSIVELY RENDERS THE REPORT INTO XML
;
; PARENT IEN of the parent element
; PELC Type of the parent element
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of rendered lines has reached the limit
; (see the $$XMLSTR function for details)
;
XMLREPI(PARENT,PELC) ;
N RORIEN ; IEN of the report element being processed
;
N BUF,DIR,LC,ELEMENT,I,LINE,MODE,RC,SVC,TMP,VAL,XREF
I $G(PELC)>0 D
. S BUF=$G(RORSORT(PELC)),SVC=+$P(BUF,U),DIR=$S($P(BUF,U,2)<0:-1,1:1)
E S SVC=0,DIR=1
S XREF=$NA(@RORSRC@("APSV",PARENT,SVC))
;--- Use order of creation if the xref is not available
S:$D(@XREF)<10 XREF=$NA(@RORSRC@("APSV",PARENT,0))
;--- Determine the starting point (FROM)
I $G(RORSTACK)>0 S RC=0 D Q:RC RC
. S RORIEN=+$P(RORSTACK(RORSTACK),U)
. S MODE=+$P(RORSTACK(RORSTACK),U,2)
. S LINE=+$P(RORSTACK(RORSTACK),U,3)
. S RORSTACK=RORSTACK-1
. S I=+$O(@RORSRC@("APSR",RORIEN,SVC,""))
. I I>0 D
. . S TMP=+$P($G(@RORSRC@(I,0)),U,3)
. . S VAL=$$SORTBY^RORDD01(TMP,$G(@RORSRC@(I,1)))
. E S VAL=" "
. S RORIEN=$O(@RORSRC@("APSV",PARENT,SVC,VAL,RORIEN),-DIR)
. S VAL=$O(@RORSRC@("APSV",PARENT,SVC,VAL),-DIR)
E K RORSTACK S (LINE,MODE)=0,(RORIEN,VAL)=""
;--- Render the report elements
S RC=0
F S VAL=$O(@XREF@(VAL),DIR) Q:VAL="" D Q:RC
. F S RORIEN=$O(@XREF@(VAL,RORIEN),DIR) Q:RORIEN="" D S MODE=0 Q:RC
. . S TMP=$G(@RORSRC@(RORIEN,0)) Q:$P(TMP,U,4)
. . S ELC=+$P(TMP,U) Q:ELC'>0
. . S ELEMENT=$P(^ROR(799.31,ELC,0),U)
. . S I=0,BUF="<"_ELEMENT
. . ;--- Render the attributes of the element
. . F S I=$O(@RORSRC@(RORIEN,2,I)) Q:I'>0 D
. . . S TMP=$P(@RORSRC@(RORIEN,2,I,0),U)
. . . S BUF=BUF_" "_$P(^ROR(799.31,TMP,0),U)
. . . S TMP=$G(@RORSRC@(RORIEN,2,I,1))
. . . S BUF=BUF_"="""_$$XMLENC^RORUTL03(TMP)_""""
. . ;--- Append the SORT attribute(s) to a table
. . D:$D(RORSORT(ELC))
. . . S TMP=+$P(RORSORT(ELC),U) Q:TMP'>0
. . . S BUF=BUF_" SORT="""_$P(^ROR(799.31,TMP,0),U)_""""
. . . S TMP=+$P(RORSORT(ELC),U,2)
. . . S:TMP<0 BUF=BUF_" SORTDESC=""1"""
. . ;--- Leaf element (without children)
. . I $D(@RORSRC@("APSV",RORIEN))<10 D Q
. . . ;--- <ELEMENT...>VALUE</ELEMENT>
. . . S TMP=$G(@RORSRC@(RORIEN,1))
. . . I TMP'="" D:MODE'>2 Q
. . . . S BUF=BUF_">"_$$XMLENC^RORUTL03(TMP)_"</"_ELEMENT_">"
. . . . S RC=$$XMLSTR(BUF,2)
. . . ;--- <ELEMENT.../>
. . . S I=$O(@RORSRC@(RORIEN,3,0))
. . . I I'>0 S:MODE'>2 RC=$$XMLSTR(BUF_"/>",2) Q
. . . ;--- <ELEMENT...>
. . . ; TEXT
. . . ;--- </ELEMENT>
. . . I MODE'>3 D Q:RC
. . . . S:MODE'>1 RC=$$XMLSTR(BUF_">",1)
. . . . S:LINE>0 I=LINE,LINE=0
. . . . F Q:RC D S I=$O(@RORSRC@(RORIEN,3,I)) Q:I'>0
. . . . . S RC=$$XMLSTR($G(@RORSRC@(RORIEN,3,I,0)),3,I)
. . . S RC=$$XMLSTR("</"_ELEMENT_">",5)
. . ;--- Parent element and all children (recursively)
. . I MODE'>4 D Q:RC
. . . I MODE'>1 S RC=$$XMLSTR(BUF_">",1) Q:RC
. . . S RC=$$XMLREPI(RORIEN,ELC)
. . S RC=$$XMLSTR("</"_ELEMENT_">",5)
. S RORIEN=""
Q RC
;
;***** APPENDS THE STRING TO THE OUTPUT BUFFER
;
; STR String that should be appended to the document
; TYPE Type of the rendered item
; [LINE] IEN of the text line
;
; Return Values:
; 0 Ok
; >0 Number of rendered lines has reached the limit
; ^1: Where exactly the rendering process has stopped
; 1 Opening tag
; 2 Single value
; 3 Multiline text value
; 4 Nested tag
; 5 Closing tag
; ^2: IEN of the report element
; ^3: IEN of the text line (if the 1st piece = 3)
;
XMLSTR(STR,TYPE,LINE) ;
N SL S SL=$L(STR)+2
I RORNUM(1)>0 Q:RORNUM'<RORNUM(1) TYPE_U_RORIEN_U_$G(LINE)
I RORSIZE(1)>0 Q:RORSIZE'<RORSIZE(1) TYPE_U_RORIEN_U_$G(LINE)
S RORNUM=RORNUM+1,@ROR8DST@(RORNUM)=STR
S RORSIZE=RORSIZE+SL
Q 0
;
;*****
XREFNODE(TASK,PARENT,SORT) ;
N NODE
S NODE=$$ROOT^DILFD(798.87,","_TASK_",",1)
S SORT=$$XEC^RORTSK11(SORT)
Q $S(SORT>0:$NA(@NODE@("APSV",PARENT,SORT)),1:"")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORTSK10 8426 printed Dec 13, 2024@01:43:32 Page 2
RORTSK10 ;HCIOFO/SG - REPORT RETRIEVING UTILITIES ; 11/14/06 1:11pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
+2 ;
+3 QUIT
+4 ;
+5 ;***** TRACES THE PATH FROM THE ELEMENT TO THE ROOT
+6 ;
+7 ; IEN IEN of the report element
+8 ;
+9 ; .STACK Reference to a local variable where the path will
+10 ; be stored to.
+11 ;
+12 ; STACK Number of elements in the path (n)
+13 ; STACK(i) Identifiers of the elements (i=1 - the source
+14 ; element; i=n - the root element)
+15 ; ^1: IEN of the report element
+16 ; ^2: Where exactly the rendering process
+17 ; has stopped (see $$XMLSTR for details)
+18 ; ^3: IEN of the text line
+19 ;
PATH(IEN,STACK) ;
+1 KILL STACK
SET STACK=0
+2 FOR
Begin DoDot:1
+3 SET STACK=STACK+1
SET STACK(STACK)=IEN
+4 if '$PIECE(IEN,U,2)
SET $PIECE(STACK(STACK),U,2)=4
+5 SET IEN=$PIECE($GET(@RORSRC@(+IEN,0)),U,2)
End DoDot:1
if IEN'>0
QUIT
+6 QUIT
+7 ;
+8 ;***** RENDERS THE REPORT INTO XML
+9 ;
+10 ; ROR8DST Closed root of the destination buffer
+11 ;
+12 ; TASK Task number
+13 ;
+14 ; [.SORT] Sort modes for the report
+15 ;
+16 ; [.FROM] Where to start/continue the rendering process
+17 ; ^1: IEN of the report element
+18 ; ^2: Where exactly the rendering process has stopped
+19 ; (see the $$XMLSTR function for details)
+20 ; ^3: IEN of the text line (if the 2nd piece = 3)
+21 ;
+22 ; You must not make any assumptions about structure of
+23 ; this parameter (it can be changed at any time without
+24 ; warning). The only exception is the IEN of the report
+25 ; element. You can assign a positive value to this
+26 ; parameter before the call to start the rendering from
+27 ; the corresponding element.
+28 ;
+29 ; [MAXSIZE] Either the maximum number of lines to retrieve or
+30 ; the maximum size of the output in bytes (append the
+31 ; "B" to the number). By default (if $G(MAXSIZE)'>0,)
+32 ; the whole report (starting from the point indicated
+33 ; by the FROM parameter if it is defined) is retrieved.
+34 ;
+35 ; Examples:
+36 ; 500 Retrieve no more than 500 lines
+37 ; 4096B Retrieve no more than 4Kb
+38 ;
+39 ; NOTE: If the "B" suffix is used, the size of the retrieved
+40 ; portion of the document can be somewhat bigger than
+41 ; MAXSIZE! The last line of the chunk is not truncated
+42 ; even if the size will be bigger than MAXSIZE.
+43 ;
+44 ; Return Values:
+45 ; <0 Error code
+46 ; 0 Ok
+47 ; >0 Number of rendered lines
+48 ;
+49 ; If the maximum size (MAXSIZE) is reached, the identifiers
+50 ; of the last item (it has not been added to the output buffer) are
+51 ; returned via the FROM parameter. The next call of the function will
+52 ; continue the rendering process starting from that item.
+53 ;
XMLREP(ROR8DST,TASK,SORT,FROM,MAXSIZE) ;
+1 ; Number of rendered lines of the report
NEW RORNUM
+2 ; Size of the output (in bytes)
NEW RORSIZE
+3 ; Sort modes for the report
NEW RORSORT
+4 ; Path from the FROM element to the root
NEW RORSTACK
+5 ; Closed root of the source report data
NEW RORSRC
+6 ;
+7 NEW DIR,I,RC,SORTFLD,SORTLST
KILL @ROR8DST
+8 SET RORSRC=$$ROOT^DILFD(798.87,","_TASK_",",1)
+9 ;--- Setup the size limits
+10 SET (RORNUM,RORSIZE)=0
+11 SET MAXSIZE=$$UP^XLFSTR($GET(MAXSIZE))
+12 IF MAXSIZE["B"
SET RORNUM(1)=0
SET RORSIZE(1)=+MAXSIZE
+13 IF '$TEST
SET RORNUM(1)=+MAXSIZE
SET RORSIZE(1)=0
+14 ;--- Setup the starting point
+15 IF $GET(FROM)>0
Begin DoDot:1
+16 if $PIECE(FROM,U,2)'>0
SET $PIECE(FROM,U,2)=1
+17 DO PATH(FROM,.RORSTACK)
End DoDot:1
+18 IF '$TEST
SET I=$$XMLSTR("<?xml version=""1.0""?>")
+19 ;--- Setup the sorting
+20 SET (FROM,I)=""
+21 FOR
SET I=$ORDER(SORT(I))
if I=""
QUIT
Begin DoDot:1
+22 SET SORTLST=$PIECE(SORT(I),"=")
if SORTLST=""
QUIT
+23 SET SORTFLD=$PIECE($PIECE(SORT(I),"=",2),":")
if SORTFLD=""
QUIT
+24 SET DIR=$SELECT($PIECE(SORT(I),":",2)?1"D".1"ESC":-1,1:1)
+25 SET RORSORT($$XEC^RORTSK11(SORTLST))=$$XEC^RORTSK11(SORTFLD)_U_DIR
End DoDot:1
+26 ;--- Get the report
+27 SET RC=$$XMLREPI(0,0)
+28 if RC>0
SET FROM=$PIECE(RC,U,2)_U_$PIECE(RC,U)_U_$PIECE(RC,U,3)
+29 QUIT $SELECT(RC'<0:RORNUM,1:RC)
+30 ;
+31 ;***** RECURSIVELY RENDERS THE REPORT INTO XML
+32 ;
+33 ; PARENT IEN of the parent element
+34 ; PELC Type of the parent element
+35 ;
+36 ; Return Values:
+37 ; <0 Error code
+38 ; 0 Ok
+39 ; >0 Number of rendered lines has reached the limit
+40 ; (see the $$XMLSTR function for details)
+41 ;
XMLREPI(PARENT,PELC) ;
+1 ; IEN of the report element being processed
NEW RORIEN
+2 ;
+3 NEW BUF,DIR,LC,ELEMENT,I,LINE,MODE,RC,SVC,TMP,VAL,XREF
+4 IF $GET(PELC)>0
Begin DoDot:1
+5 SET BUF=$GET(RORSORT(PELC))
SET SVC=+$PIECE(BUF,U)
SET DIR=$SELECT($PIECE(BUF,U,2)<0:-1,1:1)
End DoDot:1
+6 IF '$TEST
SET SVC=0
SET DIR=1
+7 SET XREF=$NAME(@RORSRC@("APSV",PARENT,SVC))
+8 ;--- Use order of creation if the xref is not available
+9 if $DATA(@XREF)<10
SET XREF=$NAME(@RORSRC@("APSV",PARENT,0))
+10 ;--- Determine the starting point (FROM)
+11 IF $GET(RORSTACK)>0
SET RC=0
Begin DoDot:1
+12 SET RORIEN=+$PIECE(RORSTACK(RORSTACK),U)
+13 SET MODE=+$PIECE(RORSTACK(RORSTACK),U,2)
+14 SET LINE=+$PIECE(RORSTACK(RORSTACK),U,3)
+15 SET RORSTACK=RORSTACK-1
+16 SET I=+$ORDER(@RORSRC@("APSR",RORIEN,SVC,""))
+17 IF I>0
Begin DoDot:2
+18 SET TMP=+$PIECE($GET(@RORSRC@(I,0)),U,3)
+19 SET VAL=$$SORTBY^RORDD01(TMP,$GET(@RORSRC@(I,1)))
End DoDot:2
+20 IF '$TEST
SET VAL=" "
+21 SET RORIEN=$ORDER(@RORSRC@("APSV",PARENT,SVC,VAL,RORIEN),-DIR)
+22 SET VAL=$ORDER(@RORSRC@("APSV",PARENT,SVC,VAL),-DIR)
End DoDot:1
if RC
QUIT RC
+23 IF '$TEST
KILL RORSTACK
SET (LINE,MODE)=0
SET (RORIEN,VAL)=""
+24 ;--- Render the report elements
+25 SET RC=0
+26 FOR
SET VAL=$ORDER(@XREF@(VAL),DIR)
if VAL=""
QUIT
Begin DoDot:1
+27 FOR
SET RORIEN=$ORDER(@XREF@(VAL,RORIEN),DIR)
if RORIEN=""
QUIT
Begin DoDot:2
+28 SET TMP=$GET(@RORSRC@(RORIEN,0))
if $PIECE(TMP,U,4)
QUIT
+29 SET ELC=+$PIECE(TMP,U)
if ELC'>0
QUIT
+30 SET ELEMENT=$PIECE(^ROR(799.31,ELC,0),U)
+31 SET I=0
SET BUF="<"_ELEMENT
+32 ;--- Render the attributes of the element
+33 FOR
SET I=$ORDER(@RORSRC@(RORIEN,2,I))
if I'>0
QUIT
Begin DoDot:3
+34 SET TMP=$PIECE(@RORSRC@(RORIEN,2,I,0),U)
+35 SET BUF=BUF_" "_$PIECE(^ROR(799.31,TMP,0),U)
+36 SET TMP=$GET(@RORSRC@(RORIEN,2,I,1))
+37 SET BUF=BUF_"="""_$$XMLENC^RORUTL03(TMP)_""""
End DoDot:3
+38 ;--- Append the SORT attribute(s) to a table
+39 if $DATA(RORSORT(ELC))
Begin DoDot:3
+40 SET TMP=+$PIECE(RORSORT(ELC),U)
if TMP'>0
QUIT
+41 SET BUF=BUF_" SORT="""_$PIECE(^ROR(799.31,TMP,0),U)_""""
+42 SET TMP=+$PIECE(RORSORT(ELC),U,2)
+43 if TMP<0
SET BUF=BUF_" SORTDESC=""1"""
End DoDot:3
+44 ;--- Leaf element (without children)
+45 IF $DATA(@RORSRC@("APSV",RORIEN))<10
Begin DoDot:3
+46 ;--- <ELEMENT...>VALUE</ELEMENT>
+47 SET TMP=$GET(@RORSRC@(RORIEN,1))
+48 IF TMP'=""
if MODE'>2
Begin DoDot:4
+49 SET BUF=BUF_">"_$$XMLENC^RORUTL03(TMP)_"</"_ELEMENT_">"
+50 SET RC=$$XMLSTR(BUF,2)
End DoDot:4
QUIT
+51 ;--- <ELEMENT.../>
+52 SET I=$ORDER(@RORSRC@(RORIEN,3,0))
+53 IF I'>0
if MODE'>2
SET RC=$$XMLSTR(BUF_"/>",2)
QUIT
+54 ;--- <ELEMENT...>
+55 ; TEXT
+56 ;--- </ELEMENT>
+57 IF MODE'>3
Begin DoDot:4
+58 if MODE'>1
SET RC=$$XMLSTR(BUF_">",1)
+59 if LINE>0
SET I=LINE
SET LINE=0
+60 FOR
if RC
QUIT
Begin DoDot:5
+61 SET RC=$$XMLSTR($GET(@RORSRC@(RORIEN,3,I,0)),3,I)
End DoDot:5
SET I=$ORDER(@RORSRC@(RORIEN,3,I))
if I'>0
QUIT
End DoDot:4
if RC
QUIT
+62 SET RC=$$XMLSTR("</"_ELEMENT_">",5)
End DoDot:3
QUIT
+63 ;--- Parent element and all children (recursively)
+64 IF MODE'>4
Begin DoDot:3
+65 IF MODE'>1
SET RC=$$XMLSTR(BUF_">",1)
if RC
QUIT
+66 SET RC=$$XMLREPI(RORIEN,ELC)
End DoDot:3
if RC
QUIT
+67 SET RC=$$XMLSTR("</"_ELEMENT_">",5)
End DoDot:2
SET MODE=0
if RC
QUIT
+68 SET RORIEN=""
End DoDot:1
if RC
QUIT
+69 QUIT RC
+70 ;
+71 ;***** APPENDS THE STRING TO THE OUTPUT BUFFER
+72 ;
+73 ; STR String that should be appended to the document
+74 ; TYPE Type of the rendered item
+75 ; [LINE] IEN of the text line
+76 ;
+77 ; Return Values:
+78 ; 0 Ok
+79 ; >0 Number of rendered lines has reached the limit
+80 ; ^1: Where exactly the rendering process has stopped
+81 ; 1 Opening tag
+82 ; 2 Single value
+83 ; 3 Multiline text value
+84 ; 4 Nested tag
+85 ; 5 Closing tag
+86 ; ^2: IEN of the report element
+87 ; ^3: IEN of the text line (if the 1st piece = 3)
+88 ;
XMLSTR(STR,TYPE,LINE) ;
+1 NEW SL
SET SL=$LENGTH(STR)+2
+2 IF RORNUM(1)>0
if RORNUM'<RORNUM(1)
QUIT TYPE_U_RORIEN_U_$GET(LINE)
+3 IF RORSIZE(1)>0
if RORSIZE'<RORSIZE(1)
QUIT TYPE_U_RORIEN_U_$GET(LINE)
+4 SET RORNUM=RORNUM+1
SET @ROR8DST@(RORNUM)=STR
+5 SET RORSIZE=RORSIZE+SL
+6 QUIT 0
+7 ;
+8 ;*****
XREFNODE(TASK,PARENT,SORT) ;
+1 NEW NODE
+2 SET NODE=$$ROOT^DILFD(798.87,","_TASK_",",1)
+3 SET SORT=$$XEC^RORTSK11(SORT)
+4 QUIT $SELECT(SORT>0:$NAME(@NODE@("APSV",PARENT,SORT)),1:"")
