XMCB ;ISC-SF/GMB- Batch Message Transmission ;08/28/2003 10:11
;;8.0;MailMan;**22**;Jun 28, 2002
; Was (WASH ISC)/THM
;
; Entry points used by MailMan options (not covered by DBIA):
; TAPEOUT XMS-SEQ-TRANSMIT (was BAT^XMS)
; TAPEIN XMR-SEQ-RECEIVE (was BAT^XMR)
; GLBOUT XMR-UCI-SEND (was TASKER^XMS)
; GLBIN XMR-UCI-RCV (was TASKER^XMR)
Q
TAPEOUT ; Write messages to tape.
; (Transmit them to another site via tape.)
N XMC,XMCHAN,XMINST,XMSITE,XMABORT,ER
S XMABORT=0,XMCHAN="TAPE",ER=0,XMC("BATCH")=1
D ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT,"M") Q:XMABORT
D OPEN^XML Q:$G(ER)!$G(POP)
D OUTDO
D KL^XMC
Q
TAPEIN ; Read messages from tape.
; (Receive them from another site via tape.)
N XM,XMC,XMCHAN,ER
S ER=0,(XMC("BATCH"),XMC("TURN"))=1,XMCHAN="T-IN"
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D R^XMCTRAP"
E S X="R^XMCTRAP",@^%ZOSF("TRAP")
D ENT^XMR
U IO(0) D ^%ZISC
W:'$D(ZTQUEUED) !,$$EZBLD^DIALOG(42257,+$G(XMC("R"))) ;Messages received: |1|
G KL1^XMC
Q
GLBOUT ; Write messages to a global.
; (Transmit them to another UCI via the global.)
W $C(7),!!
I '$D(^%ZISL(4.281,0)) W !!,$$EZBLD^DIALOG(42250) Q ;File 4.281 is not set up properly.
N XMTEXT
D BLD^DIALOG(42251,"","","XMTEXT","F")
D MSG^DIALOG("WM","","","","XMTEXT")
; ******* I M P O R T A N T *******"
;This option transmits messages from one UCI to another via ^%ZISL(4.281.
;Each UCI must be running MailMan, and file 4.281 must be translated and
;accessible from both UCIs. In the two-step process, the messages are
;written to the global from one UCI, and read from it in the other.
;
;Invoke this option on the sending UCI, and select the domain whose
;messages are to be transmitted. (The domain name must be the exact
;name of the domain of the receiving UCI - no synonyms.) The messages
;are written to file 4.281 and deleted from the transmit queue.
;
;Log on to the receiving UCI and invoke the receiver. It will read all
;messages in file 4.281 which were sent to it (it can't read any
;messages sent to any other domain), and queue them to be delivered.
;The messages will then be deleted from file 4.281.
N XMC,XMCHAN,XMLINE,XMFDA,XMIEN,XMIENS,XMABORT,XMINST,XMSITE,XMTASK,ER,Y
S XMCHAN="TASKER",(XMABORT,XMLINE)=0
D ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT,"M") Q:XMABORT
D GET^XML Q:$G(ER)!$G(POP)
S XMFDA(4.281,"+1,",.01)=^XMB("NETNAME")
D UPDATE^DIE("","XMFDA","XMIEN")
S XMTASK=XMIEN(1)
D OUTDO
S XMIENS=XMTASK_","
S XMFDA(4.281,XMIENS,1)=XMSITE
D FILE^DIE("","XMFDA")
D KL^XMC
Q
OUTDO ;
N XM,XMDUZ
U IO(0)
S XM="",(XMC("BATCH"),XMC("TURN"))=1,XMREC="Q"
D GET^XMCXT(0)
W !,$$EZBLD^DIALOG(42252) ;Dumping messages now
U IO
D ENTER^XMS
D XMTFINIS^XMTDR(XMINST)
U IO(0)
I $D(XMC("S")) W $C(7)," ... ",$$EZBLD^DIALOG(42253,XMC("S")) ;Messages dumped: |1|
X XMCLOSE
Q
GLBIN ; Read messages from a global.
; (Receive them from another UCI via the global.)
N XM,XMC,XMCHAN,XMDUZ,XMTASK,XMNETNAM,XMSITE,XMABORT,XMI,XMIREC,XMCNT,Y
S XM=$S($D(ZTQUEUED):"",1:"D")
S XMNETNAM=^XMB("NETNAME"),XMABORT=0,XMCHAN="TASK-IN"
D GET^XML Q:$G(ER)
I XM["D" D Q:XMABORT
. D GET^XMCXT(0)
. D DOTRAN^XMC1(42254,XMNETNAM) ;Receive messages for |1|
. D PAGE^XMXUTIL(.XMABORT)
S (XMI,XMCNT)=0
F S XMI=$O(^%ZISL(4.281,"C",XMNETNAM,XMI)) Q:'XMI D Q:ER
. S XMIREC=$G(^%ZISL(4.281,XMI,0)) Q:XMIREC=""
. Q:$P(XMIREC,U,2)'=XMNETNAM
. S XMSITE=$P(XMIREC,U,1)
. S XMIREC=$G(^%ZISL(4.281,XMI,"T",1,0)) Q:XMIREC'?1"HELO ".E
. S XMCNT=XMCNT+1
. I XM["D" D DOTRAN^XMC1(42255,XMI,XMSITE) ;Loading entry #|1| from |2|
. S XMTASK=XMI,ER=0,XMLINE=.999,(XMC("BATCH"),XMC("TURN"),XMQUIET)=1
. D RECEIVE^XMR Q:ER
. N DA,DIK
. S DA=XMTASK,DIK="^%ZISL(4.281," D ^DIK
I XM["D" D
. I XMCNT D DOTRAN^XMC1(42257,XMC("R")) Q ;Messages received: |1|
. D DOTRAN^XMC1(42256,XMNETNAM) ;No entries found in file 4.281 for |1|
D KL^XMC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMCB 4011 printed Oct 16, 2024@18:11:57 Page 2
XMCB ;ISC-SF/GMB- Batch Message Transmission ;08/28/2003 10:11
+1 ;;8.0;MailMan;**22**;Jun 28, 2002
+2 ; Was (WASH ISC)/THM
+3 ;
+4 ; Entry points used by MailMan options (not covered by DBIA):
+5 ; TAPEOUT XMS-SEQ-TRANSMIT (was BAT^XMS)
+6 ; TAPEIN XMR-SEQ-RECEIVE (was BAT^XMR)
+7 ; GLBOUT XMR-UCI-SEND (was TASKER^XMS)
+8 ; GLBIN XMR-UCI-RCV (was TASKER^XMR)
+9 QUIT
TAPEOUT ; Write messages to tape.
+1 ; (Transmit them to another site via tape.)
+2 NEW XMC,XMCHAN,XMINST,XMSITE,XMABORT,ER
+3 SET XMABORT=0
SET XMCHAN="TAPE"
SET ER=0
SET XMC("BATCH")=1
+4 DO ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT,"M")
if XMABORT
QUIT
+5 DO OPEN^XML
if $GET(ER)!$GET(POP)
QUIT
+6 DO OUTDO
+7 DO KL^XMC
+8 QUIT
TAPEIN ; Read messages from tape.
+1 ; (Receive them from another site via tape.)
+2 NEW XM,XMC,XMCHAN,ER
+3 SET ER=0
SET (XMC("BATCH"),XMC("TURN"))=1
SET XMCHAN="T-IN"
+4 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D R^XMCTRAP"
+5 IF '$TEST
SET X="R^XMCTRAP"
SET @^%ZOSF("TRAP")
+6 DO ENT^XMR
+7 USE IO(0)
DO ^%ZISC
+8 ;Messages received: |1|
if '$DATA(ZTQUEUED)
WRITE !,$$EZBLD^DIALOG(42257,+$GET(XMC("R")))
+9 GOTO KL1^XMC
+10 QUIT
GLBOUT ; Write messages to a global.
+1 ; (Transmit them to another UCI via the global.)
+2 WRITE $CHAR(7),!!
+3 ;File 4.281 is not set up properly.
IF '$DATA(^%ZISL(4.281,0))
WRITE !!,$$EZBLD^DIALOG(42250)
QUIT
+4 NEW XMTEXT
+5 DO BLD^DIALOG(42251,"","","XMTEXT","F")
+6 DO MSG^DIALOG("WM","","","","XMTEXT")
+7 ; ******* I M P O R T A N T *******"
+8 ;This option transmits messages from one UCI to another via ^%ZISL(4.281.
+9 ;Each UCI must be running MailMan, and file 4.281 must be translated and
+10 ;accessible from both UCIs. In the two-step process, the messages are
+11 ;written to the global from one UCI, and read from it in the other.
+12 ;
+13 ;Invoke this option on the sending UCI, and select the domain whose
+14 ;messages are to be transmitted. (The domain name must be the exact
+15 ;name of the domain of the receiving UCI - no synonyms.) The messages
+16 ;are written to file 4.281 and deleted from the transmit queue.
+17 ;
+18 ;Log on to the receiving UCI and invoke the receiver. It will read all
+19 ;messages in file 4.281 which were sent to it (it can't read any
+20 ;messages sent to any other domain), and queue them to be delivered.
+21 ;The messages will then be deleted from file 4.281.
+22 NEW XMC,XMCHAN,XMLINE,XMFDA,XMIEN,XMIENS,XMABORT,XMINST,XMSITE,XMTASK,ER,Y
+23 SET XMCHAN="TASKER"
SET (XMABORT,XMLINE)=0
+24 DO ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT,"M")
if XMABORT
QUIT
+25 DO GET^XML
if $GET(ER)!$GET(POP)
QUIT
+26 SET XMFDA(4.281,"+1,",.01)=^XMB("NETNAME")
+27 DO UPDATE^DIE("","XMFDA","XMIEN")
+28 SET XMTASK=XMIEN(1)
+29 DO OUTDO
+30 SET XMIENS=XMTASK_","
+31 SET XMFDA(4.281,XMIENS,1)=XMSITE
+32 DO FILE^DIE("","XMFDA")
+33 DO KL^XMC
+34 QUIT
OUTDO ;
+1 NEW XM,XMDUZ
+2 USE IO(0)
+3 SET XM=""
SET (XMC("BATCH"),XMC("TURN"))=1
SET XMREC="Q"
+4 DO GET^XMCXT(0)
+5 ;Dumping messages now
WRITE !,$$EZBLD^DIALOG(42252)
+6 USE IO
+7 DO ENTER^XMS
+8 DO XMTFINIS^XMTDR(XMINST)
+9 USE IO(0)
+10 ;Messages dumped: |1|
IF $DATA(XMC("S"))
WRITE $CHAR(7)," ... ",$$EZBLD^DIALOG(42253,XMC("S"))
+11 XECUTE XMCLOSE
+12 QUIT
GLBIN ; Read messages from a global.
+1 ; (Receive them from another UCI via the global.)
+2 NEW XM,XMC,XMCHAN,XMDUZ,XMTASK,XMNETNAM,XMSITE,XMABORT,XMI,XMIREC,XMCNT,Y
+3 SET XM=$SELECT($DATA(ZTQUEUED):"",1:"D")
+4 SET XMNETNAM=^XMB("NETNAME")
SET XMABORT=0
SET XMCHAN="TASK-IN"
+5 DO GET^XML
if $GET(ER)
QUIT
+6 IF XM["D"
Begin DoDot:1
+7 DO GET^XMCXT(0)
+8 ;Receive messages for |1|
DO DOTRAN^XMC1(42254,XMNETNAM)
+9 DO PAGE^XMXUTIL(.XMABORT)
End DoDot:1
if XMABORT
QUIT
+10 SET (XMI,XMCNT)=0
+11 FOR
SET XMI=$ORDER(^%ZISL(4.281,"C",XMNETNAM,XMI))
if 'XMI
QUIT
Begin DoDot:1
+12 SET XMIREC=$GET(^%ZISL(4.281,XMI,0))
if XMIREC=""
QUIT
+13 if $PIECE(XMIREC,U,2)'=XMNETNAM
QUIT
+14 SET XMSITE=$PIECE(XMIREC,U,1)
+15 SET XMIREC=$GET(^%ZISL(4.281,XMI,"T",1,0))
if XMIREC'?1"HELO ".E
QUIT
+16 SET XMCNT=XMCNT+1
+17 ;Loading entry #|1| from |2|
IF XM["D"
DO DOTRAN^XMC1(42255,XMI,XMSITE)
+18 SET XMTASK=XMI
SET ER=0
SET XMLINE=.999
SET (XMC("BATCH"),XMC("TURN"),XMQUIET)=1
+19 DO RECEIVE^XMR
if ER
QUIT
+20 NEW DA,DIK
+21 SET DA=XMTASK
SET DIK="^%ZISL(4.281,"
DO ^DIK
End DoDot:1
if ER
QUIT
+22 IF XM["D"
Begin DoDot:1
+23 ;Messages received: |1|
IF XMCNT
DO DOTRAN^XMC1(42257,XMC("R"))
QUIT
+24 ;No entries found in file 4.281 for |1|
DO DOTRAN^XMC1(42256,XMNETNAM)
End DoDot:1
+25 DO KL^XMC
+26 QUIT
