XWBRPCC ;OIFO-Oakland/REM - M2M Broker Client Utilities ;06/05/2002 17:25
;;1.1;RPC BROKER;**28,34**;Mar 28, 1997
;
QUIT
;
;p34 - added line to set "MODE" like in PRE^XWBM2MC. No longer will it
; be set in PRE^XWBM2MC - REQUEST.
;
; -------------------------------------------------------------------
; RPC Client: Methods Calls
; -------------------------------------------------------------------
;
; [Public/Supported Method]
EXECUTE(XWBPARMS) ; -- execute rpc call
;
; -- validate parameters passed
IF '$$VALIDATE(.XWBPARMS) QUIT 0
;
; -- call method to build request from parameters array
DO REQUEST(.XWBPARMS)
IF $G(XWBPARMS("RESULTS"))="" SET XWBPARMS("RESULTS")=$NA(^TMP("XWBRPC",$J,"XML"))
QUIT $$EXECUTE^XWBVLC(.XWBPARMS)
;
VALIDATE(XWBPARMS) ; -- validate parameters sent in
; // TODO: Do checks and build validate error message
QUIT 1
;
REQUEST(XWBPARMS) ; -- build XML request
;
NEW XWBLINE,XWBPI,PTYPE
SET XWBLINE=0
SET XWBPARMS("MESSAGE TYPE")="Gov.VA.Med.RPC.Request"
;
S XWBPARMS("MODE")="RPCBroker" ;*p34-added line to set "MODE" instead of in PRE^XWBM2MC.
;SET XWBPARMS("MODE")="single call" ;Comment out for **M2M
;
IF $G(XWBPARMS("REQUEST"))="" SET XWBPARMS("REQUEST")=$NA(XWBPARMS("REQUEST","XML"))
SET XWBREQ=XWBPARMS("REQUEST")
KILL @XWBREQ
;
DO ADD($$XMLHDR^XWBUTL())
;p34-added 'broker m2m' in XML message
DO ADD("<vistalink type="""_$G(XWBPARMS("MESSAGE TYPE"))_""" mode="""_$G(XWBPARMS("MODE"))_""" >")
;
I $G(XWBPARMS("MODE"))'="RPCBroker" D
. DO ADD("<session>")
. ;
. ;**M2M - don't send DUZ
. DO ADD("<duz value="""_$G(XWBPARMS("DUZ"))_""" />")
. DO ADD("<security>")
. ;
. DO ADD("<token value="""_$G(XWBPARMS("TOKEN"))_""" />")
. DO ADD("</security>")
. DO ADD("</session>")
. Q
DO ADD("<rpc uri="""_$G(XWBPARMS("URI"))_""" method="""_$G(XWBPARMS("METHOD"))_""" >")
IF $D(XWBPARMS("PARAMS"))>9 DO
. DO ADD("<params>")
. SET XWBPI=0
. FOR SET XWBPI=$O(XWBPARMS("PARAMS",XWBPI)) Q:'XWBPI!(XWBCRLFL) DO
. . SET PTYPE=$G(XWBPARMS("PARAMS",XWBPI,"TYPE"))
. . IF PTYPE="STRING" DO STRING QUIT
. . IF PTYPE="ARRAY" DO ARRAY QUIT
. . IF PTYPE="REF" DO REF QUIT
. DO ADD("</params>")
DO ADD("</rpc>")
DO ADD("</vistalink>")
QUIT
;
STRING ;
;;DO ADD("<param type=""string"" position="""_XWBPI_""" >"_$G(XWBPARMS("PARAMS",XWBPI,"VALUE"))_"</param>")
I $$CTLCHK($G(XWBPARMS("PARAMS",XWBPI,"VALUE"))) S XWBCRLFL=1 D ERROR^XWBM2MC(8) Q
DO ADD("<param type=""string"" position="""_XWBPI_""" >"_$$CHARCHK^XWBUTL($G(XWBPARMS("PARAMS",XWBPI,"VALUE")))_"</param>")
QUIT
;
ARRAY ;
NEW XWBNAME
DO ADD("<param type=""array"" position="""_XWBPI_""" >")
DO ADD("<indices>")
;
SET XWBNAME="" FOR SET XWBNAME=$O(XWBPARMS("PARAMS",XWBPI,"VALUE",XWBNAME)) Q:XWBNAME="" DO
. ;;DO ADD("<index name="""_XWBNAME_""" value="""_$G(XWBPARMS("PARAMS",XWBPI,"VALUE",XWBNAME))_""" />")
. I $$CTLCHK($G(XWBPARMS("PARAMS",XWBPI,"VALUE",XWBNAME))) S XWBCRLFL=1 D ERROR^XWBM2MC(8) Q
. DO ADD("<index name="""_XWBNAME_""" >"_$$CHARCHK^XWBUTL($G(XWBPARMS("PARAMS",XWBPI,"VALUE",XWBNAME)))_"</index>")
DO ADD("</indices>")
DO ADD("</param>")
QUIT
;
REF ;
I $$CTLCHK($G(XWBPARMS("PARAMS",XWBPI,"VALUE"))) S XWBCRLFL=1 D ERROR^XWBM2MC(8) Q
DO ADD("<param type=""ref"" position="""_XWBPI_""" >"_$$CHARCHK^XWBUTL($G(XWBPARMS("PARAMS",XWBPI,"VALUE")))_"</param>")
QUIT
;
ADD(STR) ; -- add string to array
SET XWBLINE=XWBLINE+1
;
I $G(XWBDBUG) S ^REM("M2MCL","REQUEST",XWBLINE)=STR
;
SET @XWBREQ@(XWBLINE)=STR
QUIT
;
CTLCHK(STR) ;Check for control character in string.
; Exception are $C(10)-LF, $C(13)-CR
N I,Q,X
S X=0
I '(STR?.E1C.E) Q X
S I="" F I=1:1:$L(STR) D
.S Q="" F Q=1:1:31 D Q:X
..;I Q=10!(Q=13) Q
..;W !,"I= ",I," Q= ",Q
..I $E(STR,I)[$C(Q) S X=1 Q
Q X
;
; -------------------------------------------------------------------
; Request Format Documentation
; -------------------------------------------------------------------
;
; [ Parameter Array Format -->> passed to REQUEST^XWBRPCC(.XWBPARMS) ]
;
; -- general information
; XWBPARMS("ADDRESS")="127.0.0.1"
; XWBPARMS("ADDRESS")="152.127.1.35"
; XWBPARMS("PORT")=9800
; XWBPARMS("DUZ")=990
; XWBPARMS("TOKEN")="SOMETHING"
; XWBPARMS("RPC NAME")="SDOE LIST ENCOUNTERS FOR PAT"
;
; -- string parameter type
; XWBPARMS("PARAMS",1,"TYPE")="STRING"
; XWBPARMS("PARAMS",1,"VALUE")=2
; XWBPARMS("PARAMS",2,"TYPE")="STRING"
; XWBPARMS("PARAMS",2,"VALUE")=2961001
; XWBPARMS("PARAMS",3,"TYPE")="STRING"
; XWBPARMS("PARAMS",3,"VALUE")=3030101
;
; -- sample array parameter type
; XWBPARMS("PARAMS",4,"TYPE")="ARRAY"
; XWBPARMS("PARAMS",4,"VALUE","FNAME")="JOE"
; XWBPARMS("PARAMS",4,"VALUE","LNAME")="GOODMAN"
;
; -------------------------------------------------------------------
;
; [ Sample XML produced by calling REQUEST^XWBRPCC(.XWBPARMS) ]
;
; <?xml version="1.0" encoding="utf-8" ?>
; <vistalink type="Gov.VA.Med.RPC.Request" mode="single call" >
; <rpc uri="XWB TEST CALL" >
; <session>
; <duz value="990" />
; <security>
; <token value="something" />
; </security>
; </session>
; <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>
; </rpc>
; </vistalink>
;
; -------------------------------------------------------------------
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXWBRPCC 5934 printed Nov 22, 2024@17:47:21 Page 2
XWBRPCC ;OIFO-Oakland/REM - M2M Broker Client Utilities ;06/05/2002 17:25
+1 ;;1.1;RPC BROKER;**28,34**;Mar 28, 1997
+2 ;
+3 QUIT
+4 ;
+5 ;p34 - added line to set "MODE" like in PRE^XWBM2MC. No longer will it
+6 ; be set in PRE^XWBM2MC - REQUEST.
+7 ;
+8 ; -------------------------------------------------------------------
+9 ; RPC Client: Methods Calls
+10 ; -------------------------------------------------------------------
+11 ;
+12 ; [Public/Supported Method]
EXECUTE(XWBPARMS) ; -- execute rpc call
+1 ;
+2 ; -- validate parameters passed
+3 IF '$$VALIDATE(.XWBPARMS)
QUIT 0
+4 ;
+5 ; -- call method to build request from parameters array
+6 DO REQUEST(.XWBPARMS)
+7 IF $GET(XWBPARMS("RESULTS"))=""
SET XWBPARMS("RESULTS")=$NAME(^TMP("XWBRPC",$JOB,"XML"))
+8 QUIT $$EXECUTE^XWBVLC(.XWBPARMS)
+9 ;
VALIDATE(XWBPARMS) ; -- validate parameters sent in
+1 ; // TODO: Do checks and build validate error message
+2 QUIT 1
+3 ;
REQUEST(XWBPARMS) ; -- build XML request
+1 ;
+2 NEW XWBLINE,XWBPI,PTYPE
+3 SET XWBLINE=0
+4 SET XWBPARMS("MESSAGE TYPE")="Gov.VA.Med.RPC.Request"
+5 ;
+6 ;*p34-added line to set "MODE" instead of in PRE^XWBM2MC.
SET XWBPARMS("MODE")="RPCBroker"
+7 ;SET XWBPARMS("MODE")="single call" ;Comment out for **M2M
+8 ;
+9 IF $GET(XWBPARMS("REQUEST"))=""
SET XWBPARMS("REQUEST")=$NAME(XWBPARMS("REQUEST","XML"))
+10 SET XWBREQ=XWBPARMS("REQUEST")
+11 KILL @XWBREQ
+12 ;
+13 DO ADD($$XMLHDR^XWBUTL())
+14 ;p34-added 'broker m2m' in XML message
+15 DO ADD("<vistalink type="""_$GET(XWBPARMS("MESSAGE TYPE"))_""" mode="""_$GET(XWBPARMS("MODE"))_""" >")
+16 ;
+17 IF $GET(XWBPARMS("MODE"))'="RPCBroker"
Begin DoDot:1
+18 DO ADD("<session>")
+19 ;
+20 ;**M2M - don't send DUZ
+21 DO ADD("<duz value="""_$GET(XWBPARMS("DUZ"))_""" />")
+22 DO ADD("<security>")
+23 ;
+24 DO ADD("<token value="""_$GET(XWBPARMS("TOKEN"))_""" />")
+25 DO ADD("</security>")
+26 DO ADD("</session>")
+27 QUIT
End DoDot:1
+28 DO ADD("<rpc uri="""_$GET(XWBPARMS("URI"))_""" method="""_$GET(XWBPARMS("METHOD"))_""" >")
+29 IF $DATA(XWBPARMS("PARAMS"))>9
Begin DoDot:1
+30 DO ADD("<params>")
+31 SET XWBPI=0
+32 FOR
SET XWBPI=$ORDER(XWBPARMS("PARAMS",XWBPI))
if 'XWBPI!(XWBCRLFL)
QUIT
Begin DoDot:2
+33 SET PTYPE=$GET(XWBPARMS("PARAMS",XWBPI,"TYPE"))
+34 IF PTYPE="STRING"
DO STRING
QUIT
+35 IF PTYPE="ARRAY"
DO ARRAY
QUIT
+36 IF PTYPE="REF"
DO REF
QUIT
End DoDot:2
+37 DO ADD("</params>")
End DoDot:1
+38 DO ADD("</rpc>")
+39 DO ADD("</vistalink>")
+40 QUIT
+41 ;
STRING ;
+1 ;;DO ADD("<param type=""string"" position="""_XWBPI_""" >"_$G(XWBPARMS("PARAMS",XWBPI,"VALUE"))_"</param>")
+2 IF $$CTLCHK($GET(XWBPARMS("PARAMS",XWBPI,"VALUE")))
SET XWBCRLFL=1
DO ERROR^XWBM2MC(8)
QUIT
+3 DO ADD("<param type=""string"" position="""_XWBPI_""" >"_$$CHARCHK^XWBUTL($GET(XWBPARMS("PARAMS",XWBPI,"VALUE")))_"</param>")
+4 QUIT
+5 ;
ARRAY ;
+1 NEW XWBNAME
+2 DO ADD("<param type=""array"" position="""_XWBPI_""" >")
+3 DO ADD("<indices>")
+4 ;
+5 SET XWBNAME=""
FOR
SET XWBNAME=$ORDER(XWBPARMS("PARAMS",XWBPI,"VALUE",XWBNAME))
if XWBNAME=""
QUIT
Begin DoDot:1
+6 ;;DO ADD("<index name="""_XWBNAME_""" value="""_$G(XWBPARMS("PARAMS",XWBPI,"VALUE",XWBNAME))_""" />")
+7 IF $$CTLCHK($GET(XWBPARMS("PARAMS",XWBPI,"VALUE",XWBNAME)))
SET XWBCRLFL=1
DO ERROR^XWBM2MC(8)
QUIT
+8 DO ADD("<index name="""_XWBNAME_""" >"_$$CHARCHK^XWBUTL($GET(XWBPARMS("PARAMS",XWBPI,"VALUE",XWBNAME)))_"</index>")
End DoDot:1
+9 DO ADD("</indices>")
+10 DO ADD("</param>")
+11 QUIT
+12 ;
REF ;
+1 IF $$CTLCHK($GET(XWBPARMS("PARAMS",XWBPI,"VALUE")))
SET XWBCRLFL=1
DO ERROR^XWBM2MC(8)
QUIT
+2 DO ADD("<param type=""ref"" position="""_XWBPI_""" >"_$$CHARCHK^XWBUTL($GET(XWBPARMS("PARAMS",XWBPI,"VALUE")))_"</param>")
+3 QUIT
+4 ;
ADD(STR) ; -- add string to array
+1 SET XWBLINE=XWBLINE+1
+2 ;
+3 IF $GET(XWBDBUG)
SET ^REM("M2MCL","REQUEST",XWBLINE)=STR
+4 ;
+5 SET @XWBREQ@(XWBLINE)=STR
+6 QUIT
+7 ;
CTLCHK(STR) ;Check for control character in string.
+1 ; Exception are $C(10)-LF, $C(13)-CR
+2 NEW I,Q,X
+3 SET X=0
+4 IF '(STR?.E1C.E)
QUIT X
+5 SET I=""
FOR I=1:1:$LENGTH(STR)
Begin DoDot:1
+6 SET Q=""
FOR Q=1:1:31
Begin DoDot:2
+7 ;I Q=10!(Q=13) Q
+8 ;W !,"I= ",I," Q= ",Q
+9 IF $EXTRACT(STR,I)[$CHAR(Q)
SET X=1
QUIT
End DoDot:2
if X
QUIT
End DoDot:1
+10 QUIT X
+11 ;
+12 ; -------------------------------------------------------------------
+13 ; Request Format Documentation
+14 ; -------------------------------------------------------------------
+15 ;
+16 ; [ Parameter Array Format -->> passed to REQUEST^XWBRPCC(.XWBPARMS) ]
+17 ;
+18 ; -- general information
+19 ; XWBPARMS("ADDRESS")="127.0.0.1"
+20 ; XWBPARMS("ADDRESS")="152.127.1.35"
+21 ; XWBPARMS("PORT")=9800
+22 ; XWBPARMS("DUZ")=990
+23 ; XWBPARMS("TOKEN")="SOMETHING"
+24 ; XWBPARMS("RPC NAME")="SDOE LIST ENCOUNTERS FOR PAT"
+25 ;
+26 ; -- string parameter type
+27 ; XWBPARMS("PARAMS",1,"TYPE")="STRING"
+28 ; XWBPARMS("PARAMS",1,"VALUE")=2
+29 ; XWBPARMS("PARAMS",2,"TYPE")="STRING"
+30 ; XWBPARMS("PARAMS",2,"VALUE")=2961001
+31 ; XWBPARMS("PARAMS",3,"TYPE")="STRING"
+32 ; XWBPARMS("PARAMS",3,"VALUE")=3030101
+33 ;
+34 ; -- sample array parameter type
+35 ; XWBPARMS("PARAMS",4,"TYPE")="ARRAY"
+36 ; XWBPARMS("PARAMS",4,"VALUE","FNAME")="JOE"
+37 ; XWBPARMS("PARAMS",4,"VALUE","LNAME")="GOODMAN"
+38 ;
+39 ; -------------------------------------------------------------------
+40 ;
+41 ; [ Sample XML produced by calling REQUEST^XWBRPCC(.XWBPARMS) ]
+42 ;
+43 ; <?xml version="1.0" encoding="utf-8" ?>
+44 ; <vistalink type="Gov.VA.Med.RPC.Request" mode="single call" >
+45 ; <rpc uri="XWB TEST CALL" >
+46 ; <session>
+47 ; <duz value="990" />
+48 ; <security>
+49 ; <token value="something" />
+50 ; </security>
+51 ; </session>
+52 ; <params>
+53 ; <param type="string" position="1" >2</param>
+54 ; <param type="string" position="2" >2961001</param>
+55 ; <param type="string" position="3" >3030101</param>
+56 ; <param type="array" position="4" >
+57 ; <indices>
+58 ; <index name="status" value="veteran" />
+59 ; <index name="gender" value="male" />
+60 ; </indices>
+61 ; </param>
+62 ; </params>
+63 ; </rpc>
+64 ; </vistalink>
+65 ;
+66 ; -------------------------------------------------------------------
+67 ;