BOPTCP ;IHS/ILC/ALG/CIA/PLS - TCP/IP Send/Receive Utility;03-Feb-2006 10:58;SM
;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005
;;
;
; NOTE! This routine may be saved under a different name. If this is
; done, be sure to edit the first line of the routine and the
; name of the routine in the EOR line
;
; NOTE! Normally, transmissions are ended with a sequence of control
; characters such as ASCII 13,11,13 or 27,27,27. No such
; end-of-transmit characters are used during the sending of
; data. If any such characters are
; returned, they are not checked for. PLEASE be sure
; to add them. (Data sent to in SDATA and data
; received in DATA subroutines.)
;
; Replaceable parameters that will need to be replaced are
; the following:
;
; Subroutine: IP (To IP address
; Subroutine: SOCKET (To Socket#)
;
; Or
;
; Change these subroutines to call a file or table (which is probably
; better than hardsetting the values.)
;
;
; EXPLANATION:
;
; Then EN call point will transmit to IP/Socket the data contained in
; the INPUT array. Data returned will be returned
; in the OUTPUT array.
;
;
; EXAMPLE:
;
; TRANS(1)="MSH|^~\&|..." <- message carries over into TRANS(2)
; TRANS(2)="...MSA|... etc, etc"
;
; S A7RERR=$$EN^BOPTCP("TRANS","RESULTS")
;
; W A7RERR -> will be = zero if ALL goes well, or -1^... if not
;
; If the above call works, the response will be in
; the RESULTS array. Something line this...
;
; RESULTS(1)="MSH|^~\&|..." <- the response message
; RESULTS(2)="... etc, etc"
;
EN(INPUT,OUTPUT) ;Call to do direct connect to MPI
N I,LOOP,LP,POP,X,XCS,XCSDAT,XCSER,XCSEXIT,XCSMD,XCSNT,XCSTIME
N XCSTRACE,Y
;
D SETUP
;
;IHS exemption approved on March 16, 2005
I XCSNT N $ESTACK,$ETRAP S $ETRAP="D ERROR^BOPTCP"
E S X="ERROR^BOPTCP",@^%ZOSF("TRAP")
;
D OPEN I POP QUIT $$ERR("POP=1 ON OPEN") ;->
D DATA
D GET
D QUIT
;
Q 0 ;#errors = 0
;
ERR(REA) ;Report back an error
D TRACE("ERROR "_XCS("STAT"))
D:'POP QUIT
Q "-1^"_REA
;
ERROR ;Trap an error
D ^%ZTER G UNWIND^%ZTER
;
OPEN ;Open connection
D TRACE("Make Connection")
D CALL^%ZISTCP(BOPIP,BOPOCK) Q:POP
D TRACE("Got Connection")
U IO
Q
DATA ;Send data
D TRACE("Send Data")
D SDATA(INPUT,$G(TYPE,"MPI")) ;LJA
Q
;
GET ;Get responce
D GDATA(OUTPUT)
Q
QUIT ;Shut down
D CLOSE^%ZISTCP
Q
TRACE(S1) ;
Q:0 N %,H
I S1=-1 K ^TMP($J,"ZZXCSA") Q
S H=$P($H,",",2),H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
L +^TMP($J,"ZZXCSA"):1
S %=$G(^TMP($J,"ZZXCSA",0))+1,^(0)=%,^(%)=H_XCSTRACE_S1
L -^TMP($J,"ZZXCSA")
Q
SETUP ;EP - SET UP INFO
S XCS("IP")=BOPIP,XCS("SOCK")=BOPOCK
S (XCS("STAT"),XCSEXIT)=0,XCSTIME=30,XCSTRACE="C: "
S XCSNT=$$NEWERR^%ZTER()
D TRACE(-1),TRACE("Client Setup")
Q
GDATA(ROOT,STAT) ;EP - get Data
N E,I,M
;
; changed read timeout to 2 from 5 dtg
S BOPCHKA="" F U IO R RESTRNG#200:3 Q:RESTRNG=""&'$T D Q:BOPCHKA ;
.; set quit flag if ascii 28 contained
.I RESTRNG[$C(28) S BOPCHKA=1
.;
.;Strip Control Characters from END of received string
.F Q:RESTRNG'?.E1C S RESTRNG=$E(RESTRNG,1,$L(RESTRNG)-1)
.;
.S BOPK=2
MORE .S BOPTRNG=$P(RESTRNG,$C(11),BOPK)
.Q:BOPTRNG']""
.F BOPI=1:1 S BOPLINE=$P(BOPTRNG,$C(13),BOPI) Q:BOPLINE']""!(BOPLINE=$C(28)) D
..S I=$O(@ROOT@(":"),-1)+1,@ROOT@(I)=BOPLINE
.S BOPK=BOPK+1
.G MORE
;
Q
;
SDATA(ROOT,TYPE) ;EP - Send data from a source
N X,Y,L,D
S X=ROOT
F S X=$Q(@X) Q:X']""!(X'[ROOT) D
.U IO W @X,!
;
D ENDCHARS
Q
;
ENDCHARS ; Add EOT ctrl characters, etc, below... LJA
Q
;
; If end of transmission characters needed, add here...
;
IP() ; Substitute IP ADDRESS...
Q $P(^BOP(90355,1,0),U,17)
;
SOCKET() ; Substitute SOCKET...
Q $P(^BOP(90355,1,0),U,18)
BOPTCP ;IHS/ILC/ALG/CIA/PLS - TCP/IP Send/Receive Utility;03-Feb-2006 10:58;SM
+1 ;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005
+2 ;;
+3 ;
+4 ; NOTE! This routine may be saved under a different name. If this is
+5 ; done, be sure to edit the first line of the routine and the
+6 ; name of the routine in the EOR line
+7 ;
+8 ; NOTE! Normally, transmissions are ended with a sequence of control
+9 ; characters such as ASCII 13,11,13 or 27,27,27. No such
+10 ; end-of-transmit characters are used during the sending of
+11 ; data. If any such characters are
+12 ; returned, they are not checked for. PLEASE be sure
+13 ; to add them. (Data sent to in SDATA and data
+14 ; received in DATA subroutines.)
+15 ;
+16 ; Replaceable parameters that will need to be replaced are
+17 ; the following:
+18 ;
+19 ; Subroutine: IP (To IP address
+20 ; Subroutine: SOCKET (To Socket#)
+21 ;
+22 ; Or
+23 ;
+24 ; Change these subroutines to call a file or table (which is probably
+25 ; better than hardsetting the values.)
+26 ;
+27 ;
+28 ; EXPLANATION:
+29 ;
+30 ; Then EN call point will transmit to IP/Socket the data contained in
+31 ; the INPUT array. Data returned will be returned
+32 ; in the OUTPUT array.
+33 ;
+34 ;
+35 ; EXAMPLE:
+36 ;
+37 ; TRANS(1)="MSH|^~\&|..." <- message carries over into TRANS(2)
+38 ; TRANS(2)="...MSA|... etc, etc"
+39 ;
+40 ; S A7RERR=$$EN^BOPTCP("TRANS","RESULTS")
+41 ;
+42 ; W A7RERR -> will be = zero if ALL goes well, or -1^... if not
+43 ;
+44 ; If the above call works, the response will be in
+45 ; the RESULTS array. Something line this...
+46 ;
+47 ; RESULTS(1)="MSH|^~\&|..." <- the response message
+48 ; RESULTS(2)="... etc, etc"
+49 ;
EN(INPUT,OUTPUT) ;Call to do direct connect to MPI
+1 NEW I,LOOP,LP,POP,X,XCS,XCSDAT,XCSER,XCSEXIT,XCSMD,XCSNT,XCSTIME
+2 NEW XCSTRACE,Y
+3 ;
+4 DO SETUP
+5 ;
+6 ;IHS exemption approved on March 16, 2005
+7 IF XCSNT
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERROR^BOPTCP"
+8 IF '$TEST
SET X="ERROR^BOPTCP"
SET @^%ZOSF("TRAP")
+9 ;
+10 ;->
DO OPEN
IF POP
QUIT $$ERR("POP=1 ON OPEN")
+11 DO DATA
+12 DO GET
+13 DO QUIT
+14 ;
+15 ;#errors = 0
QUIT 0
+16 ;
ERR(REA) ;Report back an error
+1 DO TRACE("ERROR "_XCS("STAT"))
+2 IF 'POP
DO QUIT
+3 QUIT "-1^"_REA
+4 ;
ERROR ;Trap an error
+1 DO ^%ZTER
GOTO UNWIND^%ZTER
+2 ;
OPEN ;Open connection
+1 DO TRACE("Make Connection")
+2 DO CALL^%ZISTCP(BOPIP,BOPOCK)
IF POP
QUIT
+3 DO TRACE("Got Connection")
+4 USE IO
+5 QUIT
DATA ;Send data
+1 DO TRACE("Send Data")
+2 ;LJA
DO SDATA(INPUT,$GET(TYPE,"MPI"))
+3 QUIT
+4 ;
GET ;Get responce
+1 DO GDATA(OUTPUT)
+2 QUIT
QUIT ;Shut down
+1 DO CLOSE^%ZISTCP
+2 QUIT
TRACE(S1) ;
+1 IF 0
QUIT
NEW %,H
+2 IF S1=-1
KILL ^TMP($JOB,"ZZXCSA")
QUIT
+3 SET H=$PIECE($HOROLOG,",",2)
SET H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
+4 LOCK +^TMP($JOB,"ZZXCSA"):1
+5 SET %=$GET(^TMP($JOB,"ZZXCSA",0))+1
SET ^(0)=%
SET ^(%)=H_XCSTRACE_S1
+6 LOCK -^TMP($JOB,"ZZXCSA")
+7 QUIT
SETUP ;EP - SET UP INFO
+1 SET XCS("IP")=BOPIP
SET XCS("SOCK")=BOPOCK
+2 SET (XCS("STAT"),XCSEXIT)=0
SET XCSTIME=30
SET XCSTRACE="C: "
+3 SET XCSNT=$$NEWERR^%ZTER()
+4 DO TRACE(-1)
DO TRACE("Client Setup")
+5 QUIT
GDATA(ROOT,STAT) ;EP - get Data
+1 NEW E,I,M
+2 ;
+3 ; changed read timeout to 2 from 5 dtg
+4 ;
SET BOPCHKA=""
FOR
USE IO
READ RESTRNG#200:3
IF RESTRNG=""&'$TEST
QUIT
Begin DoDot:1
+5 ; set quit flag if ascii 28 contained
+6 IF RESTRNG[$CHAR(28)
SET BOPCHKA=1
+7 ;
+8 ;Strip Control Characters from END of received string
+9 FOR
IF RESTRNG'?.E1C
QUIT
SET RESTRNG=$EXTRACT(RESTRNG,1,$LENGTH(RESTRNG)-1)
+10 ;
+11 SET BOPK=2
MORE SET BOPTRNG=$PIECE(RESTRNG,$CHAR(11),BOPK)
+1 IF BOPTRNG']""
QUIT
+2 FOR BOPI=1:1
SET BOPLINE=$PIECE(BOPTRNG,$CHAR(13),BOPI)
IF BOPLINE']""!(BOPLINE=$CHAR(28))
QUIT
Begin DoDot:2
+3 SET I=$ORDER(@ROOT@(":"),-1)+1
SET @ROOT@(I)=BOPLINE
End DoDot:2
+4 SET BOPK=BOPK+1
+5 GOTO MORE
End DoDot:1
IF BOPCHKA
QUIT
+6 ;
+7 QUIT
+8 ;
SDATA(ROOT,TYPE) ;EP - Send data from a source
+1 NEW X,Y,L,D
+2 SET X=ROOT
+3 FOR
SET X=$QUERY(@X)
IF X']""!(X'[ROOT)
QUIT
Begin DoDot:1
+4 USE IO
WRITE @X,!
End DoDot:1
+5 ;
+6 DO ENDCHARS
+7 QUIT
+8 ;
ENDCHARS ; Add EOT ctrl characters, etc, below... LJA
+1 QUIT
+2 ;
+3 ; If end of transmission characters needed, add here...
+4 ;
IP() ; Substitute IP ADDRESS...
+1 QUIT $PIECE(^BOP(90355,1,0),U,17)
+2 ;
SOCKET() ; Substitute SOCKET...
+1 QUIT $PIECE(^BOP(90355,1,0),U,18)
