XMCX ;ISC-SF/GMB-Play a Script / Queue Transmit Task ;12/04/2002 13:45
;;8.0;MailMan;**6,10**;Jun 28, 2002
; Was (WASH ISC)/THM
;
; Entry points used by MailMan options (not covered by DBIA):
; PLAY XMSCRIPTPLAY (was GO^XMC11)
; Q1 XMSTARTQUE (was Q^XMC2)
; QALL XMSTARTQUE-ALL (was REQUE^XMS5)
Q
PLAY ; Play a script
N XM,XMB,XMC,XMINST,XMSITE,XMIO,XMHOST,XMABORT
K XMTLER
S XM="D",XMABORT=0
D ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT) Q:XMABORT
D CHKTSK^XMCXU(XMINST,2,.XMABORT) Q:XMABORT
D ASKSCR^XMCXU(XMINST,XMSITE,.XMB,.XMABORT) Q:XMABORT
S XMIO=$P(XMB("SCR REC"),U,5)
AGAIN ;
D ENT^XMC1
I ER=25!($G(XMHOST)="NO-IP") D G:'XMABORT AGAIN
. N XMTEXT,XMIPSAVE
. I '$$USEDNS^XMKPR1 D Q
. . S XMABORT=1
. . ;DNS is not activated at this site, so you'll have to figure
. . ;out the correct IP address yourself.
. . D BLD^DIALOG(42263,"","","XMTEXT","F")
. . D MSG^DIALOG("WM","","","","XMTEXT")
. ;Let's see what we can do...
. ;We've tried these: |1|
. D BLD^DIALOG(42264,XMB("IP TRIED"),"","XMTEXT","F")
. D MSG^DIALOG("WM","","","","XMTEXT")
. S XMB("TRIES")=XMB("TRIES")+1
. S XMIPSAVE=XMB("IP TRIED"),XMC("PLAY")=1
. D NEXTIP^XMKPR1(XMSITE,.XMB) K XMC("PLAY")
. I XMIPSAVE=XMB("IP TRIED") D Q
. . S XMABORT=1
. . ;The DNS did not return any other addresses to try. Sorry!
. . D BLD^DIALOG(42265,"","","XMTEXT","F")
. . D MSG^DIALOG("WM","","","","XMTEXT")
. W !,$$EZBLD^DIALOG(42266,$P(XMB("SCR REC"),U,6)) ;Now, let's try: |1|
. K ER,XMER
I 'XMABORT,'ER S XMC("PLAY")=1 D CHKSETIP^XMTDR(XMINST,XMSITE,.XMB)
D KL^XMC
Q
Q1 ; Trigger a queue for transmission
N XMB,XMINST,XMSITE,XMTSK,XMABORT
S XMABORT=0 ; pick a queue w/msgs
D ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT,"M") Q:XMABORT
D CHKTSK^XMCXU(XMINST,1,.XMABORT) Q:XMABORT
D ASKSCR^XMCXU(XMINST,XMSITE,.XMB,.XMABORT) Q:XMABORT
D QUEUE(XMINST,XMSITE,.XMB)
Q
TASK ;
QALL ;
N XMDUZ,XMK,XMIEN,XMSITE
S:$D(ZTQUEUED) ZTREQ="@"
D RESEQ^XMCQA
K ^TMP("XM",$J)
S XMK=1000
F S XMK=$O(^XMB(3.7,.5,2,XMK)) Q:'XMK Q:XMK>9999 D
. Q:'$$BMSGCT^XMXUTIL(.5,XMK)
. W:'$D(ZTQUEUED) "."
. S XMIEN=XMK-1000
. S:'$$TSKEXIST^XMKPR(XMIEN) ^TMP("XM",$J,$P(^DIC(4.2,XMIEN,0),U))=XMIEN
I '$D(^TMP("XM",$J)) D Q
. W:'$D(ZTQUEUED) !!,$$EZBLD^DIALOG(42125) ;All queues with messages have tasks.
I '$D(ZTQUEUED) D Q:'$D(^TMP("XM",$J))
. W:$E($G(IOST),1,2)="C-" @IOF
. W !,$$EZBLD^DIALOG(42126),! ;These queues with messages have no tasks:
. S XMSITE=""
. F S XMSITE=$O(^TMP("XM",$J,XMSITE)) Q:XMSITE="" D
. . I $Y+3>IOSL D
. . . D WAIT^XMXUTIL
. . . W @IOF
. . S XMIEN=^TMP("XM",$J,XMSITE)
. . W !,$E(XMSITE,1,37)
. . Q:$P(^DIC(4.2,XMIEN,0),U,2)["S"
. . W ?40,$$EZBLD^DIALOG(42127) ;No Send Flag - Will not task
. . K ^TMP("XM",$J,XMSITE)
. Q:'$D(^TMP("XM",$J))
. N DIR
. S DIR(0)="YO"
. S DIR("A")=$$EZBLD^DIALOG(42128) ;Requeue the missing tasks
. S DIR("B")=$$EZBLD^DIALOG(39053) ;No
. D BLD^DIALOG(42129,"","","DIR(""?"")") ;Answer YES to create tasks to transmit these queues.
. D ^DIR Q:Y
. W !!,$$EZBLD^DIALOG(42130) ;Tasks not requeued.
. K ^TMP("XM",$J)
S XMSITE=""
F S XMSITE=$O(^TMP("XM",$J,XMSITE)) Q:XMSITE="" D
. S XMIEN=^TMP("XM",$J,XMSITE)
. I $$UP^XLFSTR($P(^DIC(4.2,XMIEN,0),U,2))'["S" D Q
. . W:'$D(ZTQUEUED) !,$E(XMSITE,1,37),?40,$$EZBLD^DIALOG(42127) ;No Send Flag - Will not task
. D QUEUE(XMIEN,XMSITE)
W:'$D(ZTQUEUED) !,$$EZBLD^DIALOG(42132) ;Finished.
K ^TMP("XM",$J)
Q
QUEUE(XMINST,XMSITE,XMB,XMWHEN,XMTSK) ;
D QUEUE^XMKPR(XMINST,XMSITE,.XMB,.XMWHEN,.XMTSK) Q:$D(ZTQUEUED)
W !,$E(XMSITE,1,37),?40,$$EZBLD^DIALOG($S($D(XMTSK):42131,1:39311),$G(XMTSK)) ;Task |1| queued / Task creation failed
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMCX 3773 printed Sep 23, 2025@19:47:24 Page 2
XMCX ;ISC-SF/GMB-Play a Script / Queue Transmit Task ;12/04/2002 13:45
+1 ;;8.0;MailMan;**6,10**;Jun 28, 2002
+2 ; Was (WASH ISC)/THM
+3 ;
+4 ; Entry points used by MailMan options (not covered by DBIA):
+5 ; PLAY XMSCRIPTPLAY (was GO^XMC11)
+6 ; Q1 XMSTARTQUE (was Q^XMC2)
+7 ; QALL XMSTARTQUE-ALL (was REQUE^XMS5)
+8 QUIT
PLAY ; Play a script
+1 NEW XM,XMB,XMC,XMINST,XMSITE,XMIO,XMHOST,XMABORT
+2 KILL XMTLER
+3 SET XM="D"
SET XMABORT=0
+4 DO ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT)
if XMABORT
QUIT
+5 DO CHKTSK^XMCXU(XMINST,2,.XMABORT)
if XMABORT
QUIT
+6 DO ASKSCR^XMCXU(XMINST,XMSITE,.XMB,.XMABORT)
if XMABORT
QUIT
+7 SET XMIO=$PIECE(XMB("SCR REC"),U,5)
AGAIN ;
+1 DO ENT^XMC1
+2 IF ER=25!($GET(XMHOST)="NO-IP")
Begin DoDot:1
+3 NEW XMTEXT,XMIPSAVE
+4 IF '$$USEDNS^XMKPR1
Begin DoDot:2
+5 SET XMABORT=1
+6 ;DNS is not activated at this site, so you'll have to figure
+7 ;out the correct IP address yourself.
+8 DO BLD^DIALOG(42263,"","","XMTEXT","F")
+9 DO MSG^DIALOG("WM","","","","XMTEXT")
End DoDot:2
QUIT
+10 ;Let's see what we can do...
+11 ;We've tried these: |1|
+12 DO BLD^DIALOG(42264,XMB("IP TRIED"),"","XMTEXT","F")
+13 DO MSG^DIALOG("WM","","","","XMTEXT")
+14 SET XMB("TRIES")=XMB("TRIES")+1
+15 SET XMIPSAVE=XMB("IP TRIED")
SET XMC("PLAY")=1
+16 DO NEXTIP^XMKPR1(XMSITE,.XMB)
KILL XMC("PLAY")
+17 IF XMIPSAVE=XMB("IP TRIED")
Begin DoDot:2
+18 SET XMABORT=1
+19 ;The DNS did not return any other addresses to try. Sorry!
+20 DO BLD^DIALOG(42265,"","","XMTEXT","F")
+21 DO MSG^DIALOG("WM","","","","XMTEXT")
End DoDot:2
QUIT
+22 ;Now, let's try: |1|
WRITE !,$$EZBLD^DIALOG(42266,$PIECE(XMB("SCR REC"),U,6))
+23 KILL ER,XMER
End DoDot:1
if 'XMABORT
GOTO AGAIN
+24 IF 'XMABORT
IF 'ER
SET XMC("PLAY")=1
DO CHKSETIP^XMTDR(XMINST,XMSITE,.XMB)
+25 DO KL^XMC
+26 QUIT
Q1 ; Trigger a queue for transmission
+1 NEW XMB,XMINST,XMSITE,XMTSK,XMABORT
+2 ; pick a queue w/msgs
SET XMABORT=0
+3 DO ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT,"M")
if XMABORT
QUIT
+4 DO CHKTSK^XMCXU(XMINST,1,.XMABORT)
if XMABORT
QUIT
+5 DO ASKSCR^XMCXU(XMINST,XMSITE,.XMB,.XMABORT)
if XMABORT
QUIT
+6 DO QUEUE(XMINST,XMSITE,.XMB)
+7 QUIT
TASK ;
QALL ;
+1 NEW XMDUZ,XMK,XMIEN,XMSITE
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 DO RESEQ^XMCQA
+4 KILL ^TMP("XM",$JOB)
+5 SET XMK=1000
+6 FOR
SET XMK=$ORDER(^XMB(3.7,.5,2,XMK))
if 'XMK
QUIT
if XMK>9999
QUIT
Begin DoDot:1
+7 if '$$BMSGCT^XMXUTIL(.5,XMK)
QUIT
+8 if '$DATA(ZTQUEUED)
WRITE "."
+9 SET XMIEN=XMK-1000
+10 if '$$TSKEXIST^XMKPR(XMIEN)
SET ^TMP("XM",$JOB,$PIECE(^DIC(4.2,XMIEN,0),U))=XMIEN
End DoDot:1
+11 IF '$DATA(^TMP("XM",$JOB))
Begin DoDot:1
+12 ;All queues with messages have tasks.
if '$DATA(ZTQUEUED)
WRITE !!,$$EZBLD^DIALOG(42125)
End DoDot:1
QUIT
+13 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+14 if $EXTRACT($GET(IOST),1,2)="C-"
WRITE @IOF
+15 ;These queues with messages have no tasks:
WRITE !,$$EZBLD^DIALOG(42126),!
+16 SET XMSITE=""
+17 FOR
SET XMSITE=$ORDER(^TMP("XM",$JOB,XMSITE))
if XMSITE=""
QUIT
Begin DoDot:2
+18 IF $Y+3>IOSL
Begin DoDot:3
+19 DO WAIT^XMXUTIL
+20 WRITE @IOF
End DoDot:3
+21 SET XMIEN=^TMP("XM",$JOB,XMSITE)
+22 WRITE !,$EXTRACT(XMSITE,1,37)
+23 if $PIECE(^DIC(4.2,XMIEN,0),U,2)["S"
QUIT
+24 ;No Send Flag - Will not task
WRITE ?40,$$EZBLD^DIALOG(42127)
+25 KILL ^TMP("XM",$JOB,XMSITE)
End DoDot:2
+26 if '$DATA(^TMP("XM",$JOB))
QUIT
+27 NEW DIR
+28 SET DIR(0)="YO"
+29 ;Requeue the missing tasks
SET DIR("A")=$$EZBLD^DIALOG(42128)
+30 ;No
SET DIR("B")=$$EZBLD^DIALOG(39053)
+31 ;Answer YES to create tasks to transmit these queues.
DO BLD^DIALOG(42129,"","","DIR(""?"")")
+32 DO ^DIR
if Y
QUIT
+33 ;Tasks not requeued.
WRITE !!,$$EZBLD^DIALOG(42130)
+34 KILL ^TMP("XM",$JOB)
End DoDot:1
if '$DATA(^TMP("XM",$JOB))
QUIT
+35 SET XMSITE=""
+36 FOR
SET XMSITE=$ORDER(^TMP("XM",$JOB,XMSITE))
if XMSITE=""
QUIT
Begin DoDot:1
+37 SET XMIEN=^TMP("XM",$JOB,XMSITE)
+38 IF $$UP^XLFSTR($PIECE(^DIC(4.2,XMIEN,0),U,2))'["S"
Begin DoDot:2
+39 ;No Send Flag - Will not task
if '$DATA(ZTQUEUED)
WRITE !,$EXTRACT(XMSITE,1,37),?40,$$EZBLD^DIALOG(42127)
End DoDot:2
QUIT
+40 DO QUEUE(XMIEN,XMSITE)
End DoDot:1
+41 ;Finished.
if '$DATA(ZTQUEUED)
WRITE !,$$EZBLD^DIALOG(42132)
+42 KILL ^TMP("XM",$JOB)
+43 QUIT
QUEUE(XMINST,XMSITE,XMB,XMWHEN,XMTSK) ;
+1 DO QUEUE^XMKPR(XMINST,XMSITE,.XMB,.XMWHEN,.XMTSK)
if $DATA(ZTQUEUED)
QUIT
+2 ;Task |1| queued / Task creation failed
WRITE !,$EXTRACT(XMSITE,1,37),?40,$$EZBLD^DIALOG($SELECT($DATA(XMTSK):42131,1:39311),$GET(XMTSK))
+3 QUIT
