HLCSAS ;ISCSF/RWF - MPI direct connect server ;09/23/2005 14:36
;;1.6;HEALTH LEVEL SEVEN;**43,89,120,169**;Oct 13,1995;Build 2
;Per VA Directive 6402, this routine should not be modified.
Q
;HLCS is used to pass data around.
; 5500 is the standard VA port for the MPI_direct connect
LISTEN ;only for OpenM
S $ETRAP="D ^%ZTER H"
D LISTEN^%ZISTCPS(5500,"ONT^HLCSAS")
Q
DSM ;%=device^HLDP
S IO=$P(%,"^"),HLDP=$P(%,"^",2)
O IO:(SHARE) U IO ;Setup TCP port
S IO(0)="_NLA0:" O IO(0) ;Setup null device
D SVR
Q
CACHE ;%=device^HLDP
S (IO,IO(0))="SYS$NET"
S HLDP=$ZF("GETSYM","HLDP")
O IO U IO:(::"-M") ;Setup TCP port
S IO(0)="_NLA0:" O IO(0) ;Setup null device
D SVR
Q
MSM ;Entry point from MSERVER
;S HLDP=ien
S IO=56,IO(0)=46
O 46 ;Null device
D SVR C IO
Q
ONT ;Cache/OpenM
;S HLDP=ien
S IO=$I,IO(0)="//./nul"
O IO(0)
D SVR
Q
;
LINUX ;RRA HL*169 add entry point for LINUX
S HLDP=$O(^HLCS(870,"B","MPIVA DIR",0))
S IO=$P
O IO U IO:(::"-M")
S IO(0)="/dev/null" O IO(0) ;Setup null device
D SVR
Q
;
SVR ;Entry point when we have a connect
;See that IO=TCP device, and IO(0) is Null device and Open.
;HLDP=ien of Logical Link
N HCSA1,HCSER,HCSEXIT,HCSCMD,HCSDAT
D SETUP Q:HCSER
N $ESTACK,$ETRAP S $ETRAP="D ^%ZTER H"
D UPDT^HLCSTCP(1)
F D CREAD Q:HCSEXIT D Q:HCSEXIT
. I HCSCMD="" S HCSA1("TCNT")=$G(HCSA1("TCNT"))+1 S:$$STOP^HLCSTCP!(HCSA1("TCNT")>10) HCSEXIT=1 Q
. I HCSCMD'?4A D SEND("500 Bad CMD: "_$E(HCSCMD,1,20)) Q
. I $T(@HCSCMD)="" D SEND("500 ") Q
. S HCSA1("TCNT")=0
. D @HCSCMD I $G(HCSER) D TRACE("ERROR: "_HCSER)
. Q
S:HCSEXIT IO("C")=1
D TRACE("Exit"),UPDT^HLCSTCP(0)
Q
HELO ;Process HELO
S HCSA1("SITE")=$P(HCSDAT," ")
;Do any check on who is sending
D SEND("220 "_$$KSP^XUPARAM("WHERE")_" Ready for "_HCSDAT)
Q
;
NOOP ;
D SEND("250 OK")
Q
;
DATA ;Process DATA
; The DATA cmd can pass some parameters as well, this could be passed
; to the processing routine also.
N P,I,DUZ,HLMID,HLTIEN,HLDT
;S DUZ=0,DUZ(0)="@"
D TRACE("Get Data")
S HCSA1("DATA")=HCSDAT,HCSIN=$NA(TMP("HCSI",$J)),HCSOUT=$NA(^TMP("HCSO",$J))
K @HCSOUT
D DATA^HLCSAS1(HCSIN,.HCSA1) QUIT:$G(HCSER)
S P="" F I=1:1 Q:'$D(HCSA1("P"_I)) S P=P_"P"_I_"="_HCSA1("P"_I)_", "
D TRACE("PARAM "_P)
;Use the Null Device
U IO(0)
;Now call soneone to process the data
I HCSA1("P1")="MPI" D ^MPIDIRQ(HCSIN,HCSOUT)
I HCSA1("P1")="PING" M @HCSOUT=@HCSIN
U IO ;Back to the TCP device
D LLCNT^HLCSTCP(HLDP,2)
Q
TURN ;Turn and send responce
D SEND("220 OK")
D SDATA^HLCSAS1(HCSOUT,HCSA1("P1"))
D CREAD,TRACE("Data Sent ") ;Look for 220 ok
Q
QUIT ;Process QUIT
D TRACE("QUIT")
S HCSMSG="",HCSEXIT=1
Q
;
CREAD ;Read a string
N $ETRAP S $ETRAP="S $EC="""" G CREX"
N I S (Y,HCSDAT,HCSCMD)="",HCSER=0
F I=0:1:255 R X#1:HLDREAD S:'$T HCSER=1 Q:X=$C(10)!HCSER S Y=Y_X
S Y=$TR(Y,$C(13,10)),HCSCMD=$P(Y," "),HCSDAT=$P(Y," ",2,99)
D TRACE("Cmd Read "_Y)
Q
CREX S HCSEXIT=1,HCSER="1 Error"
Q
;
SEND(MSG) ;Send a cmd MSG
N $ETRAP S $ETRAP="S $EC="""" D CREX"
D TRACE("Cmd Send "_MSG)
W MSG,$C(13,10),!
Q
;
SETUP ;Setup needed variables
K IO("C")
S X=$$INIT^HLCSTCP
I 'X D ^%ZTER S HCSER=1 Q
S (HCSER,HCSEXIT)=0,HCSTRACE="S: ",HCSA1("P1")="TEXT"
D TRACE(-1),TRACE("Server Setup")
Q
;
TRACE(S1) ;
Q
N H,%
I S1=-1 K ^TMP("HCSA",$J) Q
S H=$P($H,",",2),H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
L +^TMP("HCSA",$J):$G(DILOCKTM,3) S %=$G(^TMP("HCSA",$J,0))+1,^(0)=%,^(%)=H_$G(HCSTRACE)_S1 L -^TMP("HCSA",$J)
Q
;