- PXRMEXWB ;SLC/PKR - Reminder Exchange Web routines. ;05/06/2020
- ;;2.0;CLINICAL REMINDERS;**26,47,46**;Feb 04, 2005;Build 236
- ;==========================================
- 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)
- ;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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXWB 950 printed Apr 23, 2025@17:59:48 Page 2
- PXRMEXWB ;SLC/PKR - Reminder Exchange Web routines. ;05/06/2020
- +1 ;;2.0;CLINICAL REMINDERS;**26,47,46**;Feb 04, 2005;Build 236
- +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 ;Load the file contents into ^TMP.
- +10 SET NODE="EXHF"
- +11 KILL ^TMP($JOB,NODE),^TMP($JOB,"WEBPRD")
- +12 ;DBIA #5553
- +13 SET RESULT=$$GETURL^XTHC10(URL,10,"^TMP($J,""WEBPRD"")",.HDR)
- +14 IF $PIECE(RESULT,U,1)'=200
- Begin DoDot:1
- +15 SET TEXT="Could not load the .prd file: "
- +16 SET TEXT=TEXT_"Error "_$PIECE(RESULT,U,1)_" "_$PIECE(RESULT,U,2)
- +17 DO EN^DDIOL(.TEXT)
- HANG 2
- +18 KILL ^TMP($JOB,"WEBPRD")
- End DoDot:1
- QUIT 0
- +19 DO RBLCKWEB^PXRMTXIM("WEBPRD",NODE)
- +20 KILL ^TMP($JOB,"WEBPRD")
- +21 ;Load the ^TMP into the Exchange file.
- +22 DO LTMP^PXRMEXHF(.RESULT,NODE)
- +23 KILL ^TMP($JOB,NODE)
- +24 QUIT RESULT
- +25 ;
