INHRDUP(INUIF,INERR) ;DJL,DGH; 7 May 98 12:41;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.
;INPUT:
;--INUIF = ien in Universal Interface File
;--INERR = array to contain any error messages
;USER INTERACTION IN USER-DEFINED CODE:
;--INUIF = ien of duplicated message. User can manipuate this message.
;--INMSH = variable into which user must store MSH if user-manipulated.
;LOCAL:
;--INMSH0 = Base message MSH segment. May be an array
;--INMSH = MSH for replicated message. May be from MSH0 or from node 2.
;--INMSHNEW = "Composite" MSH with non-null fields from MSH0 and MSH.
;--INSTAT = The return status. See OUTPUT below.
;OUTPUT:
;--INERR = array to contain any error messages
;--RETURN = 0: Complete with NO errors, mark Base UIF enry complete.
;--RETURN = 1: Complete WITH errors, Don't mark Base UIF entry complete.
;
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,%
N INSRDATA,INSRMC,INSRCTL,INSDEST,%INV,INCMPMSH,INPROC,INA,INDA,INATVAL,INSRPRIO,INPRIO,INGETOUT,INUIF6,INUIF7
;
;
K ^UTILITY("INV",$J)
;If status="C", don't allow requeue
I $P(^INTHU(INUIF,0),U,3)="C" Q 0
;Look up originating transaction type from UIF.
S INOTT=$P($G(^INTHU(INUIF,0)),U,11) I 'INOTT S INERR(1)="No originating transaction type" Q 1
I '$D(^INRHR("AC",INOTT)) S INERR(1)="No replicants defined" Q 1
; Set the INPROC, INDA, and INA variables
S INSRCTL("INSRPROC")="REP",INSRCTL("INTT")=INOTT,INDA="^INTHU("_INUIF_",6)",INA="^INTHU("_INUIF_",7)"
M INUIF6=@INDA,INUIF7=@INA ; selective routing - pass info to replicant msgs
; setup the table holding File # and Nodes holding SRMC information
S INPRIO(3)="4000^INOTT^5",INPRIO(2)="4005^INDEST^12",INPRIO(1)="4000^INTT^5"
;Start transaction audit of "base" message
D:$D(XUAUDIT) TTSTRT^XUSAUD(INUIF,"",$P($G(^INTHPC(INBPN,0)),U),$G(INHSRVR),"REPLICATE")
;* If SRMC exists for the Base TT (Priority-3), execute it
K INSRDATA I $L($G(^INRHT(INOTT,5))) S INSRPRIO=3 X ^INRHT(INOTT,5)
;---Store "base" MSH in INMSH0 to be used for non-reformatted MSHs.
S LCT=0 D GETLINE^INHOU(INUIF,.LCT,.INMSH0)
I INMSH0'["MSH" S INMSH0="",LCT=0
I $L(INMSH0) S INDELIM=$E(INMSH0,4),INSUBDEL=$E(INMSH0,5),INSUBCOM=$E(INMSH0,8)
I '$L(INMSH0) S INDELIM=$$FIELD^INHUT(),INSUBDEL=$$COMP^INHUT(),INSUBCOM=$$SUBCOMP^INHUT()
;** Create @INV@ data storage for BASE message content/building
S INVS=$P(^INRHSITE(1,0),U,12),INV=$S(INVS<2:"INV",1:"^UTILITY(""INV"",$J)"),INSTAT=0
S INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
;Store message body in array starting with LCT=2 (MSH will be in 1)
;* This is the BASE message that all replicants will be derived from.
S I=LCT,LCT=2,DSC=0 F S I=$O(^INTHU(INUIF,3,I)) Q:'I D
.S %=^INTHU(INUIF,3,I,0)
.D:INVS<2 MC^INHS
.I 'DSC S @INV@(LCT)=%
.I DSC S @INV@(LCT,DSC)=%
.;if global line contains end of segment, increment line count
.I $E(%,$L(%)-6,$L(%))["|CR|" S LCT=LCT+1,DSC=0 Q
.;Else global line is continued to next line, increment DeSCendent count
.S DSC=DSC+1
;---build INMULT array with all ACTIVE TTs, DESTs for the originating TT
S INIEN="" F S INIEN=$O(^INRHR("AC",INOTT,INIEN)) Q:INIEN="" D
.; process the Replication TTs' Primary Destination AND Default Rec'v Fac into INMULT
. S INTT=+^INRHR(INIEN,0) Q:'+$P(^INRHT(INTT,0),U,5) ; Not ACTIVE
. S INMULT("TT",INTT)=$G(^INRHT(INTT,5)) ; set 'TT' cross-ref with SRMC
. S INPDEST=+$P(^INRHT(INTT,0),U,2) I 'INPDEST S INSTAT=1 Q
.; process the Primary Dest and Default Rec'v Fac into INMULT
. S INMULT(INTT,INPDEST)=$P($G(^INRHD(INPDEST,7)),U) ; Def Rec'v Fac
. S INMULT("PD",INTT,INPDEST)=$G(^INRHD(INPDEST,12)) ; set 'PD' cross-ref with SRMC
.; process the Secondary Destinations AND Default Rec'v Fac into INMULT
. S INSDEST=0 F S INSDEST=$O(^INRHD("APD",INPDEST,INSDEST)) Q:'INSDEST S INMULT(INTT,INSDEST)=$P($G(^INRHD(INSDEST,7)),U)
;--if base message is requeued, don't replicate messages/destinations
;--that successfully processed previously--.02="R", .03=uif msg pointer
I $D(^INTHU(INUIF,1)) D
.S LOG=0 F S LOG=$O(^INTHU(INUIF,1,LOG)) Q:'LOG D
..Q:'$D(^INTHU(INUIF,1,LOG,0)) Q:$P(^INTHU(INUIF,1,LOG,0),U,2)'="R"
..S INUIFD=+$P(^INTHU(INUIF,1,LOG,0),U,3) Q:'INUIFD S INTT=$P(^INTHU(INUIFD,0),U,11)
..I INTT K INMULT(INTT,+$P(^INTHU(INUIFD,0),U,2))
;* 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
. 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 NEW INSRDATA, 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) 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
. ;* INMULT array Processing LOOP at Destination level
. S INDEST=0 F S INDEST=$O(INMULT(INTT,INDEST)) Q:'INDEST D
.. 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 LOG^INHUT6(+INPRIO(INSRPRIO),@($P(INPRIO(INSRPRIO),U,2)),$P(INPRIO(INSRPRIO),U,3),INUIF) Q ; can't find a matching RouteID in Destination
.. ;** 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)
.. D NEWMSG(.INCMPMSH,.%INV,.INV) ; create the NEW mesage w/newMSH in %INV
.. ; get user and division information and pass it to new msg entry
.. N INORDUZ,INORDIV S INORDUZ=$P($G(^INTHU(INUIF,0)),U,15),INORDIV=$P($G(^(0)),U,21)
.. ;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)
.. I INNEWUIF<0 S INERR(INERROR)="UIF creation failed for transaction type "_$P(INTYPE(0),U),INERROR=INERROR+1,INSTAT=1
.. D LOG
.. K @%INV ; cleanup the Replication Messages temp storage
G EXIT ; Cleanup Utility global (one last time) and exit
Q
;
NEWMSG(INNEWMSH,%INV,INV) ; merge the message Body in INV into %INV with New MSH
N %
; * Copy Base Message Body ( from @INV@ to @%INV@ )
S @%INV@(1)=INNEWMSH I $D(INNEWMSH)>9 S @%INV@(1,1)=INNEWMSH(1)
;* Copy Base Message Body ( from @INV@ ) to @%INV@. After MSH.
S %=1 F S %=$O(@INV@(%)) Q:%="" M @%INV@(%)=@INV@(%) D:INVS<2 MC
Q
;
MC ;Check if time to move variables to a global
Q:%INV["^"
I $S<INSMIN M ^UTILITY("%INV",$J)=%INV K %INV S %INV="^UTILITY(""%INV"",$J)"
Q
;
LOG ;In activity log multiple of "base" message, log successful messages
;Note: INHER is undefined on purpose, we don't want to file array
K INHER D ULOG^INHU(INUIF,"R",.INHER,INNEWUIF)
Q
;
EXIT K @INV ; cleanup the Base Messages temp storage
;Stop transaction audit
D:$D(XUAUDIT) TTSTP^XUSAUD(0)
Q INSTAT
;
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
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;This functions as the transceiver routine for messages which are to
+4 ;be routed to multiple destinations.
+5 ;INPUT:
+6 ;--INUIF = ien in Universal Interface File
+7 ;--INERR = array to contain any error messages
+8 ;USER INTERACTION IN USER-DEFINED CODE:
+9 ;--INUIF = ien of duplicated message. User can manipuate this message.
+10 ;--INMSH = variable into which user must store MSH if user-manipulated.
+11 ;LOCAL:
+12 ;--INMSH0 = Base message MSH segment. May be an array
+13 ;--INMSH = MSH for replicated message. May be from MSH0 or from node 2.
+14 ;--INMSHNEW = "Composite" MSH with non-null fields from MSH0 and MSH.
+15 ;--INSTAT = The return status. See OUTPUT below.
+16 ;OUTPUT:
+17 ;--INERR = array to contain any error messages
+18 ;--RETURN = 0: Complete with NO errors, mark Base UIF enry complete.
+19 ;--RETURN = 1: Complete WITH errors, Don't mark Base UIF entry complete.
+20 ;
EN1 NEW 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 NEW INSRDATA,INSRMC,INSRCTL,INSDEST,%INV,INCMPMSH,INPROC,INA,INDA,INATVAL,INSRPRIO,INPRIO,INGETOUT,INUIF6,INUIF7
+2 ;
+3 ;
+4 KILL ^UTILITY("INV",$JOB)
+5 ;If status="C", don't allow requeue
+6 IF $PIECE(^INTHU(INUIF,0),U,3)="C"
QUIT 0
+7 ;Look up originating transaction type from UIF.
+8 SET INOTT=$PIECE($GET(^INTHU(INUIF,0)),U,11)
IF 'INOTT
SET INERR(1)="No originating transaction type"
QUIT 1
+9 IF '$DATA(^INRHR("AC",INOTT))
SET INERR(1)="No replicants defined"
QUIT 1
+10 ; Set the INPROC, INDA, and INA variables
+11 SET INSRCTL("INSRPROC")="REP"
SET INSRCTL("INTT")=INOTT
SET INDA="^INTHU("_INUIF_",6)"
SET INA="^INTHU("_INUIF_",7)"
+12 ; selective routing - pass info to replicant msgs
MERGE INUIF6=@INDA,INUIF7=@INA
+13 ; setup the table holding File # and Nodes holding SRMC information
+14 SET INPRIO(3)="4000^INOTT^5"
SET INPRIO(2)="4005^INDEST^12"
SET INPRIO(1)="4000^INTT^5"
+15 ;Start transaction audit of "base" message
+16 IF $DATA(XUAUDIT)
DO TTSTRT^XUSAUD(INUIF,"",$PIECE($GET(^INTHPC(INBPN,0)),U),$GET(INHSRVR),"REPLICATE")
+17 ;* If SRMC exists for the Base TT (Priority-3), execute it
+18 KILL INSRDATA
IF $LENGTH($GET(^INRHT(INOTT,5)))
SET INSRPRIO=3
XECUTE ^INRHT(INOTT,5)
+19 ;---Store "base" MSH in INMSH0 to be used for non-reformatted MSHs.
+20 SET LCT=0
DO GETLINE^INHOU(INUIF,.LCT,.INMSH0)
+21 IF INMSH0'["MSH"
SET INMSH0=""
SET LCT=0
+22 IF $LENGTH(INMSH0)
SET INDELIM=$EXTRACT(INMSH0,4)
SET INSUBDEL=$EXTRACT(INMSH0,5)
SET INSUBCOM=$EXTRACT(INMSH0,8)
+23 IF '$LENGTH(INMSH0)
SET INDELIM=$$FIELD^INHUT()
SET INSUBDEL=$$COMP^INHUT()
SET INSUBCOM=$$SUBCOMP^INHUT()
+24 ;** Create @INV@ data storage for BASE message content/building
+25 SET INVS=$PIECE(^INRHSITE(1,0),U,12)
SET INV=$SELECT(INVS<2:"INV",1:"^UTILITY(""INV"",$J)")
SET INSTAT=0
+26 SET INSMIN=$SELECT($PIECE($GET(^INRHSITE(1,0)),U,14):$PIECE(^(0),U,14),1:2500)
+27 ;Store message body in array starting with LCT=2 (MSH will be in 1)
+28 ;* This is the BASE message that all replicants will be derived from.
+29 SET I=LCT
SET LCT=2
SET DSC=0
FOR
SET I=$ORDER(^INTHU(INUIF,3,I))
IF 'I
QUIT
Begin DoDot:1
+30 SET %=^INTHU(INUIF,3,I,0)
+31 IF INVS<2
DO MC^INHS
+32 IF 'DSC
SET @INV@(LCT)=%
+33 IF DSC
SET @INV@(LCT,DSC)=%
+34 ;if global line contains end of segment, increment line count
+35 IF $EXTRACT(%,$LENGTH(%)-6,$LENGTH(%))["|CR|"
SET LCT=LCT+1
SET DSC=0
QUIT
+36 ;Else global line is continued to next line, increment DeSCendent count
+37 SET DSC=DSC+1
End DoDot:1
+38 ;---build INMULT array with all ACTIVE TTs, DESTs for the originating TT
+39 SET INIEN=""
FOR
SET INIEN=$ORDER(^INRHR("AC",INOTT,INIEN))
IF INIEN=""
QUIT
Begin DoDot:1
+40 ; process the Replication TTs' Primary Destination AND Default Rec'v Fac into INMULT
+41 ; Not ACTIVE
SET INTT=+^INRHR(INIEN,0)
IF '+$PIECE(^INRHT(INTT,0),U,5)
QUIT
+42 ; set 'TT' cross-ref with SRMC
SET INMULT("TT",INTT)=$GET(^INRHT(INTT,5))
+43 SET INPDEST=+$PIECE(^INRHT(INTT,0),U,2)
IF 'INPDEST
SET INSTAT=1
QUIT
+44 ; process the Primary Dest and Default Rec'v Fac into INMULT
+45 ; Def Rec'v Fac
SET INMULT(INTT,INPDEST)=$PIECE($GET(^INRHD(INPDEST,7)),U)
+46 ; set 'PD' cross-ref with SRMC
SET INMULT("PD",INTT,INPDEST)=$GET(^INRHD(INPDEST,12))
+47 ; process the Secondary Destinations AND Default Rec'v Fac into INMULT
+48 SET INSDEST=0
FOR
SET INSDEST=$ORDER(^INRHD("APD",INPDEST,INSDEST))
IF 'INSDEST
QUIT
SET INMULT(INTT,INSDEST)=$PIECE($GET(^INRHD(INSDEST,7)),U)
End DoDot:1
+49 ;--if base message is requeued, don't replicate messages/destinations
+50 ;--that successfully processed previously--.02="R", .03=uif msg pointer
+51 IF $DATA(^INTHU(INUIF,1))
Begin DoDot:1
+52 SET LOG=0
FOR
SET LOG=$ORDER(^INTHU(INUIF,1,LOG))
IF 'LOG
QUIT
Begin DoDot:2
+53 IF '$DATA(^INTHU(INUIF,1,LOG,0))
QUIT
IF $PIECE(^INTHU(INUIF,1,LOG,0),U,2)'="R"
QUIT
+54 SET INUIFD=+$PIECE(^INTHU(INUIF,1,LOG,0),U,3)
IF 'INUIFD
QUIT
SET INTT=$PIECE(^INTHU(INUIFD,0),U,11)
+55 IF INTT
KILL INMULT(INTT,+$PIECE(^INTHU(INUIFD,0),U,2))
End DoDot:2
End DoDot:1
+56 ;* Suppressed messages will be logged in the ActivityLog Multiple (and Error log w/DEBUG)
+57 ;* INMULT array Processing LOOP at Rep TT level
+58 SET INERROR=1
SET INGETOUT=0
SET INTT=""
SET INIEN=""
FOR
SET INTT=$ORDER(INMULT(INTT))
IF 'INTT!INGETOUT
QUIT
Begin DoDot:1
+59 IF '$DATA(^INRHT(INTT))
SET INERR(INERROR)="Replication attempted to unknown transaction type:"_INTT
SET INERROR=INERROR+1
SET INSTAT=1
QUIT
+60 ;* If SRMC exists for the Primary Dest (Priority-2), set SRMC variable=SRMC
+61 SET INPDEST=$ORDER(INMULT("PD",INTT,""))
SET INSRMC=$GET(INMULT("PD",INTT,INPDEST))
+62 IF $LENGTH(INSRMC)
SET INSRPRIO=2
+63 ;* If SRMC exists for the Rep TT (Priority-1), set SRMC variable=SRMC
+64 IF $LENGTH($GET(INMULT("TT",INTT)))
SET INSRPRIO=1
SET INSRMC=INMULT("TT",INTT)
+65 ;* if INSRMC variable has SRMC (PRIORITY 1 or 2) then NEW INSRDATA, execute SRMC.
+66 ; if priority=1 or 2 AND INSRDATA=1 Quit and log SUPPRESSION for this TT
+67 IF $LENGTH(INSRMC)
NEW INSRDATA
SET INSRCTL("INTT")=INTT
SET INSRCTL("INDEST")=INPDEST
XECUTE INSRMC
+68 IF $GET(INSRDATA)
IF INSRPRIO=3
SET INGETOUT=1
SET INSRCTL("INDEST")=""
SET INDEST=INPDEST
DO LOG^INHUT6(+INPRIO(INSRPRIO),@$PIECE(INPRIO(INSRPRIO),U,2),$PIECE(INPRIO(INSRPRIO),U,3),INUIF)
QUIT
+69 ;* INMULT array Processing LOOP at Destination level
+70 SET INDEST=0
FOR
SET INDEST=$ORDER(INMULT(INTT,INDEST))
IF 'INDEST
QUIT
Begin DoDot:2
+71 SET INSRCTL("INDEST")=INDEST
+72 ;* If INSRDATA exists as a list then Quit if NOT $$FINDRID^INHUT5( .INSRDATA, Dest )
+73 ; can't find a match of RouteID in Destination
+74 ; can't find a matching RouteID in Destination
IF $DATA(INSRDATA)>9
IF $$FINDRID^INHUT5(.INSRDATA,INDEST)
DO LOG^INHUT6(+INPRIO(INSRPRIO),@($PIECE(INPRIO(INSRPRIO),U,2)),$PIECE(INPRIO(INSRPRIO),U,3),INUIF)
QUIT
+75 ;** Create temporary @INV@(%INV) data storage for message content/building
+76 KILL %INV
SET %INV=$SELECT(INVS<2:"%INV",1:"^UTILITY(""%INV"",$J)")
IF %INV'="%INV"
KILL @%INV
+77 ;* Set INCMPMSH with GENMSH^INHRDUP1( .INCMPMSH, repINTT IEN, Def Recv Fac, MessageID ) // user reverse precedence
+78 ; order through all operation to allow an accumulation of MSH/Message construction
+79 KILL INCMPMSH
SET INCMPMSH=INMSH0
SET INMESSID=$$MESSID^INHD
DO GENMSH^INHRDUP1(.INCMPMSH,INTT,INMULT(INTT,INDEST),INMESSID)
+80 ; create the NEW mesage w/newMSH in %INV
DO NEWMSG(.INCMPMSH,.%INV,.INV)
+81 ; get user and division information and pass it to new msg entry
+82 NEW INORDUZ,INORDIV
SET INORDUZ=$PIECE($GET(^INTHU(INUIF,0)),U,15)
SET INORDIV=$PIECE($GET(^(0)),U,21)
+83 ;Create new message in ^INTHU and deliver to its outbound queue
+84 SET INNEWUIF=$$NEWO^INHD(INDEST,.%INV,+$PIECE(^INRHT(INTT,0),U,12),INTT,INMESSID,"",INORDUZ,INORDIV,.INUIF6,.INUIF7)
+85 IF INNEWUIF<0
SET INERR(INERROR)="UIF creation failed for transaction type "_$PIECE(INTYPE(0),U)
SET INERROR=INERROR+1
SET INSTAT=1
+86 DO LOG
+87 ; cleanup the Replication Messages temp storage
KILL @%INV
End DoDot:2
End DoDot:1
+88 ; Cleanup Utility global (one last time) and exit
GOTO EXIT
+89 QUIT
+90 ;
NEWMSG(INNEWMSH,%INV,INV) ; merge the message Body in INV into %INV with New MSH
+1 NEW %
+2 ; * Copy Base Message Body ( from @INV@ to @%INV@ )
+3 SET @%INV@(1)=INNEWMSH
IF $DATA(INNEWMSH)>9
SET @%INV@(1,1)=INNEWMSH(1)
+4 ;* Copy Base Message Body ( from @INV@ ) to @%INV@. After MSH.
+5 SET %=1
FOR
SET %=$ORDER(@INV@(%))
IF %=""
QUIT
MERGE @%INV@(%)=@INV@(%)
IF INVS<2
DO MC
+6 QUIT
+7 ;
MC ;Check if time to move variables to a global
+1 IF %INV["^"
QUIT
+2 IF $STORAGE<INSMIN
MERGE ^UTILITY("%INV",$JOB)=%INV
KILL %INV
SET %INV="^UTILITY(""%INV"",$J)"
+3 QUIT
+4 ;
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
+2 KILL INHER
DO ULOG^INHU(INUIF,"R",.INHER,INNEWUIF)
+3 QUIT
+4 ;
EXIT ; cleanup the Base Messages temp storage
KILL @INV
+1 ;Stop transaction audit
+2 IF $DATA(XUAUDIT)
DO TTSTP^XUSAUD(0)
+3 QUIT INSTAT
+4 ;
