INHUSEN4 ; DGH ; 9 Jun 97 17:52; Enhanced processing functions and utilities
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
STORE ;Store incoming xmission in the Universal Interface file
;INPUT:
;-INLHSCH = (OPT) 0 will queue entry, = 1 won't
;---Appl acks will go in queue. O/P CTLR will update
;---status of originating msg as processing by queue.
;---Commit acks won't go in queue. CACKLOG^INHUSEN2 will update status.
;---Msgs will go in queue.
;-INDST = string name of entry in Int. Dest. File
;-ING = array to be stored
;-INMSASTA = MSA-1 - Ack Status
;OUTPUT:
;-INMSG = UIF of new msg, or -1 if creation failed.
N SOURCE,DIE,DR
S INLHSCH=$S($L($G(INLHSCH)):INLHSCH,INTYP["ACK"&($E($G(INMSASTA))="C"):1,1:0)
;Create a unique INCOMING MESSAGE ID for field 2.1 of the UIF
;in format "ORIGID-XX-NN" where XX is 1st two letters from background
;process file and NN increments from 1.
;Set PN to piece # of the # (If ORIGID already has "-"
;embedded, need to place XX-NN further than pieces 2 and 3)
S ORIGID2=ORIGID_"-"_$E(^INTHPC(INBPN,0),1,2)_"-1" D:$D(^INTHU("C",ORIGID2))
. N USED,PN S PN=$L(ORIGID,"-")+2
. F USED=2:1 S $P(ORIGID2,"-",PN)=USED Q:'$D(^INTHU("C",ORIGID2))
S SOURCE=$E("Incoming message from transceiver "_$P(^INTHPC(INBPN,0),U),1,60)
;Create msg in UIF using modified originating messid
S INMSG=$$NEW^INHD(ORIGID2,INDST,SOURCE,ING,0,"I",1)
;If the input driver returns a -1 then the transaction was rejected
I INMSG<0 S INERR="Message "_MESSID_" was rejected by the GIS",INVL=2 Q
;store original message id (will also be in "D" x-ref)
S DA=+INMSG,DIE="^INTHU(",DR="2.1///"_ORIGID_";2.02///`"_INDSTR D ^DIE
; Determine if msg should be queued
I 'INLHSCH D ; if request to queue msg
. I INTYP'["ACK",$$SUPPRESS^INHUT6("RCV",$P(^INRHD(INDSTP,0),U,2),$P($G(^INTHPC(INBPN,0)),U,7),INBPN,"","",INMSG,INMSH) Q ; suppress inbound msg
. ; que msg to o/p ctlr
. S DA=+INMSG,DIE="^INTHU(",DR=".2///0" D ^DIE ; update que flag
. N DEST,TIME,TT S DEST=INDSTP D TIME^INHD,SET^INHD(TIME,DEST,INMSG)
Q
;
VERIF(INGBL,INMSH,INTYP,INEVN,INERR) ;Determine HL7 message type and event
;INPUT
;--INGBL = global being checked, can be ^INTHU
;--------If numeric, assumed to be IEN for ^INTHU
;--------If non-numeric, assumed to be global reference
;--INMSH = variable for MSH segment (Pass by reference)
;--INTYP = Message type in format (PBR)
;--INEVN = Trigger event (PBR)
;--INERR = error message array (PBR)
;RETURN
;0=success 1=failure 2=fatal error
N LCT,EVN,TYPE
I +INGBL S LCT=0 D GETLINE^INHOU(INGBL,.LCT,.INMSH)
I 'INGBL S INMSH=$G(@INGBL@(1))
I $E(INMSH,1,3)'="MSH" S MSG(1)="Message from receiver "_$P(^INTHPC(INBPN,0),U)_" does not have the MSH segment in the correct location",MSG(2)=$E(INMSH,1,250) D ERRADD^INHUSEN3(.INERR,.MSG) Q 2
S INDELIM=$E(INMSH,4),INSUBDEL=$E(INMSH,5)
D
. ;First get message type from MSH-9. Trigger Event may be
. ;second component of type.
. S TYPE=$P(INMSH,INDELIM,9) S INEVN=$P(TYPE,INSUBDEL,2),INTYP=$P(TYPE,INSUBDEL) Q:$L(INEVN)
. ;If no EVENT, check for EVN segment in next 5 lines
. I INGBL F I=1:1:5 D Q:$L(INEVN)
.. D GETLINE^INHOU(INGBL,.LCT,.EVN)
.. S:$P(EVN,INDELIM)="EVN" INEVN=$P(EVN,INDELIM,2)
. I 'INGBL F I=2:1:5 D Q:$L(INEVN)
.. S EVN=$G(@INGBL@(I))
.. S:$P(EVN,INDELIM)="EVN" INEVN=$P(EVN,INDELIM,2)
Q 0
;
DEST ;Find destination for incoming message (not incoming ack?).
;INPUT:
;--INDEST(INTYP_INEVN)=INDST is array of destinations where INDST
;--is a string value of a valid entry in Int. Dest. File
;--INTYP can be 3-character of 6-character
;--INEVN will be treated as null if '$D(INEVN)
;OUTPUT:
;--INDSTR = pointer equilivant of INDST
;
S:'$D(INEVN) INEVN=""
I '$D(INDEST) S MSG(1)="No known destination in message "_MESSID,MSG(2)=$E($G(INMSH),1,250),INVL=2 D ERRADD^INHUSEN3(.INERR,.MSG) Q
I '$D(INDEST(INTYP_INEVN)) S MSG(1)="No known destination for event type "_INTYP_" in message "_MESSID,MSG(2)=$E($G(INMSH),1,250),INVL=2 D ERRADD^INHUSEN3(.INERR,.MSG) Q
S INDST=INDEST(INTYP_INEVN)
I '$D(^INRHD("B",INDST)) D ERRADD^INHUSEN3(.INERR,"No entry in Destination file for "_INDST_" in message "_MESSID) S INVL=2 Q
S INDSTP=$O(^INRHD("B",INDST,""))
Q
;
INHUSEN4 ; DGH ; 9 Jun 97 17:52; Enhanced processing functions and utilities
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
STORE ;Store incoming xmission in the Universal Interface file
+1 ;INPUT:
+2 ;-INLHSCH = (OPT) 0 will queue entry, = 1 won't
+3 ;---Appl acks will go in queue. O/P CTLR will update
+4 ;---status of originating msg as processing by queue.
+5 ;---Commit acks won't go in queue. CACKLOG^INHUSEN2 will update status.
+6 ;---Msgs will go in queue.
+7 ;-INDST = string name of entry in Int. Dest. File
+8 ;-ING = array to be stored
+9 ;-INMSASTA = MSA-1 - Ack Status
+10 ;OUTPUT:
+11 ;-INMSG = UIF of new msg, or -1 if creation failed.
+12 NEW SOURCE,DIE,DR
+13 SET INLHSCH=$SELECT($LENGTH($GET(INLHSCH)):INLHSCH,INTYP["ACK"&($EXTRACT($GET(INMSASTA))="C"):1,1:0)
+14 ;Create a unique INCOMING MESSAGE ID for field 2.1 of the UIF
+15 ;in format "ORIGID-XX-NN" where XX is 1st two letters from background
+16 ;process file and NN increments from 1.
+17 ;Set PN to piece # of the # (If ORIGID already has "-"
+18 ;embedded, need to place XX-NN further than pieces 2 and 3)
+19 SET ORIGID2=ORIGID_"-"_$EXTRACT(^INTHPC(INBPN,0),1,2)_"-1"
IF $DATA(^INTHU("C",ORIGID2))
Begin DoDot:1
+20 NEW USED,PN
SET PN=$LENGTH(ORIGID,"-")+2
+21 FOR USED=2:1
SET $PIECE(ORIGID2,"-",PN)=USED
IF '$DATA(^INTHU("C",ORIGID2))
QUIT
End DoDot:1
+22 SET SOURCE=$EXTRACT("Incoming message from transceiver "_$PIECE(^INTHPC(INBPN,0),U),1,60)
+23 ;Create msg in UIF using modified originating messid
+24 SET INMSG=$$NEW^INHD(ORIGID2,INDST,SOURCE,ING,0,"I",1)
+25 ;If the input driver returns a -1 then the transaction was rejected
+26 IF INMSG<0
SET INERR="Message "_MESSID_" was rejected by the GIS"
SET INVL=2
QUIT
+27 ;store original message id (will also be in "D" x-ref)
+28 SET DA=+INMSG
SET DIE="^INTHU("
SET DR="2.1///"_ORIGID_";2.02///`"_INDSTR
DO ^DIE
+29 ; Determine if msg should be queued
+30 ; if request to queue msg
IF 'INLHSCH
Begin DoDot:1
+31 ; suppress inbound msg
IF INTYP'["ACK"
IF $$SUPPRESS^INHUT6("RCV",$PIECE(^INRHD(INDSTP,0),U,2),$PIECE($GET(^INTHPC(INBPN,0)),U,7),INBPN,"","",INMSG,INMSH)
QUIT
+32 ; que msg to o/p ctlr
+33 ; update que flag
SET DA=+INMSG
SET DIE="^INTHU("
SET DR=".2///0"
DO ^DIE
+34 NEW DEST,TIME,TT
SET DEST=INDSTP
DO TIME^INHD
DO SET^INHD(TIME,DEST,INMSG)
End DoDot:1
+35 QUIT
+36 ;
VERIF(INGBL,INMSH,INTYP,INEVN,INERR) ;Determine HL7 message type and event
+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 ;--INMSH = variable for MSH segment (Pass by reference)
+6 ;--INTYP = Message type in format (PBR)
+7 ;--INEVN = Trigger event (PBR)
+8 ;--INERR = error message array (PBR)
+9 ;RETURN
+10 ;0=success 1=failure 2=fatal error
+11 NEW LCT,EVN,TYPE
+12 IF +INGBL
SET LCT=0
DO GETLINE^INHOU(INGBL,.LCT,.INMSH)
+13 IF 'INGBL
SET INMSH=$GET(@INGBL@(1))
+14 IF $EXTRACT(INMSH,1,3)'="MSH"
SET MSG(1)="Message from receiver "_$PIECE(^INTHPC(INBPN,0),U)_" does not have the MSH segment in the correct location"
SET MSG(2)=$EXTRACT(INMSH,1,250)
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT 2
+15 SET INDELIM=$EXTRACT(INMSH,4)
SET INSUBDEL=$EXTRACT(INMSH,5)
+16 Begin DoDot:1
+17 ;First get message type from MSH-9. Trigger Event may be
+18 ;second component of type.
+19 SET TYPE=$PIECE(INMSH,INDELIM,9)
SET INEVN=$PIECE(TYPE,INSUBDEL,2)
SET INTYP=$PIECE(TYPE,INSUBDEL)
IF $LENGTH(INEVN)
QUIT
+20 ;If no EVENT, check for EVN segment in next 5 lines
+21 IF INGBL
FOR I=1:1:5
Begin DoDot:2
+22 DO GETLINE^INHOU(INGBL,.LCT,.EVN)
+23 IF $PIECE(EVN,INDELIM)="EVN"
SET INEVN=$PIECE(EVN,INDELIM,2)
End DoDot:2
IF $LENGTH(INEVN)
QUIT
+24 IF 'INGBL
FOR I=2:1:5
Begin DoDot:2
+25 SET EVN=$GET(@INGBL@(I))
+26 IF $PIECE(EVN,INDELIM)="EVN"
SET INEVN=$PIECE(EVN,INDELIM,2)
End DoDot:2
IF $LENGTH(INEVN)
QUIT
End DoDot:1
+27 QUIT 0
+28 ;
DEST ;Find destination for incoming message (not incoming ack?).
+1 ;INPUT:
+2 ;--INDEST(INTYP_INEVN)=INDST is array of destinations where INDST
+3 ;--is a string value of a valid entry in Int. Dest. File
+4 ;--INTYP can be 3-character of 6-character
+5 ;--INEVN will be treated as null if '$D(INEVN)
+6 ;OUTPUT:
+7 ;--INDSTR = pointer equilivant of INDST
+8 ;
+9 IF '$DATA(INEVN)
SET INEVN=""
+10 IF '$DATA(INDEST)
SET MSG(1)="No known destination in message "_MESSID
SET MSG(2)=$EXTRACT($GET(INMSH),1,250)
SET INVL=2
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT
+11 IF '$DATA(INDEST(INTYP_INEVN))
SET MSG(1)="No known destination for event type "_INTYP_" in message "_MESSID
SET MSG(2)=$EXTRACT($GET(INMSH),1,250)
SET INVL=2
DO ERRADD^INHUSEN3(.INERR,.MSG)
QUIT
+12 SET INDST=INDEST(INTYP_INEVN)
+13 IF '$DATA(^INRHD("B",INDST))
DO ERRADD^INHUSEN3(.INERR,"No entry in Destination file for "_INDST_" in message "_MESSID)
SET INVL=2
QUIT
+14 SET INDSTP=$ORDER(^INRHD("B",INDST,""))
+15 QUIT
+16 ;
