INHRDUP1 ;DJL,DGH; 8 Mar 96 14:09;Duplicates interface messages to multiple dests
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;This functions as the transceiver routine for messages which are to
;be routed to multiple destinations.
;
GENMSH(INCMPMSH,INTT,INRECFAC,INMESSID) ; Generate MSH nodes using REVERSE precedence order
;INPUT:
; INCMPMSH: Contains the Original Base Message MSH (used to build on)
; and IS the RETURNED composite MSH
; INTT: The TT pointer for Gallery data acquisition
; INRECFAC: The Default Receiving Facility (if set)
; INMESSID: The NEW unique message ID for the new message
;OUTPUT:
; INCMPMSH: Contains the MSH to be used for Message Processing
; Precedence order of operation is as follows:
; 1: @-sign variablility and User-Definded M-code execute
; 2: INMSH value set by User-Definded M-code execute
; 3: Gallery direct value usage
; 4: Default Recieving Facility value, clear if = ""
; 5: Base Message values
;
N INGALMSH,INTMP,INATVAL,INDELIM,INMSH
; Set INDELIM to the Base Message Delimiter
S INDELIM=$E(INCMPMSH,4)
S INTT=$O(^INRHR("B",INTT,0))
; Set the Message ID into the Composite MSH
S $P(INCMPMSH,INDELIM,10)=INMESSID
; Priority-4:
I $L($G(INRECFAC)) S:INRECFAC="""""" INRECFAC="" S $P(INCMPMSH,INDELIM,6)=INRECFAC
; Priority-3: If 2 node is present & 2.01=0 create Composite MSH adding Gallery info
I $D(^INRHR(INTT,2)) S INGALMSH=$G(^INRHR(INTT,2)) I 'INGALMSH K INATVAL D GALMSH(.INATVAL,.INCMPMSH,INGALMSH,INMESSID)
I $D(^INRHR(INTT,1)) D ; User-defined M-code to execute
. K INMSH X:$L($G(^INRHR(INTT,1))) ^INRHR(INTT,1)
. ; Priority-2: Create new composite MSH using INMSH data and INCMPMSH
. I $D(INMSH) D
.. K INTMP S INTMP=$P(INCMPMSH,INDELIM,1,2),CP=2
.. F I=3:1:17 S L=$$PIECE^INHU(.INMSH,INDELIM,I) S L=$S('$L(L):$$PIECE^INHU(.INCMPMSH,INDELIM,I),$L(L)&(L=""""""):"",1:L) D SETPIECE^INHU(.INTMP,INDELIM,I,L,.CP)
.. K INCMPMSH M INCMPMSH=INTMP
; If @ sign variables, Reformat using INA("xxx") values
I $D(INATVAL) D
. K INTMP S INTMP=$P(INCMPMSH,INDELIM,1,2),CP=2
. F I=3:1:17 S L=$S('$D(INATVAL(I)):$$PIECE^INHU(.INCMPMSH,INDELIM,I),1:$G(@INA@(INATVAL(I)))) S:L="""""" L="" D SETPIECE^INHU(.INTMP,INDELIM,I,L,.CP)
. K INCMPMSH M INCMPMSH=INTMP
Q
;
GALMSH(INATVAL,INCMPMSH,INGALMSH,INMESSID) ;Create new COMPOSITE MSH using gallery-set data
;INPUT:
; INCMPMSH: The composit MSH to merge into
; INGALMSH: The Gallery set MSH data (INGALMSH is HL7 formatted)
; INMESSID: The NEW unique message ID for the new message
;OUTPUT:
; INATVAL: Array containing MSH piece and varable name used with @ sign access
N INMRGMSH,CP,L,L1,I
S INMRGMSH=$P(INCMPMSH,INDELIM,1,2),CP=2
F I=3:1:17 D
. I I=7 S L1=$$DATEFMT^UTDT("NOW","YYYYMMDDHHIISS") D SET Q
. I I=9 D TYPE,SET Q
. I I=10 S L1=INMESSID D SET Q
. S L=$$PIECE^INHU(.INGALMSH,U,I),L1=$S(L="""""":"",L["NULL":"",L'="":L,1:$$PIECE^INHU(.INCMPMSH,INDELIM,I))
. D SET
K INCMPMSH M INCMPMSH=INMRGMSH
Q
;
SET ;Set pieces into INMRGMSH
I $E(L1)="@",$L($E(L1,2)) S INATVAL(I)=$P(L1,"@",2) Q ; Set index to piece and variable to use for lookup
D SETPIECE^INHU(.INMRGMSH,INDELIM,I,L1,.CP) Q
;
TYPE ;create <message type><subdelim><event type> field
S L=$P(INGALMSH,U,I),INEVTYP=$P(INGALMSH,U,2)
I $E(L)="@" S L1=L Q
I '$L(INEVTYP)!(INEVTYP?.P) S L1=$S(L="""""":"",L'="":L,1:$P(INCMPMSH,INDELIM,I)) Q
S L1=L_$E($P(INCMPMSH,INDELIM,2),1)_INEVTYP Q
Q
INTLOOP ;Transaction Type loop
;* Suppressed messages will be logged in the ActivityLog Multiple
; (and Error log w/DEBUG)
;* INMULT array Processing LOOP at Rep TT level
S INERROR=1,INGETOUT=0,INTT="",INIEN=""
F S INTT=$O(INMULT(INTT)) Q:'INTT!INGETOUT D INTT(INTT,.INGETOUT)
Q
;
INTT(INTT,INGETOUT) ;Process Transaction Type
;Input:
; INTT - Transaction Type
;Output:
; INGETOUT(r) - GET OUT OF LOOP
;
N INPDEST,INSRMC,INSRPRIO
I '$D(^INRHT(INTT)) S INERR(INERROR)="Replication attempted to unknown transaction type:"_INTT,INERROR=INERROR+1,INSTAT=1 Q
;* If SRMC exists for the Primary Dest (Priority-2),
;set SRMC variable=SRMC
S INPDEST=$O(INMULT("PD",INTT,"")),INSRMC=$G(INMULT("PD",INTT,INPDEST))
S:$L(INSRMC) INSRPRIO=2
;If SRMC exists for the Rep TT (Priority-1), set SRMC variable=SRMC
I $L($G(INMULT("TT",INTT))) S INSRPRIO=1,INSRMC=INMULT("TT",INTT)
;if INSRMC variable has SRMC (PRIORITY 1 or 2) then execute SRMC.
;if priority=1 or 2 AND INSRDATA=1 Quit and log SUPPRESSION for this TT
I $L(INSRMC) N INSRDATA S INSRCTL("INTT")=INTT,INSRCTL("INDEST")=INPDEST X INSRMC
I $G(INSRDATA) D Q
.S:INSRPRIO=3 INGETOUT=1,INSRCTL("INDEST")=""
.S INDEST=INPDEST
.D LOG^INHUT6(+INPRIO(INSRPRIO),@$P(INPRIO(INSRPRIO),U,2),$P(INPRIO(INSRPRIO),U,3),INUIF)
; INMULT array Processing LOOP at Destination level
S INDEST=0
F S INDEST=$O(INMULT(INTT,INDEST)) Q:'INDEST D
.D DEST(INDEST,.INV)
.; cleanup the UIF Messages temp storage
.K @INV
.S INV=$S(INVS<2:"INV",1:"^UTILITY(""INV"",$J)")
.D:INVS<2 MC1^INHS
.S %=0
.F S %=$O(@INVTMP@(%)) Q:%="" D:INVS<2 MC^INHS M @INV@(%)=@INVTMP@(%)
Q
DEST(INDEST,INV) ;Process destinations
;Input:
; INDEST - Destination
; INV - Message segment array from UIF
S INSRCTL("INDEST")=INDEST
;* If INSRDATA exists as a list then Quit
;if NOT $$FINDRID^INHUT5( .INSRDATA, Dest )
; can't find a match of RouteID in Destination
I $D(INSRDATA)>9,$$FINDRID^INHUT5(.INSRDATA,INDEST) D Q
.; can't find a matching RouteID in Destination
.D LOG^INHUT6(+INPRIO(INSRPRIO),@($P(INPRIO(INSRPRIO),U,2)),$P(INPRIO(INSRPRIO),U,3),INUIF)
;Create temporary @INV@(%INV) data storage for message content/building
K %INV S %INV=$S(INVS<2:"%INV",1:"^UTILITY(""%INV"",$J)")
K:%INV'="%INV" @%INV
;
; * Set INCMPMSH with
; GENMSH^INHRDUP1( .INCMPMSH, repINTT IEN, Def Recv Fac, MessageID )
; user reverse precedence order through all operation to allow an
; accumulation of MSH/Message construction
K INCMPMSH S INCMPMSH=INMSH0,INMESSID=$$MESSID^INHD
D GENMSH^INHRDUP1(.INCMPMSH,INTT,INMULT(INTT,INDEST),INMESSID)
; create the NEW mesage w/newMSH in %INV
D NEWMSG^INHRDUP(.INCMPMSH,.%INV,.INV)
; get user and division information and pass it to new msg entry
N INORDUZ,INORDIV,INMIDGEN
S INORDUZ=$P($G(^INTHU(INUIF,0)),U,15),INORDIV=$P($G(^(0)),U,21),INMIDGEN=$P($G(^(0)),U,5)
;Create new message in ^INTHU and deliver to its outbound queue
S INNEWUIF=$$NEWO^INHD(INDEST,.%INV,+$P(^INRHT(INTT,0),U,12),INTT,INMESSID,"",INORDUZ,INORDIV,.INUIF6,.INUIF7,INMIDGEN)
I INNEWUIF<0 S INERR(INERROR)="UIF creation failed for transaction type "_$P(INTYPE(0),U),INERROR=INERROR+1,INSTAT=1
D LOG^INHRDUP
; cleanup the Replication Messages temp storage
K @%INV
Q
;
INHRDUP1 ;DJL,DGH; 8 Mar 96 14:09;Duplicates interface messages to multiple dests
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;This functions as the transceiver routine for messages which are to
+4 ;be routed to multiple destinations.
+5 ;
GENMSH(INCMPMSH,INTT,INRECFAC,INMESSID) ; Generate MSH nodes using REVERSE precedence order
+1 ;INPUT:
+2 ; INCMPMSH: Contains the Original Base Message MSH (used to build on)
+3 ; and IS the RETURNED composite MSH
+4 ; INTT: The TT pointer for Gallery data acquisition
+5 ; INRECFAC: The Default Receiving Facility (if set)
+6 ; INMESSID: The NEW unique message ID for the new message
+7 ;OUTPUT:
+8 ; INCMPMSH: Contains the MSH to be used for Message Processing
+9 ; Precedence order of operation is as follows:
+10 ; 1: @-sign variablility and User-Definded M-code execute
+11 ; 2: INMSH value set by User-Definded M-code execute
+12 ; 3: Gallery direct value usage
+13 ; 4: Default Recieving Facility value, clear if = ""
+14 ; 5: Base Message values
+15 ;
+16 NEW INGALMSH,INTMP,INATVAL,INDELIM,INMSH
+17 ; Set INDELIM to the Base Message Delimiter
+18 SET INDELIM=$EXTRACT(INCMPMSH,4)
+19 SET INTT=$ORDER(^INRHR("B",INTT,0))
+20 ; Set the Message ID into the Composite MSH
+21 SET $PIECE(INCMPMSH,INDELIM,10)=INMESSID
+22 ; Priority-4:
+23 IF $LENGTH($GET(INRECFAC))
IF INRECFAC=""""""
SET INRECFAC=""
SET $PIECE(INCMPMSH,INDELIM,6)=INRECFAC
+24 ; Priority-3: If 2 node is present & 2.01=0 create Composite MSH adding Gallery info
+25 IF $DATA(^INRHR(INTT,2))
SET INGALMSH=$GET(^INRHR(INTT,2))
IF 'INGALMSH
KILL INATVAL
DO GALMSH(.INATVAL,.INCMPMSH,INGALMSH,INMESSID)
+26 ; User-defined M-code to execute
IF $DATA(^INRHR(INTT,1))
Begin DoDot:1
+27 KILL INMSH
IF $LENGTH($GET(^INRHR(INTT,1)))
XECUTE ^INRHR(INTT,1)
+28 ; Priority-2: Create new composite MSH using INMSH data and INCMPMSH
+29 IF $DATA(INMSH)
Begin DoDot:2
+30 KILL INTMP
SET INTMP=$PIECE(INCMPMSH,INDELIM,1,2)
SET CP=2
+31 FOR I=3:1:17
SET L=$$PIECE^INHU(.INMSH,INDELIM,I)
SET L=$SELECT('$LENGTH(L):$$PIECE^INHU(.INCMPMSH,INDELIM,I),$LENGTH(L)&(L=""""""):"",1:L)
DO SETPIECE^INHU(.INTMP,INDELIM,I,L,.CP)
+32 KILL INCMPMSH
MERGE INCMPMSH=INTMP
End DoDot:2
End DoDot:1
+33 ; If @ sign variables, Reformat using INA("xxx") values
+34 IF $DATA(INATVAL)
Begin DoDot:1
+35 KILL INTMP
SET INTMP=$PIECE(INCMPMSH,INDELIM,1,2)
SET CP=2
+36 FOR I=3:1:17
SET L=$SELECT('$DATA(INATVAL(I)):$$PIECE^INHU(.INCMPMSH,INDELIM,I),1:$GET(@INA@(INATVAL(I))))
IF L=""""""
SET L=""
DO SETPIECE^INHU(.INTMP,INDELIM,I,L,.CP)
+37 KILL INCMPMSH
MERGE INCMPMSH=INTMP
End DoDot:1
+38 QUIT
+39 ;
GALMSH(INATVAL,INCMPMSH,INGALMSH,INMESSID) ;Create new COMPOSITE MSH using gallery-set data
+1 ;INPUT:
+2 ; INCMPMSH: The composit MSH to merge into
+3 ; INGALMSH: The Gallery set MSH data (INGALMSH is HL7 formatted)
+4 ; INMESSID: The NEW unique message ID for the new message
+5 ;OUTPUT:
+6 ; INATVAL: Array containing MSH piece and varable name used with @ sign access
+7 NEW INMRGMSH,CP,L,L1,I
+8 SET INMRGMSH=$PIECE(INCMPMSH,INDELIM,1,2)
SET CP=2
+9 FOR I=3:1:17
Begin DoDot:1
+10 IF I=7
SET L1=$$DATEFMT^UTDT("NOW","YYYYMMDDHHIISS")
DO SET
QUIT
+11 IF I=9
DO TYPE
DO SET
QUIT
+12 IF I=10
SET L1=INMESSID
DO SET
QUIT
+13 SET L=$$PIECE^INHU(.INGALMSH,U,I)
SET L1=$SELECT(L="""""":"",L["NULL":"",L'="":L,1:$$PIECE^INHU(.INCMPMSH,INDELIM,I))
+14 DO SET
End DoDot:1
+15 KILL INCMPMSH
MERGE INCMPMSH=INMRGMSH
+16 QUIT
+17 ;
SET ;Set pieces into INMRGMSH
+1 ; Set index to piece and variable to use for lookup
IF $EXTRACT(L1)="@"
IF $LENGTH($EXTRACT(L1,2))
SET INATVAL(I)=$PIECE(L1,"@",2)
QUIT
+2 DO SETPIECE^INHU(.INMRGMSH,INDELIM,I,L1,.CP)
QUIT
+3 ;
TYPE ;create <message type><subdelim><event type> field
+1 SET L=$PIECE(INGALMSH,U,I)
SET INEVTYP=$PIECE(INGALMSH,U,2)
+2 IF $EXTRACT(L)="@"
SET L1=L
QUIT
+3 IF '$LENGTH(INEVTYP)!(INEVTYP?.P)
SET L1=$SELECT(L="""""":"",L'="":L,1:$PIECE(INCMPMSH,INDELIM,I))
QUIT
+4 SET L1=L_$EXTRACT($PIECE(INCMPMSH,INDELIM,2),1)_INEVTYP
QUIT
+5 QUIT
INTLOOP ;Transaction Type loop
+1 ;* Suppressed messages will be logged in the ActivityLog Multiple
+2 ; (and Error log w/DEBUG)
+3 ;* INMULT array Processing LOOP at Rep TT level
+4 SET INERROR=1
SET INGETOUT=0
SET INTT=""
SET INIEN=""
+5 FOR
SET INTT=$ORDER(INMULT(INTT))
IF 'INTT!INGETOUT
QUIT
DO INTT(INTT,.INGETOUT)
+6 QUIT
+7 ;
INTT(INTT,INGETOUT) ;Process Transaction Type
+1 ;Input:
+2 ; INTT - Transaction Type
+3 ;Output:
+4 ; INGETOUT(r) - GET OUT OF LOOP
+5 ;
+6 NEW INPDEST,INSRMC,INSRPRIO
+7 IF '$DATA(^INRHT(INTT))
SET INERR(INERROR)="Replication attempted to unknown transaction type:"_INTT
SET INERROR=INERROR+1
SET INSTAT=1
QUIT
+8 ;* If SRMC exists for the Primary Dest (Priority-2),
+9 ;set SRMC variable=SRMC
+10 SET INPDEST=$ORDER(INMULT("PD",INTT,""))
SET INSRMC=$GET(INMULT("PD",INTT,INPDEST))
+11 IF $LENGTH(INSRMC)
SET INSRPRIO=2
+12 ;If SRMC exists for the Rep TT (Priority-1), set SRMC variable=SRMC
+13 IF $LENGTH($GET(INMULT("TT",INTT)))
SET INSRPRIO=1
SET INSRMC=INMULT("TT",INTT)
+14 ;if INSRMC variable has SRMC (PRIORITY 1 or 2) then execute SRMC.
+15 ;if priority=1 or 2 AND INSRDATA=1 Quit and log SUPPRESSION for this TT
+16 IF $LENGTH(INSRMC)
NEW INSRDATA
SET INSRCTL("INTT")=INTT
SET INSRCTL("INDEST")=INPDEST
XECUTE INSRMC
+17 IF $GET(INSRDATA)
Begin DoDot:1
+18 IF INSRPRIO=3
SET INGETOUT=1
SET INSRCTL("INDEST")=""
+19 SET INDEST=INPDEST
+20 DO LOG^INHUT6(+INPRIO(INSRPRIO),@$PIECE(INPRIO(INSRPRIO),U,2),$PIECE(INPRIO(INSRPRIO),U,3),INUIF)
End DoDot:1
QUIT
+21 ; INMULT array Processing LOOP at Destination level
+22 SET INDEST=0
+23 FOR
SET INDEST=$ORDER(INMULT(INTT,INDEST))
IF 'INDEST
QUIT
Begin DoDot:1
+24 DO DEST(INDEST,.INV)
+25 ; cleanup the UIF Messages temp storage
+26 KILL @INV
+27 SET INV=$SELECT(INVS<2:"INV",1:"^UTILITY(""INV"",$J)")
+28 IF INVS<2
DO MC1^INHS
+29 SET %=0
+30 FOR
SET %=$ORDER(@INVTMP@(%))
IF %=""
QUIT
IF INVS<2
DO MC^INHS
MERGE @INV@(%)=@INVTMP@(%)
End DoDot:1
+31 QUIT
DEST(INDEST,INV) ;Process destinations
+1 ;Input:
+2 ; INDEST - Destination
+3 ; INV - Message segment array from UIF
+4 SET INSRCTL("INDEST")=INDEST
+5 ;* If INSRDATA exists as a list then Quit
+6 ;if NOT $$FINDRID^INHUT5( .INSRDATA, Dest )
+7 ; can't find a match of RouteID in Destination
+8 IF $DATA(INSRDATA)>9
IF $$FINDRID^INHUT5(.INSRDATA,INDEST)
Begin DoDot:1
+9 ; can't find a matching RouteID in Destination
+10 DO LOG^INHUT6(+INPRIO(INSRPRIO),@($PIECE(INPRIO(INSRPRIO),U,2)),$PIECE(INPRIO(INSRPRIO),U,3),INUIF)
End DoDot:1
QUIT
+11 ;Create temporary @INV@(%INV) data storage for message content/building
+12 KILL %INV
SET %INV=$SELECT(INVS<2:"%INV",1:"^UTILITY(""%INV"",$J)")
+13 IF %INV'="%INV"
KILL @%INV
+14 ;
+15 ; * Set INCMPMSH with
+16 ; GENMSH^INHRDUP1( .INCMPMSH, repINTT IEN, Def Recv Fac, MessageID )
+17 ; user reverse precedence order through all operation to allow an
+18 ; accumulation of MSH/Message construction
+19 KILL INCMPMSH
SET INCMPMSH=INMSH0
SET INMESSID=$$MESSID^INHD
+20 DO GENMSH^INHRDUP1(.INCMPMSH,INTT,INMULT(INTT,INDEST),INMESSID)
+21 ; create the NEW mesage w/newMSH in %INV
+22 DO NEWMSG^INHRDUP(.INCMPMSH,.%INV,.INV)
+23 ; get user and division information and pass it to new msg entry
+24 NEW INORDUZ,INORDIV,INMIDGEN
+25 SET INORDUZ=$PIECE($GET(^INTHU(INUIF,0)),U,15)
SET INORDIV=$PIECE($GET(^(0)),U,21)
SET INMIDGEN=$PIECE($GET(^(0)),U,5)
+26 ;Create new message in ^INTHU and deliver to its outbound queue
+27 SET INNEWUIF=$$NEWO^INHD(INDEST,.%INV,+$PIECE(^INRHT(INTT,0),U,12),INTT,INMESSID,"",INORDUZ,INORDIV,.INUIF6,.INUIF7,INMIDGEN)
+28 IF INNEWUIF<0
SET INERR(INERROR)="UIF creation failed for transaction type "_$PIECE(INTYPE(0),U)
SET INERROR=INERROR+1
SET INSTAT=1
+29 DO LOG^INHRDUP
+30 ; cleanup the Replication Messages temp storage
+31 KILL @%INV
+32 QUIT
+33 ;
