XMCB.m

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 ---XMCB   4011     printed  Feb 18, 2025@23:37:24                                                                                                                                                                                                        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