ABSPOSAR ; IHS/FCS/DRS - low-level Receive response ; [ 09/12/2002 10:06 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,11**;JUN 21, 2001;Build 38
;---------------------------------------------------------------------
;Gather message from host until ETX, EOT control characters have been
;received or timeout has occurred
;
;Parameters: DIALOUT
; .RESPMSG - Message text gathered from modem
; .RESPLRC - Longitudinal redundancy checker character
; TIMEOUT - Number of seconds before process terminates
;
;Returns: "EOT" - an EOT was received from the host
; "" - process timed out
; "ETX" - ETX received; we have a message & LRC
;---------------------------------------------------------------------
;IHS/SD/lwj 10/13/04 patch 11
; With NCPDP 5.1 the limitation on the response length is now extended
; with the repeating segments and fields. Due to this, the limitation
; originally set (2048 characters) needs to be extended and the number
; of prescriptions sent on a claim for some processors needs to be
; reduced to help limit the size of the response coming back.
; Limitation extended to 4096, and for now Pharmacare 5.1 altered to
; 2 rxs per claim.
;---------------------------------------------------------------------
Q
GETMSG(DIALOUT,RESPMSG,RESPLRC,TIMEOUT) ;EP - from ABSPOSAM
;
; Since we cannot USE:(parameters) to set the READ terminator,
; we must read one character at a time and check for STX,ETX,EOT
;
;FIXED128 = how many times we had to clear unwanted high bit
;ZB mimics a terminal device's $ZB, the READ terminator
N IO S IO=$$IO^ABSPOSA(DIALOUT) U IO
D LOG^ABSPOSL($T(+0)_" - RESP - Begin gathering host system's response",$G(ECHO))
1 N FIXED128,MAXMSG,ZA,ZB,I,X,T1LENGTH,T1LINE
;IHS/SD/lwj 10/13/04 patch 11 nxt line rmkd out, following added
;S FIXED128=0,MAXMSG=2048
S FIXED128=0,MAXMSG=4096
;IHS/SD/lwj 10/13/04 patch 11 end changes
S T1LINE=$$T1DIRECT^ABSPOSA(DIALOUT) ; true if this is a T1 connection
;
START S (RESPMSG,RESPLRC,RET)="",(T1LENGTH,ZB)=0
S X="GETZE^"_$T(+0),@^%ZOSF("TRAP")
F I=1:1:MAXMSG D Q:ZB ; loop to read characters
4 . R *X:0
. I '$T S ZB=-1 D ; timed out; retry for up to TIMEOUT secs more
. . N J F J=1:1:TIMEOUT U IO R *X:1 I $T S ZB=0 Q
. I ZB D S RET="+++" Q ; Timed out, retried, still couldn't get more
. . D LOG^ABSPOSL($T(+0)_" - RESP - Timed out after "_$L(RESPMSG)_" characters",$G(ECHO))
. I X<1 Q ; Something's wrong: got a character but it's 0 or negative
5 . I X>127 S X=X-128,FIXED128=FIXED128+1 ; clear unwanted high bit
. ;
. ; Did not time out; process the character
. ;
. S X=$C(X)
. ;
. ; If it's a T1 connection, first four bytes are the length
. ; But if a length contains a nonnumeric byte, you have an error.
. ;
. I T1LINE,I<5 D Q:X?1N
. . I X'?1N D S X=EOT
. . . D LOG^ABSPOSL($T(+0)_" - RESP - Character #"_I_" of length prefix was nonnumeric $C("_$A(X)_")")
. . S T1LENGTH=T1LENGTH*10+$A(X)-$A("0")
. ;
. ; Handle special control characters for modem connections:
. ;
. I 'T1LINE,X=STX!(X=ETX)!(X=EOT) D Q ; a terminator was received
. . S ZB=$A(X) ; remember what terminated the READ
. . I X=ETX D ; (and this terminator is our favorite one)
7 . . . S RESPMSG=RESPMSG_X
. . . S RESPLRC=$$GETCH(5) ; got the RESPMSG,now get the LRC
. . . I RESPLRC="" D S ZB=-1 ; reset ZB to indicate timeout in GETLRC()
. . . . D LOG^ABSPOSL($T(+0)_" - RESP - Timed out - got "_$L(RESPMSG)_" characters but not LRC character",$G(ECHO))
8 . S RESPMSG=RESPMSG_X
. ;
. ; If T1 line and you've got the entire message gathered,
. ; then fake out an ETX. This will cause the outer loop to stop.
. ;
. I T1LINE,I=(T1LENGTH+4) S ZB=$A(ETX),RESPLRC=0
;
; The READ loop is done - now act on the results
;
;D SAVECOPY^ABSPOSAY(RESPMSG,"R",RESPLRC)
I FIXED128 D LOG^ABSPOSL($T(+0)_" - RESP - Had to clear high bit "_FIXED128_" times",$G(ECHO))
I ZB=$A(EOT) D Q "EOT" ; EOT received from host
.D LOG^ABSPOSL($T(+0)_" - RESP - received EOT",$G(ECHO))
I ZB=$A(STX) D G START ; 03/08/2000
. D LOG^ABSPOSL($T(+0)_" - RESP - received STX, read again",$G(ECHO))
I ZB=-1 D Q "" ; timed out
.D LOG^ABSPOSL($T(+0)_" - RESP - timed out",$G(ECHO))
I ZB=0 D Q "" ; must have gotten to MAXMSG !?
.D LOG^ABSPOSL($T(+0)_" - RESP - got to MAXMSG characters",$G(ECHO))
I ZB'=$A(ETX) D Q "" ;ZT ; must be ETX, then, right?
.D LOG^ABSPOSL($T(+0)_" - RESP - unexpected ZB = "_ZB_" (should have gotten ETX)",$G(ECHO))
. D IMPOSS^ABSPOSUE("P","TRI","ZB="_ZB,,"GETMSG",$T(+0))
D LOG^ABSPOSL($T(+0)_" - RESP - Received "_$L(RESPMSG)_" characters",$G(ECHO))
9999999 Q "ETX"
;
; GETCH(timeout) - read one character
; Returns the character obtained, if any.
; Returns "" if it timed out.
GETCH(TO) ; read one character, timeout TO ; returns "" if timed out
;
; If a character is ready immediately, grab it and get out.
;
N X U IO R *X:0 I $T Q $C(X)
;
; Otherwise, loop and keep trying; maybe timeout.
;
N J,RET S RET="" F J=1:1:TO R *X:1 I $T S RET=$C(X) Q
Q RET
;
GETZE D LOGZE("GETMSG") Q:$Q "" Q
LOGZE(WHERE) D LOG^ABSPOSL($T(+0)_" - MODEM - "_WHERE_" - $ZE="_$$ZE^ABSPOS) Q
ABSPOSAR ; IHS/FCS/DRS - low-level Receive response ; [ 09/12/2002 10:06 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,11**;JUN 21, 2001;Build 38
+2 ;---------------------------------------------------------------------
+3 ;Gather message from host until ETX, EOT control characters have been
+4 ;received or timeout has occurred
+5 ;
+6 ;Parameters: DIALOUT
+7 ; .RESPMSG - Message text gathered from modem
+8 ; .RESPLRC - Longitudinal redundancy checker character
+9 ; TIMEOUT - Number of seconds before process terminates
+10 ;
+11 ;Returns: "EOT" - an EOT was received from the host
+12 ; "" - process timed out
+13 ; "ETX" - ETX received; we have a message & LRC
+14 ;---------------------------------------------------------------------
+15 ;IHS/SD/lwj 10/13/04 patch 11
+16 ; With NCPDP 5.1 the limitation on the response length is now extended
+17 ; with the repeating segments and fields. Due to this, the limitation
+18 ; originally set (2048 characters) needs to be extended and the number
+19 ; of prescriptions sent on a claim for some processors needs to be
+20 ; reduced to help limit the size of the response coming back.
+21 ; Limitation extended to 4096, and for now Pharmacare 5.1 altered to
+22 ; 2 rxs per claim.
+23 ;---------------------------------------------------------------------
+24 QUIT
GETMSG(DIALOUT,RESPMSG,RESPLRC,TIMEOUT) ;EP - from ABSPOSAM
+1 ;
+2 ; Since we cannot USE:(parameters) to set the READ terminator,
+3 ; we must read one character at a time and check for STX,ETX,EOT
+4 ;
+5 ;FIXED128 = how many times we had to clear unwanted high bit
+6 ;ZB mimics a terminal device's $ZB, the READ terminator
+7 NEW IO
SET IO=$$IO^ABSPOSA(DIALOUT)
USE IO
+8 DO LOG^ABSPOSL($TEXT(+0)_" - RESP - Begin gathering host system's response",$GET(ECHO))
1 NEW FIXED128,MAXMSG,ZA,ZB,I,X,T1LENGTH,T1LINE
+1 ;IHS/SD/lwj 10/13/04 patch 11 nxt line rmkd out, following added
+2 ;S FIXED128=0,MAXMSG=2048
+3 SET FIXED128=0
SET MAXMSG=4096
+4 ;IHS/SD/lwj 10/13/04 patch 11 end changes
+5 ; true if this is a T1 connection
SET T1LINE=$$T1DIRECT^ABSPOSA(DIALOUT)
+6 ;
START SET (RESPMSG,RESPLRC,RET)=""
SET (T1LENGTH,ZB)=0
+1 SET X="GETZE^"_$TEXT(+0)
SET @^%ZOSF("TRAP")
+2 ; loop to read characters
FOR I=1:1:MAXMSG
Begin DoDot:1
4 READ *X:0
+1 ; timed out; retry for up to TIMEOUT secs more
IF '$TEST
SET ZB=-1
Begin DoDot:2
+2 NEW J
FOR J=1:1:TIMEOUT
USE IO
READ *X:1
IF $TEST
SET ZB=0
QUIT
End DoDot:2
+3 ; Timed out, retried, still couldn't get more
IF ZB
Begin DoDot:2
+4 DO LOG^ABSPOSL($TEXT(+0)_" - RESP - Timed out after "_$LENGTH(RESPMSG)_" characters",$GET(ECHO))
End DoDot:2
SET RET="+++"
QUIT
+5 ; Something's wrong: got a character but it's 0 or negative
IF X<1
QUIT
5 ; clear unwanted high bit
IF X>127
SET X=X-128
SET FIXED128=FIXED128+1
+1 ;
+2 ; Did not time out; process the character
+3 ;
+4 SET X=$CHAR(X)
+5 ;
+6 ; If it's a T1 connection, first four bytes are the length
+7 ; But if a length contains a nonnumeric byte, you have an error.
+8 ;
+9 IF T1LINE
IF I<5
Begin DoDot:2
+10 IF X'?1N
Begin DoDot:3
+11 DO LOG^ABSPOSL($TEXT(+0)_" - RESP - Character #"_I_" of length prefix was nonnumeric $C("_$ASCII(X)_")")
End DoDot:3
SET X=EOT
+12 SET T1LENGTH=T1LENGTH*10+$ASCII(X)-$ASCII("0")
End DoDot:2
IF X?1N
QUIT
+13 ;
+14 ; Handle special control characters for modem connections:
+15 ;
+16 ; a terminator was received
IF 'T1LINE
IF X=STX!(X=ETX)!(X=EOT)
Begin DoDot:2
+17 ; remember what terminated the READ
SET ZB=$ASCII(X)
+18 ; (and this terminator is our favorite one)
IF X=ETX
Begin DoDot:3
7 SET RESPMSG=RESPMSG_X
+1 ; got the RESPMSG,now get the LRC
SET RESPLRC=$$GETCH(5)
+2 ; reset ZB to indicate timeout in GETLRC()
IF RESPLRC=""
Begin DoDot:4
+3 DO LOG^ABSPOSL($TEXT(+0)_" - RESP - Timed out - got "_$LENGTH(RESPMSG)_" characters but not LRC character",$GET(ECHO))
End DoDot:4
SET ZB=-1
End DoDot:3
End DoDot:2
QUIT
8 SET RESPMSG=RESPMSG_X
+1 ;
+2 ; If T1 line and you've got the entire message gathered,
+3 ; then fake out an ETX. This will cause the outer loop to stop.
+4 ;
+5 IF T1LINE
IF I=(T1LENGTH+4)
SET ZB=$ASCII(ETX)
SET RESPLRC=0
End DoDot:1
IF ZB
QUIT
+6 ;
+7 ; The READ loop is done - now act on the results
+8 ;
+9 ;D SAVECOPY^ABSPOSAY(RESPMSG,"R",RESPLRC)
+10 IF FIXED128
DO LOG^ABSPOSL($TEXT(+0)_" - RESP - Had to clear high bit "_FIXED128_" times",$GET(ECHO))
+11 ; EOT received from host
IF ZB=$ASCII(EOT)
Begin DoDot:1
+12 DO LOG^ABSPOSL($TEXT(+0)_" - RESP - received EOT",$GET(ECHO))
End DoDot:1
QUIT "EOT"
+13 ; 03/08/2000
IF ZB=$ASCII(STX)
Begin DoDot:1
+14 DO LOG^ABSPOSL($TEXT(+0)_" - RESP - received STX, read again",$GET(ECHO))
End DoDot:1
GOTO START
+15 ; timed out
IF ZB=-1
Begin DoDot:1
+16 DO LOG^ABSPOSL($TEXT(+0)_" - RESP - timed out",$GET(ECHO))
End DoDot:1
QUIT ""
+17 ; must have gotten to MAXMSG !?
IF ZB=0
Begin DoDot:1
+18 DO LOG^ABSPOSL($TEXT(+0)_" - RESP - got to MAXMSG characters",$GET(ECHO))
End DoDot:1
QUIT ""
+19 ;ZT ; must be ETX, then, right?
IF ZB'=$ASCII(ETX)
Begin DoDot:1
+20 DO LOG^ABSPOSL($TEXT(+0)_" - RESP - unexpected ZB = "_ZB_" (should have gotten ETX)",$GET(ECHO))
+21 DO IMPOSS^ABSPOSUE("P","TRI","ZB="_ZB,,"GETMSG",$TEXT(+0))
End DoDot:1
QUIT ""
+22 DO LOG^ABSPOSL($TEXT(+0)_" - RESP - Received "_$LENGTH(RESPMSG)_" characters",$GET(ECHO))
9999999 QUIT "ETX"
+1 ;
+2 ; GETCH(timeout) - read one character
+3 ; Returns the character obtained, if any.
+4 ; Returns "" if it timed out.
GETCH(TO) ; read one character, timeout TO ; returns "" if timed out
+1 ;
+2 ; If a character is ready immediately, grab it and get out.
+3 ;
+4 NEW X
USE IO
READ *X:0
IF $TEST
QUIT $CHAR(X)
+5 ;
+6 ; Otherwise, loop and keep trying; maybe timeout.
+7 ;
+8 NEW J,RET
SET RET=""
FOR J=1:1:TO
READ *X:1
IF $TEST
SET RET=$CHAR(X)
QUIT
+9 QUIT RET
+10 ;
GETZE DO LOGZE("GETMSG")
IF $QUIT
QUIT ""
QUIT
LOGZE(WHERE) DO LOG^ABSPOSL($TEXT(+0)_" - MODEM - "_WHERE_" - $ZE="_$$ZE^ABSPOS)
QUIT
