HLCSAC ;ISCSF/RWF - MPI direct connect client ;05/31/2000 09:40
;;1.6;HEALTH LEVEL SEVEN;**43,64**;Jul 17,1995
;
EN(HLDP,INPUT,OUTPUT) ;Call to do direct connect to MPI
N HCSCMD,HLCS,HCSDAT,HCSER,HCSEXIT,HCSTRACE,HLDT1,HLOS
N HLDRETR,HLDBSIZE,HLDREAD,HLDBACK,HLDWAIT,HLTCPADD,HLTCPORT,HLTCPCS,HLTCPLNK,X,Y
;HLCS=error
S HLCS="",HCSTRACE="C: ",POP=1
N $ESTACK,$ETRAP S $ETRAP="D ERROR^HLCSAC"
D SETUP G:HLCS ERR
D OPEN G:HLCS ERR
D HELO G:HLCS ERR
D DATA G:HLCS ERR
D TURN G:HLCS ERR
D GET G:HLCS ERR
D QUIT
Q 0
ERR ;Report back an error
D TRACE("ERROR "_HLCS)
D:'POP QUIT
Q HLCS
;
ERROR ;Trap an error
D ^%ZTER G UNWIND^%ZTER
;
OPEN ;Open connection
N HLI
D TRACE("Make Connection")
F HLI=1:1:HLDRETR D Q:'POP
. D CALL^%ZISTCP(HLTCPADD,HLTCPORT,1)
I POP S HLCS="-1^Inital Connection Failed" Q
D TRACE("Got Connection")
U IO
Q
HELO ;start conversation
S X=$$POST("HELO "_$$KSP^XUPARAM("WHERE"))
I $E(X,1)'=2 S HLCS="-1^Initial HELO Failed"
I $E(X,1,3)="421" S HLCS="-1^Busy"
Q
DATA ;Send data
D TRACE("Send Data")
D SDATA^HLCSAS1(INPUT,"MPI"),CREAD^HLCSAS
I $E(HCSCMD,1)'=2 S HLCS="-1^No 220 after send "_HCSDAT Q
Q
;
TURN ;Turn channel
S X=$$POST("TURN ") I $E(X,1)'=2 S HLCS="-1^No 220 after Turn"
Q
GET ;Get responce
D CREAD^HLCSAS I HCSCMD[220 G GET
I HCSCMD'["DATA" S HLCS="-1^No DATA cmd "_HCSCMD Q
D DATA^HLCSAS1(OUTPUT)
Q
QUIT ;Shut down
D SEND^HLCSAS("QUIT ")
D CLOSE^%ZISTCP,USE^%ZISUTL("HCS-HOME"),RMDEV^%ZISUTL("HCS-HOME")
Q
;
POST(MSG) ;Send a command and get responce
D SEND^HLCSAS(MSG)
D CREAD^HLCSAS
Q HCSCMD
;
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) S %=$G(^TMP("HCSA",$J,0))+1,^(0)=%,^(%)=H_HCSTRACE_S1 L -^TMP("HCSA",$J)
Q
SETUP ;
I ($G(HLDP)']"")!($G(INPUT)']"")!($G(OUTPUT)']"") S HLCS="-1^Missing input paramerter" Q
S X=$$INIT^HLCSTCP
I 'X S HLCS="-1^Bad Logical Link" Q
I $G(HLP("ACKTIME")) S HLDREAD=HLP("ACKTIME")
S (HCS("STAT"),HCSEXIT)=0
D TRACE(-1),TRACE("Client Setup")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSAC 2132 printed Oct 16, 2024@17:57:07 Page 2
HLCSAC ;ISCSF/RWF - MPI direct connect client ;05/31/2000 09:40
+1 ;;1.6;HEALTH LEVEL SEVEN;**43,64**;Jul 17,1995
+2 ;
EN(HLDP,INPUT,OUTPUT) ;Call to do direct connect to MPI
+1 NEW HCSCMD,HLCS,HCSDAT,HCSER,HCSEXIT,HCSTRACE,HLDT1,HLOS
+2 NEW HLDRETR,HLDBSIZE,HLDREAD,HLDBACK,HLDWAIT,HLTCPADD,HLTCPORT,HLTCPCS,HLTCPLNK,X,Y
+3 ;HLCS=error
+4 SET HLCS=""
SET HCSTRACE="C: "
SET POP=1
+5 NEW $ESTACK,$ETRAP
SET $ETRAP="D ERROR^HLCSAC"
+6 DO SETUP
if HLCS
GOTO ERR
+7 DO OPEN
if HLCS
GOTO ERR
+8 DO HELO
if HLCS
GOTO ERR
+9 DO DATA
if HLCS
GOTO ERR
+10 DO TURN
if HLCS
GOTO ERR
+11 DO GET
if HLCS
GOTO ERR
+12 DO QUIT
+13 QUIT 0
ERR ;Report back an error
+1 DO TRACE("ERROR "_HLCS)
+2 if 'POP
DO QUIT
+3 QUIT HLCS
+4 ;
ERROR ;Trap an error
+1 DO ^%ZTER
GOTO UNWIND^%ZTER
+2 ;
OPEN ;Open connection
+1 NEW HLI
+2 DO TRACE("Make Connection")
+3 FOR HLI=1:1:HLDRETR
Begin DoDot:1
+4 DO CALL^%ZISTCP(HLTCPADD,HLTCPORT,1)
End DoDot:1
if 'POP
QUIT
+5 IF POP
SET HLCS="-1^Inital Connection Failed"
QUIT
+6 DO TRACE("Got Connection")
+7 USE IO
+8 QUIT
HELO ;start conversation
+1 SET X=$$POST("HELO "_$$KSP^XUPARAM("WHERE"))
+2 IF $EXTRACT(X,1)'=2
SET HLCS="-1^Initial HELO Failed"
+3 IF $EXTRACT(X,1,3)="421"
SET HLCS="-1^Busy"
+4 QUIT
DATA ;Send data
+1 DO TRACE("Send Data")
+2 DO SDATA^HLCSAS1(INPUT,"MPI")
DO CREAD^HLCSAS
+3 IF $EXTRACT(HCSCMD,1)'=2
SET HLCS="-1^No 220 after send "_HCSDAT
QUIT
+4 QUIT
+5 ;
TURN ;Turn channel
+1 SET X=$$POST("TURN ")
IF $EXTRACT(X,1)'=2
SET HLCS="-1^No 220 after Turn"
+2 QUIT
GET ;Get responce
+1 DO CREAD^HLCSAS
IF HCSCMD[220
GOTO GET
+2 IF HCSCMD'["DATA"
SET HLCS="-1^No DATA cmd "_HCSCMD
QUIT
+3 DO DATA^HLCSAS1(OUTPUT)
+4 QUIT
QUIT ;Shut down
+1 DO SEND^HLCSAS("QUIT ")
+2 DO CLOSE^%ZISTCP
DO USE^%ZISUTL("HCS-HOME")
DO RMDEV^%ZISUTL("HCS-HOME")
+3 QUIT
+4 ;
POST(MSG) ;Send a command and get responce
+1 DO SEND^HLCSAS(MSG)
+2 DO CREAD^HLCSAS
+3 QUIT HCSCMD
+4 ;
TRACE(S1) ;
+1 QUIT
+2 NEW %,H
+3 IF S1=-1
KILL ^TMP("HCSA",$JOB)
QUIT
+4 SET H=$PIECE($HOROLOG,",",2)
SET H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
+5 LOCK +^TMP("HCSA",$JOB)
SET %=$GET(^TMP("HCSA",$JOB,0))+1
SET ^(0)=%
SET ^(%)=H_HCSTRACE_S1
LOCK -^TMP("HCSA",$JOB)
+6 QUIT
SETUP ;
+1 IF ($GET(HLDP)']"")!($GET(INPUT)']"")!($GET(OUTPUT)']"")
SET HLCS="-1^Missing input paramerter"
QUIT
+2 SET X=$$INIT^HLCSTCP
+3 IF 'X
SET HLCS="-1^Bad Logical Link"
QUIT
+4 IF $GET(HLP("ACKTIME"))
SET HLDREAD=HLP("ACKTIME")
+5 SET (HCS("STAT"),HCSEXIT)=0
+6 DO TRACE(-1)
DO TRACE("Client Setup")
+7 QUIT
