source: WorldVistAEHR/trunk/r/RPC_BROKER-XWB/XWBTCPMT.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1XWBTCPMT ;ISF/RWF - Routine to test a connection ;11/28/2005
2 ;;1.1;RPC BROKER;**43**;Mar 28, 1997
3CALL ;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 ;
17TEST(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
30EXIT ;Close and Exit
31 D CLOSE^%ZISTCP
32 Q RES
33 ;
34ERR ;
35 D CLOSE^%ZISTCP
36 U $P
37 Q "-1^"_$$EC^%ZOSV
38 ;
39CHECK ;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 ;
63HOLD(MJ) ;Show that a new job is allowed.
64 S ^TMP("XWB",MJ)=5
65 HANG 5
66 Q
Note: See TracBrowser for help on using the repository browser.