XWBM2MT ;OIFO-Oakland/REM - M2M Broker Example ;05/16/2002 14:09
;;1.1;RPC BROKER;**28**;Mar 28, 1997
;
QUIT
;
EN(CONTX,RPCN) ;Entry point to hard code IP,PORT,AV
S IP="127.0.0.1",PORT=9800,AV="QQQQ11;11ZZZZ.."
D EN1(CONTX,RPCN,PORT,IP,AV)
Q
;
EN1(CONTX,RPCN,PORT,IP,AV) ;
N I
;Entry point that passes in needed parameters. If use this entry point,
; need to set up params first.
;CONTX - Name of context
;RPCN - RPC name
;PORT - port number
;IP - IP address
;AV - access/verify codes
;XWBOPEN - set this flag before call to keep connection open after call.
K REQ,STATE,RPC
S U="^" I $G(DUZ)'>0 W !,"Please Call XUP first!" Q
D HOME^%ZIS U IO
W !!,"Test a M2M call to ",CONTX," context."
D OPEN(PORT,IP,AV)
I XWBSTATE("M2M","OPEN")=0 D HOME^%ZIS U IO W !,"Didn't get port open or AV failed." Q
I '$$SETCONTX^XWBM2MC(CONTX) D HOME^%ZIS U IO W !,"Didn't get Context" G EXIT
;This code is run if called from EN3
I $G(RMFLAG)=1 D
.D CLEARP
.D SETPARAM(1,"STRING","RAUL TEST")
D HOME^%ZIS U IO
W !,"Call ",RPCN," - RPC."
I '$$CALLRPC^XWBM2MC(RPCN,"REQ",1) D HOME^%ZIS U IO W !,"Could not run RPC."
W !,"Result: " F I=1:1 Q:'$D(REQ(I)) W !,REQ(I)
W !
K RMFLAG
I $G(XWBOPEN)=1 Q ;flag to quit and keep connection open
;
EXIT D CLOSE
Q
;
EN2 ;Entry point that hard sets IP,PORT,AV,CONTEXT,RPC.
;RMFLAG - if RMGLAG=1, it will set PARAM in EN1.
N IP,PORT,AV,CONTX,RPCN,RMFLAG
S RMFLAG=1
;S IP="127.0.0.1",PORT="9800",AV="2287CTD;11ZZZZ.." ;BayPines Cache
S IP="127.0.0.1",PORT=9800,AV="QQQQ11;11ZZZZ.."
S CONTX="XWB BROKER EXAMPLE",RPCN="XWB EXAMPLE ECHO STRING"
D EN1(CONTX,RPCN,PORT,IP,AV)
Q
;
EN3(VAL) ;Just runs RPC; need to OPEN, SETCONTX then CLOSE. Or just call after
; connection has been done. **ONLY WORKS FOR TESTING IN DEV,XWB**
N STR,ROOT,RPC,RES
S ^TMP("XWBM2MTEST",$J,"TYPE")="STRING"
S ^TMP("XWBM2MTEST",$J,"VALUE")=VAL
S ROOT=$NA(^TMP("XWBM2MTEST",$J))
I '$$PARAM^XWBM2MC(1,ROOT) W !,"PARAM failed." Q 0
S RPC="ZZRM TEST RPC",RES="RESPONSE"
I '$$CALLRPC^XWBM2MC(RPC,RES,0) Q 0 ;D HOME^%ZIS U IO W !,"Could not run RPC."
K ^TMP("XWBM2MTEST")
Q 1
;
ECHOSTR ;Example of Echo String
N XWBSTR,XWBIP,XWBPORT,XWBAV,Y
S XWBIP="",XWBPORT="",XWBAV=""
K DIR S DIR(0)="FAU^1:50",DIR("A")="Enter String: ",DIR("B")="TEST STRING"
D ^DIR I $D(DIRUT) Q
S XWBSTR=$$CHARCHK^XWBUTL(Y)
D CLEARP
D SETPARAM(1,"STRING",XWBSTR)
I $G(XWBFLAG) D EN("XWB BROKER EXAMPLE","XWB EXAMPLE ECHO STRING") K XWBFLAG Q
D USERIP Q:$G(XWBQUIT)
D EN1("XWB BROKER EXAMPLE","XWB EXAMPLE ECHO STRING",XWBPORT,XWBIP,XWBAV)
D CLEAN
Q
;
WP ;Example of WP
N XWBSTR,XWBIP,XWBPORT,XWBAV
S XWBIP="",XWBPORT="",XWBAV=""
D CLEARP
I $G(XWBFLAG) D EN("XWB BROKER EXAMPLE","XWB EXAMPLE WPTEXT") K XWBFLAG Q
D USERIP Q:$G(XWBQUIT)
D EN1("XWB BROKER EXAMPLE","XWB EXAMPLE WPTEXT",XWBPORT,XWBIP,XWBAV)
D CLEAN
Q
;
LARRY ;Example of passing Array (mult).
N XWBIP,XWBPORT,XWBAV
S XWBIP="",XWBPORT="",XWBAV=""
D CLEARP
S XWBPARMS("PARAMS",1,"TYPE")="ARRAY"
S XWBPARMS("PARAMS",1,"VALUE","Raul")="Programmer"
S XWBPARMS("PARAMS",1,"VALUE","Susan")="Tech Writter"
S XWBPARMS("PARAMS",1,"VALUE","Dan")="Project Mgr"
I $G(XWBFLAG) D EN("XWB BROKER EXAMPLE","XWB M2M EXAMPLE LARRY") K XWBFLAG Q
D USERIP Q:$G(XWBQUIT)
D EN1("XWB BROKER EXAMPLE","XWB M2M EXAMPLE LARRY",XWBPORT,XWBIP,XWBAV)
D CLEAN
Q
;
LARRYRP(XWBY,XWBARR,XWBSTR) ;Remote procedure for local array
NEW XWBX,XWBLINE
;
SET XWBLINE=0
I $G(XWBSTR)'="" S XWBY(1)=$G(XWBSTR) S XWBLINE=1
SET XWBX="" FOR SET XWBX=$O(XWBARR(XWBX)) QUIT:XWBX="" DO
.S XWBLINE=XWBLINE+1
.S XWBY(XWBLINE)=XWBX_" / "_XWBARR(XWBX)
Q
;
LARRSTR ;Example of passing Array (mult) and String.
N XWBIP,XWBPORT,XWBAV
S XWBIP="",XWBPORT="",XWBAV=""
D CLEARP
S XWBPARMS("PARAMS",1,"TYPE")="ARRAY"
S XWBPARMS("PARAMS",1,"VALUE","Raul")="Programmer"
S XWBPARMS("PARAMS",1,"VALUE","Susan")="Tech Writter"
S XWBPARMS("PARAMS",1,"VALUE","Dan")="Project Mgr"
S XWBPARMS("PARAMS",2,"TYPE")="STRING"
S XWBPARMS("PARAMS",2,"VALUE")="String and Array (MULT) TEST"
I $G(XWBFLAG) D EN("XWB BROKER EXAMPLE","XWB M2M EXAMPLE LARRY") K XWBFLAG Q
D USERIP Q:$G(XWBQUIT)
D EN1("XWB BROKER EXAMPLE","XWB M2M EXAMPLE LARRY",XWBPORT,XWBIP,XWBAV)
D CLEAN
Q
;
REF ;Example of passing a value by reference
N XWBREF,Y,XWBSTR,XWBIP,XWBPORT,XWBAV
S XWBIP="",XWBPORT="",XWBAV=""
K DIR S DIR(0)="FAU^1:50",DIR("A")="Enter Reference Value: ",DIR("B")="DT"
D ^DIR I $D(DIRUT) Q
S XWBREF=$$CHARCHK^XWBUTL(Y)
D CLEARP
D SETPARAM(1,"REF",XWBREF)
I $G(XWBFLAG) D EN("XWB BROKER EXAMPLE","XWB M2M EXAMPLE REF") K XWBFLAG Q
D USERIP Q:$G(XWBQUIT)
D EN1("XWB BROKER EXAMPLE","XWB M2M EXAMPLE REF",XWBPORT,XWBIP,XWBAV)
D CLEAN
Q
;
REFRP(RET,PARAM) ;Remote procedure for value passed by reference
S RET(0)=PARAM
Q
;
USERIP ;Get IP,Port,AV from user for connection.
N Y
S XWBQUIT=0
K DIR S DIR(0)="FAU^1:50",DIR("A")="Enter IP: ",DIR("B")="127.0.0.1"
D ^DIR I $D(DIRUT) S XWBQUIT=1 Q
S XWBIP=Y
K DIR S DIR(0)="FAU^1:50",DIR("A")="Enter PORT: ",DIR("B")="9800"
D ^DIR I $D(DIRUT) S XWBQUIT=1 Q
S XWBPORT=Y
K DIR S DIR(0)="FAU^1:50",DIR("A")="Enter AV: ",DIR("?")="e.g. Smith;11PASSWORD!! "
D ^DIR I $D(DIRUT) S XWBQUIT=1 Q
S XWBAV=Y
K DIR S DIR(0)="FAU^1:50",DIR("A")="Enter CONTEXT: ",DIR("B")="XWB BROKER EXAMPLE"
D ^DIR I $D(DIRUT) S XWBQUIT=1 Q
S XWBCONTX=Y
I $G(XWBREPFL) D
.K DIR S DIR(0)="FAU^1:50",DIR("A")="Enter REPS: "
.D ^DIR I $D(DIRUT) S XWBQUIT=1 Q
.S XWBREPS=Y
Q
;
OPEN(PORT,IP,AV) ;Opens connection to server.
;S IP="127.0.0.1",PORT="9800",AV="QQQQ11;11ZZZZ.." ;Local
;S IP="127.0.0.1",PORT="9800",AV="2287CTD;11ZZZZ.." ;BayPines Cache
S XWBSTATE("M2M","OPEN")=$$CONNECT^XWBM2MC(PORT,IP,AV)
Q
;
CLOSE ;Close the connection.
S X=$$CLOSE^XWBM2MC()
S XWBSTATE("M2M","OPEN")=0
D CLEAN
K X,XWBOPEN
Q
;
CLEARP ;Clear the PARAMS array
I '$G(XWBDBUG) K XWBPARMS
D PRE^XWBM2MC
Q
;
SETPARAM(INDEX,TYPE,VALUE) ;Set a Params entry
S XWBPARMS("PARAMS",INDEX,"TYPE")=TYPE
S XWBPARMS("PARAMS",INDEX,"VALUE")=VALUE
Q
;
CLNTMP ;Kills the TMP("XWB*"
K ^TMP("XWBM2M"),^TMP("XWBM2MVLC"),^TMP("XWBM2MRPC"),^TMP("XWBM2MRL")
K ^TMP("XWBM2ME"),^TMP("XWBM2M"),^TMP("XWBM2ML")
Q
;
CLEAN ;
K REQ,XWBCONTX
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXWBM2MT 6418 printed Dec 13, 2024@02:37:18 Page 2
XWBM2MT ;OIFO-Oakland/REM - M2M Broker Example ;05/16/2002 14:09
+1 ;;1.1;RPC BROKER;**28**;Mar 28, 1997
+2 ;
+3 QUIT
+4 ;
EN(CONTX,RPCN) ;Entry point to hard code IP,PORT,AV
+1 SET IP="127.0.0.1"
SET PORT=9800
SET AV="QQQQ11;11ZZZZ.."
+2 DO EN1(CONTX,RPCN,PORT,IP,AV)
+3 QUIT
+4 ;
EN1(CONTX,RPCN,PORT,IP,AV) ;
+1 NEW I
+2 ;Entry point that passes in needed parameters. If use this entry point,
+3 ; need to set up params first.
+4 ;CONTX - Name of context
+5 ;RPCN - RPC name
+6 ;PORT - port number
+7 ;IP - IP address
+8 ;AV - access/verify codes
+9 ;XWBOPEN - set this flag before call to keep connection open after call.
+10 KILL REQ,STATE,RPC
+11 SET U="^"
IF $GET(DUZ)'>0
WRITE !,"Please Call XUP first!"
QUIT
+12 DO HOME^%ZIS
USE IO
+13 WRITE !!,"Test a M2M call to ",CONTX," context."
+14 DO OPEN(PORT,IP,AV)
+15 IF XWBSTATE("M2M","OPEN")=0
DO HOME^%ZIS
USE IO
WRITE !,"Didn't get port open or AV failed."
QUIT
+16 IF '$$SETCONTX^XWBM2MC(CONTX)
DO HOME^%ZIS
USE IO
WRITE !,"Didn't get Context"
GOTO EXIT
+17 ;This code is run if called from EN3
+18 IF $GET(RMFLAG)=1
Begin DoDot:1
+19 DO CLEARP
+20 DO SETPARAM(1,"STRING","RAUL TEST")
End DoDot:1
+21 DO HOME^%ZIS
USE IO
+22 WRITE !,"Call ",RPCN," - RPC."
+23 IF '$$CALLRPC^XWBM2MC(RPCN,"REQ",1)
DO HOME^%ZIS
USE IO
WRITE !,"Could not run RPC."
+24 WRITE !,"Result: "
FOR I=1:1
if '$DATA(REQ(I))
QUIT
WRITE !,REQ(I)
+25 WRITE !
+26 KILL RMFLAG
+27 ;flag to quit and keep connection open
IF $GET(XWBOPEN)=1
QUIT
+28 ;
EXIT DO CLOSE
+1 QUIT
+2 ;
EN2 ;Entry point that hard sets IP,PORT,AV,CONTEXT,RPC.
+1 ;RMFLAG - if RMGLAG=1, it will set PARAM in EN1.
+2 NEW IP,PORT,AV,CONTX,RPCN,RMFLAG
+3 SET RMFLAG=1
+4 ;S IP="127.0.0.1",PORT="9800",AV="2287CTD;11ZZZZ.." ;BayPines Cache
+5 SET IP="127.0.0.1"
SET PORT=9800
SET AV="QQQQ11;11ZZZZ.."
+6 SET CONTX="XWB BROKER EXAMPLE"
SET RPCN="XWB EXAMPLE ECHO STRING"
+7 DO EN1(CONTX,RPCN,PORT,IP,AV)
+8 QUIT
+9 ;
EN3(VAL) ;Just runs RPC; need to OPEN, SETCONTX then CLOSE. Or just call after
+1 ; connection has been done. **ONLY WORKS FOR TESTING IN DEV,XWB**
+2 NEW STR,ROOT,RPC,RES
+3 SET ^TMP("XWBM2MTEST",$JOB,"TYPE")="STRING"
+4 SET ^TMP("XWBM2MTEST",$JOB,"VALUE")=VAL
+5 SET ROOT=$NAME(^TMP("XWBM2MTEST",$JOB))
+6 IF '$$PARAM^XWBM2MC(1,ROOT)
WRITE !,"PARAM failed."
QUIT 0
+7 SET RPC="ZZRM TEST RPC"
SET RES="RESPONSE"
+8 ;D HOME^%ZIS U IO W !,"Could not run RPC."
IF '$$CALLRPC^XWBM2MC(RPC,RES,0)
QUIT 0
+9 KILL ^TMP("XWBM2MTEST")
+10 QUIT 1
+11 ;
ECHOSTR ;Example of Echo String
+1 NEW XWBSTR,XWBIP,XWBPORT,XWBAV,Y
+2 SET XWBIP=""
SET XWBPORT=""
SET XWBAV=""
+3 KILL DIR
SET DIR(0)="FAU^1:50"
SET DIR("A")="Enter String: "
SET DIR("B")="TEST STRING"
+4 DO ^DIR
IF $DATA(DIRUT)
QUIT
+5 SET XWBSTR=$$CHARCHK^XWBUTL(Y)
+6 DO CLEARP
+7 DO SETPARAM(1,"STRING",XWBSTR)
+8 IF $GET(XWBFLAG)
DO EN("XWB BROKER EXAMPLE","XWB EXAMPLE ECHO STRING")
KILL XWBFLAG
QUIT
+9 DO USERIP
if $GET(XWBQUIT)
QUIT
+10 DO EN1("XWB BROKER EXAMPLE","XWB EXAMPLE ECHO STRING",XWBPORT,XWBIP,XWBAV)
+11 DO CLEAN
+12 QUIT
+13 ;
WP ;Example of WP
+1 NEW XWBSTR,XWBIP,XWBPORT,XWBAV
+2 SET XWBIP=""
SET XWBPORT=""
SET XWBAV=""
+3 DO CLEARP
+4 IF $GET(XWBFLAG)
DO EN("XWB BROKER EXAMPLE","XWB EXAMPLE WPTEXT")
KILL XWBFLAG
QUIT
+5 DO USERIP
if $GET(XWBQUIT)
QUIT
+6 DO EN1("XWB BROKER EXAMPLE","XWB EXAMPLE WPTEXT",XWBPORT,XWBIP,XWBAV)
+7 DO CLEAN
+8 QUIT
+9 ;
LARRY ;Example of passing Array (mult).
+1 NEW XWBIP,XWBPORT,XWBAV
+2 SET XWBIP=""
SET XWBPORT=""
SET XWBAV=""
+3 DO CLEARP
+4 SET XWBPARMS("PARAMS",1,"TYPE")="ARRAY"
+5 SET XWBPARMS("PARAMS",1,"VALUE","Raul")="Programmer"
+6 SET XWBPARMS("PARAMS",1,"VALUE","Susan")="Tech Writter"
+7 SET XWBPARMS("PARAMS",1,"VALUE","Dan")="Project Mgr"
+8 IF $GET(XWBFLAG)
DO EN("XWB BROKER EXAMPLE","XWB M2M EXAMPLE LARRY")
KILL XWBFLAG
QUIT
+9 DO USERIP
if $GET(XWBQUIT)
QUIT
+10 DO EN1("XWB BROKER EXAMPLE","XWB M2M EXAMPLE LARRY",XWBPORT,XWBIP,XWBAV)
+11 DO CLEAN
+12 QUIT
+13 ;
LARRYRP(XWBY,XWBARR,XWBSTR) ;Remote procedure for local array
+1 NEW XWBX,XWBLINE
+2 ;
+3 SET XWBLINE=0
+4 IF $GET(XWBSTR)'=""
SET XWBY(1)=$GET(XWBSTR)
SET XWBLINE=1
+5 SET XWBX=""
FOR
SET XWBX=$ORDER(XWBARR(XWBX))
if XWBX=""
QUIT
Begin DoDot:1
+6 SET XWBLINE=XWBLINE+1
+7 SET XWBY(XWBLINE)=XWBX_" / "_XWBARR(XWBX)
End DoDot:1
+8 QUIT
+9 ;
LARRSTR ;Example of passing Array (mult) and String.
+1 NEW XWBIP,XWBPORT,XWBAV
+2 SET XWBIP=""
SET XWBPORT=""
SET XWBAV=""
+3 DO CLEARP
+4 SET XWBPARMS("PARAMS",1,"TYPE")="ARRAY"
+5 SET XWBPARMS("PARAMS",1,"VALUE","Raul")="Programmer"
+6 SET XWBPARMS("PARAMS",1,"VALUE","Susan")="Tech Writter"
+7 SET XWBPARMS("PARAMS",1,"VALUE","Dan")="Project Mgr"
+8 SET XWBPARMS("PARAMS",2,"TYPE")="STRING"
+9 SET XWBPARMS("PARAMS",2,"VALUE")="String and Array (MULT) TEST"
+10 IF $GET(XWBFLAG)
DO EN("XWB BROKER EXAMPLE","XWB M2M EXAMPLE LARRY")
KILL XWBFLAG
QUIT
+11 DO USERIP
if $GET(XWBQUIT)
QUIT
+12 DO EN1("XWB BROKER EXAMPLE","XWB M2M EXAMPLE LARRY",XWBPORT,XWBIP,XWBAV)
+13 DO CLEAN
+14 QUIT
+15 ;
REF ;Example of passing a value by reference
+1 NEW XWBREF,Y,XWBSTR,XWBIP,XWBPORT,XWBAV
+2 SET XWBIP=""
SET XWBPORT=""
SET XWBAV=""
+3 KILL DIR
SET DIR(0)="FAU^1:50"
SET DIR("A")="Enter Reference Value: "
SET DIR("B")="DT"
+4 DO ^DIR
IF $DATA(DIRUT)
QUIT
+5 SET XWBREF=$$CHARCHK^XWBUTL(Y)
+6 DO CLEARP
+7 DO SETPARAM(1,"REF",XWBREF)
+8 IF $GET(XWBFLAG)
DO EN("XWB BROKER EXAMPLE","XWB M2M EXAMPLE REF")
KILL XWBFLAG
QUIT
+9 DO USERIP
if $GET(XWBQUIT)
QUIT
+10 DO EN1("XWB BROKER EXAMPLE","XWB M2M EXAMPLE REF",XWBPORT,XWBIP,XWBAV)
+11 DO CLEAN
+12 QUIT
+13 ;
REFRP(RET,PARAM) ;Remote procedure for value passed by reference
+1 SET RET(0)=PARAM
+2 QUIT
+3 ;
USERIP ;Get IP,Port,AV from user for connection.
+1 NEW Y
+2 SET XWBQUIT=0
+3 KILL DIR
SET DIR(0)="FAU^1:50"
SET DIR("A")="Enter IP: "
SET DIR("B")="127.0.0.1"
+4 DO ^DIR
IF $DATA(DIRUT)
SET XWBQUIT=1
QUIT
+5 SET XWBIP=Y
+6 KILL DIR
SET DIR(0)="FAU^1:50"
SET DIR("A")="Enter PORT: "
SET DIR("B")="9800"
+7 DO ^DIR
IF $DATA(DIRUT)
SET XWBQUIT=1
QUIT
+8 SET XWBPORT=Y
+9 KILL DIR
SET DIR(0)="FAU^1:50"
SET DIR("A")="Enter AV: "
SET DIR("?")="e.g. Smith;11PASSWORD!! "
+10 DO ^DIR
IF $DATA(DIRUT)
SET XWBQUIT=1
QUIT
+11 SET XWBAV=Y
+12 KILL DIR
SET DIR(0)="FAU^1:50"
SET DIR("A")="Enter CONTEXT: "
SET DIR("B")="XWB BROKER EXAMPLE"
+13 DO ^DIR
IF $DATA(DIRUT)
SET XWBQUIT=1
QUIT
+14 SET XWBCONTX=Y
+15 IF $GET(XWBREPFL)
Begin DoDot:1
+16 KILL DIR
SET DIR(0)="FAU^1:50"
SET DIR("A")="Enter REPS: "
+17 DO ^DIR
IF $DATA(DIRUT)
SET XWBQUIT=1
QUIT
+18 SET XWBREPS=Y
End DoDot:1
+19 QUIT
+20 ;
OPEN(PORT,IP,AV) ;Opens connection to server.
+1 ;S IP="127.0.0.1",PORT="9800",AV="QQQQ11;11ZZZZ.." ;Local
+2 ;S IP="127.0.0.1",PORT="9800",AV="2287CTD;11ZZZZ.." ;BayPines Cache
+3 SET XWBSTATE("M2M","OPEN")=$$CONNECT^XWBM2MC(PORT,IP,AV)
+4 QUIT
+5 ;
CLOSE ;Close the connection.
+1 SET X=$$CLOSE^XWBM2MC()
+2 SET XWBSTATE("M2M","OPEN")=0
+3 DO CLEAN
+4 KILL X,XWBOPEN
+5 QUIT
+6 ;
CLEARP ;Clear the PARAMS array
+1 IF '$GET(XWBDBUG)
KILL XWBPARMS
+2 DO PRE^XWBM2MC
+3 QUIT
+4 ;
SETPARAM(INDEX,TYPE,VALUE) ;Set a Params entry
+1 SET XWBPARMS("PARAMS",INDEX,"TYPE")=TYPE
+2 SET XWBPARMS("PARAMS",INDEX,"VALUE")=VALUE
+3 QUIT
+4 ;
CLNTMP ;Kills the TMP("XWB*"
+1 KILL ^TMP("XWBM2M"),^TMP("XWBM2MVLC"),^TMP("XWBM2MRPC"),^TMP("XWBM2MRL")
+2 KILL ^TMP("XWBM2ME"),^TMP("XWBM2M"),^TMP("XWBM2ML")
+3 QUIT
+4 ;
CLEAN ;
+1 KILL REQ,XWBCONTX
+2 QUIT
+3 ;
