XMCP.m

XMCP ;ISC-SF/GMB-Poll Domains ;08/29/2002  13:12

 ;;8.0;MailMan;**4**;Jun 28, 2002

 ; Was (WASH ISC)/CAP/RM/AML/THM

 ;

 ; Entry points used by MailMan options (not covered by DBIA):

 ; POLL   XMPOLL     (was POLL^XMS1 and TSKPOLR^XMS5B)

 ;

 ; This option may be SCHEDULED.

 ; It goes through a list of domains whose FLAGS field contains P,

 ; meaning that the domains are to be "polled", that they should be

 ; contacted whether or not there are messages in their queues.

 ; If no messages are in the queues, the script for the poll domain

 ; will be 'played' anyway, and the TURN command executed to pull in

 ; any messages which may be waiting to be transmitted to this domain.

 ;

POLL ; Process domains on poll list.

 S:$D(ZTQUEUED) ZTREQ="@"

 K ^TMP("XM",$J)

 I $$GOTTASKS W:'$D(ZTQUEUED) !!,$$EZBLD^DIALOG(42150) Q  ;All domains have tasks.

 I $$XMITOK D TASKXMIT

 K ^TMP("XM",$J)

 Q

GOTTASKS() ; Does every poll site have a task?

 N XMTSK,XMINST,XMSITE,XMPARM

 S XMINST=0

 F  S XMINST=$O(^DIC(4.2,"AC","P",XMINST)) Q:'XMINST  D

 . W:'$D(ZTQUEUED) "."

 . S XMSITE=$P(^DIC(4.2,XMINST,0),U)

 . S XMTSK=$$GETTSK^XMKPR(XMINST)

 . I XMTSK,'$$TSKEXIST^XMKPR(XMINST,XMTSK) S ^TMP("XM",$J,XMSITE)=XMINST Q

 . Q:$D(ZTQUEUED)

 . S XMPARM(1)=XMTSK,XMPARM(2)=XMSITE

 . W !,$$EZBLD^DIALOG(42151,.XMPARM) ;Task |1| is already scheduled for domain |2|

 Q '$D(^TMP("XM",$J))

XMITOK() ; Ask whether eligible queues should be transmitted.

 N DIR,DIRUT,DTOUT,DUOUT,X,Y,XMSITE

 I $D(ZTQUEUED) Q 1

 W @IOF,$$EZBLD^DIALOG(42152) ;These domains lack tasks:

 S XMSITE=""

 F  S XMSITE=$O(^TMP("XM",$J,XMSITE)) Q:XMSITE=""  D

 . I $Y+4>IOSL D

 . . D WAIT^XMXUTIL

 . . W @IOF

 . W !?5,XMSITE

 S DIR(0)="YO"

 S DIR("A")=$$EZBLD^DIALOG(42128) ;Requeue the missing tasks

 S DIR("B")=$$EZBLD^DIALOG(39053) ;NO

 S DIR("?")=$$EZBLD^DIALOG(42153) ;Answer YES to transmit these domains.

 D ^DIR

 I 'Y W !!,$$EZBLD^DIALOG(42130) ;Tasks not requeued.

 Q Y

TASKXMIT ;

 ; Task off transmission jobs

 N XMINST,XMSITE,XMPOLL

 I '$D(ZTQUEUED) W !

 S XMSITE="",XMPOLL=1

 F  S XMSITE=$O(^TMP("XM",$J,XMSITE)) Q:XMSITE=""  S XMINST=^(XMSITE) D

 . D QUEUE^XMCX(XMINST,XMSITE)

 W:'$D(ZTQUEUED) !,$$EZBLD^DIALOG(42132) ; Finished.

 Q

XMCP      ;ISC-SF/GMB-Poll Domains ;08/29/2002  13:12

 +1       ;;8.0;MailMan;**4**;Jun 28, 2002

 +2       ; Was (WASH ISC)/CAP/RM/AML/THM

 +3       ;

 +4       ; Entry points used by MailMan options (not covered by DBIA):

 +5       ; POLL   XMPOLL     (was POLL^XMS1 and TSKPOLR^XMS5B)

 +6       ;

 +7       ; This option may be SCHEDULED.

 +8       ; It goes through a list of domains whose FLAGS field contains P,

 +9       ; meaning that the domains are to be "polled", that they should be

 +10      ; contacted whether or not there are messages in their queues.

 +11      ; If no messages are in the queues, the script for the poll domain

 +12      ; will be 'played' anyway, and the TURN command executed to pull in

 +13      ; any messages which may be waiting to be transmitted to this domain.

 +14      ;

POLL      ; Process domains on poll list.

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        KILL ^TMP("XM",$JOB)

 +3       ;All domains have tasks.

           IF $$GOTTASKS

               IF '$DATA(ZTQUEUED)

                   WRITE !!,$$EZBLD^DIALOG(42150)

               QUIT 

 +4        IF $$XMITOK

               DO TASKXMIT

 +5        KILL ^TMP("XM",$JOB)

 +6        QUIT 

GOTTASKS() ; Does every poll site have a task?

 +1        NEW XMTSK,XMINST,XMSITE,XMPARM

 +2        SET XMINST=0

 +3        FOR 

               SET XMINST=$ORDER(^DIC(4.2,"AC","P",XMINST))

               IF 'XMINST

                   QUIT 

               Begin DoDot:1

 +4                IF '$DATA(ZTQUEUED)

                       WRITE "."

 +5                SET XMSITE=$PIECE(^DIC(4.2,XMINST,0),U)

 +6                SET XMTSK=$$GETTSK^XMKPR(XMINST)

 +7                IF XMTSK

                       IF '$$TSKEXIST^XMKPR(XMINST,XMTSK)

                           SET ^TMP("XM",$JOB,XMSITE)=XMINST

                           QUIT 

 +8                IF $DATA(ZTQUEUED)

                       QUIT 

 +9                SET XMPARM(1)=XMTSK

                   SET XMPARM(2)=XMSITE

 +10      ;Task |1| is already scheduled for domain |2|

                   WRITE !,$$EZBLD^DIALOG(42151,.XMPARM)

               End DoDot:1

 +11       QUIT '$DATA(^TMP("XM",$JOB))

XMITOK()  ; Ask whether eligible queues should be transmitted.

 +1        NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,XMSITE

 +2        IF $DATA(ZTQUEUED)

               QUIT 1

 +3       ;These domains lack tasks:

           WRITE @IOF,$$EZBLD^DIALOG(42152)

 +4        SET XMSITE=""

 +5        FOR 

               SET XMSITE=$ORDER(^TMP("XM",$JOB,XMSITE))

               IF XMSITE=""

                   QUIT 

               Begin DoDot:1

 +6                IF $Y+4>IOSL

                       Begin DoDot:2

 +7                        DO WAIT^XMXUTIL

 +8                        WRITE @IOF

                       End DoDot:2

 +9                WRITE !?5,XMSITE

               End DoDot:1

 +10       SET DIR(0)="YO"

 +11      ;Requeue the missing tasks

           SET DIR("A")=$$EZBLD^DIALOG(42128)

 +12      ;NO

           SET DIR("B")=$$EZBLD^DIALOG(39053)

 +13      ;Answer YES to transmit these domains.

           SET DIR("?")=$$EZBLD^DIALOG(42153)

 +14       DO ^DIR

 +15      ;Tasks not requeued.

           IF 'Y

               WRITE !!,$$EZBLD^DIALOG(42130)

 +16       QUIT Y

TASKXMIT  ;

 +1       ; Task off transmission jobs

 +2        NEW XMINST,XMSITE,XMPOLL

 +3        IF '$DATA(ZTQUEUED)

               WRITE !

 +4        SET XMSITE=""

           SET XMPOLL=1

 +5        FOR 

               SET XMSITE=$ORDER(^TMP("XM",$JOB,XMSITE))

               IF XMSITE=""

                   QUIT 

               SET XMINST=^(XMSITE)

               Begin DoDot:1

 +6                DO QUEUE^XMCX(XMINST,XMSITE)

               End DoDot:1

 +7       ; Finished.

           IF '$DATA(ZTQUEUED)

               WRITE !,$$EZBLD^DIALOG(42132)

 +8        QUIT