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

ABSPOSAM.m

Go to the documentation of this file. 
  1. ABSPOSAM ; IHS/FCS/DRS - JWS ;      [ 06/10/2002  7:19 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**2**;JUN 21, 2001;Build 38
  1.  ;
  1.  ;  ABSPOSAM is the main program for send/receive communications
  1.  ;  with the Envoy or NDC switches.  Or certain insurance company
  1.  ;  systems, such as the PCS test system.
  1.  ;
  1.  ;  Sets up these variables:
  1.  ;     ABSPECT2 = count of successful xmit/recv transactions
  1.  ;            (without regard to rejected claims, merely that the
  1.  ;             xmit/recv sequence completed with apparent success)
  1.  ;
  1.  ;  Subroutines are in ABSPOSAN, ABSPOSAO, ABSPOSAP, ABSPOSAQ
  1.  ;
  1.  ; Future:  List of claims to be sent is handled by an index in
  1.  ; file 9002313.02; list of responses to be processed is handled by
  1.  ; an index in file 9002313.03.  Make sure Fileman Database Server
  1.  ; calls really do handle the locking you need.
  1.  ;
  1.  ; IHS/SD/lwj  06/10/02  change made to the S12 subroutine - checking
  1.  ; of the value in IO changed from a numeric assumption to an
  1.  ; alpha/numeric check.  This was done as a result of the Cache changes.
  1.  ; For Cache, the device is now an alpha/numeric value as opposed to the
  1.  ; numerice value (56) used in MSM.
  1.  ;
  1.  ;
  1.  Q
  1. SEND(DIALOUT) ;EP - from ABSPOSQ3
  1.  S ABSPECT2=0
  1.  ;
  1.  N CLAIMNXT,I,RESPLRC,RESPMSG
  1.  N HMSG,LRCOK,SENDMSG,SENDMSGP,GETMSG,CLAIMIEN,LRC,RET
  1.  N TRANSBEG,TRANSEND,TRANSTIM ; transaction begin,end,time
  1.  N SEG S SEG=245 ; length of string segments storing long string in gbl
  1.  ;
  1.  N ACK,ENQ,EOT,ETX,NAK,STX,ETB
  1.  S ACK=$C(6),ENQ=$C(5),EOT=$C(4),ETX=$C(3)
  1.  S NAK=$C(21),STX=$C(2),ETB=$C(23)
  1.  ;
  1. S12 ; 
  1.  ;IHS/SD/lwj  06/10/02  nxt line remarkd out- following line added
  1.  ; this change was done as a result of the Cache changes - IO will no
  1.  ; longer just be a number (56) - for Cache, it will be a "|TCP|"
  1.  ; coupled with the port number
  1.  ;
  1.  ;N IO S IO=$$IO^ABSPOSA(DIALOUT) I 'IO G S12:$$IMPOSS^ABSPOSUE("DB","TRI","IO field missing in DIALOUT="_DIALOUT,,"S12",$T(+0))
  1.  N IO S IO=$$IO^ABSPOSA(DIALOUT) I IO="" G S12:$$IMPOSS^ABSPOSUE("DB","TRI","IO field missing in DIALOUT="_DIALOUT,,"S12",$T(+0))
  1.  ; IHS/SD/lwj 06/10/02 - end of Cache changes
  1.  ;
  1.  N T1LINE S T1LINE=$$T1DIRECT^ABSPOSA(DIALOUT)
  1.  ;
  1.  I $$SHUTDOWN Q 0
  1.  I '$$GETNEXT^ABSPOSAP Q 0
  1.  ; Dial the phone and connect to Envoy
  1.  S RET=$$CONNECT^ABSPOSAQ(DIALOUT)
  1.  I RET D PUTBACK^ABSPOSAP Q RET ; error? put back claim before quitting
  1.  ;
  1. START ;Main message loop ; we have SENDMSG and SENDMSGP and CLAIMIEN
  1.  ; If anything goes wrong, be sure to DO PUTBACK before quitting!
  1.  ;
  1.  D CLAIMBEG ; write to our own log file - beginning for this claim
  1.  D SETCOMMS^ABSPOSU(CLAIMIEN,$$GETPLACE^ABSPOSL) ; mark start in .59
  1.  ;
  1. LOOP0 ; Wait for host to send ENQ
  1.  ;
  1.  I 'T1LINE D  I RET Q RET
  1.  . S RET=$$INITIATE^ABSPOSAO I RET D  ; wait for host to send ENQ
  1.  . . D PUTBACK^ABSPOSAP,CLAIMEND ; and if you didn't get it...
  1.  ;
  1.  ;Send message to host:   STX, message, ETX, LRC
  1.  ;
  1.  D SETCSTAT^ABSPOSU(CLAIMIEN,60) ; set prescrs' status = "Transmitting"
  1. LOOP1A D LOG("2 - Sending message #"_CLAIMIEN)
  1.  ; NDC and test mode, "HN." instead of "HN*" ?  Ancient code.
  1.  ; I don't know if it makes a shred of difference
  1.  I $E(SENDMSG,1,3)="HN." D
  1.  . D LOG("2 - Sending message in TEST mode")
  1.  S TRANSBEG=$P($H,",",2) ; beginning time (for timing transaction)
  1.  D SENDREQ^ABSPOSAS(DIALOUT,.SENDMSG)
  1.  D  ; stats - figure out which piece the transaction code increments
  1.  .N % S %=$P($G(^ABSPC(CLAIMIEN,100)),U,3)
  1.  .S %=$S(%>0&(%<5):%,%=11:5,1:19)
  1.  .D ADDSTAT^ABSPOSUD("C",2,1,"C",3,$L(SENDMSG)+3,"C",%,1)
  1.  ;
  1.  ;Wait for response from host
  1.  ; Envoy sends an ACK at this point.
  1.  ; Apparently NDC does not?  Or maybe NDC sends ACK then STX
  1.  ; Also: make the timeout 60 seconds.  "The Envoy host typically allows 
  1.  ; an end processor up to 55 seconds to respond."
  1.  ;
  1. LOOP1B I T1LINE S HMSG="ACK" G LOOP1C
  1.  D LOG("2 - Waiting for ACK or NAK")
  1.  S HMSG=$$WAITCHAR(ACK_NAK_STX_ENQ,60)
  1.  I HMSG="ACK" D
  1.  . ; we got what we expected; do nothing else here
  1.  E  I HMSG="STX" D
  1.  . D LOG("2 - Missing ACK but got STX; must be start of response?")
  1.  E  I HMSG="NAK" D  G LOOP1A
  1.  . D LOG("2 - Host sent NAK - we will resend")
  1.  E  I HMSG="ENQ" D  G LOOP1A ; Envoy 4.1, p. 12
  1.  . D LOG("2 - Host sent another ENQ - we will resend")
  1.  E  D  Q RET
  1.  . D LOG("2 - But received "_HMSG_" instead.")
  1.  . D PUTBACK^ABSPOSAP,CLAIMEND ; put message back for later transmission
  1.  . I HMSG'="+++" D HANGUP
  1.  . S RET=$S(HMSG="+++":31101,HMSG="":31102,1:31103)
  1.  ;
  1.  ; The response message is preceded by STX
  1.  ; If we just got an ACK, then wait for the STX
  1.  ;
  1. LOOP1C I HMSG="ACK" D
  1.  . I T1LINE S HMSG="STX" Q
  1.  . S HMSG=$$WAITCHAR(STX,60)
  1.  . D LOG("2 - "_HMSG_" received from host")
  1.  E  I HMSG="STX" D
  1.  . ; do nothing; fall through with STX still here
  1.  E  D  Q 30239
  1.  . D LOG("Internal error at LOOP1C")
  1.  ;
  1.  I HMSG="STX" D
  1.  . ; nothing, got what we expected
  1.  E  D  Q RET
  1.  . D LOG("2 - Expected STX but got "_HMSG_" instead")
  1.  . D PUTBACK^ABSPOSAP,CLAIMEND
  1.  . S RET=$S(HMSG="+++":30251,HMSG="":30252,1:30253)
  1.  ;I HMSG'="STX" D INCSTAT^ABSPOSUD("CR",$S(HMSG="ENQ":2,HMSG="NAK":3,HMSG="+++":4,HMSG="":5,1:9))
  1.  ;
  1.  ;   The host sends us the response message
  1.  ;
  1. LOOP3 S (GETMSG,LRC)=""
  1.  D SETCSTAT^ABSPOSU(CLAIMIEN,70) ; status = "Receiving response"
  1.  D LOG("3 - Gathering response from host")
  1.  S HMSG=$$GETMSG^ABSPOSAR(DIALOUT,.RESPMSG,.RESPLRC,60)
  1.  ;
  1.  ;         HMSG="ETX" or "EOT" or "" (if timed out)
  1.  ;
  1.  I HMSG="ETX" D
  1.  . D LOG("3 - Received "_$L(RESPMSG)_" bytes; LRC "_$A(RESPLRC))
  1.  . D ADDSTAT^ABSPOSUD("C",4,1,"C",5,$L(RESPMSG)+3)
  1.  E  D  Q RET
  1.  . D INCSTAT^ABSPOSUD("CR2",1,"CR2",$S(HMSG="EOT":2,HMSG="":3,HMSG="+++":4,1:9))
  1.  . D LOG("3 - Error while gathering response: HMSG="_HMSG)
  1.  . D PUTBACK^ABSPOSAP
  1.  . D CLAIMEND
  1.  . I HMSG'="+++" D HANGUP
  1.  . S RET=$S(HMSG="+++":30261,HMSG="":30262,1:30263)
  1.  ;
  1.  ; Test LRC character.  If we agree, we send ACK.  If not, we NAK.
  1.  ; And if we send ACK, get the next message to send, if any.
  1.  ;
  1.  I T1LINE S LRCOK=1 ; G PASTLRC ; if  T1 connection, LRC is n/a
  1.  E  I $L(RESPMSG)<9 S LRCOK=0 ; we have seen 1-byte response msg!
  1.  E  S LRCOK=$$TESTLRC^ABSPOSAD(RESPMSG,RESPLRC)
  1.  ;
  1.  S CLAIMNXT=0 ; assume no claims to send after this one
  1.  I LRCOK D
  1.  . N CLAIMIEN ; protect CLAIMIEN - $$GETNEXT will reset it
  1.  . I '$$SHUTDOWN S CLAIMNXT=$$GETNEXT^ABSPOSAP ; remember next CLAIMIEN
  1.  . I CLAIMNXT,$P($G(^ABSP(9002313.55,DIALOUT,"PROTOCOL")),U) D
  1.  . . Q:T1LINE
  1.  . . D LOG("6 - Send ETB to host")
  1.  . . D SENDETB^ABSPOSAS(DIALOUT)
  1.  . E  D
  1.  . . Q:T1LINE
  1.  . . D LOG("6 - Send ACK to host")
  1.  . . D SENDACK^ABSPOSAS(DIALOUT)
  1.  . S ABSPECT2=ABSPECT2+1 ; count our successes (and blessings)
  1.  . ;
  1.  . ; ABSPOSQ3 will start up processing of responses 
  1.  . ; But here, if we have heavy volume, we need to get it going
  1.  . ; right now, every so often.
  1.  . ;
  1.  . I ABSPECT2>10,ABSPECT2#5=0 D TASK^ABSPOSQ3()
  1.  E  D
  1.  . D LOG("6 - Send NAK to host because of LRC disagreement")
  1.  . D SENDNAK^ABSPOSAS(DIALOUT)
  1.  ;
  1. PASTLRC ;
  1.  S TRANSEND=$P($H,",",2) ; timing - when transaction completed
  1.  S TRANSTIM=TRANSEND-TRANSBEG S:TRANSTIM<0 TRANSTIM=TRANSTIM+86400
  1.  ; Statistics:  Comms - Transaction Time Comms
  1.  ;              Comms - Send ACK      Comms - Send NAK
  1.  D ADDSTAT^ABSPOSUD("CT",1,TRANSTIM,"C",7+'LRCOK,1)
  1.  ;
  1.  I 'LRCOK D  G LOOP1C
  1.  . S HMSG="ACK" ; fake it out so it drops into the WAITCHAR(STX) code
  1.  ;
  1.  D CLAIMEND
  1.  ;
  1.  ;  At this happy point, we have received a response and ACK'ed it.
  1.  ;  NOTE!! SENDMSG is the _next_ message to send, not the one just sent!
  1.  ;
  1.  ;File response message in temporary global
  1.  ;
  1. LR L +^ABSPECX("POS",DIALOUT,"R",CLAIMIEN):300 ; lock the response
  1.  I '$T G LR:$$IMPOSS^ABSPOSUE("L","RIT","LOCK response",,"LR",$T(+0))
  1.  K ^ABSPECX("POS",DIALOUT,"R",CLAIMIEN) ; kill anything that's there
  1.  F I=1:SEG:$L(RESPMSG) D
  1.  .S ^ABSPECX("POS",DIALOUT,"R",CLAIMIEN,I\SEG+1)=$E(RESPMSG,I,I+SEG-1)
  1.  .S ^ABSPECX("POS",DIALOUT,"R",CLAIMIEN,0)=I\SEG+1
  1.  L -^ABSPECX("POS",DIALOUT,"R",CLAIMIEN) ; unlock the response
  1.  D SETCSTAT^ABSPOSU(CLAIMIEN,80) ; Waiting to process response.
  1.  ;
  1.  ; Now we're ready to go again.
  1.  I CLAIMNXT S CLAIMIEN=CLAIMNXT G START
  1.  ;
  1.  ; No more to send.
  1.  ; We expect EOT from Envoy.  NDC might send ENQ here?
  1.  I T1LINE Q 0
  1.  S HMSG=$$WAITCHAR(EOT_ENQ,3)
  1.  I HMSG'="+++",HMSG'="ENQ" D
  1.  . D LOG("9 - No more to send; expect EOT, got "_HMSG)
  1.  I HMSG'="+++" D HANGUP
  1.  Q 0
  1.  ; ----- end of main part of routine -----
  1.  ;
  1. LOG(X) D LOG^ABSPOSL($T(+0)_" - "_X) Q
  1.  ;
  1.  ; READCHAR not used? READCHAR(TIMEOUT)  N X U IO R *X:TIMEOUT Q X
  1.  ;
  1.  ; WAITCHAR:  Envoy 4.1, page 16
  1.  ;   If during one of the wait stages of the transmission, the
  1.  ; pharmacy system should receive unexpected characters, they should
  1.  ; be ignored unless they are transmitted as a part of the response
  1.  ; (beginning with the STX and concluding with the ETX).  At that
  1.  ; point, they should be considered a part of a message.  The ENVOY
  1.  ; system will react in the same manner after returning a response.
  1.  ; After the issuance of the ENQ, however, if the host receives
  1.  ; unexpected characters without receiving the STX and/or the ETX,
  1.  ; it will issue an EOT.
  1.  ;
  1.  ; In plain English:  WAITCHAR^ABSPOSAW ignores unexpected characters.
  1.  ; Except for EOT - it catches that, as well as the watched-for
  1.  ; characters.
  1.  ;
  1. WAITCHAR(CHARS,TIMEOUT) ;EP -
  1.  N RET S RET=$$WAITCHAR^ABSPOSAW(DIALOUT,CHARS,TIMEOUT)
  1.  I RET="+++" D LOG("WAITCHAR tells us that modem is disconnected.")
  1.  Q RET
  1.  ;
  1. SHUTDOWN()         N RET S RET=$$SHUTDOWN^ABSPOSQ3
  1.  I RET D LOG("The transmit/receive shutdown flag is set.")
  1.  Q RET
  1. HANGUP D HANGUP^ABSPOSAB(DIALOUT) Q
  1.  ;  NOTE!!!  Print of log for one claim depends on finding
  1.  ;  the exact texts shown below!
  1. CLAIMBEG D LOG("CLAIM - BEGIN - #"_CLAIMIEN_$$CLAIM01) Q
  1. CLAIMEND D LOG("CLAIM - END - #"_CLAIMIEN_$$CLAIM01) Q
  1. CLAIM01() Q " ("_$P(^ABSPC(CLAIMIEN,0),U)_")"