source: FOIAVistA/tag/r/CLINICAL_CASE_REGISTRIES-ROR/RORTSK10.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1RORTSK10 ;HCIOFO/SG - REPORT RETRIEVING UTILITIES ; 11/14/06 1:11pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 Q
5 ;
6 ;***** TRACES THE PATH FROM THE ELEMENT TO THE ROOT
7 ;
8 ; IEN IEN of the report element
9 ;
10 ; .STACK Reference to a local variable where the path will
11 ; be stored to.
12 ;
13 ; STACK Number of elements in the path (n)
14 ; STACK(i) Identifiers of the elements (i=1 - the source
15 ; element; i=n - the root element)
16 ; ^1: IEN of the report element
17 ; ^2: Where exactly the rendering process
18 ; has stopped (see $$XMLSTR for details)
19 ; ^3: IEN of the text line
20 ;
21PATH(IEN,STACK) ;
22 K STACK S STACK=0
23 F D Q:IEN'>0
24 . S STACK=STACK+1,STACK(STACK)=IEN
25 . S:'$P(IEN,U,2) $P(STACK(STACK),U,2)=4
26 . S IEN=$P($G(@RORSRC@(+IEN,0)),U,2)
27 Q
28 ;
29 ;***** RENDERS THE REPORT INTO XML
30 ;
31 ; ROR8DST Closed root of the destination buffer
32 ;
33 ; TASK Task number
34 ;
35 ; [.SORT] Sort modes for the report
36 ;
37 ; [.FROM] Where to start/continue the rendering process
38 ; ^1: IEN of the report element
39 ; ^2: Where exactly the rendering process has stopped
40 ; (see the $$XMLSTR function for details)
41 ; ^3: IEN of the text line (if the 2nd piece = 3)
42 ;
43 ; You must not make any assumptions about structure of
44 ; this parameter (it can be changed at any time without
45 ; warning). The only exception is the IEN of the report
46 ; element. You can assign a positive value to this
47 ; parameter before the call to start the rendering from
48 ; the corresponding element.
49 ;
50 ; [MAXSIZE] Either the maximum number of lines to retrieve or
51 ; the maximum size of the output in bytes (append the
52 ; "B" to the number). By default (if $G(MAXSIZE)'>0,)
53 ; the whole report (starting from the point indicated
54 ; by the FROM parameter if it is defined) is retrieved.
55 ;
56 ; Examples:
57 ; 500 Retrieve no more than 500 lines
58 ; 4096B Retrieve no more than 4Kb
59 ;
60 ; NOTE: If the "B" suffix is used, the size of the retrieved
61 ; portion of the document can be somewhat bigger than
62 ; MAXSIZE! The last line of the chunk is not truncated
63 ; even if the size will be bigger than MAXSIZE.
64 ;
65 ; Return Values:
66 ; <0 Error code
67 ; 0 Ok
68 ; >0 Number of rendered lines
69 ;
70 ; If the maximum size (MAXSIZE) is reached, the identifiers
71 ; of the last item (it has not been added to the output buffer) are
72 ; returned via the FROM parameter. The next call of the function will
73 ; continue the rendering process starting from that item.
74 ;
75XMLREP(ROR8DST,TASK,SORT,FROM,MAXSIZE) ;
76 N RORNUM ; Number of rendered lines of the report
77 N RORSIZE ; Size of the output (in bytes)
78 N RORSORT ; Sort modes for the report
79 N RORSTACK ; Path from the FROM element to the root
80 N RORSRC ; Closed root of the source report data
81 ;
82 N DIR,I,RC,SORTFLD,SORTLST K @ROR8DST
83 S RORSRC=$$ROOT^DILFD(798.87,","_TASK_",",1)
84 ;--- Setup the size limits
85 S (RORNUM,RORSIZE)=0
86 S MAXSIZE=$$UP^XLFSTR($G(MAXSIZE))
87 I MAXSIZE["B" S RORNUM(1)=0,RORSIZE(1)=+MAXSIZE
88 E S RORNUM(1)=+MAXSIZE,RORSIZE(1)=0
89 ;--- Setup the starting point
90 I $G(FROM)>0 D
91 . S:$P(FROM,U,2)'>0 $P(FROM,U,2)=1
92 . D PATH(FROM,.RORSTACK)
93 E S I=$$XMLSTR("<?xml version=""1.0""?>")
94 ;--- Setup the sorting
95 S (FROM,I)=""
96 F S I=$O(SORT(I)) Q:I="" D
97 . S SORTLST=$P(SORT(I),"=") Q:SORTLST=""
98 . S SORTFLD=$P($P(SORT(I),"=",2),":") Q:SORTFLD=""
99 . S DIR=$S($P(SORT(I),":",2)?1"D".1"ESC":-1,1:1)
100 . S RORSORT($$XEC^RORTSK11(SORTLST))=$$XEC^RORTSK11(SORTFLD)_U_DIR
101 ;--- Get the report
102 S RC=$$XMLREPI(0,0)
103 S:RC>0 FROM=$P(RC,U,2)_U_$P(RC,U)_U_$P(RC,U,3)
104 Q $S(RC'<0:RORNUM,1:RC)
105 ;
106 ;***** RECURSIVELY RENDERS THE REPORT INTO XML
107 ;
108 ; PARENT IEN of the parent element
109 ; PELC Type of the parent element
110 ;
111 ; Return Values:
112 ; <0 Error code
113 ; 0 Ok
114 ; >0 Number of rendered lines has reached the limit
115 ; (see the $$XMLSTR function for details)
116 ;
117XMLREPI(PARENT,PELC) ;
118 N RORIEN ; IEN of the report element being processed
119 ;
120 N BUF,DIR,LC,ELEMENT,I,LINE,MODE,RC,SVC,TMP,VAL,XREF
121 I $G(PELC)>0 D
122 . S BUF=$G(RORSORT(PELC)),SVC=+$P(BUF,U),DIR=$S($P(BUF,U,2)<0:-1,1:1)
123 E S SVC=0,DIR=1
124 S XREF=$NA(@RORSRC@("APSV",PARENT,SVC))
125 ;--- Use order of creation if the xref is not available
126 S:$D(@XREF)<10 XREF=$NA(@RORSRC@("APSV",PARENT,0))
127 ;--- Determine the starting point (FROM)
128 I $G(RORSTACK)>0 S RC=0 D Q:RC RC
129 . S RORIEN=+$P(RORSTACK(RORSTACK),U)
130 . S MODE=+$P(RORSTACK(RORSTACK),U,2)
131 . S LINE=+$P(RORSTACK(RORSTACK),U,3)
132 . S RORSTACK=RORSTACK-1
133 . S I=+$O(@RORSRC@("APSR",RORIEN,SVC,""))
134 . I I>0 D
135 . . S TMP=+$P($G(@RORSRC@(I,0)),U,3)
136 . . S VAL=$$SORTBY^RORDD01(TMP,$G(@RORSRC@(I,1)))
137 . E S VAL=" "
138 . S RORIEN=$O(@RORSRC@("APSV",PARENT,SVC,VAL,RORIEN),-DIR)
139 . S VAL=$O(@RORSRC@("APSV",PARENT,SVC,VAL),-DIR)
140 E K RORSTACK S (LINE,MODE)=0,(RORIEN,VAL)=""
141 ;--- Render the report elements
142 S RC=0
143 F S VAL=$O(@XREF@(VAL),DIR) Q:VAL="" D Q:RC
144 . F S RORIEN=$O(@XREF@(VAL,RORIEN),DIR) Q:RORIEN="" D S MODE=0 Q:RC
145 . . S TMP=$G(@RORSRC@(RORIEN,0)) Q:$P(TMP,U,4)
146 . . S ELC=+$P(TMP,U) Q:ELC'>0
147 . . S ELEMENT=$P(^ROR(799.31,ELC,0),U)
148 . . S I=0,BUF="<"_ELEMENT
149 . . ;--- Render the attributes of the element
150 . . F S I=$O(@RORSRC@(RORIEN,2,I)) Q:I'>0 D
151 . . . S TMP=$P(@RORSRC@(RORIEN,2,I,0),U)
152 . . . S BUF=BUF_" "_$P(^ROR(799.31,TMP,0),U)
153 . . . S TMP=$G(@RORSRC@(RORIEN,2,I,1))
154 . . . S BUF=BUF_"="""_$$XMLENC^RORUTL03(TMP)_""""
155 . . ;--- Append the SORT attribute(s) to a table
156 . . D:$D(RORSORT(ELC))
157 . . . S TMP=+$P(RORSORT(ELC),U) Q:TMP'>0
158 . . . S BUF=BUF_" SORT="""_$P(^ROR(799.31,TMP,0),U)_""""
159 . . . S TMP=+$P(RORSORT(ELC),U,2)
160 . . . S:TMP<0 BUF=BUF_" SORTDESC=""1"""
161 . . ;--- Leaf element (without children)
162 . . I $D(@RORSRC@("APSV",RORIEN))<10 D Q
163 . . . ;--- <ELEMENT...>VALUE</ELEMENT>
164 . . . S TMP=$G(@RORSRC@(RORIEN,1))
165 . . . I TMP'="" D:MODE'>2 Q
166 . . . . S BUF=BUF_">"_$$XMLENC^RORUTL03(TMP)_"</"_ELEMENT_">"
167 . . . . S RC=$$XMLSTR(BUF,2)
168 . . . ;--- <ELEMENT.../>
169 . . . S I=$O(@RORSRC@(RORIEN,3,0))
170 . . . I I'>0 S:MODE'>2 RC=$$XMLSTR(BUF_"/>",2) Q
171 . . . ;--- <ELEMENT...>
172 . . . ; TEXT
173 . . . ;--- </ELEMENT>
174 . . . I MODE'>3 D Q:RC
175 . . . . S:MODE'>1 RC=$$XMLSTR(BUF_">",1)
176 . . . . S:LINE>0 I=LINE,LINE=0
177 . . . . F Q:RC D S I=$O(@RORSRC@(RORIEN,3,I)) Q:I'>0
178 . . . . . S RC=$$XMLSTR($G(@RORSRC@(RORIEN,3,I,0)),3,I)
179 . . . S RC=$$XMLSTR("</"_ELEMENT_">",5)
180 . . ;--- Parent element and all children (recursively)
181 . . I MODE'>4 D Q:RC
182 . . . I MODE'>1 S RC=$$XMLSTR(BUF_">",1) Q:RC
183 . . . S RC=$$XMLREPI(RORIEN,ELC)
184 . . S RC=$$XMLSTR("</"_ELEMENT_">",5)
185 . S RORIEN=""
186 Q RC
187 ;
188 ;***** APPENDS THE STRING TO THE OUTPUT BUFFER
189 ;
190 ; STR String that should be appended to the document
191 ; TYPE Type of the rendered item
192 ; [LINE] IEN of the text line
193 ;
194 ; Return Values:
195 ; 0 Ok
196 ; >0 Number of rendered lines has reached the limit
197 ; ^1: Where exactly the rendering process has stopped
198 ; 1 Opening tag
199 ; 2 Single value
200 ; 3 Multiline text value
201 ; 4 Nested tag
202 ; 5 Closing tag
203 ; ^2: IEN of the report element
204 ; ^3: IEN of the text line (if the 1st piece = 3)
205 ;
206XMLSTR(STR,TYPE,LINE) ;
207 N SL S SL=$L(STR)+2
208 I RORNUM(1)>0 Q:RORNUM'<RORNUM(1) TYPE_U_RORIEN_U_$G(LINE)
209 I RORSIZE(1)>0 Q:RORSIZE'<RORSIZE(1) TYPE_U_RORIEN_U_$G(LINE)
210 S RORNUM=RORNUM+1,@ROR8DST@(RORNUM)=STR
211 S RORSIZE=RORSIZE+SL
212 Q 0
213 ;
214 ;*****
215XREFNODE(TASK,PARENT,SORT) ;
216 N NODE
217 S NODE=$$ROOT^DILFD(798.87,","_TASK_",",1)
218 S SORT=$$XEC^RORTSK11(SORT)
219 Q $S(SORT>0:$NA(@NODE@("APSV",PARENT,SORT)),1:"")
Note: See TracBrowser for help on using the repository browser.