| 1 | HLCSAC ;ISCSF/RWF - MPI direct connect client ;05/31/2000 09:40
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**43,64**;Jul 17,1995
|
|---|
| 3 | ;
|
|---|
| 4 | EN(HLDP,INPUT,OUTPUT) ;Call to do direct connect to MPI
|
|---|
| 5 | N HCSCMD,HLCS,HCSDAT,HCSER,HCSEXIT,HCSTRACE,HLDT1,HLOS
|
|---|
| 6 | N HLDRETR,HLDBSIZE,HLDREAD,HLDBACK,HLDWAIT,HLTCPADD,HLTCPORT,HLTCPCS,HLTCPLNK,X,Y
|
|---|
| 7 | ;HLCS=error
|
|---|
| 8 | S HLCS="",HCSTRACE="C: ",POP=1
|
|---|
| 9 | N $ESTACK,$ETRAP S $ETRAP="D ERROR^HLCSAC"
|
|---|
| 10 | D SETUP G:HLCS ERR
|
|---|
| 11 | D OPEN G:HLCS ERR
|
|---|
| 12 | D HELO G:HLCS ERR
|
|---|
| 13 | D DATA G:HLCS ERR
|
|---|
| 14 | D TURN G:HLCS ERR
|
|---|
| 15 | D GET G:HLCS ERR
|
|---|
| 16 | D QUIT
|
|---|
| 17 | Q 0
|
|---|
| 18 | ERR ;Report back an error
|
|---|
| 19 | D TRACE("ERROR "_HLCS)
|
|---|
| 20 | D:'POP QUIT
|
|---|
| 21 | Q HLCS
|
|---|
| 22 | ;
|
|---|
| 23 | ERROR ;Trap an error
|
|---|
| 24 | D ^%ZTER G UNWIND^%ZTER
|
|---|
| 25 | ;
|
|---|
| 26 | OPEN ;Open connection
|
|---|
| 27 | N HLI
|
|---|
| 28 | D TRACE("Make Connection")
|
|---|
| 29 | F HLI=1:1:HLDRETR D Q:'POP
|
|---|
| 30 | . D CALL^%ZISTCP(HLTCPADD,HLTCPORT,1)
|
|---|
| 31 | I POP S HLCS="-1^Inital Connection Failed" Q
|
|---|
| 32 | D TRACE("Got Connection")
|
|---|
| 33 | U IO
|
|---|
| 34 | Q
|
|---|
| 35 | HELO ;start conversation
|
|---|
| 36 | S X=$$POST("HELO "_$$KSP^XUPARAM("WHERE"))
|
|---|
| 37 | I $E(X,1)'=2 S HLCS="-1^Initial HELO Failed"
|
|---|
| 38 | I $E(X,1,3)="421" S HLCS="-1^Busy"
|
|---|
| 39 | Q
|
|---|
| 40 | DATA ;Send data
|
|---|
| 41 | D TRACE("Send Data")
|
|---|
| 42 | D SDATA^HLCSAS1(INPUT,"MPI"),CREAD^HLCSAS
|
|---|
| 43 | I $E(HCSCMD,1)'=2 S HLCS="-1^No 220 after send "_HCSDAT Q
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | TURN ;Turn channel
|
|---|
| 47 | S X=$$POST("TURN ") I $E(X,1)'=2 S HLCS="-1^No 220 after Turn"
|
|---|
| 48 | Q
|
|---|
| 49 | GET ;Get responce
|
|---|
| 50 | D CREAD^HLCSAS I HCSCMD[220 G GET
|
|---|
| 51 | I HCSCMD'["DATA" S HLCS="-1^No DATA cmd "_HCSCMD Q
|
|---|
| 52 | D DATA^HLCSAS1(OUTPUT)
|
|---|
| 53 | Q
|
|---|
| 54 | QUIT ;Shut down
|
|---|
| 55 | D SEND^HLCSAS("QUIT ")
|
|---|
| 56 | D CLOSE^%ZISTCP,USE^%ZISUTL("HCS-HOME"),RMDEV^%ZISUTL("HCS-HOME")
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | POST(MSG) ;Send a command and get responce
|
|---|
| 60 | D SEND^HLCSAS(MSG)
|
|---|
| 61 | D CREAD^HLCSAS
|
|---|
| 62 | Q HCSCMD
|
|---|
| 63 | ;
|
|---|
| 64 | TRACE(S1) ;
|
|---|
| 65 | Q
|
|---|
| 66 | N %,H
|
|---|
| 67 | I S1=-1 K ^TMP("HCSA",$J) Q
|
|---|
| 68 | S H=$P($H,",",2),H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
|
|---|
| 69 | L +^TMP("HCSA",$J) S %=$G(^TMP("HCSA",$J,0))+1,^(0)=%,^(%)=H_HCSTRACE_S1 L -^TMP("HCSA",$J)
|
|---|
| 70 | Q
|
|---|
| 71 | SETUP ;
|
|---|
| 72 | I ($G(HLDP)']"")!($G(INPUT)']"")!($G(OUTPUT)']"") S HLCS="-1^Missing input paramerter" Q
|
|---|
| 73 | S X=$$INIT^HLCSTCP
|
|---|
| 74 | I 'X S HLCS="-1^Bad Logical Link" Q
|
|---|
| 75 | I $G(HLP("ACKTIME")) S HLDREAD=HLP("ACKTIME")
|
|---|
| 76 | S (HCS("STAT"),HCSEXIT)=0
|
|---|
| 77 | D TRACE(-1),TRACE("Client Setup")
|
|---|
| 78 | Q
|
|---|
