XTHCURL ;HCIOFO/SG - HTTP 1.0 CLIENT (URL TOOLS) ; Oct 01, 2025 10:54
;;7.3;TOOLKIT;**123,162**;Apr 25, 1995;Build 4
;Per VA Directive 6402, this routine should not be modified.
Q
;
;***** ENCODES THE STRING
;
; STR String to be encoded
;
ENCODE(STR) ;
N CH,I
I $G(STR)="" Q "" ;XT162
F I=1:1 S CH=$E(STR,I) Q:CH="" I CH?1CP D
. I CH="." Q
. I CH=" " S $E(STR,I)="+" Q
. S $E(STR,I)="%"_$$RJ^XLFSTR($$CNV^XLFUTL($A(CH),16),2,"0"),I=I+2
Q STR
;
;##### CREATES URL FROM COMPONENTS
;
; HOST Host name
; [PORT] Port number (80, by default)
; [PATH] Resource path ("/", by default)
;
; [.QUERY] Reference to a local variable containing values of
; the query parameters: QUERY(Name)=Value.
;
; Return values:
; <0 Error Descriptor
; ... Resulting URL
;
MAKEURL(HOST,PORT,PATH,QUERY) ;
N NAME,QSTR,VAL
I $G(HOST)=""!('$D(QUERY)) Q "" ;XT162
I HOST'["://" S HOST=$S(PORT=443:"https://",1:"http://")_HOST ;XT162
S PORT=$S($G(PORT)>0:":"_(+PORT),1:"")
;---
S (NAME,QSTR)=""
F S NAME=$O(QUERY(NAME)) Q:NAME="" D
. S VAL=$G(QUERY(NAME))
. S QSTR=QSTR_"&"_$$ENCODE(NAME)_"="_$$ENCODE(VAL)
S:QSTR'="" $E(QSTR,1)="?"
;---
S:$G(PATH)="" PATH="/"
Q HOST_PORT_$$NORMPATH($G(PATH)_QSTR)
;
;##### RETURNS "NORMALIZED" PATH
;
; PATH Source path
;
NORMPATH(PATH) ;
;--- Make sure the path has a leading slash if it
;--- is not empty and has no query string.
I $E(PATH,1)'="/",PATH'="" S:$E(PATH,1)'="?" PATH="/"_PATH ;XT162
;--- The logic to append a trailing slash has been removed as it
;--- can break modern RESTful URLs (e.g. /api/resource/123)
Q PATH
;
;##### PARSES THE URL INTO COMPONENTS
;
; URL Source URL
;
; .HOST Reference to a local variable for the host name
; .PORT Reference to a local variable for the port number
; .PATH Reference to a local variable for the path
;
; Return values:
; <0 Error Descriptor
; 0 Ok
;
PARSEURL(URL,HOST,PORT,PATH) ;
;XT162 Updated entire function to also handle https
N ISHTTPS
I $G(URL)="" Q "-1^No URL to parse."
S ISHTTPS=($$UP^XLFSTR(URL)?1"HTTPS://".E)
S:$F(URL,"://") URL=$P(URL,"://",2,999)
S HOST=$TR($P(URL,"/")," ")
S PATH=$$NORMPATH($P(URL,"/",2,999))
S PORT=$P(HOST,":",2),HOST=$P(HOST,":")
Q:HOST?." " "-1^Missing host name"
I PORT'>0 S PORT=$S(ISHTTPS:443,1:80)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTHCURL 2513 printed Sep 17, 2026@21:27:08 Page 2
XTHCURL ;HCIOFO/SG - HTTP 1.0 CLIENT (URL TOOLS) ; Oct 01, 2025 10:54
+1 ;;7.3;TOOLKIT;**123,162**;Apr 25, 1995;Build 4
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;***** ENCODES THE STRING
+6 ;
+7 ; STR String to be encoded
+8 ;
ENCODE(STR) ;
+1 NEW CH,I
+2 ;XT162
IF $GET(STR)=""
QUIT ""
+3 FOR I=1:1
SET CH=$EXTRACT(STR,I)
if CH=""
QUIT
IF CH?1CP
Begin DoDot:1
+4 IF CH="."
QUIT
+5 IF CH=" "
SET $EXTRACT(STR,I)="+"
QUIT
+6 SET $EXTRACT(STR,I)="%"_$$RJ^XLFSTR($$CNV^XLFUTL($ASCII(CH),16),2,"0")
SET I=I+2
End DoDot:1
+7 QUIT STR
+8 ;
+9 ;##### CREATES URL FROM COMPONENTS
+10 ;
+11 ; HOST Host name
+12 ; [PORT] Port number (80, by default)
+13 ; [PATH] Resource path ("/", by default)
+14 ;
+15 ; [.QUERY] Reference to a local variable containing values of
+16 ; the query parameters: QUERY(Name)=Value.
+17 ;
+18 ; Return values:
+19 ; <0 Error Descriptor
+20 ; ... Resulting URL
+21 ;
MAKEURL(HOST,PORT,PATH,QUERY) ;
+1 NEW NAME,QSTR,VAL
+2 ;XT162
IF $GET(HOST)=""!('$DATA(QUERY))
QUIT ""
+3 ;XT162
IF HOST'["://"
SET HOST=$SELECT(PORT=443:"https://",1:"http://")_HOST
+4 SET PORT=$SELECT($GET(PORT)>0:":"_(+PORT),1:"")
+5 ;---
+6 SET (NAME,QSTR)=""
+7 FOR
SET NAME=$ORDER(QUERY(NAME))
if NAME=""
QUIT
Begin DoDot:1
+8 SET VAL=$GET(QUERY(NAME))
+9 SET QSTR=QSTR_"&"_$$ENCODE(NAME)_"="_$$ENCODE(VAL)
End DoDot:1
+10 if QSTR'=""
SET $EXTRACT(QSTR,1)="?"
+11 ;---
+12 if $GET(PATH)=""
SET PATH="/"
+13 QUIT HOST_PORT_$$NORMPATH($GET(PATH)_QSTR)
+14 ;
+15 ;##### RETURNS "NORMALIZED" PATH
+16 ;
+17 ; PATH Source path
+18 ;
NORMPATH(PATH) ;
+1 ;--- Make sure the path has a leading slash if it
+2 ;--- is not empty and has no query string.
+3 ;XT162
IF $EXTRACT(PATH,1)'="/"
IF PATH'=""
if $EXTRACT(PATH,1)'="?"
SET PATH="/"_PATH
+4 ;--- The logic to append a trailing slash has been removed as it
+5 ;--- can break modern RESTful URLs (e.g. /api/resource/123)
+6 QUIT PATH
+7 ;
+8 ;##### PARSES THE URL INTO COMPONENTS
+9 ;
+10 ; URL Source URL
+11 ;
+12 ; .HOST Reference to a local variable for the host name
+13 ; .PORT Reference to a local variable for the port number
+14 ; .PATH Reference to a local variable for the path
+15 ;
+16 ; Return values:
+17 ; <0 Error Descriptor
+18 ; 0 Ok
+19 ;
PARSEURL(URL,HOST,PORT,PATH) ;
+1 ;XT162 Updated entire function to also handle https
+2 NEW ISHTTPS
+3 IF $GET(URL)=""
QUIT "-1^No URL to parse."
+4 SET ISHTTPS=($$UP^XLFSTR(URL)?1"HTTPS://".E)
+5 if $FIND(URL,"
SET URL=$PIECE(URL,"://",2,999)
+6 SET HOST=$TRANSLATE($PIECE(URL,"/")," ")
+7 SET PATH=$$NORMPATH($PIECE(URL,"/",2,999))
+8 SET PORT=$PIECE(HOST,":",2)
SET HOST=$PIECE(HOST,":")
+9 if HOST?." "
QUIT "-1^Missing host name"
+10 IF PORT'>0
SET PORT=$SELECT(ISHTTPS:443,1:80)
+11 QUIT 0
