Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSNPPSNC

PSNPPSNC.m

Go to the documentation of this file.
  1. PSNPPSNC ;HP/SXT-PPSN update NDF data ; 05 Mar 2014 1:20 PM
  1. ;;4.0;NATIONAL DRUG FILE;**513,563**; 30 Oct 98;Build 5
  1. ;
  1. ; taken mostly from: PSSHTTP ;WOIFO/AV - REENGINERING Sends XML Request to PEPS via HWSC ;09/20/07
  1. ;
  1. Q
  1. ;;
  1. ;
  1. SEND(STATUS,VERSION,MESSAGE) ;
  1. ;
  1. NEW TIME,SITE,XML,OK,DOCHAND
  1. ;TIME FORMAT: yyyy/mm/ddThh:mm:ss i.e. - 2014/3/24T13:20:27
  1. S TIME=$$HTE^XLFDT($H,7)
  1. S TIME=$TR(TIME,"@","T")
  1. S SITE=+$P($$SITE^VASITE(),"^",3)
  1. S XML="<vistaUpdateStatus><message>"_MESSAGE_"</message><site>"_SITE_"</site><status>"_STATUS_"</status>"
  1. S XML=XML_"<timeApplied>"_TIME_"</timeApplied><version>"_VERSION_"</version></vistaUpdateStatus>"
  1. S OK=$$PPSNPOST(.DOCHAND,XML)
  1. Q:'OK 0
  1. Q 1
  1. ;
  1. TEST ;
  1. S X=$$SEND("STARTED","PPS_1PRV_11NEW.DAT","")
  1. W !,$S(X:"Sent",1:"Failed")
  1. Q
  1. ;
  1. N RESPONSE,X S (X,RESPONSE)=""
  1. S XML="<vistaUpdateStatus><message></message><site>512</site><status>STARTED</status>"
  1. S XML=XML_"<timeApplied>2014-02-25T19:32:39.911-05:00</timeApplied><version>PPS_0PRV_6NEW.DAT</version></vistaUpdateStatus>"
  1. ;S XML=XML_"<vistaUpdateStatus><version>PPS_5PRV_6NEW.DAT</version><site>512</site><status>COMPLETED</status><message></message></vistaUpdateStatus"
  1. S X="TEST"
  1. U 0 W !,"calling function"
  1. S RESPONSE=$$PPSNPOST(.X,XML)
  1. Q
  1. ;
  1. PPSNPOST(DOCHAND,XML) ;
  1. ; @DESC Sends an HTTP request to PEPS as a POST
  1. ;
  1. ; @DOCHAND Handle to XML document
  1. ; @XML XML request as string
  1. ;
  1. ; @RETURNS A handle to response XML document
  1. ; 1 for success, 0 for failure
  1. ;
  1. NEW PSS,PSSERR,$ETRAP,$ESTACK
  1. ;
  1. ; Set error trap
  1. SET $ETRAP="DO ERROR^PSNPPSNC"
  1. ;
  1. SET PSS("server")="PPSN"
  1. ;SET PSS("server")="TIM" ;DEBUG
  1. SET PSS("webserviceName")="UPDATE_STATUS"
  1. SET PSS("path")="status"
  1. ;
  1. SET PSS("parameterName")="xmlRequest"
  1. SET PSS("parameterValue")=XML
  1. K ^TMP($JOB,"OUT","EXCEPTION")
  1. ;
  1. ; Get instance of client REST request object
  1. ;***W !,"get instance"
  1. SET PSS("restObject")=$$GETREST^XOBWLIB(PSS("webserviceName"),PSS("server"))
  1. IF $DATA(^TMP($JOB,"OUT","EXCEPTION"))>0 QUIT 0
  1. ;
  1. ; Insert XML as parameter
  1. ;*** W !,"insert XML parameter"
  1. DO PSS("restObject").InsertFormData(PSS("parameterName"),PSS("parameterValue"))
  1. IF $DATA(^TMP($JOB,"OUT","EXCEPTION"))>0 QUIT 0
  1. ;
  1. ; Execute HTTP Post method
  1. ;***W !,"execute POST ?" R Z I Z'="Y" B
  1. SET PSS("postResult")=$$POST^XOBWLIB(PSS("restObject"),PSS("path"),.PSSERR)
  1. IF $DATA(^TMP($JOB,"OUT","EXCEPTION"))>0 QUIT 0
  1. ;
  1. DO:PSS("postResult")
  1. . SET PSS("result")=##class(gov.va.med.pre.ws.XMLHandler).getHandleToXmlDoc(PSS("restObject").HttpResponse.Data, .DOCHAND)
  1. . QUIT
  1. ;
  1. DO:'PSS("postResult")
  1. . SET ^TMP($JOB,"OUT","EXCEPTION")="Unable to make http request."
  1. . SET PSS("result")=0
  1. . QUIT
  1. ;
  1. QUIT PSS("result")
  1. ;;
  1. ERROR ;
  1. ; @DESC Handles error during request to PEPS via webservice.
  1. ;
  1. ; Depends on GLOBAL variable PSSERR to be set in previous call.
  1. ;
  1. ; @RETURNS Nothing. Value store in global.
  1. ;
  1. NEW ERRARRAY
  1. ;
  1. ; Get error object from Error Object Factory
  1. IF $GET(PSSERR)="" SET PSSERR=$$EOFAC^XOBWLIB()
  1. ; Store the error object in the error array
  1. DO ERR2ARR^XOBWLIB(PSSERR,.ERRARRAY)
  1. ;
  1. ; Parse out the error text and store in global
  1. SET ^TMP($JOB,"OUT","EXCEPTION")=$$GETTEXT(.ERRARRAY)
  1. ;
  1. ; Set ecode to empty to return to calling function
  1. SET $ECODE=""
  1. ;
  1. QUIT
  1. ;;
  1. GETTEXT(ERRARRAY) ;
  1. ; @DESC Gets the error text from the array
  1. ;
  1. ; @ERRARRAY Error array stores error in format defined by web service product.
  1. ;
  1. ; @RETURNS Error info as a single string
  1. ;
  1. NEW PSS
  1. ;
  1. ; Loop through the text subscript of error array and concatenate
  1. SET PSS("errorText")=""
  1. SET PSS("I")=""
  1. FOR SET PSS("I")=$ORDER(ERRARRAY("text",PSS("I"))) QUIT:PSS("I")="" DO
  1. . SET PSS("errorText")=PSS("errorText")_ERRARRAY("text",PSS("I"))
  1. . QUIT
  1. ;
  1. QUIT PSS("errorText")
  1. ;;