source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSAS.m@ 1423

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1HLCSAS ;ISCSF/RWF - MPI direct connect server ;09/23/2005 14:36
2 ;;1.6;HEALTH LEVEL SEVEN;**43,89,120**;Oct 13,1995;Build 12
3 Q
4 ;HLCS is used to pass data around.
5 ; 5500 is the standard VA port for the MPI_direct connect
6LISTEN ;only for OpenM
7 S $ETRAP="D ^%ZTER H"
8 D LISTEN^%ZISTCPS(5500,"ONT^HLCSAS")
9 Q
10DSM ;%=device^HLDP
11 S IO=$P(%,"^"),HLDP=$P(%,"^",2)
12 O IO:(SHARE) U IO ;Setup TCP port
13 S IO(0)="_NLA0:" O IO(0) ;Setup null device
14 D SVR
15 Q
16CACHE ;%=device^HLDP
17 S (IO,IO(0))="SYS$NET"
18 S HLDP=$ZF("GETSYM","HLDP")
19 O IO U IO:(::"-M") ;Setup TCP port
20 S IO(0)="_NLA0:" O IO(0) ;Setup null device
21 D SVR
22 Q
23MSM ;Entry point from MSERVER
24 ;S HLDP=ien
25 S IO=56,IO(0)=46
26 O 46 ;Null device
27 D SVR C IO
28 Q
29ONT ;Cache/OpenM
30 ;S HLDP=ien
31 S IO=$I,IO(0)="//./nul"
32 O IO(0)
33 D SVR
34 Q
35 ;
36SVR ;Entry point when we have a connect
37 ;See that IO=TCP device, and IO(0) is Null device and Open.
38 ;HLDP=ien of Logical Link
39 N HCSA1,HCSER,HCSEXIT,HCSCMD,HCSDAT
40 D SETUP Q:HCSER
41 N $ESTACK,$ETRAP S $ETRAP="D ^%ZTER H"
42 D UPDT^HLCSTCP(1)
43 F D CREAD Q:HCSEXIT D Q:HCSEXIT
44 . I HCSCMD="" S HCSA1("TCNT")=$G(HCSA1("TCNT"))+1 S:$$STOP^HLCSTCP!(HCSA1("TCNT")>10) HCSEXIT=1 Q
45 . I HCSCMD'?4A D SEND("500 Bad CMD: "_$E(HCSCMD,1,20)) Q
46 . I $T(@HCSCMD)="" D SEND("500 ") Q
47 . S HCSA1("TCNT")=0
48 . D @HCSCMD I $G(HCSER) D TRACE("ERROR: "_HCSER)
49 . Q
50 S:HCSEXIT IO("C")=1
51 D TRACE("Exit"),UPDT^HLCSTCP(0)
52 Q
53HELO ;Process HELO
54 S HCSA1("SITE")=$P(HCSDAT," ")
55 ;Do any check on who is sending
56 D SEND("220 "_$$KSP^XUPARAM("WHERE")_" Ready for "_HCSDAT)
57 Q
58 ;
59NOOP ;
60 D SEND("250 OK")
61 Q
62 ;
63DATA ;Process DATA
64 ; The DATA cmd can pass some parameters as well, this could be passed
65 ; to the processing routine also.
66 N P,I,DUZ,HLMID,HLTIEN,HLDT
67 ;S DUZ=0,DUZ(0)="@"
68 D TRACE("Get Data")
69 S HCSA1("DATA")=HCSDAT,HCSIN=$NA(TMP("HCSI",$J)),HCSOUT=$NA(^TMP("HCSO",$J))
70 K @HCSOUT
71 D DATA^HLCSAS1(HCSIN,.HCSA1) QUIT:$G(HCSER)
72 S P="" F I=1:1 Q:'$D(HCSA1("P"_I)) S P=P_"P"_I_"="_HCSA1("P"_I)_", "
73 D TRACE("PARAM "_P)
74 ;Use the Null Device
75 U IO(0)
76 ;Now call soneone to process the data
77 I HCSA1("P1")="MPI" D ^MPIDIRQ(HCSIN,HCSOUT)
78 I HCSA1("P1")="PING" M @HCSOUT=@HCSIN
79 U IO ;Back to the TCP device
80 D LLCNT^HLCSTCP(HLDP,2)
81 Q
82TURN ;Turn and send responce
83 D SEND("220 OK")
84 D SDATA^HLCSAS1(HCSOUT,HCSA1("P1"))
85 D CREAD,TRACE("Data Sent ") ;Look for 220 ok
86 Q
87QUIT ;Process QUIT
88 D TRACE("QUIT")
89 S HCSMSG="",HCSEXIT=1
90 Q
91 ;
92CREAD ;Read a string
93 N $ETRAP S $ETRAP="S $EC="""" G CREX"
94 N I S (Y,HCSDAT,HCSCMD)="",HCSER=0
95 F I=0:1:255 R X#1:HLDREAD S:'$T HCSER=1 Q:X=$C(10)!HCSER S Y=Y_X
96 S Y=$TR(Y,$C(13,10)),HCSCMD=$P(Y," "),HCSDAT=$P(Y," ",2,99)
97 D TRACE("Cmd Read "_Y)
98 Q
99CREX S HCSEXIT=1,HCSER="1 Error"
100 Q
101 ;
102SEND(MSG) ;Send a cmd MSG
103 N $ETRAP S $ETRAP="S $EC="""" D CREX"
104 D TRACE("Cmd Send "_MSG)
105 W MSG,$C(13,10),!
106 Q
107 ;
108SETUP ;Setup needed variables
109 K IO("C")
110 S X=$$INIT^HLCSTCP
111 I 'X D ^%ZTER S HCSER=1 Q
112 S (HCSER,HCSEXIT)=0,HCSTRACE="S: ",HCSA1("P1")="TEXT"
113 D TRACE(-1),TRACE("Server Setup")
114 Q
115 ;
116TRACE(S1) ;
117 Q
118 N H,%
119 I S1=-1 K ^TMP("HCSA",$J) Q
120 S H=$P($H,",",2),H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
121 L +^TMP("HCSA",$J) S %=$G(^TMP("HCSA",$J,0))+1,^(0)=%,^(%)=H_$G(HCSTRACE)_S1 L -^TMP("HCSA",$J)
122 Q
123 ;
Note: See TracBrowser for help on using the repository browser.