source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCX10.m@ 1154

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

initial load of WorldVistAEHR
File size: 5.7 KB
RevLine 
[613]1ONCX10 ;HCIOFO/SG - HTTP 1.0 CLIENT ; 6/20/06 9:29am
2 ;;2.11;ONCOLOGY;**40,41,46**;Mar 07, 1995;Build 39
3 ;
4 Q
5 ;
6 ;***** GETS THE DATA FROM THE PROVIDED URL USING HTTP 1.0
7 ;
8 ; URL URL (http://host:port/path)
9 ;
10 ; [ONC8FLG] Timeout and flags to control processing
11 ; If a value of this parameter starts from a number
12 ; then this number is used as a value of the timeout
13 ; (in seconds). Otherwise, the default value of 3
14 ; seconds is used.
15 ;
16 ; [ONC8RDAT] Closed root of the variable where the message
17 ; body is returned. Data is stored in consecutive
18 ; nodes (numbers starting from 1). If a line is
19 ; longer than 245 characters, only 245 characters
20 ; are stored in the corresponding node. After that,
21 ; overflow sub-nodes are created. For example:
22 ;
23 ; @ONC8DATA@(1)="<html>"
24 ; @ONC8DATA@(2)="<head><title>VistA</title></head>"
25 ; @ONC8DATA@(3)="<body>"
26 ; @ONC8DATA@(4)="<p>"
27 ; @ONC8DATA@(5)="Beginning of a very long line"
28 ; @ONC8DATA@(5,1)="Continuation #1 of the long line"
29 ; @ONC8DATA@(5,2)="Continuation #2 of the long line"
30 ; @ONC8DATA@(5,...)=...
31 ; @ONC8DATA@(6)="</p>"
32 ; ...
33 ;
34 ; [.ONC8RHDR] Reference to a local variable where the parsed
35 ; headers are returned. Header names are converted to
36 ; upper case; the values are left "as is". The root
37 ; node contains the status line. For example:
38 ;
39 ; ONC8HDR="HTTP/1.0 200 OK"
40 ; ONC8HDR("CACHE-CONTROL")="private"
41 ; ONC8HDR("CONNECTION")="Keep-Alive"
42 ; ONC8HDR("CONTENT-LENGTH")="2690"
43 ; ONC8HDR("CONTENT-TYPE")="text/html"
44 ; ONC8HDR("DATE")="Fri, 26 Sep 2003 16:04:10 GMT"
45 ; ONC8HDR("SERVER")="GWS/2.1"
46 ;
47 ; [ONC8SDAT] Closed root of a variable containing body of the
48 ; request message. Data should be formatted as
49 ; described earlier (see the ONC8RDAT parameter).
50 ;
51 ; NOTE: If this parameter is defined, not empty, and the
52 ; referenced array contains data then the POST request
53 ; is generated. Otherwise, the GET request is sent.
54 ;
55 ; [.ONC8SHDR] Reference to a local variable containing header
56 ; values, which will be added to the request.
57 ;
58 ; [REDIR] This IS NOT a published parameter. It is used
59 ; internally to limit number of redirections.
60 ;
61 ; Return values:
62 ;
63 ; <0 Error Descriptor
64 ; (see the $$ERROR^ONCXERR for descriptor structure
65 ; and the MSGLIST^ONCXERR for list of error)
66 ;
67 ; >0 HTTP Status Code^Description
68 ;
69 ; Most common HTTP status codes:
70 ;
71 ; 200 Ok
72 ;
73 ; 301 Moved Permanently (The application should either
74 ; automatically update the URL with the new one from
75 ; the Location response header or instruct the user
76 ; how to do this).
77 ;
78 ; 302 Moved Temporarily (The application should continue
79 ; using the original URL).
80 ;
81 ; NOTE: You will not see this code for GET requests.
82 ; They are redirected automatically.
83 ;
84 ; 303 See Other (The resource has moved to another URL
85 ; given by the Location response header, and should
86 ; be automatically retrieved by the client using the
87 ; GET method. This is often used by a CGI script to
88 ; redirect the client to an existing file).
89 ;
90 ; NOTE: You will not see this status code because it
91 ; is handled automatically inside the function.
92 ;
93 ; 400 Bad Request
94 ;
95 ; 404 Not Found
96 ;
97 ; 500 Server Error (An unexpected server error. The most
98 ; common cause is a server-side script that has bad
99 ; syntax, fails, or otherwise can't run correctly).
100 ;
101 ; See the http://www.faqs.org/rfcs/rfc1945.html for more details.
102 ;
103GETURL(URL,ONC8FLG,ONC8RDAT,ONC8RHDR,ONC8SDAT,ONC8SHDR,REDIR) ;
104 N $ESTACK,$ETRAP,HOST,I,IP,IPADDR,PATH,PORT,RQS,STATUS,X
105 S ONC8FLG=$G(ONC8FLG) S:ONC8FLG'?1.N.E ONC8FLG="3"_ONC8FLG
106 S I=$$PARSE^ONCXURL(URL,.HOST,.PORT,.PATH) Q:I<0 I
107 ;--- Check the host name/address
108 I HOST'?1.3N3(1"."1.3N) D Q:IPADDR="" $$ERROR^ONCXERR(-2,,HOST)
109 . ;--- Resolve the host name into IP address(es)
110 . S IPADDR=$$ADDRESS^XLFNSLK(HOST) Q:IPADDR=""
111 . ;--- Check for the Host header value
112 . S I=""
113 . F S I=$O(ONC8SHDR(I)) Q:(I="")!($$UP^XLFSTR(I)="HOST")
114 . S:I="" ONC8SHDR("Host")=HOST
115 E S IPADDR=HOST
116 ;--- Connect to the host
117 F I=1:1 S IP=$P(IPADDR,",",I) Q:IP="" D Q:'$G(POP)
118 . D CALL^%ZISTCP(IP,PORT,+ONC8FLG)
119 Q:$G(POP) $$ERROR^ONCXERR(-3,,IPADDR)
120 ;--- Perform the transaction
121 K STATUS D S:'$D(STATUS) STATUS=$$ERROR^ONCXERR(-6)
122 . ;--- Setup the error processing
123 . S X="ERRTRAP^ONCX10",@^%ZOSF("TRAP"),$ETRAP=""
124 . ;--- Send the request and get the response
125 . S RQS=$$REQUEST^ONCX10A(PATH,$G(ONC8SDAT),.ONC8SHDR)
126 . I RQS<0 S STATUS=RQS Q
127 . S STATUS=$$RECEIVE^ONCX10A(+ONC8FLG,$G(ONC8RDAT),.ONC8RHDR)
128 ;--- Close the socket
129 D CLOSE^%ZISTCP
130 ;--- Redirect if requested by the server
131 S I=+STATUS
132 I (I\100)=3 D:$S(I=303:1,I=301:0,1:RQS="GET")
133 . I $G(REDIR)>5 S STATUS=$$ERROR^ONCXERR(-5) Q
134 . S URL=$G(ONC8RHDR("LOCATION"))
135 . I URL="" S STATUS=$$ERROR^ONCXERR(-4) Q
136 . I RQS="POST" N ONC8SDAT ; Force the GET request
137 . S STATUS=$$GETURL(URL,ONC8FLG,$G(ONC8RDAT),.ONC8RHDR,$G(ONC8SDAT),.ONC8SHDR,$G(REDIR)+1)
138 ;--- Return the status
139 Q STATUS
140 ;
141ERRTRAP D @^%ZOSF("ERRTN") Q
Note: See TracBrowser for help on using the repository browser.