- HLCSAC ;ISCSF/RWF - MPI direct connect client ;05/31/2000 09:40 [ 04/02/2003 8:38 AM ]
- ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
- ;;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
- HLCSAC ;ISCSF/RWF - MPI direct connect client ;05/31/2000 09:40 [ 04/02/2003 8:38 AM ]
- +1 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
- +2 ;;1.6;HEALTH LEVEL SEVEN;**43,64**;Jul 17,1995
- +3 ;
- 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">GET">GET">GET(HLDP)']"")!($GET">GET">GET">GET(INPUT)']"")!($GET">GET">GET">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
