VBECRPCC ;HOIFO/bnt - VBECS VistALink RPC Client Utilities ;07/27/2002 13:00
;;2.0;VBECS;;Jun 05, 2015;Build 4
;
; Note: This routine supports data exchange with an FDA registered
; medical device. As such, it may not be changed in any way without
; prior written approval from the medical device manufacturer.
;
; Integration Agreements:
; Reference to $$GET^XPAR supported by IA #2263
; Reference to $$XMLHDR^XOBVLIB supported by IA #4090
;
QUIT
;
; -------------------------------------------------------------------
; RPC Client: Methods Calls
; -------------------------------------------------------------------
;
EXECUTE(VBECPRMS) ; -- execute rpc call
;
; -- validate parmeters passed
IF '$$VALIDATE(.VBECPRMS) QUIT 0
;
; -- call method to build request from parameters array
DO REQUEST(.VBECPRMS)
;SET VBECPRMS("CLOSE MESSAGE")="<VistaLink messageType='gov.va.med.foundations.rpc.request' ></VistaLink>"
IF $G(VBECPRMS("RESULTS"))="" SET VBECPRMS("RESULTS")=$NA(^TMP("VBECRPC",$J,"XML"))
QUIT $$EXECUTE^VBECVLC(.VBECPRMS)
;
VALIDATE(VBECPRMS) ; -- validate parameters sent in
; // TODO: Do checks and build validate error message
QUIT 1
;
REQUEST(VBECPRMS) ; -- build xml request
NEW VBECLINE,VBECPI,PTYPE,VBECREQ
SET VBECLINE=0
SET VBECPRMS("MESSAGE TYPE")="gov.va.med.foundations.rpc.request"
SET VBECPRMS("MODE")="singleton"
IF $G(VBECPRMS("REQUEST"))="" SET VBECPRMS("REQUEST")=$NA(VBECPRMS("REQUEST","XML"))
SET VBECREQ=VBECPRMS("REQUEST")
KILL @VBECREQ
;
DO ADD($$XMLHDR^XOBVLIB())
DO ADD("<VistaLink messageType="""_$G(VBECPRMS("MESSAGE TYPE"))_""" mode="""_$G(VBECPRMS("MODE"))_""" version=""1.0"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:noNamespaceSchemaLocation=""rpcRequest.xsd"" ")
DO ADD("xmlns=""http://domain.ext/Foundations"">")
DO ADD("<RpcHandler version=""1.0"" />")
DO ADD("<Request rpcName="""_$G(VBECPRMS("RPC NAME"))_""" version=""1.0"" rpcClientTimeOut=""900"" >")
DO ADD("<RpcContext><![CDATA["_$G(VBECPRMS("RPC CONTEXT"))_"]]></RpcContext>")
DO ADD("<Params>")
IF $D(VBECPRMS("PARAMS"))>9 DO
. SET VBECPI=0
. FOR SET VBECPI=$O(VBECPRMS("PARAMS",VBECPI)) Q:'VBECPI DO
. . SET PTYPE=$G(VBECPRMS("PARAMS",VBECPI,"TYPE"))
. . IF PTYPE="STRING" DO STRING QUIT
. . IF PTYPE="ARRAY" DO ARRAY QUIT
. . IF PTYPE="REF" DO REF QUIT
DO ADD("</Params>")
DO ADD("</Request>")
DO ADD("</VistaLink>")
QUIT
;
STRING ;
DO ADD("<Param type=""string"" position="""_VBECPI_""" >"_$G(VBECPRMS("PARAMS",VBECPI,"VALUE"))_"</Param>")
QUIT
;
ARRAY ;
NEW VBECNAME
DO ADD("<Param type=""array"" position="""_VBECPI_""" >")
DO ADD("<Indices>")
SET VBECNAME="" FOR SET VBECNAME=$O(VBECPRMS("PARAMS",VBECPI,"VALUE",VBECNAME)) Q:VBECNAME="" DO
. DO ADD("<Index name="""_VBECNAME_""" value="""_$G(VBECPRMS("PARAMS",VBECPI,"VALUE",VBECNAME))_""" />")
DO ADD("</Indices>")
DO ADD("</Param>")
QUIT
;
REF ;
DO ADD("<Param type=""ref"" position="""_VBECPI_""" >"_$G(VBECPRMS("PARAMS",VBECPI,"VALUE"))_"</Param>")
QUIT
;
ADD(STR) ; -- add string to array
SET VBECLINE=VBECLINE+1
SET @VBECREQ@(VBECLINE)=STR
QUIT
;
INITV(RPC) ; Initialize VBECS VistALink Client parameters
; Input: RPC = Parameter Toolkit Instance of RPC Name
; Output: VBECPRMS or -1^"error specific text" if error occurs setting any VBECPRMS parameter
;
NEW ENT,PAR
KILL VBECPRMS
SET VBECPRMS("ERROR")=0
IF RPC']"" DO ERR("NO RPC NAME SUPPLIED") QUIT
; Parameter Toolkit variables
SET ENT="PKG.VBECS" ;Entity
SET PAR="VBECS VISTALINK" ;Parameter
SET VBECPRMS("ADDRESS")=$$GET^XPAR(ENT,PAR,"LISTENER IP ADDRESS","Q")
IF VBECPRMS("ADDRESS")="" DO ERR("NO LISTENER IP ADDRESS FOUND") QUIT
SET VBECPRMS("PORT")=$$GET^XPAR(ENT,PAR,"LISTENER PORT NUMBER","Q")
IF VBECPRMS("PORT")="" DO ERR("NO LISTENER PORT NUMBER FOUND") QUIT
SET VBECPRMS("RPC NAME")=RPC
SET VBECPRMS("RPC CONTEXT")=$$GET^XPAR(ENT,PAR,RPC,"Q")
IF VBECPRMS("RPC CONTEXT")="" DO ERR("UNABLE TO RETRIEVE RPC CONTEXT FOR "_RPC) QUIT
QUIT
;
CHGADPRT(IP,PORT) ; Change the IP Address and Port of the VBECS VistALink Listner
NEW ERR,ENT,PAR
SET ENT="PKG.VBECS" ; Entity
SET PAR="VBECS VISTALINK" ; Parameter
IF IP]"" DO
. DO EN^XPAR(ENT,PAR,"LISTENER IP ADDRESS",IP,.ERR)
. IF ERR QUIT
;
IF PORT]"" DO
. DO EN^XPAR(ENT,PAR,"LISTENER PORT NUMBER",PORT,.ERR)
. IF ERR QUIT
QUIT ERR
;
CONTEXT(INSTANCE,CONTEXT) ; Adds, or changes, an RPC Instance and
; it's associated context
; Set CONTEXT to "@" to delete the instance of the RPC.
;
NEW ERR,ENT,PAR
SET ENT="PKG.VBECS" ; Entity
SET PAR="VBECS VISTALINK" ; Parameter
DO EN^XPAR(ENT,PAR,INSTANCE,CONTEXT,.ERR)
QUIT ERR
;
ERR(ERRTXT) ; Set VBECPRMS("ERROR") node with error text and quit
S VBECPRMS("ERROR")="1^"_ERRTXT
QUIT
;
; -------------------------------------------------------------------
; Request Format Documentation
; -------------------------------------------------------------------
;
; [ Parameter Array Format -->> passed to REQUEST^VBECRPCC(.VBECPRMS) ]
;
; -- general information
; VBECPRMS("ADDRESS")="127.0.0.1"
; VBECPRMS("PORT")=19811
; VBECPRMS("RPC NAME")="VBECS Order Entry"
; VBECPRMS("RPC CONTEXT")="VBECS VISTALINK CONTEXT"
;
; -- string parameter type
; VBECPRMS("PARAMS",1,"TYPE")="STRING"
; VBECPRMS("PARAMS",1,"VALUE")=2
; VBECPRMS("PARAMS",2,"TYPE")="STRING"
; VBECPRMS("PARAMS",2,"VALUE")=2961001
; VBECPRMS("PARAMS",3,"TYPE")="STRING"
; VBECPRMS("PARAMS",3,"VALUE")=3030101
;
; -- sample array parameter type
; VBECPRMS("PARAMS",4,"TYPE")="ARRAY"
; VBECPRMS("PARAMS",4,"VALUE","FNAME")="JOE"
; VBECPRMS("PARAMS",4,"VALUE","LNAME")="GOODMAN"
;
; -------------------------------------------------------------------
;
; [ Sample XML produced by calling REQUEST^VBECRPCC(.VBECPRMS) ]
;
; <?xml version="1.0" encoding="utf-8" ?>
; <VistaLink type="gov.va.med.foundations.rpc.request" mode="singleton"
; version="1.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
; xsi:noNamespaceSchemaLocation="rpcRequest.xsd"
; xmlns="http://domain.ext/Foundations">
; <RpcHandler version="1.0" />
; <Request rpcName="VBECS Order Entry" version="1.0"
; rpcClientTimeOut="900">
; <RpcContext>
; <![CDATA[ VBECS VISTALINK ]]>
; </RpcContext>
; <Params>
; <Param type="string" position="1" >2</Param>
; <Param type="string" position="2" >2961001</Param>
; <Param type="string" position="3" >3030101</Param>
; <Param type="array" position="4" >
; <Indices>
; <Index name="status" value="veteran" />
; <Index name="gender" value="male" />
; </Indices>
; </Param>
; </Params>
; </Request>
; </VistaLink>
;
; -------------------------------------------------------------------
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECRPCC 7064 printed Sep 23, 2025@20:20:39 Page 2
VBECRPCC ;HOIFO/bnt - VBECS VistALink RPC Client Utilities ;07/27/2002 13:00
+1 ;;2.0;VBECS;;Jun 05, 2015;Build 4
+2 ;
+3 ; Note: This routine supports data exchange with an FDA registered
+4 ; medical device. As such, it may not be changed in any way without
+5 ; prior written approval from the medical device manufacturer.
+6 ;
+7 ; Integration Agreements:
+8 ; Reference to $$GET^XPAR supported by IA #2263
+9 ; Reference to $$XMLHDR^XOBVLIB supported by IA #4090
+10 ;
+11 QUIT
+12 ;
+13 ; -------------------------------------------------------------------
+14 ; RPC Client: Methods Calls
+15 ; -------------------------------------------------------------------
+16 ;
EXECUTE(VBECPRMS) ; -- execute rpc call
+1 ;
+2 ; -- validate parmeters passed
+3 IF '$$VALIDATE(.VBECPRMS)
QUIT 0
+4 ;
+5 ; -- call method to build request from parameters array
+6 DO REQUEST(.VBECPRMS)
+7 ;SET VBECPRMS("CLOSE MESSAGE")="<VistaLink messageType='gov.va.med.foundations.rpc.request' ></VistaLink>"
+8 IF $GET(VBECPRMS("RESULTS"))=""
SET VBECPRMS("RESULTS")=$NAME(^TMP("VBECRPC",$JOB,"XML"))
+9 QUIT $$EXECUTE^VBECVLC(.VBECPRMS)
+10 ;
VALIDATE(VBECPRMS) ; -- validate parameters sent in
+1 ; // TODO: Do checks and build validate error message
+2 QUIT 1
+3 ;
REQUEST(VBECPRMS) ; -- build xml request
+1 NEW VBECLINE,VBECPI,PTYPE,VBECREQ
+2 SET VBECLINE=0
+3 SET VBECPRMS("MESSAGE TYPE")="gov.va.med.foundations.rpc.request"
+4 SET VBECPRMS("MODE")="singleton"
+5 IF $GET(VBECPRMS("REQUEST"))=""
SET VBECPRMS("REQUEST")=$NAME(VBECPRMS("REQUEST","XML"))
+6 SET VBECREQ=VBECPRMS("REQUEST")
+7 KILL @VBECREQ
+8 ;
+9 DO ADD($$XMLHDR^XOBVLIB())
+10 DO ADD("<VistaLink messageType="""_$GET(VBECPRMS("MESSAGE TYPE"))_""" mode="""_$GET(VBECPRMS("MODE"))_""" version=""1.0"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:noNamespaceSchemaLocation=""rpcRequest.xsd"" ")
+11 DO ADD("xmlns=""http://domain.ext/Foundations"">")
+12 DO ADD("<RpcHandler version=""1.0"" />")
+13 DO ADD("<Request rpcName="""_$GET(VBECPRMS("RPC NAME"))_""" version=""1.0"" rpcClientTimeOut=""900"" >")
+14 DO ADD("<RpcContext><![CDATA["_$GET(VBECPRMS("RPC CONTEXT"))_"]]></RpcContext>")
+15 DO ADD("<Params>")
+16 IF $DATA(VBECPRMS("PARAMS"))>9
Begin DoDot:1
+17 SET VBECPI=0
+18 FOR
SET VBECPI=$ORDER(VBECPRMS("PARAMS",VBECPI))
if 'VBECPI
QUIT
Begin DoDot:2
+19 SET PTYPE=$GET(VBECPRMS("PARAMS",VBECPI,"TYPE"))
+20 IF PTYPE="STRING"
DO STRING
QUIT
+21 IF PTYPE="ARRAY"
DO ARRAY
QUIT
+22 IF PTYPE="REF"
DO REF
QUIT
End DoDot:2
End DoDot:1
+23 DO ADD("</Params>")
+24 DO ADD("</Request>")
+25 DO ADD("</VistaLink>")
+26 QUIT
+27 ;
STRING ;
+1 DO ADD("<Param type=""string"" position="""_VBECPI_""" >"_$GET(VBECPRMS("PARAMS",VBECPI,"VALUE"))_"</Param>")
+2 QUIT
+3 ;
ARRAY ;
+1 NEW VBECNAME
+2 DO ADD("<Param type=""array"" position="""_VBECPI_""" >")
+3 DO ADD("<Indices>")
+4 SET VBECNAME=""
FOR
SET VBECNAME=$ORDER(VBECPRMS("PARAMS",VBECPI,"VALUE",VBECNAME))
if VBECNAME=""
QUIT
Begin DoDot:1
+5 DO ADD("<Index name="""_VBECNAME_""" value="""_$GET(VBECPRMS("PARAMS",VBECPI,"VALUE",VBECNAME))_""" />")
End DoDot:1
+6 DO ADD("</Indices>")
+7 DO ADD("</Param>")
+8 QUIT
+9 ;
REF ;
+1 DO ADD("<Param type=""ref"" position="""_VBECPI_""" >"_$GET(VBECPRMS("PARAMS",VBECPI,"VALUE"))_"</Param>")
+2 QUIT
+3 ;
ADD(STR) ; -- add string to array
+1 SET VBECLINE=VBECLINE+1
+2 SET @VBECREQ@(VBECLINE)=STR
+3 QUIT
+4 ;
INITV(RPC) ; Initialize VBECS VistALink Client parameters
+1 ; Input: RPC = Parameter Toolkit Instance of RPC Name
+2 ; Output: VBECPRMS or -1^"error specific text" if error occurs setting any VBECPRMS parameter
+3 ;
+4 NEW ENT,PAR
+5 KILL VBECPRMS
+6 SET VBECPRMS("ERROR")=0
+7 IF RPC']""
DO ERR("NO RPC NAME SUPPLIED")
QUIT
+8 ; Parameter Toolkit variables
+9 ;Entity
SET ENT="PKG.VBECS"
+10 ;Parameter
SET PAR="VBECS VISTALINK"
+11 SET VBECPRMS("ADDRESS")=$$GET^XPAR(ENT,PAR,"LISTENER IP ADDRESS","Q")
+12 IF VBECPRMS("ADDRESS")=""
DO ERR("NO LISTENER IP ADDRESS FOUND")
QUIT
+13 SET VBECPRMS("PORT")=$$GET^XPAR(ENT,PAR,"LISTENER PORT NUMBER","Q")
+14 IF VBECPRMS("PORT")=""
DO ERR("NO LISTENER PORT NUMBER FOUND")
QUIT
+15 SET VBECPRMS("RPC NAME")=RPC
+16 SET VBECPRMS("RPC CONTEXT")=$$GET^XPAR(ENT,PAR,RPC,"Q")
+17 IF VBECPRMS("RPC CONTEXT")=""
DO ERR("UNABLE TO RETRIEVE RPC CONTEXT FOR "_RPC)
QUIT
+18 QUIT
+19 ;
CHGADPRT(IP,PORT) ; Change the IP Address and Port of the VBECS VistALink Listner
+1 NEW ERR,ENT,PAR
+2 ; Entity
SET ENT="PKG.VBECS"
+3 ; Parameter
SET PAR="VBECS VISTALINK"
+4 IF IP]""
Begin DoDot:1
+5 DO EN^XPAR(ENT,PAR,"LISTENER IP ADDRESS",IP,.ERR)
+6 IF ERR
QUIT
End DoDot:1
+7 ;
+8 IF PORT]""
Begin DoDot:1
+9 DO EN^XPAR(ENT,PAR,"LISTENER PORT NUMBER",PORT,.ERR)
+10 IF ERR
QUIT
End DoDot:1
+11 QUIT ERR
+12 ;
CONTEXT(INSTANCE,CONTEXT) ; Adds, or changes, an RPC Instance and
+1 ; it's associated context
+2 ; Set CONTEXT to "@" to delete the instance of the RPC.
+3 ;
+4 NEW ERR,ENT,PAR
+5 ; Entity
SET ENT="PKG.VBECS"
+6 ; Parameter
SET PAR="VBECS VISTALINK"
+7 DO EN^XPAR(ENT,PAR,INSTANCE,CONTEXT,.ERR)
+8 QUIT ERR
+9 ;
ERR(ERRTXT) ; Set VBECPRMS("ERROR") node with error text and quit
+1 SET VBECPRMS("ERROR")="1^"_ERRTXT
+2 QUIT
+3 ;
+4 ; -------------------------------------------------------------------
+5 ; Request Format Documentation
+6 ; -------------------------------------------------------------------
+7 ;
+8 ; [ Parameter Array Format -->> passed to REQUEST^VBECRPCC(.VBECPRMS) ]
+9 ;
+10 ; -- general information
+11 ; VBECPRMS("ADDRESS")="127.0.0.1"
+12 ; VBECPRMS("PORT")=19811
+13 ; VBECPRMS("RPC NAME")="VBECS Order Entry"
+14 ; VBECPRMS("RPC CONTEXT")="VBECS VISTALINK CONTEXT"
+15 ;
+16 ; -- string parameter type
+17 ; VBECPRMS("PARAMS",1,"TYPE")="STRING"
+18 ; VBECPRMS("PARAMS",1,"VALUE")=2
+19 ; VBECPRMS("PARAMS",2,"TYPE")="STRING"
+20 ; VBECPRMS("PARAMS",2,"VALUE")=2961001
+21 ; VBECPRMS("PARAMS",3,"TYPE")="STRING"
+22 ; VBECPRMS("PARAMS",3,"VALUE")=3030101
+23 ;
+24 ; -- sample array parameter type
+25 ; VBECPRMS("PARAMS",4,"TYPE")="ARRAY"
+26 ; VBECPRMS("PARAMS",4,"VALUE","FNAME")="JOE"
+27 ; VBECPRMS("PARAMS",4,"VALUE","LNAME")="GOODMAN"
+28 ;
+29 ; -------------------------------------------------------------------
+30 ;
+31 ; [ Sample XML produced by calling REQUEST^VBECRPCC(.VBECPRMS) ]
+32 ;
+33 ; <?xml version="1.0" encoding="utf-8" ?>
+34 ; <VistaLink type="gov.va.med.foundations.rpc.request" mode="singleton"
+35 ; version="1.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+36 ; xsi:noNamespaceSchemaLocation="rpcRequest.xsd"
+37 ; xmlns="http://domain.ext/Foundations">
+38 ; <RpcHandler version="1.0" />
+39 ; <Request rpcName="VBECS Order Entry" version="1.0"
+40 ; rpcClientTimeOut="900">
+41 ; <RpcContext>
+42 ; <![CDATA[ VBECS VISTALINK ]]>
+43 ; </RpcContext>
+44 ; <Params>
+45 ; <Param type="string" position="1" >2</Param>
+46 ; <Param type="string" position="2" >2961001</Param>
+47 ; <Param type="string" position="3" >3030101</Param>
+48 ; <Param type="array" position="4" >
+49 ; <Indices>
+50 ; <Index name="status" value="veteran" />
+51 ; <Index name="gender" value="male" />
+52 ; </Indices>
+53 ; </Param>
+54 ; </Params>
+55 ; </Request>
+56 ; </VistaLink>
+57 ;
+58 ; -------------------------------------------------------------------
+59 ;
