Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPOSAR

ABSPOSAR.m

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