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

INHRDUP1.m

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