source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSC1C.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1XUSC1C ;ISCSF/RWF - Client Interface to Server services. ;10/09/2002 17:03
2 ;;8.0;KERNEL;**283**;Jul 10, 1995
3 ;Return 0 = OK, else -1^msg
4EN(INPUT,OUTPUT,TYPE) ;Call to connect to Server
5 N X,Y,XUSCCMD,XUSCDAT,XUSCER,XUSCTIME,XUSCTRC,XUSCEXIT
6 D SETUP
7 D TRACE("IP:"_XUSC("IP")_" Port: "_XUSC("SOCK"))
8 N $ESTACK,$ETRAP S $ETRAP="D ERROR^XUSC1C"
9 D OPEN G:XUSC("STAT") ERR
10 D HELO G:XUSC("STAT") ERR
11 ;D SERV G:XUSC("STAT") ERR
12 D DATA G:XUSC("STAT") ERR
13 D TURN G:XUSC("STAT") ERR
14 D GET G:XUSC("STAT") ERR
15 D QUIT
16 Q 0
17ERR ;Report back an error
18 D TRACE("ERROR "_XUSC("STAT"))
19 D:'POP QUIT
20 Q XUSC("STAT")
21 ;
22ERROR ;Trap an error
23 S XUSC("STAT")="-1^M error: "_$ECODE
24 D ^%ZTER G UNWIND^%ZTER
25 ;
26OPEN ;Open connection
27 N IPCNT,IPA
28 D TRACE("Make Connection")
29 F IPCNT=1:1 S IPA=$P(XUSC("IP"),",",IPCNT) Q:IPA="" D
30 . I IPA'?1.3N1P1.3N1P1.3N1P1.3N S IPA=$P($$ADDRESS^XLFNSLK(IPA),",")
31 . I IPA'?1.3N1P1.3N1P1.3N1P1.3N Q
32 . D TRACE("Call IP "_IPA)
33 . F XUSCCNT=0:1:5 D Q:'POP
34 . . D CALL^%ZISTCP(IPA,XUSC("SOCK"),1)
35 I POP S XUSC("STAT")="-1^Inital Connection Failed" Q
36 D TRACE("Got Connection")
37 U IO
38 Q
39HELO ;start conversation
40 S X=$$POST("HELO "_$$KSP^XUPARAM("WHERE"))
41 I $E(X,1)'=2 S XUSC("STAT")="-1^Initial HELO Failed",XUSC("REC")=X
42 I $E(X,1,3)="421" S XUSC("STAT")="-1^Busy"
43 F Q:$E(XUSCCMD,1,3)=220 D CREAD^XUSC1S
44 Q
45SERV ;Requested Service
46 D TRACE("Service Request: "_TYPE)
47 S X=$$POST("SERV "_TYPE)
48 I $E(X,1)'=2 S XUSC("STAT")="-1^"_X,XUSC("REC")=X
49 Q
50DATA ;Send data
51 D TRACE("Send Data")
52 D SDATA^XUSC1S1(INPUT,$G(TYPE,"MPI")),CREAD^XUSC1S
53 I $E(XUSCCMD,1)'=2 S XUSC("STAT")="-1^No 220 after send "_XUSCDAT Q
54 Q
55 ;
56TURN ;Turn channel
57 S X=$$POST("TURN ") I $E(X,1)'=2 S XUSC("STAT")="-1^No 220 after Turn"
58 Q
59GET ;Get responce
60 D CREAD^XUSC1S I XUSCCMD[220 G GET
61 I XUSCCMD'["DATA" S XUSC("STAT")="-1^No DATA cmd "_XUSCCMD Q
62 D DATA^XUSC1S1(OUTPUT)
63 Q
64QUIT ;Shut down
65 D SEND^XUSC1S("QUIT ")
66 D CLOSE^%ZISTCP
67 Q
68POST(MSG) ;Send a command and get responce
69 D SEND^XUSC1S(MSG)
70 D CREAD^XUSC1S
71 Q XUSCCMD
72 ;
73TRACE(S1) ;
74 N %,H
75 I S1=-1 K ^TMP("XUSC1",$J) Q
76 Q:'$G(XUSCDBUG)
77 S H=$P($H,",",2),H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
78 L +^TMP("XUSC1",$J)
79 S %=$G(^TMP("XUSC1",$J,0))+1,^(0)=%,^(%)=H_XUSCTRC_S1
80 L -^TMP("XUSC1",$J)
81 Q
82SETUP ;
83 S (XUSC("STAT"),XUSCEXIT)=0,XUSCTIME=30,XUSCTRC="C: "
84 S XUSCDBUG=$$GET^XPAR("SYS","XUSC1 DEBUG",,"Q")
85 D TRACE(-1),TRACE("Client Setup")
86 Q
Note: See TracBrowser for help on using the repository browser.