| 1 | ONCX10 ;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 |  ;
 | 
|---|
| 103 | GETURL(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 |  ;
 | 
|---|
| 141 | ERRTRAP D @^%ZOSF("ERRTN")  Q
 | 
|---|