Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLCSAS

HLCSAS.m

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