| 1 | XWBTCPMT ;ISF/RWF - Routine to test a connection ;11/28/2005
|
|---|
| 2 | ;;1.1;RPC BROKER;**43**;Mar 28, 1997
|
|---|
| 3 | CALL ;Interactive
|
|---|
| 4 | N IP,PORT,STAT
|
|---|
| 5 | D HOME^%ZIS
|
|---|
| 6 | S U="^",DTIME=$$DTIME^XUP
|
|---|
| 7 | W !,"Interactive Broker Test"
|
|---|
| 8 | R !,"IP ADDRESS: ",IP:DTIME
|
|---|
| 9 | I IP["^" Q
|
|---|
| 10 | R !,"PORT: ",PORT:DTIME
|
|---|
| 11 | I PORT["^" Q
|
|---|
| 12 | S STAT=$$TEST(IP,PORT,1)
|
|---|
| 13 | U $P
|
|---|
| 14 | W !,$S(STAT>0:"Success, response: "_$P(STAT,U,2),1:"Failed: "_$P(STAT,U,2,9))
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | TEST(IP,PORT,TALK) ;
|
|---|
| 18 | I IP'?1.3N1P1.3N1P1.3N1P1.3N S IP=$$ADDRESS^XLFNSLK(IP)
|
|---|
| 19 | I IP'?1.3N1P1.3N1P1.3N1P1.3N Q "-1^BAD IP"
|
|---|
| 20 | D CALL^%ZISTCP(IP,PORT)
|
|---|
| 21 | I POP Q "-1^Failed to Connect"
|
|---|
| 22 | U IO
|
|---|
| 23 | N $ET S $ET="G ERR^XWBTCPMT"
|
|---|
| 24 | ;TCPConnect
|
|---|
| 25 | W "[XWB]10304"_$C(10)_"TCPConnect5001010.6.17.95f00010f0024ISF-FORTW.vha.med.va.govf"_$C(4),@IOF
|
|---|
| 26 | R RES:10 I '$T S RES="-1^TIMEOUT" G EXIT
|
|---|
| 27 | W "[XWB]10304"_$C(5)_"#BYE#"_$C(4),@IOF
|
|---|
| 28 | R RES2:10 I '$T S RES="-1^TIMEOUT after accept"
|
|---|
| 29 | S RES="1^"_RES
|
|---|
| 30 | EXIT ;Close and Exit
|
|---|
| 31 | D CLOSE^%ZISTCP
|
|---|
| 32 | Q RES
|
|---|
| 33 | ;
|
|---|
| 34 | ERR ;
|
|---|
| 35 | D CLOSE^%ZISTCP
|
|---|
| 36 | U $P
|
|---|
| 37 | Q "-1^"_$$EC^%ZOSV
|
|---|
| 38 | ;
|
|---|
| 39 | CHECK ;Check server setup
|
|---|
| 40 | N XPARSYS,XWBDEBUG,XWBOS,XWBT,XWNRBUF,XWBTIME,NEWJOB
|
|---|
| 41 | W !,"This will check for some of the errors that can prevent the Broker"
|
|---|
| 42 | W !,"from getting started.",!
|
|---|
| 43 | D HOME^%ZIS
|
|---|
| 44 | D INIT^XWBTCPM
|
|---|
| 45 | W !,"Debuging is set to ",$S(XWBDEBUG=1:"On",XWBDEBUG=2:"Verbose",XWBDEBUG=3:"Very Verbose",1:"Off")
|
|---|
| 46 | D SETTIME^XWBTCPM(0)
|
|---|
| 47 | W !,"Broker activity timeout is set to ",XWBTIME
|
|---|
| 48 | S %ZIS="MN",IOP="NULL" D ^%ZIS
|
|---|
| 49 | I POP W !,"The NULL device is not setup correctly."
|
|---|
| 50 | I 'POP D ^%ZISC W !,"The NULL device is OK."
|
|---|
| 51 | I $T(SHARELIC^%ZOSV)="" W !,"The routine %ZOSV is missing the entry point 'SHARELIC'."
|
|---|
| 52 | I $T(GETPEER^%ZOSV)="" W !,"The routine %ZOSV is missing the entry point 'GETPEER'."
|
|---|
| 53 | I $G(XWBT("PCNT")),$T(COUNT^XUSCNT)="" W !,"The routine XUSCNT is missing on a GT.M system."
|
|---|
| 54 | W !,"Checking if new JOB's can start."
|
|---|
| 55 | S ^TMP("XWB",$J)=1 J HOLD^XWBTCPMT($J) H 1
|
|---|
| 56 | I $G(^TMP("XWB",$J))=1 W !,"Doesn't look like a new JOB could start!",!
|
|---|
| 57 | S NEWJOB=$$NEWJOB^XWBTCPM()
|
|---|
| 58 | W !,"New jobs are "_$S('NEWJOB:"not ",1:"")_"allowed."
|
|---|
| 59 | W !,"Done with the checks.",!
|
|---|
| 60 | K ^TMP("XWB",$J)
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | HOLD(MJ) ;Show that a new job is allowed.
|
|---|
| 64 | S ^TMP("XWB",MJ)=5
|
|---|
| 65 | HANG 5
|
|---|
| 66 | Q
|
|---|
