ONCXDEM.m

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 ---ONCXDEM   1635     printed  Mar 13, 2025@21:34:06                                                                                                                                                                                                     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