XTHC10A ;HCIOFO/SG - HTTP 1.0 CLIENT (TOOLS) ;2018-07-25 4:15 PM
;;7.3;TOOLKIT;**123,144**;Apr 25, 1995;Build 1
;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
;+++++ APPENDS RECEIVED PIECE OF DATA TO THE DESTINATION BUFFER
;
; BUF Received data
;
; [NEWLINE] Start a new line after appending the data
;
; The XT8BUF, XT8DST, XT8IS, XT8MBL, XT8PTR, and XT8SL
; variables must be properly initialized before calling this
; procedure (see the $$RECEIVE^XTHC10A for details).
;
APPEND(BUF,NEWLINE) ;
N BASE,L
S L=$L(BUF) S:$A(BUF,L)=13 L=L-1
;--- Append the data
I L'<XT8SL D
. S XT8BUF=XT8BUF_$E(BUF,1,XT8SL),L=L-XT8SL
. S BASE=1
. F D Q:L'>0
. . I 'XT8IS S @XT8DST@(XT8PTR)=XT8BUF
. . E S @XT8DST@(XT8PTR,XT8IS)=XT8BUF
. . S BASE=BASE+XT8SL,XT8IS=XT8IS+1,XT8SL=XT8MBL
. . S XT8BUF=$E(BUF,BASE,BASE+XT8SL-1),L=L-XT8SL
. S XT8SL=-L
E S XT8BUF=XT8BUF_$E(BUF,1,L),XT8SL=XT8SL-L
;--- Flush the buffer and start a new line
I $G(NEWLINE) D S XT8BUF="",XT8IS=0,XT8PTR=XT8PTR+1,XT8SL=XT8MBL
. I 'XT8IS S @XT8DST@(XT8PTR)=XT8BUF Q
. S @XT8DST@(XT8PTR,XT8IS)=XT8BUF
Q
;
;+++++ CALCULATES NUMBER OF BYTES IN THE MESSAGE BODY
;
; XT8DATA Closed root of a variable containing body
; of the message
;
; NLS Length of the line terminator(s)
;
DATASIZE(XT8DATA,NLS) ;
N I,J,SIZE
S SIZE=0,I=""
F S I=$O(@XT8DATA@(I)) Q:I="" D S SIZE=SIZE+NLS
. S SIZE=SIZE+$L($G(@XT8DATA@(I)))
. S J=""
. F S J=$O(@XT8DATA@(I,J)) Q:J="" D
. . S SIZE=SIZE+$L($G(@XT8DATA@(I,J)))
Q $S(SIZE>0:SIZE-NLS,1:0)
;
;+++++ PROCESSES THE HTTP HEADER
;
; .XT8H Reference to a local array containing
; the raw header data
;
; .XT8HDR Reference to a local variable where the parsed
; header will be returned
;
; Return values:
; <0 Error Descriptor (see the $$ERROR^XTERROR)
; >0 HTTP Status Code^Description
;
N BUF,I,NAME,TAB,TMP
S XT8HDR=$$NORMSTAT($G(XT8H(1))),TAB=$C(9)
F I=2:1 S BUF=$TR($G(XT8H(I)),TAB," ") Q:BUF="" D
. ;--- Continuation of the previous header line
. I $E(BUF,1)=" " D:$G(NAME)'="" Q
. . S TMP=$$TRIM^XLFSTR(BUF)
. . S:TMP'="" XT8HDR(NAME)=XT8HDR(NAME)_" "_TMP
. ;--- New header line
. S NAME=$$UP^XLFSTR($$TRIM^XLFSTR($P(BUF,":")))
. S:NAME'="" XT8HDR(NAME)=$$TRIM^XLFSTR($P(BUF,":",2,999))
Q $P(XT8HDR," ",2)_U_$P(XT8HDR," ",3,999)
;
;+++++ NORMALIZES THE HTTP STATUS LINE
NORMSTAT(STATUS) ;
N I,J1,J2,TMP
;--- Remove leading and trailing spaces
S STATUS=$$TRIM^XLFSTR(STATUS)
;--- Replace groups of consecutive spaces with single spaces
S J2=1
F I=1,2 D Q:'J1
. S J1=$F(STATUS," ",J2) Q:'J1
. F J2=J1:1 Q:$E(STATUS,J2)'=" "
. S $E(STATUS,J1,J2-1)=""
;--- Return normalized status line
Q STATUS
;
;+++++ RECEIVES AN HTTP RESPONSE
;
; TIMEOUT Timeout value (in seconds) for TCP/IP input.
;
; [XT8DATA] Closed root of the variable where the message
; body is returned. See the $$GETURL^XTHC10
; for details.
;
; [.XT8HDR] Reference to a local variable where the parsed
; headers will be returned. See the $$GETURL^XTHC10
; for details.
;
RECEIVE(TIMEOUT,XT8DATA,XT8HDR) ;
;
; XT8BUF Work buffer where the current line is being built
;
; XT8DST Closed root of the current destination buffer used
; by the APPEND^XTHC10A
;
; XT8H Temporary buffer for the raw HTTP header
;
; XT8IS Subscript of the current continuation sub-node in
; the destination buffer (if 0 then the current main
; node is used)
;
; XT8MBL Maximum buffer length
;
; XT8PTR Subscript of the current node in the dest. buffer
;
; XT8SL Number of available bytes in the current (sub)node
;
N $ESTACK,$ETRAP,BLCHS,BUF,EXIT,I1,I2,MBL,RTO,STATUS,TMP,X,XT8BUF,XT8DST,XT8H,XT8IS,XT8MBL,XT8PTR,XT8SL
S BLCHS=$C(9,10,12,13)_" ",XT8MBL=245
K:$G(XT8DATA)'="" @XT8DATA K XT8HDR
S XT8BUF="",XT8IS=0,XT8PTR=1,XT8SL=XT8MBL
;
;=== Setup the error processing
;S X="RCVERR^XTHC10A",@^%ZOSF("TRAP"),$ETRAP=""
S $ET="D RCVERR^XTHC10A"
;
;=== Receive the header (until the first empty line)
U IO
S XT8DST="XT8H",(EXIT,RTO)=0
;F R BUF#XT8MBL:TIMEOUT S RTO='$T D Q:EXIT!RTO
F R BUF#XT8MBL:TIMEOUT S RTO='$T D Q:EXIT!RTO
. N ISCONT S ISCONT=XT8BUF]"" ;*p144-(1/0)reads a continuation of a previous read?
. S I1=1
. F S I2=$F(BUF,$C(10),I1) Q:'I2 D Q:EXIT
. . S TMP=$E(BUF,I1,I2-2) D APPEND(TMP,1) S I1=I2
. . I $TR(TMP,BLCHS)="",'ISCONT S EXIT=1 ;*p144-terminate header readings only if this header isn't a continuation
. . S ISCONT=0 ;*p144-after the first time through, it's not a continuation
. D:'EXIT APPEND($E(BUF,I1,XT8MBL))
;--- A header must end with an empty line.
;--- Otherwise, there was a timeout.
Q:'EXIT $$ERROR^XTHC10(-7)
;--- Remove ending of the header from the buffer. The buffer
;--- can contain beginning of the message body.
S:I1>1 $E(BUF,1,I1-1)=""
;--- Process the header
S STATUS=$$HEADER(.XT8H,.XT8HDR)
;
;=== Receive the message body
D:$G(XT8DATA)'=""
. N CNTLEN,RDLEN
. S RDLEN=XT8MBL
. ;--- Check for Content-Length header
. I $D(XT8HDR("CONTENT-LENGTH")) D Q:CNTLEN'>0
. . S CNTLEN=+XT8HDR("CONTENT-LENGTH")
. . S:CNTLEN<XT8MBL RDLEN=CNTLEN
. E S CNTLEN=-1
. ;--- Read the content
. S XT8DST=XT8DATA,RTO=0
. F D Q:'CNTLEN!RTO R BUF#RDLEN:TIMEOUT S RTO='$T
. . D:CNTLEN>0
. . . S CNTLEN=CNTLEN-$L(BUF) S:CNTLEN<0 CNTLEN=0
. . . S:CNTLEN<RDLEN RDLEN=CNTLEN
. . S I1=1
. . F S I2=$F(BUF,$C(10),I1) Q:'I2 D
. . . D APPEND($E(BUF,I1,I2-2),1) S I1=I2
. . D APPEND($E(BUF,I1,XT8MBL))
;
;=== Flush the buffers and process the header (only if necessary)
RCVERR U IO(0)
D APPEND("",1)
S:$G(STATUS)="" STATUS=$$HEADER(.XT8H,.XT8HDR)
I $L($EC) S $ECODE="" S $ETRAP="D UNW^%ZTER Q:$QUIT STATUS Q " S $ECODE=",U1,"
Q STATUS
;
;
;+++++ SENDS THE HTTP REQUEST
;
; URI Request URI
;
; [XT8DATA] Closed root of a variable containing body of the
; request message. If this parameter is defined, not
; empty, and the referenced variable is defined then
; the POST request is generated. Otherwise, the GET
; request is sent.
;
; [.XT8HDR] Reference to a local variable containing header
; values
;
; Return values:
; <0 Error Code^Description
; "GET" Ok
; "POST" Ok
;
REQUEST(URI,XT8DATA,XT8HDR) ;
N CRLF,DFLTHDR,I,J,STATUS
S CRLF=$C(13,10)
;
;=== Check for default header(s)
S DFLTHDR("CONTENT-LENGTH")=""
S DFLTHDR("CONTENT-TYPE")=""
S DFLTHDR("USER-AGENT")=""
S I=""
F S I=$O(XT8HDR(I)) Q:I="" K DFLTHDR($$UP^XLFSTR(I))
S:$D(DFLTHDR("USER-AGENT")) XT8HDR("User-Agent")="VistA/1.0"
;
;=== Send the request
U IO
I $G(XT8DATA)'="",$D(@XT8DATA)>1 S STATUS="POST" D
. S:$D(DFLTHDR("CONTENT-TYPE")) XT8HDR("Content-Type")="text/html"
. D:$D(DFLTHDR("CONTENT-LENGTH"))
. . S XT8HDR("Content-Length")=$$DATASIZE(XT8DATA,$L(CRLF))
. W "POST "_URI_" HTTP/1.0",CRLF,!
. ;--- Header
. S I=""
. F S I=$O(XT8HDR(I)) Q:I="" W I_": "_XT8HDR(I),CRLF,!
. ;--- Body
. S I=""
. F S I=$O(@XT8DATA@(I)) Q:I="" D
. . W CRLF,$G(@XT8DATA@(I)),!
. . S J=""
. . F S J=$O(@XT8DATA@(I,J)) Q:J="" W $G(@XT8DATA@(I,J)),!
E S STATUS="GET" D
. W "GET "_URI_" HTTP/1.0",CRLF,!
. S I=""
. F S I=$O(XT8HDR(I)) Q:I="" W I_": "_XT8HDR(I),CRLF,!
. W CRLF,!
;U $P
Q STATUS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTHC10A 7848 printed Oct 16, 2024@18:41:38 Page 2
XTHC10A ;HCIOFO/SG - HTTP 1.0 CLIENT (TOOLS) ;2018-07-25 4:15 PM
+1 ;;7.3;TOOLKIT;**123,144**;Apr 25, 1995;Build 1
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ;+++++ APPENDS RECEIVED PIECE OF DATA TO THE DESTINATION BUFFER
+7 ;
+8 ; BUF Received data
+9 ;
+10 ; [NEWLINE] Start a new line after appending the data
+11 ;
+12 ; The XT8BUF, XT8DST, XT8IS, XT8MBL, XT8PTR, and XT8SL
+13 ; variables must be properly initialized before calling this
+14 ; procedure (see the $$RECEIVE^XTHC10A for details).
+15 ;
APPEND(BUF,NEWLINE) ;
+1 NEW BASE,L
+2 SET L=$LENGTH(BUF)
if $ASCII(BUF,L)=13
SET L=L-1
+3 ;--- Append the data
+4 IF L'<XT8SL
Begin DoDot:1
+5 SET XT8BUF=XT8BUF_$EXTRACT(BUF,1,XT8SL)
SET L=L-XT8SL
+6 SET BASE=1
+7 FOR
Begin DoDot:2
+8 IF 'XT8IS
SET @XT8DST@(XT8PTR)=XT8BUF
+9 IF '$TEST
SET @XT8DST@(XT8PTR,XT8IS)=XT8BUF
+10 SET BASE=BASE+XT8SL
SET XT8IS=XT8IS+1
SET XT8SL=XT8MBL
+11 SET XT8BUF=$EXTRACT(BUF,BASE,BASE+XT8SL-1)
SET L=L-XT8SL
End DoDot:2
if L'>0
QUIT
+12 SET XT8SL=-L
End DoDot:1
+13 IF '$TEST
SET XT8BUF=XT8BUF_$EXTRACT(BUF,1,L)
SET XT8SL=XT8SL-L
+14 ;--- Flush the buffer and start a new line
+15 IF $GET(NEWLINE)
Begin DoDot:1
+16 IF 'XT8IS
SET @XT8DST@(XT8PTR)=XT8BUF
QUIT
+17 SET @XT8DST@(XT8PTR,XT8IS)=XT8BUF
End DoDot:1
SET XT8BUF=""
SET XT8IS=0
SET XT8PTR=XT8PTR+1
SET XT8SL=XT8MBL
+18 QUIT
+19 ;
+20 ;+++++ CALCULATES NUMBER OF BYTES IN THE MESSAGE BODY
+21 ;
+22 ; XT8DATA Closed root of a variable containing body
+23 ; of the message
+24 ;
+25 ; NLS Length of the line terminator(s)
+26 ;
DATASIZE(XT8DATA,NLS) ;
+1 NEW I,J,SIZE
+2 SET SIZE=0
SET I=""
+3 FOR
SET I=$ORDER(@XT8DATA@(I))
if I=""
QUIT
Begin DoDot:1
+4 SET SIZE=SIZE+$LENGTH($GET(@XT8DATA@(I)))
+5 SET J=""
+6 FOR
SET J=$ORDER(@XT8DATA@(I,J))
if J=""
QUIT
Begin DoDot:2
+7 SET SIZE=SIZE+$LENGTH($GET(@XT8DATA@(I,J)))
End DoDot:2
End DoDot:1
SET SIZE=SIZE+NLS
+8 QUIT $SELECT(SIZE>0:SIZE-NLS,1:0)
+9 ;
+10 ;+++++ PROCESSES THE HTTP HEADER
+11 ;
+12 ; .XT8H Reference to a local array containing
+13 ; the raw header data
+14 ;
+15 ; .XT8HDR Reference to a local variable where the parsed
+16 ; header will be returned
+17 ;
+18 ; Return values:
+19 ; <0 Error Descriptor (see the $$ERROR^XTERROR)
+20 ; >0 HTTP Status Code^Description
+21 ;
+1 NEW BUF,I,NAME,TAB,TMP
+2 SET XT8HDR=$$NORMSTAT($GET(XT8H(1)))
SET TAB=$CHAR(9)
+3 FOR I=2:1
SET BUF=$TRANSLATE($GET(XT8H(I)),TAB," ")
if BUF=""
QUIT
Begin DoDot:1
+4 ;--- Continuation of the previous header line
+5 IF $EXTRACT(BUF,1)=" "
if $GET(NAME)'=""
Begin DoDot:2
+6 SET TMP=$$TRIM^XLFSTR(BUF)
+7 if TMP'=""
SET XT8HDR(NAME)=XT8HDR(NAME)_" "_TMP
End DoDot:2
QUIT
+8 ;--- New header line
+9 SET NAME=$$UP^XLFSTR($$TRIM^XLFSTR($PIECE(BUF,":")))
+10 if NAME'=""
SET XT8HDR(NAME)=$$TRIM^XLFSTR($PIECE(BUF,":",2,999))
End DoDot:1
+11 QUIT $PIECE(XT8HDR," ",2)_U_$PIECE(XT8HDR," ",3,999)
+12 ;
+13 ;+++++ NORMALIZES THE HTTP STATUS LINE
NORMSTAT(STATUS) ;
+1 NEW I,J1,J2,TMP
+2 ;--- Remove leading and trailing spaces
+3 SET STATUS=$$TRIM^XLFSTR(STATUS)
+4 ;--- Replace groups of consecutive spaces with single spaces
+5 SET J2=1
+6 FOR I=1,2
Begin DoDot:1
+7 SET J1=$FIND(STATUS," ",J2)
if 'J1
QUIT
+8 FOR J2=J1:1
if $EXTRACT(STATUS,J2)'=" "
QUIT
+9 SET $EXTRACT(STATUS,J1,J2-1)=""
End DoDot:1
if 'J1
QUIT
+10 ;--- Return normalized status line
+11 QUIT STATUS
+12 ;
+13 ;+++++ RECEIVES AN HTTP RESPONSE
+14 ;
+15 ; TIMEOUT Timeout value (in seconds) for TCP/IP input.
+16 ;
+17 ; [XT8DATA] Closed root of the variable where the message
+18 ; body is returned. See the $$GETURL^XTHC10
+19 ; for details.
+20 ;
+21 ; [.XT8HDR] Reference to a local variable where the parsed
+22 ; headers will be returned. See the $$GETURL^XTHC10
+23 ; for details.
+24 ;
RECEIVE(TIMEOUT,XT8DATA,XT8HDR) ;
+1 ;
+2 ; XT8BUF Work buffer where the current line is being built
+3 ;
+4 ; XT8DST Closed root of the current destination buffer used
+5 ; by the APPEND^XTHC10A
+6 ;
+7 ; XT8H Temporary buffer for the raw HTTP header
+8 ;
+9 ; XT8IS Subscript of the current continuation sub-node in
+10 ; the destination buffer (if 0 then the current main
+11 ; node is used)
+12 ;
+13 ; XT8MBL Maximum buffer length
+14 ;
+15 ; XT8PTR Subscript of the current node in the dest. buffer
+16 ;
+17 ; XT8SL Number of available bytes in the current (sub)node
+18 ;
+19 NEW $ESTACK,$ETRAP,BLCHS,BUF,EXIT,I1,I2,MBL,RTO,STATUS,TMP,X,XT8BUF,XT8DST,XT8H,XT8IS,XT8MBL,XT8PTR,XT8SL
+20 SET BLCHS=$CHAR(9,10,12,13)_" "
SET XT8MBL=245
+21 if $GET(XT8DATA)'=""
KILL @XT8DATA
KILL XT8HDR
+22 SET XT8BUF=""
SET XT8IS=0
SET XT8PTR=1
SET XT8SL=XT8MBL
+23 ;
+24 ;=== Setup the error processing
+25 ;S X="RCVERR^XTHC10A",@^%ZOSF("TRAP"),$ETRAP=""
+26 SET $ETRAP="D RCVERR^XTHC10A"
+27 ;
+28 ;=== Receive the header (until the first empty line)
+29 USE IO
+30 SET XT8DST="XT8H"
SET (EXIT,RTO)=0
+31 ;F R BUF#XT8MBL:TIMEOUT S RTO='$T D Q:EXIT!RTO
+32 FOR
READ BUF#XT8MBL:TIMEOUT
SET RTO='$TEST
Begin DoDot:1
+33 ;*p144-(1/0)reads a continuation of a previous read?
NEW ISCONT
SET ISCONT=XT8BUF]""
+34 SET I1=1
+35 FOR
SET I2=$FIND(BUF,$CHAR(10),I1)
if 'I2
QUIT
Begin DoDot:2
+36 SET TMP=$EXTRACT(BUF,I1,I2-2)
DO APPEND(TMP,1)
SET I1=I2
+37 ;*p144-terminate header readings only if this header isn't a continuation
IF $TRANSLATE(TMP,BLCHS)=""
IF 'ISCONT
SET EXIT=1
+38 ;*p144-after the first time through, it's not a continuation
SET ISCONT=0
End DoDot:2
if EXIT
QUIT
+39 if 'EXIT
DO APPEND($EXTRACT(BUF,I1,XT8MBL))
End DoDot:1
if EXIT!RTO
QUIT
+40 ;--- A header must end with an empty line.
+41 ;--- Otherwise, there was a timeout.
+42 if 'EXIT
QUIT $$ERROR^XTHC10(-7)
+43 ;--- Remove ending of the header from the buffer. The buffer
+44 ;--- can contain beginning of the message body.
+45 if I1>1
SET $EXTRACT(BUF,1,I1-1)=""
+46 ;--- Process the header
+47 SET STATUS=$$HEADER(.XT8H,.XT8HDR)
+48 ;
+49 ;=== Receive the message body
+50 if $GET(XT8DATA)'=""
Begin DoDot:1
+51 NEW CNTLEN,RDLEN
+52 SET RDLEN=XT8MBL
+53 ;--- Check for Content-Length header
+54 IF $DATA(XT8HDR("CONTENT-LENGTH"))
Begin DoDot:2
+55 SET CNTLEN=+XT8HDR("CONTENT-LENGTH")
+56 if CNTLEN<XT8MBL
SET RDLEN=CNTLEN
End DoDot:2
if CNTLEN'>0
QUIT
+57 IF '$TEST
SET CNTLEN=-1
+58 ;--- Read the content
+59 SET XT8DST=XT8DATA
SET RTO=0
+60 FOR
Begin DoDot:2
+61 if CNTLEN>0
Begin DoDot:3
+62 SET CNTLEN=CNTLEN-$LENGTH(BUF)
if CNTLEN<0
SET CNTLEN=0
+63 if CNTLEN<RDLEN
SET RDLEN=CNTLEN
End DoDot:3
+64 SET I1=1
+65 FOR
SET I2=$FIND(BUF,$CHAR(10),I1)
if 'I2
QUIT
Begin DoDot:3
+66 DO APPEND($EXTRACT(BUF,I1,I2-2),1)
SET I1=I2
End DoDot:3
+67 DO APPEND($EXTRACT(BUF,I1,XT8MBL))
End DoDot:2
if 'CNTLEN!RTO
QUIT
READ BUF#RDLEN:TIMEOUT
SET RTO='$TEST
End DoDot:1
+68 ;
+69 ;=== Flush the buffers and process the header (only if necessary)
RCVERR USE IO(0)
+1 DO APPEND("",1)
+2 if $GET(STATUS)=""
SET STATUS=$$HEADER(.XT8H,.XT8HDR)
+3 IF $LENGTH($ECODE)
SET $ECODE=""
SET $ETRAP="D UNW^%ZTER Q:$QUIT STATUS Q "
SET $ECODE=",U1,"
+4 QUIT STATUS
+5 ;
+6 ;
+7 ;+++++ SENDS THE HTTP REQUEST
+8 ;
+9 ; URI Request URI
+10 ;
+11 ; [XT8DATA] Closed root of a variable containing body of the
+12 ; request message. If this parameter is defined, not
+13 ; empty, and the referenced variable is defined then
+14 ; the POST request is generated. Otherwise, the GET
+15 ; request is sent.
+16 ;
+17 ; [.XT8HDR] Reference to a local variable containing header
+18 ; values
+19 ;
+20 ; Return values:
+21 ; <0 Error Code^Description
+22 ; "GET" Ok
+23 ; "POST" Ok
+24 ;
REQUEST(URI,XT8DATA,XT8HDR) ;
+1 NEW CRLF,DFLTHDR,I,J,STATUS
+2 SET CRLF=$CHAR(13,10)
+3 ;
+4 ;=== Check for default header(s)
+5 SET DFLTHDR("CONTENT-LENGTH")=""
+6 SET DFLTHDR("CONTENT-TYPE")=""
+7 SET DFLTHDR("USER-AGENT")=""
+8 SET I=""
+9 FOR
SET I=$ORDER(XT8HDR(I))
if I=""
QUIT
KILL DFLTHDR($$UP^XLFSTR(I))
+10 if $DATA(DFLTHDR("USER-AGENT"))
SET XT8HDR("User-Agent")="VistA/1.0"
+11 ;
+12 ;=== Send the request
+13 USE IO
+14 IF $GET(XT8DATA)'=""
IF $DATA(@XT8DATA)>1
SET STATUS="POST"
Begin DoDot:1
+15 if $DATA(DFLTHDR("CONTENT-TYPE"))
SET XT8HDR("Content-Type")="text/html"
+16 if $DATA(DFLTHDR("CONTENT-LENGTH"))
Begin DoDot:2
+17 SET XT8HDR("Content-Length")=$$DATASIZE(XT8DATA,$LENGTH(CRLF))
End DoDot:2
+18 WRITE "POST "_URI_" HTTP/1.0",CRLF,!
+19 ;--- Header
+20 SET I=""
+21 FOR
SET I=$ORDER(XT8HDR(I))
if I=""
QUIT
WRITE I_": "_XT8HDR(I),CRLF,!
+22 ;--- Body
+23 SET I=""
+24 FOR
SET I=$ORDER(@XT8DATA@(I))
if I=""
QUIT
Begin DoDot:2
+25 WRITE CRLF,$GET(@XT8DATA@(I)),!
+26 SET J=""
+27 FOR
SET J=$ORDER(@XT8DATA@(I,J))
if J=""
QUIT
WRITE $GET(@XT8DATA@(I,J)),!
End DoDot:2
End DoDot:1
+28 IF '$TEST
SET STATUS="GET"
Begin DoDot:1
+29 WRITE "GET "_URI_" HTTP/1.0",CRLF,!
+30 SET I=""
+31 FOR
SET I=$ORDER(XT8HDR(I))
if I=""
QUIT
WRITE I_": "_XT8HDR(I),CRLF,!
+32 WRITE CRLF,!
End DoDot:1
+33 ;U $P
+34 QUIT STATUS
