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

INHRDUP.m

Go to the documentation of this file. 
  1. INHRDUP(INUIF,INERR) ;DJL,DGH; 7 May 98 12:41;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.  ;INPUT:
  1.  ;--INUIF = ien in Universal Interface File
  1.  ;--INERR = array to contain any error messages
  1.  ;USER INTERACTION IN USER-DEFINED CODE:
  1.  ;--INUIF = ien of duplicated message. User can manipuate this message.
  1.  ;--INMSH = variable into which user must store MSH if user-manipulated.
  1.  ;LOCAL:
  1.  ;--INMSH0 = Base message MSH segment. May be an array
  1.  ;--INMSH = MSH for replicated message. May be from MSH0 or from node 2.
  1.  ;--INMSHNEW = "Composite" MSH with non-null fields from MSH0 and MSH.
  1.  ;--INSTAT = The return status. See OUTPUT below.
  1.  ;OUTPUT:
  1.  ;--INERR  = array to contain any error messages
  1.  ;--RETURN = 0: Complete with NO errors, mark Base UIF enry complete.
  1.  ;--RETURN = 1: Complete WITH errors, Don't mark Base UIF entry complete.
  1.  ;
  1. EN1 N INTT,INOTT,INMSH0,INMSH,INMSHNEW,INVS,INV,INSMIN,INL1,INCP,INDELIM,INDEST,INIEN,LCT,INMSH,INEVTYP,INNEWUIF,INUIFD,I,L,INMESSID,INMULT,INSTAT,INERROR,INHER,LOG,INSUBCOM,INSUBDEL,DSC,%
  1.  N INSRDATA,INSRMC,INSRCTL,INSDEST,%INV,INCMPMSH,INPROC,INA,INDA,INATVAL,INSRPRIO,INPRIO,INGETOUT,INUIF6,INUIF7
  1.  ;
  1.  ;
  1.  K ^UTILITY("INV",$J)
  1.  ;If status="C", don't allow requeue
  1.  I $P(^INTHU(INUIF,0),U,3)="C" Q 0
  1.  ;Look up originating transaction type from UIF.
  1.  S INOTT=$P($G(^INTHU(INUIF,0)),U,11) I 'INOTT S INERR(1)="No originating transaction type" Q 1
  1.  I '$D(^INRHR("AC",INOTT)) S INERR(1)="No replicants defined" Q 1
  1.  ; Set the INPROC, INDA, and INA variables
  1.  S INSRCTL("INSRPROC")="REP",INSRCTL("INTT")=INOTT,INDA="^INTHU("_INUIF_",6)",INA="^INTHU("_INUIF_",7)"
  1.  M INUIF6=@INDA,INUIF7=@INA  ; selective routing - pass info to replicant msgs
  1.  ; setup the table holding File # and Nodes holding SRMC information
  1.  S INPRIO(3)="4000^INOTT^5",INPRIO(2)="4005^INDEST^12",INPRIO(1)="4000^INTT^5"
  1.  ;Start transaction audit of "base" message
  1.  D:$D(XUAUDIT) TTSTRT^XUSAUD(INUIF,"",$P($G(^INTHPC(INBPN,0)),U),$G(INHSRVR),"REPLICATE")
  1.  ;* If SRMC exists for the Base TT (Priority-3), execute it
  1.  K INSRDATA I $L($G(^INRHT(INOTT,5))) S INSRPRIO=3 X ^INRHT(INOTT,5)
  1.  ;---Store "base" MSH in INMSH0 to be used for non-reformatted MSHs.
  1.  S LCT=0 D GETLINE^INHOU(INUIF,.LCT,.INMSH0)
  1.  I INMSH0'["MSH" S INMSH0="",LCT=0
  1.  I $L(INMSH0) S INDELIM=$E(INMSH0,4),INSUBDEL=$E(INMSH0,5),INSUBCOM=$E(INMSH0,8)
  1.  I '$L(INMSH0) S INDELIM=$$FIELD^INHUT(),INSUBDEL=$$COMP^INHUT(),INSUBCOM=$$SUBCOMP^INHUT()
  1.  ;**  Create @INV@ data storage for BASE message content/building
  1.  S INVS=$P(^INRHSITE(1,0),U,12),INV=$S(INVS<2:"INV",1:"^UTILITY(""INV"",$J)"),INSTAT=0
  1.  S INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
  1.  ;Store message body in array starting with LCT=2 (MSH will be in 1)
  1.  ;* This is the BASE message that all replicants will be derived from.
  1.  S I=LCT,LCT=2,DSC=0 F  S I=$O(^INTHU(INUIF,3,I)) Q:'I  D
  1.  .S %=^INTHU(INUIF,3,I,0)
  1.  .D:INVS<2 MC^INHS
  1.  .I 'DSC S @INV@(LCT)=%
  1.  .I DSC S @INV@(LCT,DSC)=%
  1.  .;if global line contains end of segment, increment line count
  1.  .I $E(%,$L(%)-6,$L(%))["|CR|" S LCT=LCT+1,DSC=0 Q
  1.  .;Else global line is continued to next line, increment DeSCendent count
  1.  .S DSC=DSC+1
  1.  ;---build INMULT array with all ACTIVE TTs, DESTs for the originating TT
  1.  S INIEN="" F  S INIEN=$O(^INRHR("AC",INOTT,INIEN)) Q:INIEN=""  D
  1.  .; process the Replication TTs' Primary Destination AND Default Rec'v Fac into INMULT
  1.  . S INTT=+^INRHR(INIEN,0) Q:'+$P(^INRHT(INTT,0),U,5)  ; Not ACTIVE
  1.  . S INMULT("TT",INTT)=$G(^INRHT(INTT,5)) ; set 'TT' cross-ref with SRMC
  1.  . S INPDEST=+$P(^INRHT(INTT,0),U,2) I 'INPDEST S INSTAT=1 Q
  1.  .; process the Primary Dest and Default Rec'v Fac into INMULT
  1.  . S INMULT(INTT,INPDEST)=$P($G(^INRHD(INPDEST,7)),U) ; Def Rec'v Fac
  1.  . S INMULT("PD",INTT,INPDEST)=$G(^INRHD(INPDEST,12)) ; set 'PD' cross-ref with SRMC
  1.  .; process the Secondary Destinations AND Default Rec'v Fac into INMULT
  1.  . S INSDEST=0 F  S INSDEST=$O(^INRHD("APD",INPDEST,INSDEST)) Q:'INSDEST  S INMULT(INTT,INSDEST)=$P($G(^INRHD(INSDEST,7)),U)
  1.  ;--if base message is requeued, don't replicate messages/destinations
  1.  ;--that successfully processed previously--.02="R", .03=uif msg pointer
  1.  I $D(^INTHU(INUIF,1)) D
  1.  .S LOG=0 F  S LOG=$O(^INTHU(INUIF,1,LOG)) Q:'LOG  D
  1.  ..Q:'$D(^INTHU(INUIF,1,LOG,0))  Q:$P(^INTHU(INUIF,1,LOG,0),U,2)'="R"
  1.  ..S INUIFD=+$P(^INTHU(INUIF,1,LOG,0),U,3) Q:'INUIFD  S INTT=$P(^INTHU(INUIFD,0),U,11)
  1.  ..I INTT K INMULT(INTT,+$P(^INTHU(INUIFD,0),U,2))
  1.  ;* Suppressed messages will be logged in the ActivityLog Multiple (and Error log w/DEBUG)
  1.  ;* INMULT array Processing LOOP at Rep TT level
  1.  S INERROR=1,INGETOUT=0,INTT="",INIEN="" F  S INTT=$O(INMULT(INTT)) Q:'INTT!INGETOUT  D
  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), 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 NEW INSRDATA, 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) 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) Q
  1.  . ;* INMULT array Processing LOOP at Destination level
  1.  . S INDEST=0 F  S INDEST=$O(INMULT(INTT,INDEST)) Q:'INDEST  D
  1.  ..  S INSRCTL("INDEST")=INDEST
  1.  ..  ;* If INSRDATA exists as a list then Quit 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 LOG^INHUT6(+INPRIO(INSRPRIO),@($P(INPRIO(INSRPRIO),U,2)),$P(INPRIO(INSRPRIO),U,3),INUIF) Q  ; can't find a matching RouteID in Destination
  1.  ..  ;**  Create temporary @INV@(%INV) data storage for message content/building
  1.  ..  K %INV S %INV=$S(INVS<2:"%INV",1:"^UTILITY(""%INV"",$J)") K:%INV'="%INV" @%INV
  1.  ..  ;* Set INCMPMSH with GENMSH^INHRDUP1( .INCMPMSH, repINTT IEN, Def Recv Fac, MessageID )  // user reverse precedence
  1.  ..  ;   order through all operation to allow an accumulation of MSH/Message construction
  1.  ..  K INCMPMSH S INCMPMSH=INMSH0,INMESSID=$$MESSID^INHD D GENMSH^INHRDUP1(.INCMPMSH,INTT,INMULT(INTT,INDEST),INMESSID)
  1.  ..  D NEWMSG(.INCMPMSH,.%INV,.INV) ; create the NEW mesage w/newMSH in %INV
  1.  ..  ; get user and division information and pass it to new msg entry
  1.  ..  N INORDUZ,INORDIV S INORDUZ=$P($G(^INTHU(INUIF,0)),U,15),INORDIV=$P($G(^(0)),U,21)
  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)
  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
  1.  ..  K @%INV ; cleanup the Replication Messages temp storage
  1.  G EXIT ; Cleanup Utility global (one last time) and exit
  1.  Q
  1.  ;
  1. NEWMSG(INNEWMSH,%INV,INV) ; merge the message Body in INV into %INV with New MSH
  1.  N %
  1.  ; * Copy Base Message Body ( from @INV@ to @%INV@ )
  1.  S @%INV@(1)=INNEWMSH I $D(INNEWMSH)>9 S @%INV@(1,1)=INNEWMSH(1)
  1.  ;* Copy Base Message Body ( from @INV@ ) to @%INV@. After MSH.
  1.  S %=1 F  S %=$O(@INV@(%)) Q:%=""  M @%INV@(%)=@INV@(%) D:INVS<2 MC
  1.  Q
  1.  ;
  1. MC ;Check if time to move variables to a global
  1.  Q:%INV["^"
  1.  I $S<INSMIN M ^UTILITY("%INV",$J)=%INV K %INV S %INV="^UTILITY(""%INV"",$J)"
  1.  Q
  1.  ;
  1. LOG ;In activity log multiple of "base" message, log successful messages
  1.  ;Note: INHER is undefined on purpose, we don't want to file array
  1.  K INHER D ULOG^INHU(INUIF,"R",.INHER,INNEWUIF)
  1.  Q
  1.  ;
  1. EXIT K @INV ; cleanup the Base Messages temp storage
  1.  ;Stop transaction audit
  1.  D:$D(XUAUDIT) TTSTP^XUSAUD(0)
  1.  Q INSTAT
  1.  ;