XWBTCPM2 ;ISF/RWF - BROKER Other Service ;06/28/2012
;;1.1;RPC BROKER;**43,45,53,59**;Mar 28, 1997;Build 2
;Per VHA Directive 2004-038, this routine should not be modified
;
Q
;
OTH ;Check if some other special service.
; ZEXCEPT: XWB - set prior to call from CONNTYPE^XWBTCPM
S $ETRAP="D ERR^XWBTCPM2"
I XWB="~EAC~" G EAC
I XWB="~BSE~" G BSE
I XWB="~SVR~" G SVR
D LOG("In 0TH^XWBTCPM2 - Prefix not known: "_XWB)
Q
;
SVR ;Handle
Q
EAC ;Enterprise Access
Q
;
BSE ;Broker Security Enhancement
D LOG("BSE msg")
N L,HDL,RET,XWBSBUF
S XWBSBUF="",RET="",HDL=""
S L=$$BREAD^XWBRW(3) I L S HDL=$$BREAD^XWBRW(L)
I $E(HDL,1,3)="PUT" D
. ;D RPUT^XUSBSE1(.RET,HDL) ;p59(REM)-RPUT^XUSBSE1 does not exsist.
. Q
;Check IT
I $E(HDL,1,3)'="PUT" D GETVISIT^XUSBSE1(.RET,HDL)
D WRITE(RET),WBF
Q
;
ERR ;Error Trap
D ^%ZTER
G H2^XUSCLEAN
;
LOG(%) ;Link to logger
Q:'$G(XWBDEBUG)
D LOG^XWBTCPM(%)
Q
;
WRITE(M,F) ;Write
N L S L="" I '$G(F) S L=$E(1000+$L(M),2,4)
D WRITE^XWBRW(L_M)
Q
WBF ;Buffer Flush
D WBF^XWBRW
Q
;
OPEN(P1,P2) ;Open the device and set the variables
D CALL^%ZISTCP(P1,P2) Q:POP
S XWBTDEV=IO
Q
;
CALLBSE(SERVER,PORT,TOKEN,STN) ;Special Broker service
N XWBDEBUG,XWBOS,XWBRBUF,XWBSBUF,XWBT,XWBTIME,IO
N DEMOSTR,XWBTDEV,RET,X,POP
S IO(0)=$P
D INIT^XWBTCPM,LOG("CALLBSE")
D OPEN(SERVER,PORT)
; if initial failure try to get web address
I POP,$G(STN)'="" S SERVER=$$WEBADDRS^XUSBSE1(STN) I SERVER'="" D OPEN(SERVER,PORT)
I POP Q "Didn't open connection."
S XWBSBUF="",XWBRBUF=""
U XWBTDEV
D WRITE("~BSE~",1),WRITE(TOKEN),WBF^XWBRW
S X=$$BREAD^XWBRW(3),RET="No Response" I X S RET=$$BREAD^XWBRW(X)
D CLOSE^%ZISTCP,LOG("FINISH")
Q RET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXWBTCPM2 1753 printed Sep 11, 2024@02:57:17 Page 2
XWBTCPM2 ;ISF/RWF - BROKER Other Service ;06/28/2012
+1 ;;1.1;RPC BROKER;**43,45,53,59**;Mar 28, 1997;Build 2
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
OTH ;Check if some other special service.
+1 ; ZEXCEPT: XWB - set prior to call from CONNTYPE^XWBTCPM
+2 SET $ETRAP="D ERR^XWBTCPM2"
+3 IF XWB="~EAC~"
GOTO EAC
+4 IF XWB="~BSE~"
GOTO BSE
+5 IF XWB="~SVR~"
GOTO SVR
+6 DO LOG("In 0TH^XWBTCPM2 - Prefix not known: "_XWB)
+7 QUIT
+8 ;
SVR ;Handle
+1 QUIT
EAC ;Enterprise Access
+1 QUIT
+2 ;
BSE ;Broker Security Enhancement
+1 DO LOG("BSE msg")
+2 NEW L,HDL,RET,XWBSBUF
+3 SET XWBSBUF=""
SET RET=""
SET HDL=""
+4 SET L=$$BREAD^XWBRW(3)
IF L
SET HDL=$$BREAD^XWBRW(L)
+5 IF $EXTRACT(HDL,1,3)="PUT"
Begin DoDot:1
+6 ;D RPUT^XUSBSE1(.RET,HDL) ;p59(REM)-RPUT^XUSBSE1 does not exsist.
+7 QUIT
End DoDot:1
+8 ;Check IT
+9 IF $EXTRACT(HDL,1,3)'="PUT"
DO GETVISIT^XUSBSE1(.RET,HDL)
+10 DO WRITE(RET)
DO WBF
+11 QUIT
+12 ;
ERR ;Error Trap
+1 DO ^%ZTER
+2 GOTO H2^XUSCLEAN
+3 ;
LOG(%) ;Link to logger
+1 if '$GET(XWBDEBUG)
QUIT
+2 DO LOG^XWBTCPM(%)
+3 QUIT
+4 ;
WRITE(M,F) ;Write
+1 NEW L
SET L=""
IF '$GET(F)
SET L=$EXTRACT(1000+$LENGTH(M),2,4)
+2 DO WRITE^XWBRW(L_M)
+3 QUIT
WBF ;Buffer Flush
+1 DO WBF^XWBRW
+2 QUIT
+3 ;
OPEN(P1,P2) ;Open the device and set the variables
+1 DO CALL^%ZISTCP(P1,P2)
if POP
QUIT
+2 SET XWBTDEV=IO
+3 QUIT
+4 ;
CALLBSE(SERVER,PORT,TOKEN,STN) ;Special Broker service
+1 NEW XWBDEBUG,XWBOS,XWBRBUF,XWBSBUF,XWBT,XWBTIME,IO
+2 NEW DEMOSTR,XWBTDEV,RET,X,POP
+3 SET IO(0)=$PRINCIPAL
+4 DO INIT^XWBTCPM
DO LOG("CALLBSE")
+5 DO OPEN(SERVER,PORT)
+6 ; if initial failure try to get web address
+7 IF POP
IF $GET(STN)'=""
SET SERVER=$$WEBADDRS^XUSBSE1(STN)
IF SERVER'=""
DO OPEN(SERVER,PORT)
+8 IF POP
QUIT "Didn't open connection."
+9 SET XWBSBUF=""
SET XWBRBUF=""
+10 USE XWBTDEV
+11 DO WRITE("~BSE~",1)
DO WRITE(TOKEN)
DO WBF^XWBRW
+12 SET X=$$BREAD^XWBRW(3)
SET RET="No Response"
IF X
SET RET=$$BREAD^XWBRW(X)
+13 DO CLOSE^%ZISTCP
DO LOG("FINISH")
+14 QUIT RET
