source: FOIAVistA/tag/r/MAILMAN-XM/XMCB.m@ 1326

Last change on this file since 1326 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1XMCB ;ISC-SF/GMB- Batch Message Transmission ;08/28/2003 10:11
2 ;;8.0;MailMan;**22**;Jun 28, 2002
3 ; Was (WASH ISC)/THM
4 ;
5 ; Entry points used by MailMan options (not covered by DBIA):
6 ; TAPEOUT XMS-SEQ-TRANSMIT (was BAT^XMS)
7 ; TAPEIN XMR-SEQ-RECEIVE (was BAT^XMR)
8 ; GLBOUT XMR-UCI-SEND (was TASKER^XMS)
9 ; GLBIN XMR-UCI-RCV (was TASKER^XMR)
10 Q
11TAPEOUT ; Write messages to tape.
12 ; (Transmit them to another site via tape.)
13 N XMC,XMCHAN,XMINST,XMSITE,XMABORT,ER
14 S XMABORT=0,XMCHAN="TAPE",ER=0,XMC("BATCH")=1
15 D ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT,"M") Q:XMABORT
16 D OPEN^XML Q:$G(ER)!$G(POP)
17 D OUTDO
18 D KL^XMC
19 Q
20TAPEIN ; Read messages from tape.
21 ; (Receive them from another site via tape.)
22 N XM,XMC,XMCHAN,ER
23 S ER=0,(XMC("BATCH"),XMC("TURN"))=1,XMCHAN="T-IN"
24 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D R^XMCTRAP"
25 E S X="R^XMCTRAP",@^%ZOSF("TRAP")
26 D ENT^XMR
27 U IO(0) D ^%ZISC
28 W:'$D(ZTQUEUED) !,$$EZBLD^DIALOG(42257,+$G(XMC("R"))) ;Messages received: |1|
29 G KL1^XMC
30 Q
31GLBOUT ; Write messages to a global.
32 ; (Transmit them to another UCI via the global.)
33 W $C(7),!!
34 I '$D(^%ZISL(4.281,0)) W !!,$$EZBLD^DIALOG(42250) Q ;File 4.281 is not set up properly.
35 N XMTEXT
36 D BLD^DIALOG(42251,"","","XMTEXT","F")
37 D MSG^DIALOG("WM","","","","XMTEXT")
38 ; ******* I M P O R T A N T *******"
39 ;This option transmits messages from one UCI to another via ^%ZISL(4.281.
40 ;Each UCI must be running MailMan, and file 4.281 must be translated and
41 ;accessible from both UCIs. In the two-step process, the messages are
42 ;written to the global from one UCI, and read from it in the other.
43 ;
44 ;Invoke this option on the sending UCI, and select the domain whose
45 ;messages are to be transmitted. (The domain name must be the exact
46 ;name of the domain of the receiving UCI - no synonyms.) The messages
47 ;are written to file 4.281 and deleted from the transmit queue.
48 ;
49 ;Log on to the receiving UCI and invoke the receiver. It will read all
50 ;messages in file 4.281 which were sent to it (it can't read any
51 ;messages sent to any other domain), and queue them to be delivered.
52 ;The messages will then be deleted from file 4.281.
53 N XMC,XMCHAN,XMLINE,XMFDA,XMIEN,XMIENS,XMABORT,XMINST,XMSITE,XMTASK,ER,Y
54 S XMCHAN="TASKER",(XMABORT,XMLINE)=0
55 D ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT,"M") Q:XMABORT
56 D GET^XML Q:$G(ER)!$G(POP)
57 S XMFDA(4.281,"+1,",.01)=^XMB("NETNAME")
58 D UPDATE^DIE("","XMFDA","XMIEN")
59 S XMTASK=XMIEN(1)
60 D OUTDO
61 S XMIENS=XMTASK_","
62 S XMFDA(4.281,XMIENS,1)=XMSITE
63 D FILE^DIE("","XMFDA")
64 D KL^XMC
65 Q
66OUTDO ;
67 N XM,XMDUZ
68 U IO(0)
69 S XM="",(XMC("BATCH"),XMC("TURN"))=1,XMREC="Q"
70 D GET^XMCXT(0)
71 W !,$$EZBLD^DIALOG(42252) ;Dumping messages now
72 U IO
73 D ENTER^XMS
74 D XMTFINIS^XMTDR(XMINST)
75 U IO(0)
76 I $D(XMC("S")) W $C(7)," ... ",$$EZBLD^DIALOG(42253,XMC("S")) ;Messages dumped: |1|
77 X XMCLOSE
78 Q
79GLBIN ; Read messages from a global.
80 ; (Receive them from another UCI via the global.)
81 N XM,XMC,XMCHAN,XMDUZ,XMTASK,XMNETNAM,XMSITE,XMABORT,XMI,XMIREC,XMCNT,Y
82 S XM=$S($D(ZTQUEUED):"",1:"D")
83 S XMNETNAM=^XMB("NETNAME"),XMABORT=0,XMCHAN="TASK-IN"
84 D GET^XML Q:$G(ER)
85 I XM["D" D Q:XMABORT
86 . D GET^XMCXT(0)
87 . D DOTRAN^XMC1(42254,XMNETNAM) ;Receive messages for |1|
88 . D PAGE^XMXUTIL(.XMABORT)
89 S (XMI,XMCNT)=0
90 F S XMI=$O(^%ZISL(4.281,"C",XMNETNAM,XMI)) Q:'XMI D Q:ER
91 . S XMIREC=$G(^%ZISL(4.281,XMI,0)) Q:XMIREC=""
92 . Q:$P(XMIREC,U,2)'=XMNETNAM
93 . S XMSITE=$P(XMIREC,U,1)
94 . S XMIREC=$G(^%ZISL(4.281,XMI,"T",1,0)) Q:XMIREC'?1"HELO ".E
95 . S XMCNT=XMCNT+1
96 . I XM["D" D DOTRAN^XMC1(42255,XMI,XMSITE) ;Loading entry #|1| from |2|
97 . S XMTASK=XMI,ER=0,XMLINE=.999,(XMC("BATCH"),XMC("TURN"),XMQUIET)=1
98 . D RECEIVE^XMR Q:ER
99 . N DA,DIK
100 . S DA=XMTASK,DIK="^%ZISL(4.281," D ^DIK
101 I XM["D" D
102 . I XMCNT D DOTRAN^XMC1(42257,XMC("R")) Q ;Messages received: |1|
103 . D DOTRAN^XMC1(42256,XMNETNAM) ;No entries found in file 4.281 for |1|
104 D KL^XMC
105 Q
Note: See TracBrowser for help on using the repository browser.