INTSTO1 ;DGH; 22 May 97 11:25;Unit test Ouput Controller, part II
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
; Called from INTSTO, this processes outgoing transactions,
; including replicated transactions.
;
OUT(UIF,INEXPND,DEST) ;process outgoing message
;INPUT:
; UIF = Entry in Universal Interface file to process
; INEXPND = 1 to expand, 0 to not
; DEST = Pointer to Interface Destination File
N ROU,ACT,ER,ERR,INEDIT,REP,STAT,INENVSDB,INHERR,INTT,Z,REPDST,INPOP
S INPOP=1
;;FOLLOWING COPIED FROM D ^INHOT(IEN,1,DEV)
S ROU=$P(^INRHD(DEST,0),U,3) I ROU="" S INMSG="Destination: "_$P(^INRHD(DEST,0),U)_" is missing a routine name." D DISPLAY^INTSUT1(INMSG,0) Q
S INMSG="Processing outgoing message to destination "_$P(^INRHD(DEST,0),U)_" with routine "_ROU D DISPLAY^INTSUT1(INMSG,0)
I $P(^INRHD(DEST,0),U)["REPLICATOR" D
.;Activity log multiple should have been killed. But be sure.
.K ^INTHU(UIF,1)
.;Replicator won't process "complete" transactions
.S $P(^INTHU(UIF,0),U,3)=""
.;Set debug flag, INENVSDB "on". The replicator will then store
.;selective routing results in Activity Log Multiple.
.;S INENVSDB=$P($G(^INRHSITE(1,0)),U,16),$P(^INRHSITE(1,0),U,16)=1
.S INENVSDB=1
Q:'INPOP
S:ROU'["^" ROU="^"_ROU
K INHERR S Z="N MODE,DEST S ER=$$"_ROU_"("_UIF_",.INHERR)" X Z
K INTT D:ER>-1 DONE^INHOS
;
;--If destination was not the replicator, probably was a queue move.
;--Queue move won't create new entries in activity log multiple, but
;--other transceiver operations might. Display if there are any.
I $P(^INRHD(DEST,0),U)'["REPLICATOR" D
.D DISPLAY^INTSUT1("Output controller processing completed",0)
.S STAT=$$CVTCODE^INHUTC3($P(^INTHU(UIF,0),U,3),4001,.03)
.S INMSG="Status of message is: "_STAT D DISPLAY^INTSUT1(INMSG,0,UIF)
.D ACTLOG^INTSTO(UIF)
;
;--If destination was the replicator
I $P(^INRHD(DEST,0),U)["REPLICATOR" D
.;Restore original debug value
.;;;S $P(^INRHSITE(1,0),U,16)=INENVSDB
.D DISPLAY^INTSUT1("Processing through replicator completed",0)
.;S STAT=$P(^INTHU(UIF,0),U,3),STAT=$S(STAT="C":"Complete",STAT="E":"Error",1:"Other")
.S STAT=$$CVTCODE^INHUTC3($P(^INTHU(UIF,0),U,3),4001,.03)
.S INMSG="Status of base message is: "_STAT D DISPLAY^INTSUT1(INMSG,0)
.;Loop through activity log. Display replicants and screened messages.
.S ACT=0 F S ACT=$O(^INTHU(UIF,1,ACT)) Q:'ACT D
..S LOG=^INTHU(UIF,1,ACT,0)
..I $P(LOG,U,2)="R" D
...S REP=$P(LOG,U,3) Q:'REP
...S REPDST=$P($G(^INRHD($P(^INTHU(REP,0),U,2),0)),U)
...S INMSG="Replicated message "_$P(^INTHU(REP,0),U,5)_" created for destination "_REPDST D DISPLAY^INTSUT1(INMSG,0)
...I REPDST["HL REPLICATOR" D DISPLAY^INTSUT1("!!! WARNING - Potential run away message. Check replicator definiton.",0)
...;In expanded mode, display text of replicated messages
...D:INEXPND EXPNDIS^INTSUT1(UIF)
..Q:'INPOP
..;If activity log shows replicant was screened
..I $P(LOG,U,2)="X" D
...D DISPLAY^INTSUT1("Replication suppressed",0)
...;if debugging is on, there will be subnodes
...Q:'$D(^INTHU(UIF,1,ACT,1))
...S L1=0 F S L1=$O(^INTHU(UIF,1,ACT,1,L1)) Q:'L1 D
....S INMSG=$G(^INTHU(UIF,1,ACT,1,L1,0)) D DISPLAY^INTSUT1(INMSG,0)
;display errors
D:$D(INHERR) ERRS^INTSTO(.INHERR)
Q
;
INTSTO1 ;DGH; 22 May 97 11:25;Unit test Ouput Controller, part II
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ; Called from INTSTO, this processes outgoing transactions,
+5 ; including replicated transactions.
+6 ;
OUT(UIF,INEXPND,DEST) ;process outgoing message
+1 ;INPUT:
+2 ; UIF = Entry in Universal Interface file to process
+3 ; INEXPND = 1 to expand, 0 to not
+4 ; DEST = Pointer to Interface Destination File
+5 NEW ROU,ACT,ER,ERR,INEDIT,REP,STAT,INENVSDB,INHERR,INTT,Z,REPDST,INPOP
+6 SET INPOP=1
+7 ;;FOLLOWING COPIED FROM D ^INHOT(IEN,1,DEV)
+8 SET ROU=$PIECE(^INRHD(DEST,0),U,3)
IF ROU=""
SET INMSG="Destination: "_$PIECE(^INRHD(DEST,0),U)_" is missing a routine name."
DO DISPLAY^INTSUT1(INMSG,0)
QUIT
+9 SET INMSG="Processing outgoing message to destination "_$PIECE(^INRHD(DEST,0),U)_" with routine "_ROU
DO DISPLAY^INTSUT1(INMSG,0)
+10 IF $PIECE(^INRHD(DEST,0),U)["REPLICATOR"
Begin DoDot:1
+11 ;Activity log multiple should have been killed. But be sure.
+12 KILL ^INTHU(UIF,1)
+13 ;Replicator won't process "complete" transactions
+14 SET $PIECE(^INTHU(UIF,0),U,3)=""
+15 ;Set debug flag, INENVSDB "on". The replicator will then store
+16 ;selective routing results in Activity Log Multiple.
+17 ;S INENVSDB=$P($G(^INRHSITE(1,0)),U,16),$P(^INRHSITE(1,0),U,16)=1
+18 SET INENVSDB=1
End DoDot:1
+19 IF 'INPOP
QUIT
+20 IF ROU'["^"
SET ROU="^"_ROU
+21 KILL INHERR
SET Z="N MODE,DEST S ER=$$"_ROU_"("_UIF_",.INHERR)"
XECUTE Z
+22 KILL INTT
IF ER>-1
DO DONE^INHOS
+23 ;
+24 ;--If destination was not the replicator, probably was a queue move.
+25 ;--Queue move won't create new entries in activity log multiple, but
+26 ;--other transceiver operations might. Display if there are any.
+27 IF $PIECE(^INRHD(DEST,0),U)'["REPLICATOR"
Begin DoDot:1
+28 DO DISPLAY^INTSUT1("Output controller processing completed",0)
+29 SET STAT=$$CVTCODE^INHUTC3($PIECE(^INTHU(UIF,0),U,3),4001,.03)
+30 SET INMSG="Status of message is: "_STAT
DO DISPLAY^INTSUT1(INMSG,0,UIF)
+31 DO ACTLOG^INTSTO(UIF)
End DoDot:1
+32 ;
+33 ;--If destination was the replicator
+34 IF $PIECE(^INRHD(DEST,0),U)["REPLICATOR"
Begin DoDot:1
+35 ;Restore original debug value
+36 ;;;S $P(^INRHSITE(1,0),U,16)=INENVSDB
+37 DO DISPLAY^INTSUT1("Processing through replicator completed",0)
+38 ;S STAT=$P(^INTHU(UIF,0),U,3),STAT=$S(STAT="C":"Complete",STAT="E":"Error",1:"Other")
+39 SET STAT=$$CVTCODE^INHUTC3($PIECE(^INTHU(UIF,0),U,3),4001,.03)
+40 SET INMSG="Status of base message is: "_STAT
DO DISPLAY^INTSUT1(INMSG,0)
+41 ;Loop through activity log. Display replicants and screened messages.
+42 SET ACT=0
FOR
SET ACT=$ORDER(^INTHU(UIF,1,ACT))
IF 'ACT
QUIT
Begin DoDot:2
+43 SET LOG=^INTHU(UIF,1,ACT,0)
+44 IF $PIECE(LOG,U,2)="R"
Begin DoDot:3
+45 SET REP=$PIECE(LOG,U,3)
IF 'REP
QUIT
+46 SET REPDST=$PIECE($GET(^INRHD($PIECE(^INTHU(REP,0),U,2),0)),U)
+47 SET INMSG="Replicated message "_$PIECE(^INTHU(REP,0),U,5)_" created for destination "_REPDST
DO DISPLAY^INTSUT1(INMSG,0)
+48 IF REPDST["HL REPLICATOR"
DO DISPLAY^INTSUT1("!!! WARNING - Potential run away message. Check replicator definiton.",0)
+49 ;In expanded mode, display text of replicated messages
+50 IF INEXPND
DO EXPNDIS^INTSUT1(UIF)
End DoDot:3
+51 IF 'INPOP
QUIT
+52 ;If activity log shows replicant was screened
+53 IF $PIECE(LOG,U,2)="X"
Begin DoDot:3
+54 DO DISPLAY^INTSUT1("Replication suppressed",0)
+55 ;if debugging is on, there will be subnodes
+56 IF '$DATA(^INTHU(UIF,1,ACT,1))
QUIT
+57 SET L1=0
FOR
SET L1=$ORDER(^INTHU(UIF,1,ACT,1,L1))
IF 'L1
QUIT
Begin DoDot:4
+58 SET INMSG=$GET(^INTHU(UIF,1,ACT,1,L1,0))
DO DISPLAY^INTSUT1(INMSG,0)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+59 ;display errors
+60 IF $DATA(INHERR)
DO ERRS^INTSTO(.INHERR)
+61 QUIT
+62 ;
