XOBVRPCI ;; ld,mjk/alb - VistaLink Interface Implementation for RPCs; 07/27/2002 13:00
;;1.6;VistALink;;May 08, 2009;Build 15
;Per VHA directive 2004-038, this routine should not be modified.
;
CALLBACK(CB) ; -- init callbacks implementation
SET CB("STARTELEMENT")="ELEST^XOBVRPCI"
SET CB("ENDELEMENT")="ELEND^XOBVRPCI"
SET CB("CHARACTERS")="CHR^XOBVRPCI"
QUIT
;
READER(XOBUF,XOBDATA) ; -- proprietary format reader implementation
DO START^XOBVRPCX(.XOBUF,.XOBDATA)
QUIT
;
REQHDLR(XOBDATA) ; -- request handler implementation
DO EN^XOBVRPC(.XOBDATA)
QUIT
;
; ------------------------------------------------------------------------
; RPC Server: Request Message XML SAX Parser Callbacks
; ------------------------------------------------------------------------
ELEST(ELE,ATR) ; -- element start event handler
IF ELE="VistaLink" DO QUIT
. KILL XOBPARAM,XOBCTXT,XOBPN,XOBPTYPE
. ; -- if called from VL v1.0 client then set up J2SE defaults
. IF $GET(XOBDATA("VL VERSION"))="1.0" DO V1^XOBVRPCX
;
IF ELE="RpcHandler" SET XOBDATA("XOB RPC","RPC HANDLER VERSION")=$GET(ATR("version")) QUIT
;
IF ELE="Request" DO QUIT
. SET XOBDATA("XOB RPC","RPC NAME")=$$ESC^XOBVRMX($GET(ATR("rpcName"),"##Unkown RPC##"))
. NEW X
. SET X=$$SETTO^XOBVLIB($GET(ATR("rpcClientTimeOut"),9000))
. SET X=$$SETVER^XOBVRPCX($GET(ATR("rpcVersion"),0))
;
IF ELE="RpcContext" SET XOBCTXT="" QUIT
;
; -------------------- Param Node Start Event Processing ---------------------------
;
IF ELE="Param" DO QUIT
. SET XOBPARAM=""
. SET XOBPN="XOBP"_ATR("position")
. SET XOBDATA("XOB RPC","PARAMS",ATR("position"))=XOBPN
. SET XOBPTYPE=ATR("type")
. SET:XOBPTYPE="array" @XOBPN=""
;
IF ELE="Index" DO QUIT
. KILL XOBPARAM
. IF $DATA(ATR("name"))&$DATA(ATR("value")) DO
. . SET @XOBPN@($$ESC^XOBVRMX(ATR("name")))=$$ESC^XOBVRMX(ATR("value"))
;
IF ELE="Name" DO QUIT
. SET XOBPARNM=""
;
IF ELE="Value" DO QUIT
. SET XOBPARVL=""
;
; -------------------- Security Node Start Event Processing ---------------------------
;
IF ELE="Security" DO QUIT
. SET XOBDATA("XOB RPC","SECURITY","TYPE")=$GET(ATR("type"))
. SET XOBDATA("XOB RPC","SECURITY","DIV")=$GET(ATR("division"))
. SET XOBDATA("XOB RPC","SECURITY","STATE")=$GET(ATR("state"),"notauthenticated")
. KILL XOBSECFL
. ;
. ; -- use to make sure child nodes are from Security
. ; parent when processing child node names
. SET XOBSECFL=1
;
IF ELE="AccessVerify",$GET(XOBSECFL),$EXTRACT($GET(XOBDATA("XOB RPC","SECURITY","TYPE")),1,2)="av" DO QUIT
. SET XOBAVCOD=""
;
IF ELE="KernelCcowToken",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="ccow" DO QUIT
. SET XOBCCOWT=""
;
IF ELE="Duz",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="duz" DO QUIT
. SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
;
IF ELE="Vpid",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="vpid" DO QUIT
. SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
;
IF ELE="ApplicationProxyName",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="appproxy" DO QUIT
. SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
;
; ---------------------------------------------------------------------------
;
QUIT
;
ELEND(ELE) ; -- element end event handler
IF ELE="VistaLink" DO QUIT
. SET XOBDATA("MODE")=$GET(ATR("mode"),"singleton")
. KILL XOBPOS,XOBPARAM,XOBCTXT,XOBPN,XOBPTYPE
;
IF ELE="RpcContext" DO QUIT
. SET XOBDATA("XOB RPC","RPC CONTEXT")=$GET(XOBCTXT)
;
IF ELE="Param" DO KILL XOBPARAM QUIT
. IF XOBPTYPE="string" SET @XOBPN=$$ESC^XOBVRMX(XOBPARAM) QUIT
. IF XOBPTYPE="ref" SET @XOBPN=$GET(@$$ESC^XOBVRMX(XOBPARAM)) QUIT
;
IF ELE="Params" DO QUIT
. NEW POS,PARAMS
. SET PARAMS="",POS=0
. FOR SET POS=$ORDER(XOBDATA("XOB RPC","PARAMS",POS)) QUIT:'POS SET PARAMS=PARAMS_",."_XOBDATA("XOB RPC","PARAMS",POS)
. SET XOBDATA("XOB RPC","PARAMS")=PARAMS
;
IF ELE="Index" DO QUIT
. IF $DATA(XOBPARNM)&$DATA(XOBPARVL) DO
. . KILL XOBPARAM
. . IF $EXTRACT(XOBPARNM,1)=$CHAR(13) DO
. . . SET @("@XOBPN@("_$$ESC^XOBVRMX($EXTRACT(XOBPARNM,2,$LENGTH(XOBPARNM)))_")=$$ESC^XOBVRMX(XOBPARVL)")
. . ELSE DO
. . . SET @XOBPN@($$ESC^XOBVRMX(XOBPARNM))=$$ESC^XOBVRMX(XOBPARVL)
. . KILL XOBPARNM,XOBPARVL
;
IF ELE="Name" DO QUIT
. SET XOBPARNM("DONE")=1
;
IF ELE="Value" DO QUIT
. SET XOBPARVL("DONE")=1
;
IF ELE="AccessVerify",$GET(XOBSECFL),$EXTRACT($GET(XOBDATA("XOB RPC","SECURITY","TYPE")),1,2)="av" DO QUIT
. SET XOBDATA("XOB RPC","SECURITY","TYPE","AVCODE")=XOBAVCOD KILL XOBAVCOD
IF ELE="KernelCcowToken",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="ccow" DO QUIT
. SET XOBDATA("XOB RPC","SECURITY","TYPE","CCOW")=XOBCCOWT KILL XOBCCOWT
IF ELE="Security" KILL XOBSECFL QUIT
;
QUIT
;
CHR(TEXT) ; -- character value event handler <tag>TEXT</tag)
; -- need to concatenate because MXML parses on ENTITY characters (<>& etc.) and
; callback gets hit multiple times even though the tag text value is just one piece of data.
; (Yes, this seems kludgie!)
IF $DATA(XOBPARAM) SET XOBPARAM=XOBPARAM_TEXT
IF $DATA(XOBPARNM),'+$GET(XOBPARNM("DONE")) SET XOBPARNM=XOBPARNM_TEXT QUIT
IF $DATA(XOBPARVL),'+$GET(XOBPARVL("DONE")) SET XOBPARVL=XOBPARVL_TEXT QUIT
IF $DATA(XOBCTXT) SET XOBCTXT=XOBCTXT_TEXT QUIT
IF $DATA(XOBAVCOD) SET XOBAVCOD=XOBAVCOD_TEXT QUIT
IF $DATA(XOBCCOWT) SET XOBCCOWT=XOBCCOWT_TEXT QUIT
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBVRPCI 5615 printed Dec 13, 2024@02:44:52 Page 2
XOBVRPCI ;; ld,mjk/alb - VistaLink Interface Implementation for RPCs; 07/27/2002 13:00
+1 ;;1.6;VistALink;;May 08, 2009;Build 15
+2 ;Per VHA directive 2004-038, this routine should not be modified.
+3 ;
CALLBACK(CB) ; -- init callbacks implementation
+1 SET CB("STARTELEMENT")="ELEST^XOBVRPCI"
+2 SET CB("ENDELEMENT")="ELEND^XOBVRPCI"
+3 SET CB("CHARACTERS")="CHR^XOBVRPCI"
+4 QUIT
+5 ;
READER(XOBUF,XOBDATA) ; -- proprietary format reader implementation
+1 DO START^XOBVRPCX(.XOBUF,.XOBDATA)
+2 QUIT
+3 ;
REQHDLR(XOBDATA) ; -- request handler implementation
+1 DO EN^XOBVRPC(.XOBDATA)
+2 QUIT
+3 ;
+4 ; ------------------------------------------------------------------------
+5 ; RPC Server: Request Message XML SAX Parser Callbacks
+6 ; ------------------------------------------------------------------------
ELEST(ELE,ATR) ; -- element start event handler
+1 IF ELE="VistaLink"
Begin DoDot:1
+2 KILL XOBPARAM,XOBCTXT,XOBPN,XOBPTYPE
+3 ; -- if called from VL v1.0 client then set up J2SE defaults
+4 IF $GET(XOBDATA("VL VERSION"))="1.0"
DO V1^XOBVRPCX
End DoDot:1
QUIT
+5 ;
+6 IF ELE="RpcHandler"
SET XOBDATA("XOB RPC","RPC HANDLER VERSION")=$GET(ATR("version"))
QUIT
+7 ;
+8 IF ELE="Request"
Begin DoDot:1
+9 SET XOBDATA("XOB RPC","RPC NAME")=$$ESC^XOBVRMX($GET(ATR("rpcName"),"##Unkown RPC##"))
+10 NEW X
+11 SET X=$$SETTO^XOBVLIB($GET(ATR("rpcClientTimeOut"),9000))
+12 SET X=$$SETVER^XOBVRPCX($GET(ATR("rpcVersion"),0))
End DoDot:1
QUIT
+13 ;
+14 IF ELE="RpcContext"
SET XOBCTXT=""
QUIT
+15 ;
+16 ; -------------------- Param Node Start Event Processing ---------------------------
+17 ;
+18 IF ELE="Param"
Begin DoDot:1
+19 SET XOBPARAM=""
+20 SET XOBPN="XOBP"_ATR("position")
+21 SET XOBDATA("XOB RPC","PARAMS",ATR("position"))=XOBPN
+22 SET XOBPTYPE=ATR("type")
+23 if XOBPTYPE="array"
SET @XOBPN=""
End DoDot:1
QUIT
+24 ;
+25 IF ELE="Index"
Begin DoDot:1
+26 KILL XOBPARAM
+27 IF $DATA(ATR("name"))&$DATA(ATR("value"))
Begin DoDot:2
+28 SET @XOBPN@($$ESC^XOBVRMX(ATR("name")))=$$ESC^XOBVRMX(ATR("value"))
End DoDot:2
End DoDot:1
QUIT
+29 ;
+30 IF ELE="Name"
Begin DoDot:1
+31 SET XOBPARNM=""
End DoDot:1
QUIT
+32 ;
+33 IF ELE="Value"
Begin DoDot:1
+34 SET XOBPARVL=""
End DoDot:1
QUIT
+35 ;
+36 ; -------------------- Security Node Start Event Processing ---------------------------
+37 ;
+38 IF ELE="Security"
Begin DoDot:1
+39 SET XOBDATA("XOB RPC","SECURITY","TYPE")=$GET(ATR("type"))
+40 SET XOBDATA("XOB RPC","SECURITY","DIV")=$GET(ATR("division"))
+41 SET XOBDATA("XOB RPC","SECURITY","STATE")=$GET(ATR("state"),"notauthenticated")
+42 KILL XOBSECFL
+43 ;
+44 ; -- use to make sure child nodes are from Security
+45 ; parent when processing child node names
+46 SET XOBSECFL=1
End DoDot:1
QUIT
+47 ;
+48 IF ELE="AccessVerify"
IF $GET(XOBSECFL)
IF $EXTRACT($GET(XOBDATA("XOB RPC","SECURITY","TYPE")),1,2)="av"
Begin DoDot:1
+49 SET XOBAVCOD=""
End DoDot:1
QUIT
+50 ;
+51 IF ELE="KernelCcowToken"
IF $GET(XOBSECFL)
IF $GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="ccow"
Begin DoDot:1
+52 SET XOBCCOWT=""
End DoDot:1
QUIT
+53 ;
+54 IF ELE="Duz"
IF $GET(XOBSECFL)
IF $GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="duz"
Begin DoDot:1
+55 SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
End DoDot:1
QUIT
+56 ;
+57 IF ELE="Vpid"
IF $GET(XOBSECFL)
IF $GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="vpid"
Begin DoDot:1
+58 SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
End DoDot:1
QUIT
+59 ;
+60 IF ELE="ApplicationProxyName"
IF $GET(XOBSECFL)
IF $GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="appproxy"
Begin DoDot:1
+61 SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
End DoDot:1
QUIT
+62 ;
+63 ; ---------------------------------------------------------------------------
+64 ;
+65 QUIT
+66 ;
ELEND(ELE) ; -- element end event handler
+1 IF ELE="VistaLink"
Begin DoDot:1
+2 SET XOBDATA("MODE")=$GET(ATR("mode"),"singleton")
+3 KILL XOBPOS,XOBPARAM,XOBCTXT,XOBPN,XOBPTYPE
End DoDot:1
QUIT
+4 ;
+5 IF ELE="RpcContext"
Begin DoDot:1
+6 SET XOBDATA("XOB RPC","RPC CONTEXT")=$GET(XOBCTXT)
End DoDot:1
QUIT
+7 ;
+8 IF ELE="Param"
Begin DoDot:1
+9 IF XOBPTYPE="string"
SET @XOBPN=$$ESC^XOBVRMX(XOBPARAM)
QUIT
+10 IF XOBPTYPE="ref"
SET @XOBPN=$GET(@$$ESC^XOBVRMX(XOBPARAM))
QUIT
End DoDot:1
KILL XOBPARAM
QUIT
+11 ;
+12 IF ELE="Params"
Begin DoDot:1
+13 NEW POS,PARAMS
+14 SET PARAMS=""
SET POS=0
+15 FOR
SET POS=$ORDER(XOBDATA("XOB RPC","PARAMS",POS))
if 'POS
QUIT
SET PARAMS=PARAMS_",."_XOBDATA("XOB RPC","PARAMS",POS)
+16 SET XOBDATA("XOB RPC","PARAMS")=PARAMS
End DoDot:1
QUIT
+17 ;
+18 IF ELE="Index"
Begin DoDot:1
+19 IF $DATA(XOBPARNM)&$DATA(XOBPARVL)
Begin DoDot:2
+20 KILL XOBPARAM
+21 IF $EXTRACT(XOBPARNM,1)=$CHAR(13)
Begin DoDot:3
+22 SET @("@XOBPN@("_$$ESC^XOBVRMX($EXTRACT(XOBPARNM,2,$LENGTH(XOBPARNM)))_")=$$ESC^XOBVRMX(XOBPARVL)")
End DoDot:3
+23 IF '$TEST
Begin DoDot:3
+24 SET @XOBPN@($$ESC^XOBVRMX(XOBPARNM))=$$ESC^XOBVRMX(XOBPARVL)
End DoDot:3
+25 KILL XOBPARNM,XOBPARVL
End DoDot:2
End DoDot:1
QUIT
+26 ;
+27 IF ELE="Name"
Begin DoDot:1
+28 SET XOBPARNM("DONE")=1
End DoDot:1
QUIT
+29 ;
+30 IF ELE="Value"
Begin DoDot:1
+31 SET XOBPARVL("DONE")=1
End DoDot:1
QUIT
+32 ;
+33 IF ELE="AccessVerify"
IF $GET(XOBSECFL)
IF $EXTRACT($GET(XOBDATA("XOB RPC","SECURITY","TYPE")),1,2)="av"
Begin DoDot:1
+34 SET XOBDATA("XOB RPC","SECURITY","TYPE","AVCODE")=XOBAVCOD
KILL XOBAVCOD
End DoDot:1
QUIT
+35 IF ELE="KernelCcowToken"
IF $GET(XOBSECFL)
IF $GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="ccow"
Begin DoDot:1
+36 SET XOBDATA("XOB RPC","SECURITY","TYPE","CCOW")=XOBCCOWT
KILL XOBCCOWT
End DoDot:1
QUIT
+37 IF ELE="Security"
KILL XOBSECFL
QUIT
+38 ;
+39 QUIT
+40 ;
CHR(TEXT) ; -- character value event handler <tag>TEXT</tag)
+1 ; -- need to concatenate because MXML parses on ENTITY characters (<>& etc.) and
+2 ; callback gets hit multiple times even though the tag text value is just one piece of data.
+3 ; (Yes, this seems kludgie!)
+4 IF $DATA(XOBPARAM)
SET XOBPARAM=XOBPARAM_TEXT
+5 IF $DATA(XOBPARNM)
IF '+$GET(XOBPARNM("DONE"))
SET XOBPARNM=XOBPARNM_TEXT
QUIT
+6 IF $DATA(XOBPARVL)
IF '+$GET(XOBPARVL("DONE"))
SET XOBPARVL=XOBPARVL_TEXT
QUIT
+7 IF $DATA(XOBCTXT)
SET XOBCTXT=XOBCTXT_TEXT
QUIT
+8 IF $DATA(XOBAVCOD)
SET XOBAVCOD=XOBAVCOD_TEXT
QUIT
+9 IF $DATA(XOBCCOWT)
SET XOBCCOWT=XOBCCOWT_TEXT
QUIT
+10 QUIT
+11 ;
