INHUSEN5 ; DGH ; 27 Jul 1999 11:06:07; MEDE/NCPDP processing functions
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;CHCS TOOLS_460; GEN 5; 21-MAY-1997
;COPYRIGHT 1994 SAIC
;
;This contains the MEDE implementation of NCPDP validation software.
;
Q
INNC(ING,INSEQ,INXDST,INERR) ;Primary entry point for MEDE/NCPDP messages.
;Called from IN^INHUSEN
;INPUT:
; ING (req) = message array
; INSEQ (PBR) = variable in which to return MEDE sequence number
; INXDST = EXecutable code to identify the destination of messages.
; INERR (PBR) = variable to return error array if message is in error
; INDSTR = state variable, destination ien of transceiver
;RETURNS
; 0 = no errors--transceier will QKILL and set message to "complete"
; 1 = PDTS error--transceiver should resend message
; 2 = communication error--transceiver should reroute message
; 3 = error in outgoing MEDE ENP header--QKILL and log error
; 4 = ENP error (incoming)--log error but take no other action.
; 5 = Error in incoming such as no sequence # x-ref
; 6 = Dummy message is ok
; 7 = Dummy message is not ok
N INMEDE,INVL,PARUIF,INMSG,MESS
;Verify MEDE ENP header--get sequence number & type. Quit if error
S INVL=$$VERIF(ING,.INMEDE,.INTYP,.INSEQ,.INERR) Q:INVL INVL
;
;--Determine the GIS destination from MEDE transaction type
D Q:INVL INVL
.;Tranceiver must pass Dest. Deter. routine, INXDST, execute it.
.X INXDST
.;Dest Det. code must return INDSTP
.I '$G(INDSTP) S INVL=3,MSG="Message "_INSEQ_" has no destination" M MSG=@ING D ERRADD^INHUSEN3(.INERR,.MSG) Q
.;pointer needed for most functions, NAME needed for NEW^INHD.
.S:'$D(INDST) INDST=$P(^INRHD(INDSTP,0),U)
;
;Identify parent (original outgoing message) for this response.
S PARUIF=$O(^INTHU("ASEQ",INDSTR,INSEQ,""))
I 'PARUIF S MSG="Message "_INSEQ_" has no ASEQ cross reference",INVL=5 D ERRADD^INHUSEN3(.INERR,.MSG)
;
;Set variables needed for STORE and store the message
S (ORIGID,MESSID)=INSEQ,INMSH=INMEDE
D STORE^INHUSEN4
I INMSG>0,PARUIF D
.;Update parent pointer in incoming message.
.S:$D(^INTHU(INMSG)) $P(^INTHU(INMSG,0),U,7)=PARUIF
.;Update "application ack" pointer in parent message
.S $P(^INTHU(PARUIF,0),U,6)=INMSG
.S MESS(1)="Response received"
.D ULOG^INHU(PARUIF,"A",.MESS)
Q $S(INVL:INVL,1:0)
;
VERIF(INGBL,INMEDE,INTYP,INSEQ,INERR) ;Check for error status and extract MEDE data
;INPUT
;--INGBL = global being checked, can be ^INTHU
;--------If numeric, assumed to be IEN for ^INTHU
;--------If non-numeric, assumed to be global reference
;--INMEDE = variable for MEDE segment (Pass by reference)
;--INTYP = Message type in format (PBR)
;--INSEQ = sequence number (PBR)
;--INERR = error message array (PBR)
;RETURN
;-error codes 0-4 as desribed in INNC tag
N LCT,MSG,ERR,INDMISID,INSITE,INSE,INNCP,INNC3
;--First segment is MEDE header.
I +INGBL S LCT=0 D GETLINE^INHOU(INGBL,.LCT,.INMEDE)
I 'INGBL S INMEDE=$G(@INGBL@(1))
;--Get type = "CR", "HB" or "ER" and sequence number
S INTYP=$E(INMEDE,3,4),INSEQ=$E(INMEDE,5,12),INSITE=$E(INMEDE,17,20)
;If either of these are missing, this is a fatal ENP error
I ",CR,DR,HR,ER,SE,"'[(","_INTYP_",") S MSG="Message from receiver "_$P(^INTHPC(INBPN,0),U)_" does not have a valid type" M MSG=@INGBL D ERRADD^INHUSEN3(.INERR,.MSG) Q 4
;If sequence number = DUMMYTRX, this is a response to a dummy/heartbeat
I INSEQ="DUMMYTRX" D Q INVL
.;INTYP="DR" means the dummy was good. Otherwise build error array
.I INTYP="DR" S INVL=6 Q
.S MSG="Error in 'dummy' message from receiver "_$P(^INTHPC(INBPN,0),U)
.M MSG=@INGBL D ERRADD^INHUSEN3(.INERR,.MSG) S INVL=7
;INSEQ must be numeric except for DUMMYTRX.
I INSEQ'?.N S MSG="Sequence number contains non-numberic characters" M MSG=@INGBL D ERRADD^INHUSEN3(.INERR,.MSG) Q 4
S INSEQ=+INSEQ
I 'INSEQ S MSG="Message does not have a valid sequence number" M MSG=@INGBL D ERRADD^INHUSEN3(.INERR,.MSG) Q 4
;INTYP="ER" is reserved for ENP header problem. Log and quit.
I INTYP="ER" D Q 3
.S MSG="ENP header error in message with sequence number "_INSEQ M MSG=@INGBL
.D ERRADD^INHUSEN3(.INERR,.MSG)
;--Check destination=DMIS ID from MEDICAL TREATMENT FACILITY file
;Following code is CHCS specific. Will require equivalent IHS function
;S OUT=1 I $$SC^INHUTIL1 D Q:OUT 4
;.S INDMISID=$$DMISID^DAHPNU
;.I INDMISID'=INSITE S MSG="Message destination of "_INSITE_" does not match "_INDMISID M MSG=@INGBL D ERRADD^INHUSEN3(.INERR,.MSG) S OUT=1
;If INTYP="CR", message contains a valid response, no need to continue
Q:INTYP="CR" 0
;If INTYP="SE", a switch/communication error has occured.
I INTYP="SE" D Q INVL
. ;Switch error will start immediately in second segment.
. I INGBL D GETLINE^INHOU(INGBL,.LCT,.INNCP)
. I 'INGBL S INNCP=$G(@INGBL@(2))
. ;Trim leading and trailing blanks
. S INSE=$$LBTB^UTIL(INNCP)
. I '$L(INSE) S MSG="Error field of message "_$G(INSEQ)_" is blank" M MSG=@INGBL D ERRADD^INHUSEN3(.INERR,.MSG) S INVL=2 Q
. ;convert to upper case and match known error messages
. S INSE=$$CASECONV^UTIL(INSE,"U"),INVL=0
. F I=1:1 S ERR=$T(ERRORS+I) Q:ERR'[";;"!INVL I INSE[$P(ERR,";;",2) S INVL=$P(ERR,";;",3) M MSG=@INGBL D ERRADD^INHUSEN3(.INERR,.MSG)
. ;If no match on error message, default to INVL=4
. Q:INVL
. S INVL=4,MSG="Message contains no known error code" M MSG=@INGBL
. D ERRADD^INHUSEN3(.INERR,.MSG)
;-If heartbeat, it is unexpected. Log it.
D ERRADD^INHUSEN3(.INERR,"Heart beat received "_INMEDE) S INVL=4
Q INVL
;
ERRORS ;Tags containing all known MEDE error messages
;;TSHARED UNAVAILABLE;;2;;
;;SWITCH UNAVAILABLE;;2;;MEDE may use this instead of TSHARED
;;TSHARED NOT RESPONDING;;1;;
;;PDTS NOT RESPONDING;;1;;
;;PDTS UNAVAILABLE;;2;;May indicate need to switch processor?
;;WRONG VERSION;;3;;
;;INVALID ENP TYPE;;3;;
;;NON ALPHANUMERIC;;3;;
;;INCORRECT VALUE IN SOURCE;;3;;
;;DATA LENGTH;;3;;
;;MISSING ENP;;3;;
;
INHUSEN5 ; DGH ; 27 Jul 1999 11:06:07; MEDE/NCPDP processing functions
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;CHCS TOOLS_460; GEN 5; 21-MAY-1997
+4 ;COPYRIGHT 1994 SAIC
+5 ;
+6 ;This contains the MEDE implementation of NCPDP validation software.
+7 ;
+8 QUIT
INNC(ING,INSEQ,INXDST,INERR) ;Primary entry point for MEDE/NCPDP messages.
+1 ;Called from IN^INHUSEN
+2 ;INPUT:
+3 ; ING (req) = message array
+4 ; INSEQ (PBR) = variable in which to return MEDE sequence number
+5 ; INXDST = EXecutable code to identify the destination of messages.
+6 ; INERR (PBR) = variable to return error array if message is in error
+7 ; INDSTR = state variable, destination ien of transceiver
+8 ;RETURNS
+9 ; 0 = no errors--transceier will QKILL and set message to "complete"
+10 ; 1 = PDTS error--transceiver should resend message
+11 ; 2 = communication error--transceiver should reroute message
+12 ; 3 = error in outgoing MEDE ENP header--QKILL and log error
+13 ; 4 = ENP error (incoming)--log error but take no other action.
+14 ; 5 = Error in incoming such as no sequence # x-ref
+15 ; 6 = Dummy message is ok
+16 ; 7 = Dummy message is not ok
+17 NEW INMEDE,INVL,PARUIF,INMSG,MESS
+18 ;Verify MEDE ENP header--get sequence number & type. Quit if error
+19 SET INVL=$$VERIF(ING,.INMEDE,.INTYP,.INSEQ,.INERR)
IF INVL
QUIT INVL
+20 ;
+21 ;--Determine the GIS destination from MEDE transaction type
+22 Begin DoDot:1
+23 ;Tranceiver must pass Dest. Deter. routine, INXDST, execute it.
+24 XECUTE INXDST
+25 ;Dest Det. code must return INDSTP
+26 IF '$GET(INDSTP)
SET INVL=3
SET MSG="Message "_INSEQ_" has no destination"
MERGE MSG=@ING
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT
+27 ;pointer needed for most functions, NAME needed for NEW^INHD.
+28 IF '$DATA(INDST)
SET INDST=$PIECE(^INRHD(INDSTP,0),U)
End DoDot:1
IF INVL
QUIT INVL
+29 ;
+30 ;Identify parent (original outgoing message) for this response.
+31 SET PARUIF=$ORDER(^INTHU("ASEQ",INDSTR,INSEQ,""))
+32 IF 'PARUIF
SET MSG="Message "_INSEQ_" has no ASEQ cross reference"
SET INVL=5
DO ERRADD^INHUSEN3(.INERR,.MSG)
+33 ;
+34 ;Set variables needed for STORE and store the message
+35 SET (ORIGID,MESSID)=INSEQ
SET INMSH=INMEDE
+36 DO STORE^INHUSEN4
+37 IF INMSG>0
IF PARUIF
Begin DoDot:1
+38 ;Update parent pointer in incoming message.
+39 IF $DATA(^INTHU(INMSG))
SET $PIECE(^INTHU(INMSG,0),U,7)=PARUIF
+40 ;Update "application ack" pointer in parent message
+41 SET $PIECE(^INTHU(PARUIF,0),U,6)=INMSG
+42 SET MESS(1)="Response received"
+43 DO ULOG^INHU(PARUIF,"A",.MESS)
End DoDot:1
+44 QUIT $SELECT(INVL:INVL,1:0)
+45 ;
VERIF(INGBL,INMEDE,INTYP,INSEQ,INERR) ;Check for error status and extract MEDE data
+1 ;INPUT
+2 ;--INGBL = global being checked, can be ^INTHU
+3 ;--------If numeric, assumed to be IEN for ^INTHU
+4 ;--------If non-numeric, assumed to be global reference
+5 ;--INMEDE = variable for MEDE segment (Pass by reference)
+6 ;--INTYP = Message type in format (PBR)
+7 ;--INSEQ = sequence number (PBR)
+8 ;--INERR = error message array (PBR)
+9 ;RETURN
+10 ;-error codes 0-4 as desribed in INNC tag
+11 NEW LCT,MSG,ERR,INDMISID,INSITE,INSE,INNCP,INNC3
+12 ;--First segment is MEDE header.
+13 IF +INGBL
SET LCT=0
DO GETLINE^INHOU(INGBL,.LCT,.INMEDE)
+14 IF 'INGBL
SET INMEDE=$GET(@INGBL@(1))
+15 ;--Get type = "CR", "HB" or "ER" and sequence number
+16 SET INTYP=$EXTRACT(INMEDE,3,4)
SET INSEQ=$EXTRACT(INMEDE,5,12)
SET INSITE=$EXTRACT(INMEDE,17,20)
+17 ;If either of these are missing, this is a fatal ENP error
+18 IF ",CR,DR,HR,ER,SE,"'[(","_INTYP_",")
SET MSG="Message from receiver "_$PIECE(^INTHPC(INBPN,0),U)_" does not have a valid type"
MERGE MSG=@INGBL
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT 4
+19 ;If sequence number = DUMMYTRX, this is a response to a dummy/heartbeat
+20 IF INSEQ="DUMMYTRX"
Begin DoDot:1
+21 ;INTYP="DR" means the dummy was good. Otherwise build error array
+22 IF INTYP="DR"
SET INVL=6
QUIT
+23 SET MSG="Error in 'dummy' message from receiver "_$PIECE(^INTHPC(INBPN,0),U)
+24 MERGE MSG=@INGBL
DO ERRADD^INHUSEN3(.INERR,.MSG)
SET INVL=7
End DoDot:1
QUIT INVL
+25 ;INSEQ must be numeric except for DUMMYTRX.
+26 IF INSEQ'?.N
SET MSG="Sequence number contains non-numberic characters"
MERGE MSG=@INGBL
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT 4
+27 SET INSEQ=+INSEQ
+28 IF 'INSEQ
SET MSG="Message does not have a valid sequence number"
MERGE MSG=@INGBL
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT 4
+29 ;INTYP="ER" is reserved for ENP header problem. Log and quit.
+30 IF INTYP="ER"
Begin DoDot:1
+31 SET MSG="ENP header error in message with sequence number "_INSEQ
MERGE MSG=@INGBL
+32 DO ERRADD^INHUSEN3(.INERR,.MSG)
End DoDot:1
QUIT 3
+33 ;--Check destination=DMIS ID from MEDICAL TREATMENT FACILITY file
+34 ;Following code is CHCS specific. Will require equivalent IHS function
+35 ;S OUT=1 I $$SC^INHUTIL1 D Q:OUT 4
+36 ;.S INDMISID=$$DMISID^DAHPNU
+37 ;.I INDMISID'=INSITE S MSG="Message destination of "_INSITE_" does not match "_INDMISID M MSG=@INGBL D ERRADD^INHUSEN3(.INERR,.MSG) S OUT=1
+38 ;If INTYP="CR", message contains a valid response, no need to continue
+39 IF INTYP="CR"
QUIT 0
+40 ;If INTYP="SE", a switch/communication error has occured.
+41 IF INTYP="SE"
Begin DoDot:1
+42 ;Switch error will start immediately in second segment.
+43 IF INGBL
DO GETLINE^INHOU(INGBL,.LCT,.INNCP)
+44 IF 'INGBL
SET INNCP=$GET(@INGBL@(2))
+45 ;Trim leading and trailing blanks
+46 SET INSE=$$LBTB^UTIL(INNCP)
+47 IF '$LENGTH(INSE)
SET MSG="Error field of message "_$GET(INSEQ)_" is blank"
MERGE MSG=@INGBL
DO ERRADD^INHUSEN3(.INERR,.MSG)
SET INVL=2
QUIT
+48 ;convert to upper case and match known error messages
+49 SET INSE=$$CASECONV^UTIL(INSE,"U")
SET INVL=0
+50 FOR I=1:1
SET ERR=$TEXT(ERRORS+I)
IF ERR'[";;"!INVL
QUIT
IF INSE[$PIECE(ERR,";;",2)
SET INVL=$PIECE(ERR,";;",3)
MERGE MSG=@INGBL
DO ERRADD^INHUSEN3(.INERR,.MSG)
+51 ;If no match on error message, default to INVL=4
+52 IF INVL
QUIT
+53 SET INVL=4
SET MSG="Message contains no known error code"
MERGE MSG=@INGBL
+54 DO ERRADD^INHUSEN3(.INERR,.MSG)
End DoDot:1
QUIT INVL
+55 ;-If heartbeat, it is unexpected. Log it.
+56 DO ERRADD^INHUSEN3(.INERR,"Heart beat received "_INMEDE)
SET INVL=4
+57 QUIT INVL
+58 ;
ERRORS ;Tags containing all known MEDE error messages
+1 ;;TSHARED UNAVAILABLE;;2;;
+2 ;;SWITCH UNAVAILABLE;;2;;MEDE may use this instead of TSHARED
+3 ;;TSHARED NOT RESPONDING;;1;;
+4 ;;PDTS NOT RESPONDING;;1;;
+5 ;;PDTS UNAVAILABLE;;2;;May indicate need to switch processor?
+6 ;;WRONG VERSION;;3;;
+7 ;;INVALID ENP TYPE;;3;;
+8 ;;NON ALPHANUMERIC;;3;;
+9 ;;INCORRECT VALUE IN SOURCE;;3;;
+10 ;;DATA LENGTH;;3;;
+11 ;;MISSING ENP;;3;;
+12 ;
