source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCSAPIR.m@ 1259

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

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1ONCSAPIR ;Hines OIFO/SG - COLLABORATIVE STAGING (REQUEST) ; 2/8/07 8:28am
2 ;;2.11;ONCOLOGY;**40,41,44,47**;Mar 07, 1995;Build 19
3 ;
4 ; ONC8DST ------------- DESCRIPTOR OF THE DESTINATION BUFFER
5 ; (a parameter of HEADER, PUT, and TRAILER)
6 ;
7 ; ONC8DST( Closed root of the destination buffer
8 ; "PTR") Pointer in the destination buffer
9 ; "PTRC") Continuation pointer (optional)
10 ; "REQ") Name of the root tag of the request
11 ;
12 Q
13 ;
14 ;***** APPENDS THE STRING TO THE LAST LINE OF THE DESTINATION BUFFER
15 ;
16 ; .ONC8DST Reference to a descriptor of the destination buffer.
17 ;
18 ; STR String
19 ;
20 ; [NOENC] Disable XML encoding (enabled by default)
21 ;
22 ; This procedure appends the string as the continuation node
23 ; to the last line added by the PUT^ONCSAPIR.
24 ;
25APPEND(ONC8DST,STR,NOENC) ;
26 Q:$G(ONC8DST("PTR"))'>0
27 N ENCSTR,I1,I2,S1
28 S ENCSTR=$S('$G(NOENC):$$SYMENC^MXMLUTL(STR),1:STR)
29 S I2=0
30 F S I1=I2+1,I2=I1+249,S1=$E(ENCSTR,I1,I2) Q:S1="" D
31 . S ONC8DST("PTRC")=$G(ONC8DST("PTRC"))+1
32 . S @ONC8DST@(ONC8DST("PTR"),ONC8DST("PTRC"))=S1
33 Q
34 ;
35 ;***** CHECKS FOR PARSING AND WEB SERVICE ERRORS
36 ;
37 ; .ONCXML Reference to the XML parsing descriptor
38 ;
39 ; [ONC8INFO] Closed root of the variable that contains
40 ; additional information related to the error
41 ;
42 ; Return values:
43 ;
44 ; <0 Error Descriptor
45 ; 0 Ok
46 ; 1 Warning(s)
47 ;
48CHKERR(ONCXML,ONC8INFO) ;
49 N RC,TMP
50 I $G(ONCXML("ERR"))>0 Q $$ERROR^ONCSAPIE(-5)
51 I $G(ONCXML("FAULTCODE"))'="" D Q RC
52 . S TMP=$TR($G(ONCXML("FAULTSTRING")),"^","~")
53 . S:TMP="" TMP="Unknown error"
54 . S RC="-2"_U_ONCXML("FAULTCODE")_": "_TMP
55 . D STORE^ONCSAPIE(RC,$G(ONC8INFO))
56 . ;--- Error code -11 is returned by the web-service if the
57 . ; CStage_calculate function calculated only some staging
58 . ;--- values and returned warning(s).
59 . S:+$G(ONCXML("RC"))=-11 RC=1
60 Q 0
61 ;
62 ;***** STORES THE REQUEST HEADER INTO THE DESTINATION BUFFER
63 ;
64 ; .ONC8DST Reference to a descriptor of the destination buffer.
65 ;
66 ; REQUEST Name of the root tag of the request.
67 ;
68 ; [.ATTS] Reference to a local variable that stores a list
69 ; of attribute values (ATTS(name)=value).
70 ;
71HEADER(ONC8DST,REQUEST,ATTS) ;
72 ;;<soap:Envelope xmlns:soap="http://www.w3.org/2001/12/soap-envelope"
73 ;; soap:encodingStyle="http://www.w3.org/2001/12/soap-encoding">
74 ;;<soap:Body>
75 ;
76 N I,TAG,TMP
77 S ONC8DST("PTR")=0 K @ONC8DST
78 D PUT(.ONC8DST,,$$XMLHDR^MXMLUTL())
79 F I=1:1 S TMP=$P($T(HEADER+I),";;",2) Q:TMP="" D
80 . D PUT(.ONC8DST,,TMP)
81 S TAG=REQUEST,I=""
82 F S I=$O(ATTS(I)) Q:I="" D
83 . S TAG=TAG_" "_I_"="""_$$SYMENC^MXMLUTL(ATTS(I))_""""
84 S TAG=TAG_" ver=""2.0"" xmlns=""http://websrv.oncology.med.va.gov"""
85 D PUT(.ONC8DST,TAG,,1)
86 S ONC8DST("REQ")=REQUEST
87 Q
88 ;
89 ;***** CONVERTS INPUT PARAMETERS INTO XML FORMAT
90 ;
91 ; ONC8DST Closed root of the destination buffer
92 ;
93 ; REQUEST Name of the root tag of the request.
94 ;
95 ; [.INPUT] Reference to a local variable containg
96 ; input parameters.
97 ;
98 ; Return values:
99 ;
100 ; <0 Error Descriptor
101 ; 0 Ok
102 ;
103PARAMS(ONC8DST,REQUEST,INPUT) ;
104 N I,NAME,VAL
105 D HEADER(.ONC8DST,REQUEST)
106 ;---
107 S NAME=""
108 F S NAME=$O(INPUT(NAME)) Q:NAME="" D
109 . S VAL=$G(INPUT(NAME)) D:VAL'="" PUT(.ONC8DST,NAME,VAL)
110 ;---
111 D TRAILER(.ONC8DST)
112 Q 0
113 ;
114 ;***** ADDS THE ELEMENT/TEXT TO THE DESTINATION BUFFER
115 ;
116 ; .ONC8DST Reference to a descriptor of the destination buffer.
117 ;
118 ; [NAME] Name of the element. If omitted or empty then the
119 ; text line defined by the second parameter is added
120 ; to the buffer.
121 ;
122 ; [VAL] Value of the element.
123 ;
124 ; [TAGONLY] Ignore the value and output only the tag defined
125 ; by the NAME parameter
126 ;
127PUT(ONC8DST,NAME,VAL,TAGONLY) ;
128 S (ONC8DST("PTR"),PTR)=ONC8DST("PTR")+1 K ONC8DST("PTRC")
129 I $G(NAME)="" S @ONC8DST@(PTR)=$G(VAL) Q
130 I $G(TAGONLY) S @ONC8DST@(PTR)="<"_NAME_">" Q
131 I $G(VAL)="" S @ONC8DST@(PTR)="<"_NAME_"/>" Q
132 S @ONC8DST@(PTR)="<"_NAME_">"_$$SYMENC^MXMLUTL(VAL)_"</"_NAME_">"
133 Q
134 ;
135 ;***** SENDS THE REQUEST AND GETS THE RESPONSE
136 ;
137 ; URL URL (http://host:port/path)
138 ;
139 ; ONC8RSP Closed root of the variable where the
140 ; response text will be returned.
141 ;
142 ; [ONC8REQ] Closed root of the variable containing
143 ; the text of the request.
144 ;
145 ; Return Values:
146 ; 0 Ok
147 ; <0 Error code
148 ;
149REQUEST(URL,ONC8RSP,ONC8REQ) ;
150 N HS,ONCINFO,ONCRHDR,ONCSHDR,RC,REPCNT,REPEAT,TMP
151 ;--- Prepare the request header
152 S ONCSHDR("Content-Type")="text/xml"
153 ;---
154 S (RC,REPCNT)=0 D
155 . F S REPEAT=0 D Q:'REPEAT
156 . . ;--- Call the web service
157 . . S RC=$$GETURL^ONCX10(URL,60,ONC8RSP,.ONCRHDR,$G(ONC8REQ),.ONCSHDR)
158 . . S HS=+RC Q:HS=200
159 . . ;--- Temporary redirection
160 . . I HS=302 D Q
161 . . . S REPCNT=REPCNT+1
162 . . . I REPCNT>5 S RC=$$ERROR^ONCSAPIE(-12,,REPCNT) Q
163 . . . S URL=$G(ONCRHDR("LOCATION"))
164 . . . I URL?." " S RC=$$ERROR^ONCSAPIE(-18) Q
165 . . . D ERROR^ONCSAPIE(-7,,URL) S REPEAT=1,RC=0
166 . . ;--- Permanent redirection
167 . . I HS=301 D Q
168 . . . S REPCNT=REPCNT+1
169 . . . I REPCNT>5 S RC=$$ERROR^ONCSAPIE(-12,,REPCNT) Q
170 . . . S URL=$G(ONCRHDR("LOCATION"))
171 . . . I URL?." " S RC=$$ERROR^ONCSAPIE(-18) Q
172 . . . S RC=$$UPDCSURL^ONCSAPIU(URL) Q:RC<0
173 . . . D ERROR^ONCSAPIE(-8,,URL) S REPEAT=1,RC=0
174 . . ;--- Record the HTTP client error
175 . . K ONCINFO S ONCINFO(1)=$P(RC,U,2)_" ("_$P(RC,U)_")"
176 . . S RC=$$ERROR^ONCSAPIE(-10,.ONCINFO)
177 . Q:RC<0
178 ;---
179 Q $S(RC<0:RC,1:0)
180 ;
181 ;***** APPENDS THE REQUEST TRAILER TO THE DESTINATION BUFFER
182 ;
183 ; .ONC8DST Reference to a descriptor of the destination buffer.
184 ;
185TRAILER(ONC8DST) ;
186 S ONC8DST("PTR")=+$O(@ONC8DST@(""),-1)
187 D PUT(.ONC8DST,"/"_ONC8DST("REQ"),,1)
188 D PUT(.ONC8DST,"/soap:Body",,1)
189 D PUT(.ONC8DST,"/soap:Envelope",,1)
190 Q
Note: See TracBrowser for help on using the repository browser.