PXRMEXWB.m

PXRMEXWB ;SLC/PKR - Reminder Exchange Web routines. ;12/20/2013

 ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404

 ;==========================================

LWEB(URL) ;Load a prd file from a web site into ^TMP, then into the

 ;Exchange file.

 N DIR,HDR,NODE,RESULT,TEXT,X,Y

 S DIR(0)="F^10:245"

 S DIR("A")="Input the url for the .prd file"

 D ^DIR

 S URL=Y

 I (Y="")!(Y="^") S URL="" Q 0

 S Y=$$LOW^XLFSTR(Y)

 I $E(Y,1,5)="https" D  Q 0

 . D EN^DDIOL("The https protocol is not supported.")

 . H 2

 ;Load the file contents into ^TMP.

 S NODE="EXHF"

 K ^TMP($J,NODE),^TMP($J,"WEBPRD")

 ;DBIA #5553

 S RESULT=$$GETURL^XTHC10(URL,10,"^TMP($J,""WEBPRD"")",.HDR)

 I $P(RESULT,U,1)'=200 D  Q 0

 . S TEXT="Could not load the .prd file: "

 . S TEXT=TEXT_"Error "_$P(RESULT,U,1)_" "_$P(RESULT,U,2)

 . D EN^DDIOL(.TEXT) H 2

 . K ^TMP($J,"WEBPRD")

 D RBLCKWEB^PXRMTXIM("WEBPRD",NODE)

 K ^TMP($J,"WEBPRD")

 ;Load the ^TMP into the Exchange file.

 D LTMP^PXRMEXHF(.RESULT,NODE)

 K ^TMP($J,NODE)

 Q RESULT

 ;

PXRMEXWB  ;SLC/PKR - Reminder Exchange Web routines. ;12/20/2013

 +1       ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404

 +2       ;==========================================

LWEB(URL) ;Load a prd file from a web site into ^TMP, then into the

 +1       ;Exchange file.

 +2        NEW DIR,HDR,NODE,RESULT,TEXT,X,Y

 +3        SET DIR(0)="F^10:245"

 +4        SET DIR("A")="Input the url for the .prd file"

 +5        DO ^DIR

 +6        SET URL=Y

 +7        IF (Y="")!(Y="^")

               SET URL=""

               QUIT 0

 +8        SET Y=$$LOW^XLFSTR(Y)

 +9        IF $EXTRACT(Y,1,5)="https"

               Begin DoDot:1

 +10               DO EN^DDIOL("The https protocol is not supported.")

 +11               HANG 2

               End DoDot:1

               QUIT 0

 +12      ;Load the file contents into ^TMP.

 +13       SET NODE="EXHF"

 +14       KILL ^TMP($JOB,NODE),^TMP($JOB,"WEBPRD")

 +15      ;DBIA #5553

 +16       SET RESULT=$$GETURL^XTHC10(URL,10,"^TMP($J,""WEBPRD"")",.HDR)

 +17       IF $PIECE(RESULT,U,1)'=200

               Begin DoDot:1

 +18               SET TEXT="Could not load the .prd file: "

 +19               SET TEXT=TEXT_"Error "_$PIECE(RESULT,U,1)_" "_$PIECE(RESULT,U,2)

 +20               DO EN^DDIOL(.TEXT)

                   HANG 2

 +21               KILL ^TMP($JOB,"WEBPRD")

               End DoDot:1

               QUIT 0

 +22       DO RBLCKWEB^PXRMTXIM("WEBPRD",NODE)

 +23       KILL ^TMP($JOB,"WEBPRD")

 +24      ;Load the ^TMP into the Exchange file.

 +25       DO LTMP^PXRMEXHF(.RESULT,NODE)

 +26       KILL ^TMP($JOB,NODE)

 +27       QUIT RESULT

 +28      ;