source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCSAPIT.m@ 812

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1ONCSAPIT ;Hines OIFO/SG - COLLABORATIVE STAGING (TABLES) ; 12/7/06 11:26am
2 ;;2.11;ONCOLOGY;**40,41,47**;Mar 07, 1995;Build 19
3 ;
4 ;--- STRUCTURE OF THE RESPONSE
5 ;
6 ; <?xml version="1.0" encoding="utf-8"?>
7 ; <soap:Envelope
8 ; xmlns:soap="http://www.w3.org/2001/12/soap-envelope"
9 ; soap:encodingStyle="http://www.w3.org/2001/12/soap-encoding">
10 ; <soap:Body>
11 ; <CS-RESPONSE xmlns="http://vista.med.va.gov/oncology">
12 ; <SCHEMA>...</SCHEMA>
13 ; <TABLE>
14 ; <NUMBER>...</NUMBER>
15 ; <PATTERN>...</PATTERN>
16 ; <ROLE>...</ROLE>
17 ; <SUBTITLE>...</SUBTITLE>
18 ; <TITLE>...</TITLE>
19 ; <ROWS>
20 ; <ROW>
21 ; <CODE>...</CODE>
22 ; <DESCR>
23 ; <P>...</P>
24 ; ...
25 ; </DESCR>
26 ; <AC>...</AC>
27 ; ...
28 ; </ROW>
29 ; ...
30 ; </ROWS>
31 ; <NOTES>
32 ; <TN>
33 ; <P>...</P>
34 ; ...
35 ; </TN>
36 ; ...
37 ; <FN>
38 ; <P>...</P>
39 ; ...
40 ; </FN>
41 ; ...
42 ; </NOTES>
43 ; </TABLE>
44 ; ...
45 ; </CS-RESPONSE>
46 ; <soap:Fault>
47 ; <faultcode> ... </faultcode>
48 ; <faultstring> ... </faultstring>
49 ; <detail>
50 ; <RC> ... </RC>
51 ; </detail>
52 ; </soap:Fault>
53 ; </soap:Body >
54 ; </soap:Envelope>
55 ;
56 Q
57 ;
58 ;***** LOADS THE CS CODE DESCRIPTION
59 ;
60 ; [.ONCSAPI] Reference to the API descriptor (see the ^ONCSAPI)
61 ;
62 ; SITE Primary site
63 ; HIST Histology
64 ;
65 ; TABLE Table number (see the ^ONCSAPI routine)
66 ; CODE Primary code of a table row
67 ;
68 ; ONC8DST Closed reference of the destination buffer
69 ;
70 ; Return Values:
71 ; 0 Ok
72 ; <0 Error code
73 ;
74CODEDESC(ONCSAPI,SITE,HIST,TABLE,CODE,ONC8DST) ;
75 N I,NODE,RC,ROW,TBLIEN,TMP
76 D CLEAR^ONCSAPIE() K @ONC8DST
77 Q:$G(CODE)?." " $$ERROR^ONCSAPIE(-6,,"CODE",$G(CODE))
78 ;---
79 L +^XTMP("ONCSAPI","TABLES","JOB",$J):5 E D Q RC
80 . S RC=$$ERROR^ONCSAPIE(-15,,"access control node")
81 ;
82 S RC=0 D
83 . ;--- Get the table IEN
84 . S TBLIEN=$$GETCSTBL(.ONCSAPI,SITE,HIST,TABLE)
85 . I TBLIEN<0 S RC=TBLIEN Q
86 . S NODE=$NA(^XTMP("ONCSAPI","TABLES",TBLIEN))
87 . S CODE=+$G(CODE)
88 . ;--- Check the single code
89 . S ROW=$G(@NODE@("C",CODE))
90 . ;--- Check the interval
91 . I ROW'>0 D I ROW'>0 S RC=$$ERROR^ONCSAPIE(-6,,"CODE",CODE) Q
92 . . S TMP=$O(@NODE@("C",CODE),-1) Q:TMP=""
93 . . S ROW=$G(@NODE@("C",TMP))
94 . . S:CODE>$P(ROW,U,2) ROW=0
95 . ;--- Load the description
96 . M @ONC8DST=@NODE@(+ROW,3)
97 ;
98 L -^XTMP("ONCSAPI","TABLES","JOB",$J)
99 Q $S(RC<0:RC,1:0)
100 ;
101 ;***** END ELEMENT CALLBACK FOR THE SAX PARSER
102 ;
103 ; ELMT Name of the element
104 ;
105ENDEL(ELMT) ;
106 N I,J,L,L2E,L3E,SUBS,TMP
107 S L=$L(ONCXML("PATH"),","),L2E=$P(ONCXML("PATH"),",",L-1,L)
108 S L3E=$P(ONCXML("PATH"),",",L-2,L)
109 D ENDEL^ONCSAPIX(ELMT)
110 ;---
111 I L2E="CS-RESPONSE,TABLE" D Q
112 . N NAME,SCHEMA,TABLE
113 . S SCHEMA=+$G(ONCXML("SCHEMA")),TABLE=+$P(ONCTBDSC,U,3)
114 . S NAME=$P(ONCTBDSC,U,5)
115 . I (SCHEMA'>0)!(TABLE'>0)!(NAME="") K @ONCXML@(ONCTBIEN) Q
116 . S $P(ONCTBDSC,U,2)=SCHEMA
117 . ;---
118 . S @ONCXML@(ONCTBIEN,0)=$E(ONCTBDSC,1,254)
119 . S @ONCXML@("ST",SCHEMA,TABLE)=ONCTBIEN
120 ;---
121 I L2E="ROW,CODE" D Q
122 . S $P(@ONCXML@(ONCTBIEN,ONCTBROW,1),U)=ONCXML("ROWCODE")
123 . Q:ONCXML("ROWCODE")?."-"
124 . S TMP=ONCTBROW
125 . S:ONCXML("ROWCODE")["-" $P(TMP,U,2)=+$P(ONCXML("ROWCODE"),"-",2)
126 . S @ONCXML@(ONCTBIEN,"C",+ONCXML("ROWCODE"))=TMP
127 I L3E="ROW,DESCR,P" D Q
128 . S J=+$O(@ONCXML@(ONCTBIEN,ONCTBROW,3,""),-1)
129 . S I=""
130 . F S I=$O(^UTILITY($J,"W",1,I)) Q:I="" D
131 . . S TMP=$G(^UTILITY($J,"W",1,I,0)),J=J+1
132 . . S @ONCXML@(ONCTBIEN,ONCTBROW,3,J)=$$TRIM^XLFSTR(TMP,"R")
133 ;---
134 I (L3E="NOTES,FN,P")!(L3E="NOTES,TN,P") D Q
135 . S SUBS=$P(L3E,",",2)
136 . S J=+$O(@ONCXML@(ONCTBIEN,SUBS,ONCXML(SUBS),""),-1)
137 . S I=""
138 . F S I=$O(^UTILITY($J,"W",1,I)) Q:I="" D
139 . . S TMP=$G(^UTILITY($J,"W",1,I,0)),J=J+1
140 . . S @ONCXML@(ONCTBIEN,SUBS,ONCXML(SUBS),J)=$$TRIM^XLFSTR(TMP,"R")
141 Q
142 ;
143 ;***** RETURNS THE TABLE IEN (LOADS THE TABLES IF NECESSARY)
144 ;
145 ; [.ONCSAPI] Reference to the API descriptor (see the ^ONCSAPI)
146 ;
147 ; SITE Primary site
148 ; HIST Histology
149 ; TABLE Table number (see the ^ONCSAPI)
150 ;
151 ; The ^TMP("ONCSAPIT",$J) global node is used by this function.
152 ;
153 ; Return Values:
154 ; >0 IEN of the table
155 ; <0 Error code
156 ;
157GETCSTBL(ONCSAPI,SITE,HIST,TABLE) ;
158 N ONCTBDSC ; Descriptor of the table
159 N ONCTBIEN ; IEN of the table
160 N ONCTBROW ; Row number
161 ;
162 N DST,ONCREQ,ONCRSP,ONCXML,SCHEMA,URL,XHIST,XSITE
163 D CLEAR^ONCSAPIE()
164 Q:TABLE'>0 $$ERROR^ONCSAPIE(-6,,"TABLE",TABLE)
165 ;--- Initialize constants and variables
166 S ONCXML=$NA(^XTMP("ONCSAPI","TABLES"))
167 S ONCXML("XSITE")=$S(SITE'="":SITE,1:" ")
168 S ONCXML("XHIST")=$S(HIST'="":HIST,1:" ")
169 ;
170 ;--- Check if the schema number is available
171 S SCHEMA=+$G(@ONCXML@("SH",ONCXML("XSITE"),ONCXML("XHIST")))
172 I SCHEMA'>0 D Q:SCHEMA<0 SCHEMA
173 . S SCHEMA=+$$SCHEMA^ONCSAPIS(.ONCSAPI,SITE,HIST)
174 ;
175 ;--- Check if the table is available
176 S ONCTBIEN=+$G(@ONCXML@("ST",SCHEMA,TABLE))
177 Q:ONCTBIEN>0 ONCTBIEN
178 S ONCRSP=$NA(^TMP("ONCSAPIT",$J)) K @ONCRSP
179 ;
180 ;--- Get the server URL
181 S URL=$$GETCSURL^ONCSAPIU()
182 ;
183 L +@ONCXML@("ST",SCHEMA,TABLE):5
184 E Q $$ERROR^ONCSAPIE(-15,,"local CS table")
185 S RC=0 D
186 . ;--- Check if the table has become available
187 . S ONCTBIEN=+$G(@ONCXML@("ST",SCHEMA,TABLE)) Q:ONCTBIEN>0
188 . ;--- Prepare the request data
189 . S DST="ONCREQ"
190 . D HEADER^ONCSAPIR(.DST,"CS-GET-TABLES")
191 . D PUT^ONCSAPIR(.DST,"SCHEMA",SCHEMA)
192 . D PUT^ONCSAPIR(.DST,"TABLE",TABLE)
193 . D TRAILER^ONCSAPIR(.DST)
194 . K DST
195 . ;--- Send the request and get the response
196 . D:$G(ONCSAPI("DEBUG"))
197 . . D ZW^ONCSAPIU("ONCREQ","*** 'TABLE' REQUEST ***")
198 . S RC=$$REQUEST^ONCSAPIR(URL,ONCRSP,"ONCREQ") Q:RC<0
199 . D:$G(ONCSAPI("DEBUG"))
200 . . D ZW^ONCSAPIU(ONCRSP,"*** 'TABLE' RESPONSE ***")
201 . ;--- Load the table into the XTMP global
202 . D SETCBK(.CBK),EN^MXMLPRSE(ONCRSP,.CBK,"W")
203 . ;--- Check for parsing and web service errors
204 . S RC=$$CHKERR^ONCSAPIR(.ONCXML) Q:RC<0
205 L -@ONCXML@("ST",SCHEMA,TABLE)
206 ;
207 ;--- Cleanup
208 K @ONCRSP
209 Q $S(RC<0:RC,1:+$G(ONCTBIEN))
210 ;
211 ;***** SETS THE EVENT INTERFACE ENTRY POINTS
212 ;
213 ; .CBK Reference to the destination list
214 ;
215SETCBK(CBK) ;
216 ;;CHARACTERS ^ TEXT^ONCSAPIT
217 ;;ENDELEMENT ^ ENDEL^ONCSAPIT
218 ;;STARTELEMENT^STARTEL^ONCSAPIT
219 ;
220 D SETCBK^ONCSAPIX(.CBK,"SETCBK^ONCSAPIT")
221 Q
222 ;
223 ;***** START ELEMENT CALLBACK FOR THE SAX PARSER
224 ;
225 ; ELMT Name of the element
226 ;
227 ; .ATTR List of attributes and their values
228 ;
229STARTEL(ELMT,ATTR) ;
230 N L,L2E,L3E,SUBS,TBLIEN
231 D STARTEL^ONCSAPIX(ELMT,.ATTR)
232 S L=$L(ONCXML("PATH"),","),L2E=$P(ONCXML("PATH"),",",L-1,L)
233 S L3E=$P(ONCXML("PATH"),",",L-2,L)
234 ;---
235 I L2E="CS-RESPONSE,TABLE" D Q
236 . S ONCTBIEN=+$O(@ONCXML@(" "),-1)+1
237 . S ONCTBDSC="",ONCTBROW=0
238 . S (ONCXML("FN"),ONCXML("TN"))=0
239 ;---
240 I L2E="ROWS,ROW" D Q
241 . S ONCXML("ROWCODE")="",ONCXML("AC")=1
242 . S ONCTBROW=ONCTBROW+1
243 ;---
244 I L2E="ROW,AC" S ONCXML("AC")=ONCXML("AC")+1 Q
245 I L3E="ROW,DESCR,P" K ^UTILITY($J,"W") Q
246 ;---
247 I (L2E="NOTES,FN")!(L2E="NOTES,TN") D Q
248 . S SUBS=$P(L2E,",",2),ONCXML(SUBS)=$G(ONCXML(SUBS))+1 ; Note number
249 I L3E="NOTES,FN,P" K ^UTILITY($J,"W") Q
250 I L3E="NOTES,TN,P" K ^UTILITY($J,"W") Q
251 Q
252 ;
253 ;***** RETURNS THE TABLE TITLE AND SUBTITLE
254 ;
255 ; [.ONCSAPI] Reference to the API descriptor (see the ^ONCSAPI)
256 ;
257 ; SITE Primary site
258 ; HIST Histology
259 ; TABLE Table number (see the ^ONCSAPI)
260 ;
261 ; Tables other than site specific factors (10-15) usually do not
262 ; have subtitles.
263 ;
264 ; Return Values:
265 ; <0 Error code
266 ; 0 0^Title^Subtitle
267 ;
268TBLTTL(ONCSAPI,SITE,HIST,TABLE) ;
269 N TBLIEN
270 ;--- Make sure that table info is loaded
271 S TBLIEN=$$GETCSTBL(.ONCSAPI,SITE,HIST,TABLE) Q:TBLIEN<0 TBLIEN
272 ;--- Return the table subtitle
273 Q 0_U_$P($G(^XTMP("ONCSAPI","TABLES",TBLIEN,0)),U,5,6)
274 ;
275 ;***** TEXT CALLBACK FOR THE SAX PARSER
276 ;
277 ; TXT Line of unmarked text
278 ;
279TEXT(TXT) ;
280 N I,L,L2E,L3E,TMP
281 S L=$L(ONCXML("PATH"),","),L2E=$P(ONCXML("PATH"),",",L-1,L)
282 S L3E=$P(ONCXML("PATH"),",",L-2,L)
283 ;---
284 I L2E="CS-RESPONSE,SCHEMA" S ONCXML("SCHEMA")=TXT Q
285 ;--- Table descriptor
286 I L2E="TABLE,NUMBER" S $P(ONCTBDSC,U,3)=$P(ONCTBDSC,U,3)_TXT Q
287 I L2E="TABLE,PATTERN" S $P(ONCTBDSC,U,4)=$P(ONCTBDSC,U,4)_TXT Q
288 I L2E="TABLE,SUBTITLE" S $P(ONCTBDSC,U,6)=$P(ONCTBDSC,U,6)_TXT Q
289 I L2E="TABLE,TITLE" S $P(ONCTBDSC,U,5)=$P(ONCTBDSC,U,5)_TXT Q
290 ;--- Codes
291 I L2E="ROW,AC" D Q
292 . S $P(@ONCXML@(ONCTBIEN,ONCTBROW,1),U,ONCXML("AC"))=TXT
293 I L2E="ROW,CODE" D Q
294 . S ONCXML("ROWCODE")=ONCXML("ROWCODE")_TXT
295 ;--- Row description
296 I L3E="ROW,DESCR,P" D WW(.TXT,70) Q
297 ;--- Notes
298 I L3E="NOTES,FN,P" D WW(.TXT,75) Q
299 I L3E="NOTES,TN,P" D WW(.TXT,75) Q
300 ;--- Default processing
301 D TEXT^ONCSAPIX(TXT)
302 Q
303 ;
304 ;***** REFORMATS THE TEXT AND WRAPS THE LINES
305WW(TXT,DIWR) ;
306 N CR,DIWF,DIWL,I,ONCI1,ONCI2,LF,X
307 S DIWF="|",DIWL=1
308 S ONCI1=1,(ONCI2,L)=$L(TXT)
309 F D Q:ONCI2>L S ONCI1=ONCI2
310 . S ONCI2=$F(TXT,$C(13),ONCI1),(CR,LF)=0
311 . I ONCI2>0 S CR=1 S:$A(TXT,ONCI2)=10 LF=1,ONCI2=ONCI2+1
312 . E D
313 . . S ONCI2=$F(TXT,$C(10),ONCI1)
314 . . I ONCI2>0 S LF=1
315 . . E S ONCI2=L+1
316 . F I=ONCI1:1:ONCI2 Q:$E(TXT,I)'=" "
317 . S X=$E(TXT,(I+ONCI1)\2,ONCI2-1-CR-LF)
318 . D ^DIWP
319 Q
Note: See TracBrowser for help on using the repository browser.