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

INHVTMT3.m

Go to the documentation of this file. 
  1. INHVTMT3 ; KAC ; 04 Nov 1999 15:32 ; Multi-threaded TCP/IP socket utilities 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  Q
  1.  ;
  1. GETFRAME(INBFR,INFRMCHR,INFRMPOS) ; Create array of framing char positions
  1.  ; in INBFR.  E.g. INFRMPOS(5)=SOM, INFRMPOS(29)=SOM, INFRMPOS(134)=SOM
  1.  ;
  1.  ; Called by: RECEIVE^INHVTMT2
  1.  ;
  1.  ; Input:
  1.  ; INBFR    - (req) Buffer read by %INET (up to 512 bytes long)
  1.  ; INFRMCHR - (req) Framing char(s) to search for
  1.  ;
  1.  ; Output:
  1.  ; INFRMPOS - (pbr) Array of framing chars in INBFR by position
  1.  ;
  1.  N INFOUND
  1.  S INFOUND=0
  1.  F  D  Q:'INFOUND
  1.  . S INFOUND=$F(INBFR,INFRMCHR,INFOUND)
  1.  . Q:'INFOUND
  1.  . S INFRMPOS(INFOUND-$L(INFRMCHR))=INFRMCHR
  1.  Q
  1.  ;
  1. PUTINREC(INMSG) ; Put msg (may only be a piece of msg) into INREC array
  1.  ; Remove msg framing chars from msg portion and decrypt.
  1.  ;
  1.  ; Called by: RECEIVE^INHVTMT2
  1.  ;
  1.  N X,INCLRHDR,INLAST,INMSGHDR,INTYPE
  1.  S INLAST=$S(INMSG[INEOM:1,1:0)
  1.  S:INMSG[INSOM INMSG=$E(INMSG,$F(INMSG,INSOM),$L(INMSG)) ; remove SOM
  1.  S:INLAST INMSG=$TR(INMSG,INEOM) ; remove EOM
  1.  ; PDTS requires that ER & SE msg type be sent to CHCS unencrypted
  1.  ; Check TYPE in msg hdr
  1.  I INSTD="PDTS",'$G(INCLRMSG),(INMSG[INSOD) D
  1.  . S X="" F  S X=$O(@INREC@(X)) Q:'X  S INMSGHDR=$G(INMSGHDR)_@INREC@(X)
  1.  . S INMSGHDR=$G(INMSGHDR)_$P(INMSG,INSOD)
  1.  . S INCLRMSG="^ER^SE^"[(U_$E(INMSGHDR,3,4)_U)
  1.  I INSTD="PDTS",'$G(INCLRMSG) S INCLRHDR=$S((INMSG[INSOD):1,(INRSTATE="SOD"):1,1:0)
  1.  I $D(INSOD),(INMSG[INSOD) S INMSG=$TR(INMSG,INSOD,INEOL) ; grp separator
  1.  ;
  1.  ; Decrypt all except 1st hdr (E.g. SOM-ENP Hdr Data-EOL) and EOM char
  1.  I $L(INMSG),'$G(INCLRMSG) D
  1.  . I $G(INCLRHDR) D  ; do NOT decrypt any part of 1st hdr
  1.  .. S INMSGHDR=$P(INMSG,INEOL)_$S(INMSG[INEOL:INEOL,1:"")
  1.  ..; decrypt after 1st hdr
  1.  .. S INMSG=$P(INMSG,INEOL,2,99999)
  1.  . I $L(INMSG) D
  1.  ..; if partial IV at start of encrypted msg, save til have full IV
  1.  .. I INFIRST,(($L(INIVBLD)+$L(INMSG))<INIVLEN) S INIVBLD=INIVBLD_INMSG,INMSG="" Q
  1.  .. I $L(INIVBLD) D  S INIVBLD=""
  1.  ... I ($L(INIVBLD)+$L(INMSG))'>512 S INMSG=INIVBLD_INMSG Q
  1.  ... S INIVBLD=INIVBLD_$E(INMSG,1,INIVLEN)
  1.  ... S INMSG=$E(INMSG,INIVLEN+1,99999)
  1.  ... D DECRYPT^INCRYPT(.INIVBLD,.X,$L(INIVBLD),INFIRST,0)
  1.  ... S INIVBLD=X,INFIRST=0
  1.  ... D STORE(INIVBLD)
  1.  ..;
  1.  .. D DECRYPT^INCRYPT(.INMSG,.X,$L(INMSG),INFIRST,INLAST)
  1.  .. S INMSG=X,INFIRST=$S(INLAST:1,1:0)
  1.  .;
  1.  . S:$G(INCLRHDR) INMSG=INMSGHDR_INMSG
  1.  ;
  1.  S:INLAST INCLRMSG='$G(INIP("CRYPT"))
  1.  D STORE(INMSG)
  1.  Q
  1.  ;
  1. STORE(INMSG) ; Store decrypted msg in INREC
  1.  Q:'$L(INMSG)
  1.  S:$D(INFS) INMSG=$TR(INMSG,INFS,INDELIM) ; transform field separator
  1.  ; Ck $Storage for rollover to global
  1.  I $S<INSMIN D
  1.  .Q:INREC["^"
  1.  .K ^UTILITY("INREC",$J)
  1.  .M ^UTILITY("INREC",$J)=@INREC K @INREC S INREC="^UTILITY(""INREC"","_$J_")"
  1.  ;
  1.  S INRECCNT=INRECCNT+1,@INREC@(INRECCNT)=INMSG
  1.  Q
  1.  ;
  1. EVAL(ING) ; Evaluate incoming response.  Msg is marked complete
  1.  ; when o/p ctlr runs inbound script.
  1.  ;
  1.  ; Called by: RECEIVE^INHVTMT2
  1.  ;
  1.  ; Input:
  1.  ;   ING   - (req) Array in which decrypted, parsed msg is stored.
  1.  ;
  1.  N INERR,INERRHU,INMSG,INMSGDSP,INMSGLG,INMSGST,INSEQNUM,INUIF,INXUIF,X
  1.  S (INMSGDSP,INMSGLG,INMSGST)=""
  1.  S INMSG="Evaluating response"
  1.  D:$G(INDEBUG) LOG^INHVCRA1(INMSG,8)
  1.  S RUN=$$INRHB^INHUVUT1(INBPN,INMSG)
  1.  ; Start transaction audit for receipt of response
  1.  D:$D(XUAUDIT) TTSTRT^XUSAUD("","",INBPNM,"","RECEIVE")
  1.  ;
  1.  S INERRHU=$$IN^INHUSEN(ING,.INDEST,INDSTR,.INSEQNUM,.INSEND,.INERR,.INXDST,"","",.INMSASTA,1,INSTD)
  1.  ;
  1.  D:$D(XUAUDIT) TTSTP^XUSAUD(0)  ;stop transaction audit
  1.  ;
  1.  ;INERRHU=
  1.  ; 0 - no evaluation errors - kill msg, get next
  1.  ; 1 - transient error - resend msg, log error
  1.  ; 2 - fatal error - reroute msg, log error
  1.  ; 3 - outgoing error - kill msg, log error
  1.  ; 4 - incoming error - allow no-response timeout to cause resend, log error
  1.  ; 5 - internal error - kill msg, get next
  1.  ; 6 - heartbeat/dummy accept - get next
  1.  ; 7 - heartbeat/dummy reject - continue heartbeat
  1.  ;
  1.  D:$G(INDEBUG)
  1.  . I INERRHU D LOG^INHVCRA1("Code "_INERRHU_" evaluating response.",6) Q
  1.  . D LOG^INHVCRA1("Response accepted",9)
  1.  ;
  1.  ; Get originating UIF.  If no INSEQNUM, INERRHU must = 4,6,7
  1.  I $G(INSEQNUM) D  Q:'INUIF  ; exit EVAL if seq #, but no orig UIF
  1.  . S INUIF=$O(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM,""))
  1.  . I 'INUIF D  ; no pending que entry to manage
  1.  .. S INXUIF=$O(^INTHU("ASEQ",INDSTR,INSEQNUM,"")) ; get UIF for debugging
  1.  .. I INERRHU,$D(INERR) D ENR^INHE(INBPN,.INERR)
  1.  .. S INMSG="No pending que entry for response with sequence number "_INSEQNUM_$S(INXUIF:" and UIF="_INXUIF,1:"")_": No further processing performed by "_INBPNM
  1.  .. D ENR^INHE(INBPN,INMSG)
  1.  .. D:$G(INDEBUG) LOG^INHVCRA1(INMSG,8)
  1.  ;
  1.  ; Post-eval processing
  1.  S INMSGST="Msg "_$S(("^0^6^")[(U_INERRHU_U):"accepted",1:"rejected")
  1.  S INMSGLG=INMSGST_" ("_INERRHU_")"_$S($G(INUIF):" for originating UIF= "_INUIF,1:"")
  1.  ;
  1.  ; 0 - no evaluation errors - kill msg, get next
  1.  I INERRHU=0 D
  1.  . D PQKILL^INHVTMT4(INDSTR,INSEQNUM,INUIF,.INPEND)
  1.  . D ULOG^INHU(INUIF,"C") ; mark complete
  1.  ;
  1.  ; 1 - transient error - resend msg, log error
  1.  I INERRHU=1 D
  1.  . I INIP("STRY")'>$P(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM,INUIF),U,2) D  Q
  1.  ..; send tries exceeded, reroute msg to another xceiver
  1.  .. S X=$$GETPEND^INHVTMT4(INDSTR,INSEQNUM,INUIF,.INPEND)
  1.  .. S INMSGDSP=": Rerouting"
  1.  .. I INSTATE'="HB" D
  1.  ... D ERRADD^INHUSEN3(.INERR,"Transceiver entering heartbeat state.")
  1.  ... S INSTATE="HB" ; start heartbeat msgs following this read series
  1.  .;
  1.  .; else, send retries NOT exceeded
  1.  . D RESEND^INHVTMT4(INDSTR,INUIF,INSEQNUM)
  1.  . S INMSGDSP=": Resending"
  1.  ;
  1.  ; 2 - fatal error - reroute msg, log error
  1.  I INERRHU=2 D
  1.  . S X=$$GETPEND^INHVTMT4(INDSTR,INSEQNUM,INUIF,.INPEND)
  1.  . S INMSGDSP=": Rerouting"
  1.  . I INSTATE'="HB" D
  1.  .. D ERRADD^INHUSEN3(.INERR,"Transceiver entering heartbeat state.")
  1.  .. S INSTATE="HB" ; start heartbeat msgs following this read series
  1.  ;
  1.  ; 3 - outgoing (original o/b msg) error - kill msg, log error
  1.  I INERRHU=3 D
  1.  . D PQKILL^INHVTMT4(INDSTR,INSEQNUM,INUIF,.INPEND)
  1.  . S INMSGDSP=": Outbound msg error"
  1.  . D ULOG^INHU(INUIF,"E",.INERR) ; mark err
  1.  ;
  1.  ; 4 - incoming error - allow no-response timeout to cause resend, log error
  1.  ; No sequence # or orig UIF unavailable
  1.  I INERRHU=4 D
  1.  . S INMSGDSP=": Inbound msg error"
  1.  ;
  1.  ; 5 - internal error - kill msg, get next
  1.  I INERRHU=5 D
  1.  . D PQKILL^INHVTMT4(INDSTR,INSEQNUM,INUIF,.INPEND)
  1.  . S INMSGDSP=": Internal error"
  1.  . D ULOG^INHU(INUIF,"E",.INERR) ; mark err
  1.  ;
  1.  ; 6 - heartbeat/dummy transaction accepted - start sending claims
  1.  ; Sequence # = DUMMYTRX and no UIF unavailable
  1.  I INERRHU=6 D
  1.  . S INHBSENT=0,INMSGDSP=": Dummy trx successful"
  1.  .; if 1st time thru and pend que had entries on xceiver startup,
  1.  .;   ck for timeout before sending new entries
  1.  . I INSYNC S INSTATE="TIMEOUT" Q
  1.  . I INSTATE="HB" D
  1.  .. D ERRADD^INHUSEN3(.INERR,"Transceiver exiting heartbeat state.")
  1.  .. S INSTATE="SEND" ; start sending claims
  1.  ;
  1.  ; 7 - heartbeat/dummy transaction rejected - continue in HB state
  1.  ; Sequence # = DUMMYTRX and no UIF unavailable
  1.  I INERRHU=7 D
  1.  . S INMSGST="",INMSGDSP=": Dummy trx failed,Attempt "_INHBSENT_" with no response"
  1.  . S INSTATE="HB",INHBSENT=0  ; reset cnt if dummy response
  1.  ;
  1.  I INERRHU,$D(INERR) D ENR^INHE(INBPN,.INERR)  ; log err
  1.  S INRUNMT=$$INRHB^INHUVUT1(INBPN,INMSGST_INMSGDSP,$S(INERRHU:0,1:1))
  1.  D:$G(INDEBUG) LOG^INHVCRA1(INMSGLG_INMSGDSP,8)
  1.  Q
  1.  ;
  1. DATAFRAG(INBFR,INSTART,INEND) ; Data Fragmentation (possibly across bfrs).
  1.  ; Log error & reset vars.
  1.  ;
  1.  ; Called by: RECEIVE^INHVTMT2
  1.  ;
  1.  ; Input:
  1.  ;  INBFR   - (req) Bfr containing frag
  1.  ;  INSTART - (req) Char from which to start logging frag
  1.  ;  INEND   - (req) Char at which to stop logging frag
  1.  ;
  1.  N INERRMSG,INERRREC
  1.  S INERRREC=$$CLEAN^INHUVUT($E(INBFR,INSTART,INEND))
  1.  ; if crosses bfrs, logs chars in this INBFR only
  1.  S INERRMSG="Data Fragmentation error. Ignored: "_$E(INERRREC,1,450)
  1.  D ENR^INHE(INBPN,INERRMSG)
  1.  D:$G(INDEBUG) LOG^INHVCRA1(INERRMSG,3)
  1.  F I="SOM","SOD","EOM" S INPOS(I)=0
  1.  K @INREC S INREC="REC",INRECCNT=0
  1.  S INRSTATE="SOM"  ; looking for SOM
  1.  S INFIRST=1 ; 1st time thru decryptor per msg
  1.  S INCLRMSG='$G(INIP("CRYPT")) ; 1 = do not decrypt rcv'd msg
  1.  S INIVBLD=""
  1.  Q
  1.  ;
  1.  ;