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