VBECRPC1 ;HINES OIFO/BNT - RPC Server Listener Code ;12/28/03 11:20
;;2.0;VBEC;**8**;Jun 05, 2015;Build 27
;
; 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 DBIA 4149 - M XML Parser
; Reference to EN^MXMLPRSE supported by IA #4149
;
QUIT
;
; -----------------------------------------------------------------------
; Parse Results of Successful Legacy RPC Request
; -----------------------------------------------------------------------
;
; [Public/Supported Method]
PARSE(VBECPRMS,VBECY) ; -- parse legacy rpc results ; uses SAX parser
NEW VBECCBK,VBECOPT,VBECTYPE,VBECCNT
S VBMT=$NA(^TMP("VBECS_MAIL_TEXT",$J)) K @VBMT
DO SET(.VBECCBK)
SET VBECOPT=""
DO EN^MXMLPRSE(VBECPRMS("RESULTS"),.VBECCBK,.VBECOPT)
I $D(@VBECY@("ERROR")) D
. D BLDERMSG^VBECRPC(.VBECPRMS,VBECY,VBMT)
. D SENDMSG^VBECRPC(VBMT,"VBECS VistALink Client","G.VBECS INTERFACE ADMIN","VBECS VistALink Error")
. K @VBMT
Q
;
SET(VBECCBK) ; -- set the event interface entry points
SET VBECCBK("STARTELEMENT")="RESELEST^VBECRPC1"
SET VBECCBK("ENDELEMENT")="RESELEND^VBECRPC1"
SET VBECCBK("CHARACTERS")="RESCHR^VBECRPC1"
QUIT
;
RESELEST(ELE,ATR) ; -- element start event handler
IF ELE="Response" SET VBECTYPE=$G(ATR("type")),VBECCNT=0 QUIT
IF ELE="Message" SET VBECTYPE="fault",VBECCNT=0 QUIT
QUIT
;
RESELEND(ELE) ; -- element end event handler
KILL VBECCNT,VBECTYPE
QUIT
;
RESCHR(TEXT) ; -- character value event handler
QUIT:$G(VBECTYPE)=""
QUIT:'$L(TEXT) ; -- bug in parser? sends in empty string
;
IF VBECCNT=0,TEXT=$C(10) QUIT ; -- bug in parser? always starts with $C(10)
;
IF VBECTYPE="string" DO QUIT
. SET VBECCNT=VBECCNT+1
. SET @VBECY@(VBECCNT)=TEXT
;
IF VBECTYPE="array" DO
. SET VBECCNT=VBECCNT+1
. SET @VBECY@(VBECCNT)=$P(TEXT,$C(10))
;
IF VBECTYPE="fault" DO
. SET VBECCNT=VBECCNT+1
. SET @VBECY@("ERROR")=TEXT
QUIT
;
PARSEX(VBECPRMS,VBECY) ; -- parse legacy rpc results ; uses DOM parser
NEW VBECDOM
SET VBECDOM=$$EN^MXMLDOM(VBECPRMS("RESULTS"),"")
DO TEXT^MXMLDOM(VBECDOM,2,VBECY)
DO DELETE^MXMLDOM(VBECDOM)
QUIT
;
; -------------------------------------------------------------------
; Response Format Documentation
; -------------------------------------------------------------------
;
;
; [ Sample XML produced by a successful call of EN^XOBRPC(.VBECPRMS).
; SEND^XOBRPC does the actual work to produce response. ]
;
; <?xml version="1.0" encoding="utf-8" ?>
; <vistalink type="Gov.VA.Med.RPC.Response" >
; <results type="array" >
; <![CDATA[4261;;2961001.08^2^274^166^105^^2961001.1123^1^^9^2^8^10^^^^^^^10G1-ALN
; 4270;;2961002.08^2^274^166^112^^^1^^9^2^8^10^^^^^^^10G8-ALN
; 4274;;2961003.08^2^274^166^116^^^1^^9^2^8^10^^^^^^^10GD-ALN
; 4340;;2961117.08^2^274^166^182^^2961118.1425^1^^9^2^8^10^^^^^^^10K0-ALN
; 4342;;2961108.13^2^108^207^183^^2961118.1546^1^^9^2^8^10^^^^^^^10K2-ALN
; 6394;;3000607.084^2^165^68^6479^^3000622.13^1^^9^1^8^10^^^^^^^197M-ALN]]>
; </results>
; </vistalink>
;
; -------------------------------------------------------------------
;
; [ Sample XML produced by a unsuccessful call of EN^XOBRPC(.XOBPARMS).
; ERROR^XOBRPC does the actual work to produce response. ]
;
; <?xml version="1.0" encoding="utf-8" ?>
; <vistalink type="Gov.VA..Med.RPC.Error" >
; <errors>
; <error code="2" uri="XOB BAD NAME" >
; <msg>
; Remote Procedure Unknown: 'XOB BAD NAME' cannot be found.
; </msg>
; </error>
; </errors>
; </vistalink>
;
; -------------------------------------------------------------------
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECRPC1 4017 printed Apr 09, 2024@21:45:29 Page 2
VBECRPC1 ;HINES OIFO/BNT - RPC Server Listener Code ;12/28/03 11:20
+1 ;;2.0;VBEC;**8**;Jun 05, 2015;Build 27
+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 DBIA 4149 - M XML Parser
+9 ; Reference to EN^MXMLPRSE supported by IA #4149
+10 ;
+11 QUIT
+12 ;
+13 ; -----------------------------------------------------------------------
+14 ; Parse Results of Successful Legacy RPC Request
+15 ; -----------------------------------------------------------------------
+16 ;
+17 ; [Public/Supported Method]
PARSE(VBECPRMS,VBECY) ; -- parse legacy rpc results ; uses SAX parser
+1 NEW VBECCBK,VBECOPT,VBECTYPE,VBECCNT
+2 SET VBMT=$NAME(^TMP("VBECS_MAIL_TEXT",$JOB))
KILL @VBMT
+3 DO SET(.VBECCBK)
+4 SET VBECOPT=""
+5 DO EN^MXMLPRSE(VBECPRMS("RESULTS"),.VBECCBK,.VBECOPT)
+6 IF $DATA(@VBECY@("ERROR"))
Begin DoDot:1
+7 DO BLDERMSG^VBECRPC(.VBECPRMS,VBECY,VBMT)
+8 DO SENDMSG^VBECRPC(VBMT,"VBECS VistALink Client","G.VBECS INTERFACE ADMIN","VBECS VistALink Error")
+9 KILL @VBMT
End DoDot:1
+10 QUIT
+11 ;
SET(VBECCBK) ; -- set the event interface entry points
+1 SET VBECCBK("STARTELEMENT")="RESELEST^VBECRPC1"
+2 SET VBECCBK("ENDELEMENT")="RESELEND^VBECRPC1"
+3 SET VBECCBK("CHARACTERS")="RESCHR^VBECRPC1"
+4 QUIT
+5 ;
RESELEST(ELE,ATR) ; -- element start event handler
+1 IF ELE="Response"
SET VBECTYPE=$GET(ATR("type"))
SET VBECCNT=0
QUIT
+2 IF ELE="Message"
SET VBECTYPE="fault"
SET VBECCNT=0
QUIT
+3 QUIT
+4 ;
RESELEND(ELE) ; -- element end event handler
+1 KILL VBECCNT,VBECTYPE
+2 QUIT
+3 ;
RESCHR(TEXT) ; -- character value event handler
+1 if $GET(VBECTYPE)=""
QUIT
+2 ; -- bug in parser? sends in empty string
if '$LENGTH(TEXT)
QUIT
+3 ;
+4 ; -- bug in parser? always starts with $C(10)
IF VBECCNT=0
IF TEXT=$CHAR(10)
QUIT
+5 ;
+6 IF VBECTYPE="string"
Begin DoDot:1
+7 SET VBECCNT=VBECCNT+1
+8 SET @VBECY@(VBECCNT)=TEXT
End DoDot:1
QUIT
+9 ;
+10 IF VBECTYPE="array"
Begin DoDot:1
+11 SET VBECCNT=VBECCNT+1
+12 SET @VBECY@(VBECCNT)=$PIECE(TEXT,$CHAR(10))
End DoDot:1
+13 ;
+14 IF VBECTYPE="fault"
Begin DoDot:1
+15 SET VBECCNT=VBECCNT+1
+16 SET @VBECY@("ERROR")=TEXT
End DoDot:1
+17 QUIT
+18 ;
PARSEX(VBECPRMS,VBECY) ; -- parse legacy rpc results ; uses DOM parser
+1 NEW VBECDOM
+2 SET VBECDOM=$$EN^MXMLDOM(VBECPRMS("RESULTS"),"")
+3 DO TEXT^MXMLDOM(VBECDOM,2,VBECY)
+4 DO DELETE^MXMLDOM(VBECDOM)
+5 QUIT
+6 ;
+7 ; -------------------------------------------------------------------
+8 ; Response Format Documentation
+9 ; -------------------------------------------------------------------
+10 ;
+11 ;
+12 ; [ Sample XML produced by a successful call of EN^XOBRPC(.VBECPRMS).
+13 ; SEND^XOBRPC does the actual work to produce response. ]
+14 ;
+15 ; <?xml version="1.0" encoding="utf-8" ?>
+16 ; <vistalink type="Gov.VA.Med.RPC.Response" >
+17 ; <results type="array" >
+18 ; <![CDATA[4261;;2961001.08^2^274^166^105^^2961001.1123^1^^9^2^8^10^^^^^^^10G1-ALN
+19 ; 4270;;2961002.08^2^274^166^112^^^1^^9^2^8^10^^^^^^^10G8-ALN
+20 ; 4274;;2961003.08^2^274^166^116^^^1^^9^2^8^10^^^^^^^10GD-ALN
+21 ; 4340;;2961117.08^2^274^166^182^^2961118.1425^1^^9^2^8^10^^^^^^^10K0-ALN
+22 ; 4342;;2961108.13^2^108^207^183^^2961118.1546^1^^9^2^8^10^^^^^^^10K2-ALN
+23 ; 6394;;3000607.084^2^165^68^6479^^3000622.13^1^^9^1^8^10^^^^^^^197M-ALN]]>
+24 ; </results>
+25 ; </vistalink>
+26 ;
+27 ; -------------------------------------------------------------------
+28 ;
+29 ; [ Sample XML produced by a unsuccessful call of EN^XOBRPC(.XOBPARMS).
+30 ; ERROR^XOBRPC does the actual work to produce response. ]
+31 ;
+32 ; <?xml version="1.0" encoding="utf-8" ?>
+33 ; <vistalink type="Gov.VA..Med.RPC.Error" >
+34 ; <errors>
+35 ; <error code="2" uri="XOB BAD NAME" >
+36 ; <msg>
+37 ; Remote Procedure Unknown: 'XOB BAD NAME' cannot be found.
+38 ; </msg>
+39 ; </error>
+40 ; </errors>
+41 ; </vistalink>
+42 ;
+43 ; -------------------------------------------------------------------
+44 ;
