ONCXDEM ;HCIOFO/SG - HTTP AND WEB SERVICES (DEMO) ; 5/14/04 10:59am
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
Q
;
;***** DEMO ENTRY POINT
;
; The ^TMP($J,"ONCX") global node is used by the entry point.
;
DEMO ;
N BODY,DIR,DIRUT,DTOUT,DUOUT,HEADER,RC,URL,X,Y
S BODY=$NA(^TMP($J,"ONCX"))
S URL="http://www.hardhats.org"
;
S RC=0
F D Q:RC
. K @BODY,HEADER
. ;--- Request a URL from the user
. K DIR S DIR(0)="F"
. S DIR("A")="URL",DIR("B")=URL
. D ^DIR I $D(DIRUT) S RC=1 Q
. S URL=$$TRIM^XLFSTR(Y)
. ;--- Request the resource
. S RC=$$GETURL^ONCX10(URL,,BODY,.HEADER)
. I RC<0 D ERROR(RC) S RC=0 Q
. ;--- Print the data
. D PRINT(BODY,.HEADER)
. S RC=0
;
;--- Cleanup
K @BODY
Q
;
;***** PRINT THE ERROR MESSAGE
ERROR(ERR) ;
W !!,"ERROR: "_$J(+ERR,3)_" "_$P(ERR,U,2),!
W $J("",12)_$P(ERR,U,3,4),!
Q
;
;***** PAUSES THE OUTPUT IN THE END OF PAGE
;
; N Number of lines to reserve
;
; Return values:
; 0 Ok (continue)
; >0 Exit Request or Timeout
;
PAGE(N) ;
Q:($Y+$G(N))<IOSL 0
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="E" D ^DIR W !! S $Y=0
Q '$G(Y)
;
;***** PRINTS THE RESPONSE
PRINT(ONCX8DAT,HEADER) ;
N I,J
;---
I $D(HEADER)>0 D Q:$$PAGE(IOSL)
. W @IOF,"----- HTTP HEADER -----",!!
. W $G(HEADER),!
. S I=""
. F S I=$O(HEADER(I)) Q:I="" W I_"="_HEADER(I),!
;---
D:$D(@ONCX8DAT)>1
. W @IOF,"----- MESSAGE ONCX8DAT -----",!!
. S I=""
. F S I=$O(@ONCX8DAT@(I)) Q:I="" W @ONCX8DAT@(I) D W !
. . S J="" F S J=$O(@ONCX8DAT@(I,J)) Q:J="" W @ONCX8DAT@(I,J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCXDEM 1635 printed Sep 23, 2025@20:05:26 Page 2
ONCXDEM ;HCIOFO/SG - HTTP AND WEB SERVICES (DEMO) ; 5/14/04 10:59am
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
+3 QUIT
+4 ;
+5 ;***** DEMO ENTRY POINT
+6 ;
+7 ; The ^TMP($J,"ONCX") global node is used by the entry point.
+8 ;
DEMO ;
+1 NEW BODY,DIR,DIRUT,DTOUT,DUOUT,HEADER,RC,URL,X,Y
+2 SET BODY=$NAME(^TMP($JOB,"ONCX"))
+3 SET URL="http://www.hardhats.org"
+4 ;
+5 SET RC=0
+6 FOR
Begin DoDot:1
+7 KILL @BODY,HEADER
+8 ;--- Request a URL from the user
+9 KILL DIR
SET DIR(0)="F"
+10 SET DIR("A")="URL"
SET DIR("B")=URL
+11 DO ^DIR
IF $DATA(DIRUT)
SET RC=1
QUIT
+12 SET URL=$$TRIM^XLFSTR(Y)
+13 ;--- Request the resource
+14 SET RC=$$GETURL^ONCX10(URL,,BODY,.HEADER)
+15 IF RC<0
DO ERROR(RC)
SET RC=0
QUIT
+16 ;--- Print the data
+17 DO PRINT(BODY,.HEADER)
+18 SET RC=0
End DoDot:1
if RC
QUIT
+19 ;
+20 ;--- Cleanup
+21 KILL @BODY
+22 QUIT
+23 ;
+24 ;***** PRINT THE ERROR MESSAGE
ERROR(ERR) ;
+1 WRITE !!,"ERROR: "_$JUSTIFY(+ERR,3)_" "_$PIECE(ERR,U,2),!
+2 WRITE $JUSTIFY("",12)_$PIECE(ERR,U,3,4),!
+3 QUIT
+4 ;
+5 ;***** PAUSES THE OUTPUT IN THE END OF PAGE
+6 ;
+7 ; N Number of lines to reserve
+8 ;
+9 ; Return values:
+10 ; 0 Ok (continue)
+11 ; >0 Exit Request or Timeout
+12 ;
PAGE(N) ;
+1 if ($Y+$GET(N))<IOSL
QUIT 0
+2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="E"
DO ^DIR
WRITE !!
SET $Y=0
+4 QUIT '$GET(Y)
+5 ;
+6 ;***** PRINTS THE RESPONSE
PRINT(ONCX8DAT,HEADER) ;
+1 NEW I,J
+2 ;---
+3 IF $DATA(HEADER)>0
Begin DoDot:1
+4 WRITE @IOF,"----- HTTP HEADER -----",!!
+5 WRITE $GET(HEADER),!
+6 SET I=""
+7 FOR
SET I=$ORDER(HEADER(I))
if I=""
QUIT
WRITE I_"="_HEADER(I),!
End DoDot:1
if $$PAGE(IOSL)
QUIT
+8 ;---
+9 if $DATA(@ONCX8DAT)>1
Begin DoDot:1
+10 WRITE @IOF,"----- MESSAGE ONCX8DAT -----",!!
+11 SET I=""
+12 FOR
SET I=$ORDER(@ONCX8DAT@(I))
if I=""
QUIT
WRITE @ONCX8DAT@(I)
Begin DoDot:2
+13 SET J=""
FOR
SET J=$ORDER(@ONCX8DAT@(I,J))
if J=""
QUIT
WRITE @ONCX8DAT@(I,J)
End DoDot:2
WRITE !
End DoDot:1
+14 QUIT
