XMKPLQ.m

XMKPLQ ;ISC-SF/GMB-Post local msgs to correct queues ;07/28/2000  14:34

 ;;8.0;MailMan;;Jun 28, 2002

 ; Replaces ^XMADJF0, ZTSK^XMADGO (ISC-WASH/CAP)

GO ;

 ; Variables provided through TASKMAN:  XMHANG

 N XMACTIVE,XMUID,XMQLIST,XMTSTAMP,XMGROUP,XMCNT,XMQUEUE,XMREC

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

 L +^XMBPOST("POST_Mover"):1 E  Q

 I $D(ZTQUEUED) S %=$$PSET^%ZTLOAD(ZTSK)

 S XMACTIVE=$$TSTAMP^XMXUTIL1

 F  D  Q:$P($G(^XMB(1,1,0)),U,16)

 . D GETQ(.XMQLIST) ; Get new parameters for grouping

 . S XMTSTAMP=""

 . F  S XMTSTAMP=$O(^XMBPOST("BOX",XMTSTAMP)) Q:XMTSTAMP=""  D  Q:$$TSTAMP^XMXUTIL1-XMACTIVE>30

 . . S XMGROUP=""

 . . F  S XMGROUP=$O(^XMBPOST("BOX",XMTSTAMP,XMGROUP)) Q:XMGROUP=""  D

 . . . S XMUID=0

 . . . F  S XMUID=$O(^XMBPOST("BOX",XMTSTAMP,XMGROUP,XMUID)) Q:XMUID=""  S XMREC=^(XMUID)  D

 . . . . S XMCNT=+XMREC

 . . . . S XMQUEUE=$$WHICHQ(XMQLIST(XMGROUP),XMCNT)

 . . . . I XMGROUP="M" D

 . . . . . D MQUEUE(XMTSTAMP,XMUID,XMQUEUE,XMREC)

 . . . . E  D

 . . . . . D RQUEUE(XMTSTAMP,XMUID,XMQUEUE,XMREC)

 . . . . D STATS(XMGROUP,XMQUEUE,XMCNT)

 . . . . K ^XMBPOST("BOX",XMTSTAMP,XMGROUP,XMUID)

 . I $$TSTAMP^XMXUTIL1-XMACTIVE>30 D  Q

 . . D ZTSK

 . . S XMACTIVE=$$TSTAMP^XMXUTIL1

 . H XMHANG

 L -^XMBPOST("POST_Mover")

 I $D(ZTQUEUED) D PCLEAR^%ZTLOAD(ZTSK)

 Q

GETQ(XMQLIST) ;

 N X

 S X=$G(^XMB(1,1,6))

 S XMQLIST("M")=$P(X,U),XMQLIST("R")=$P(X,U,2)

 Q

WHICHQ(XMQLIST,XMCNT) ;

 N XMQUEUE,XMQLEN

 I XMQLIST'["," Q 1

 S XMQLEN=$L(XMQLIST,",")

 F XMQUEUE=1:1:$L(XMQLIST,",") Q:XMCNT<$P(XMQLIST,",",XMQUEUE)

 Q $S(XMCNT<$P(XMQLIST,",",XMQUEUE):XMQUEUE,1:XMQUEUE+1)

RQUEUE(XMTSTAMP,XMUID,XMQUEUE,XMREC) ; Put replies into queue

 N XMZ,XMTSQ

 ;If the response is already in the queue, find out its Timestamp

 ;and file the new response right next to it.

 S XMZ=$P(XMUID,U,1)

 S XMTSQ=$O(^XMBPOST("R",XMQUEUE,"B",XMZ,0))

 I XMTSQ S XMTSTAMP=XMTSQ

 E  S ^XMBPOST("R",XMQUEUE,"B",XMZ,XMTSTAMP)=""

 S ^XMBPOST("R",XMQUEUE,XMTSTAMP,XMZ,$P(XMUID,U,2))=XMREC

 Q

MQUEUE(XMTSTAMP,XMUID,XMQUEUE,XMREC) ; Put new & forwarded messages into queue

 S ^XMBPOST("M",XMQUEUE,XMTSTAMP,XMUID)=XMREC

 Q

STATS(XMGROUP,XMQUEUE,XMCNT) ;

 N XMSTATS

 L +^XMBPOST("QSTATS",XMGROUP,XMQUEUE)

 S XMSTATS=$G(^XMBPOST(XMGROUP,XMQUEUE)),^(XMQUEUE)=($P(XMSTATS,U,1)+1)_U_($P(XMSTATS,U,2)+XMCNT)

 L -^XMBPOST("QSTATS",XMGROUP,XMQUEUE)

 Q

ZTSK ; START Delivery Background Processes

 Q:$P(^XMB(1,1,0),U,16)  ;Quit if Background Filer Stop Flag

 N XMGROUP,XMQUEUE,ZTRTN,ZTSAVE,ZTDESC

 F XMGROUP="M","R" D  ; Check each queue for messages

 . S XMQUEUE=""

 . F  S XMQUEUE=$O(^XMBPOST(XMGROUP,XMQUEUE)) Q:XMQUEUE'>0  D

 . . Q:$D(^XMBPOST(XMGROUP,XMQUEUE))<10  ; Quit if nothing in queue

 . . L +^XMBPOST(XMGROUP,XMQUEUE):1 E  Q  ; If node locked, there is already one running

 . . S (ZTSAVE("XMGROUP"),ZTSAVE("XMQUEUE"),ZTSAVE("XMHANG"))=""

 . . S ZTDESC=$$EZBLD^DIALOG($S(XMGROUP="M":36230,1:36231),XMQUEUE) ; MailMan: Message/Response Delivery Queue |1|

 . . S ZTRTN="GO^XMTDL"

 . . D TASKIT(ZTRTN,ZTDESC,.ZTSAVE) H 0 ; Start a job, Give TaskMan a chance to start it (hang)

 . . L -^XMBPOST(XMGROUP,XMQUEUE)

 Q

TASKIT(ZTRTN,ZTDESC,ZTSAVE) ;

 N X,ZTSK,ZTQUEUED,ZTCPU,ZTDTH,ZTIO

 I '$D(ZTCPU),$D(^XMB(1,1,0)) S X=$P(^(0),U,12) I X'="" S ZTCPU=$P(X,",",2)

 S ZTIO="",ZTDTH=$H

 D ^%ZTLOAD

 Q

JOB ;Start background filer when TaskMan can't

JOBGO S IO="",IO(0)="" D DT^DICRW G GO^XMTDL

 Q

CHKQ ; Input transform for file 4.3, fields 241 and 242

 K:$L(X)>120!($L(X)<1) X Q:'$D(X)

 K:X'?1.N.9(1","1.N) X Q:'$D(X)

 N I

 F I=1:1:$L(X,",")-1 I $P(X,",",I)'<$P(X,",",I+1) K X Q

 Q

HELPQ ; Executable help for file 4.3, fields 241 and 242

 ;You determine the number of delivery queues (10 max.) ...

 N XMTEXT

 D BLD^DIALOG(36232,"","","XMTEXT","F")

 D MSG^DIALOG("WM","",79,"","XMTEXT")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XMKPLQ   3840     printed  Mar 13, 2025@21:17:03                                                                                                                                                                                                      Page 2

XMKPLQ    ;ISC-SF/GMB-Post local msgs to correct queues ;07/28/2000  14:34

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

 +2       ; Replaces ^XMADJF0, ZTSK^XMADGO (ISC-WASH/CAP)

GO        ;

 +1       ; Variables provided through TASKMAN:  XMHANG

 +2        NEW XMACTIVE,XMUID,XMQLIST,XMTSTAMP,XMGROUP,XMCNT,XMQUEUE,XMREC

 +3        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +4        LOCK +^XMBPOST("POST_Mover"):1

          IF '$TEST

               QUIT 

 +5        IF $DATA(ZTQUEUED)

               SET %=$$PSET^%ZTLOAD(ZTSK)

 +6        SET XMACTIVE=$$TSTAMP^XMXUTIL1

 +7        FOR 

               Begin DoDot:1

 +8       ; Get new parameters for grouping

                   DO GETQ(.XMQLIST)

 +9                SET XMTSTAMP=""

 +10               FOR 

                       SET XMTSTAMP=$ORDER(^XMBPOST("BOX",XMTSTAMP))

                       if XMTSTAMP=""

                           QUIT 

                       Begin DoDot:2

 +11                       SET XMGROUP=""

 +12                       FOR 

                               SET XMGROUP=$ORDER(^XMBPOST("BOX",XMTSTAMP,XMGROUP))

                               if XMGROUP=""

                                   QUIT 

                               Begin DoDot:3

 +13                               SET XMUID=0

 +14                               FOR 

                                       SET XMUID=$ORDER(^XMBPOST("BOX",XMTSTAMP,XMGROUP,XMUID))

                                       if XMUID=""

                                           QUIT 

                                       SET XMREC=^(XMUID)

                                       Begin DoDot:4

 +15                                       SET XMCNT=+XMREC

 +16                                       SET XMQUEUE=$$WHICHQ(XMQLIST(XMGROUP),XMCNT)

 +17                                       IF XMGROUP="M"

                                               Begin DoDot:5

 +18                                               DO MQUEUE(XMTSTAMP,XMUID,XMQUEUE,XMREC)

                                               End DoDot:5

 +19                                      IF '$TEST

                                               Begin DoDot:5

 +20                                               DO RQUEUE(XMTSTAMP,XMUID,XMQUEUE,XMREC)

                                               End DoDot:5

 +21                                       DO STATS(XMGROUP,XMQUEUE,XMCNT)

 +22                                       KILL ^XMBPOST("BOX",XMTSTAMP,XMGROUP,XMUID)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

                       if $$TSTAMP^XMXUTIL1-XMACTIVE>30

                           QUIT 

 +23               IF $$TSTAMP^XMXUTIL1-XMACTIVE>30

                       Begin DoDot:2

 +24                       DO ZTSK

 +25                       SET XMACTIVE=$$TSTAMP^XMXUTIL1

                       End DoDot:2

                       QUIT 

 +26               HANG XMHANG

               End DoDot:1

               if $PIECE($GET(^XMB(1,1,0)),U,16)

                   QUIT 

 +27       LOCK -^XMBPOST("POST_Mover")

 +28       IF $DATA(ZTQUEUED)

               DO PCLEAR^%ZTLOAD(ZTSK)

 +29       QUIT 

GETQ(XMQLIST) ;

 +1        NEW X

 +2        SET X=$GET(^XMB(1,1,6))

 +3        SET XMQLIST("M")=$PIECE(X,U)

           SET XMQLIST("R")=$PIECE(X,U,2)

 +4        QUIT 

WHICHQ(XMQLIST,XMCNT) ;

 +1        NEW XMQUEUE,XMQLEN

 +2        IF XMQLIST'[","

               QUIT 1

 +3        SET XMQLEN=$LENGTH(XMQLIST,",")

 +4        FOR XMQUEUE=1:1:$LENGTH(XMQLIST,",")

               if XMCNT<$PIECE(XMQLIST,",",XMQUEUE)

                   QUIT 

 +5        QUIT $SELECT(XMCNT<$PIECE(XMQLIST,",",XMQUEUE):XMQUEUE,1:XMQUEUE+1)

RQUEUE(XMTSTAMP,XMUID,XMQUEUE,XMREC) ; Put replies into queue

 +1        NEW XMZ,XMTSQ

 +2       ;If the response is already in the queue, find out its Timestamp

 +3       ;and file the new response right next to it.

 +4        SET XMZ=$PIECE(XMUID,U,1)

 +5        SET XMTSQ=$ORDER(^XMBPOST("R",XMQUEUE,"B",XMZ,0))

 +6        IF XMTSQ

               SET XMTSTAMP=XMTSQ

 +7       IF '$TEST

               SET ^XMBPOST("R",XMQUEUE,"B",XMZ,XMTSTAMP)=""

 +8        SET ^XMBPOST("R",XMQUEUE,XMTSTAMP,XMZ,$PIECE(XMUID,U,2))=XMREC

 +9        QUIT 

MQUEUE(XMTSTAMP,XMUID,XMQUEUE,XMREC) ; Put new & forwarded messages into queue

 +1        SET ^XMBPOST("M",XMQUEUE,XMTSTAMP,XMUID)=XMREC

 +2        QUIT 

STATS(XMGROUP,XMQUEUE,XMCNT) ;

 +1        NEW XMSTATS

 +2        LOCK +^XMBPOST("QSTATS",XMGROUP,XMQUEUE)

 +3        SET XMSTATS=$GET(^XMBPOST(XMGROUP,XMQUEUE))

           SET ^(XMQUEUE)=($PIECE(XMSTATS,U,1)+1)_U_($PIECE(XMSTATS,U,2)+XMCNT)

 +4        LOCK -^XMBPOST("QSTATS",XMGROUP,XMQUEUE)

 +5        QUIT 

ZTSK      ; START Delivery Background Processes

 +1       ;Quit if Background Filer Stop Flag

           if $PIECE(^XMB(1,1,0),U,16)

               QUIT 

 +2        NEW XMGROUP,XMQUEUE,ZTRTN,ZTSAVE,ZTDESC

 +3       ; Check each queue for messages

           FOR XMGROUP="M","R"

               Begin DoDot:1

 +4                SET XMQUEUE=""

 +5                FOR 

                       SET XMQUEUE=$ORDER(^XMBPOST(XMGROUP,XMQUEUE))

                       if XMQUEUE'>0

                           QUIT 

                       Begin DoDot:2

 +6       ; Quit if nothing in queue

                           if $DATA(^XMBPOST(XMGROUP,XMQUEUE))<10

                               QUIT 

 +7       ; If node locked, there is already one running

                           LOCK +^XMBPOST(XMGROUP,XMQUEUE):1

                          IF '$TEST

                               QUIT 

 +8                        SET (ZTSAVE("XMGROUP"),ZTSAVE("XMQUEUE"),ZTSAVE("XMHANG"))=""

 +9       ; MailMan: Message/Response Delivery Queue |1|

                           SET ZTDESC=$$EZBLD^DIALOG($SELECT(XMGROUP="M":36230,1:36231),XMQUEUE)

 +10                       SET ZTRTN="GO^XMTDL"

 +11      ; Start a job, Give TaskMan a chance to start it (hang)

                           DO TASKIT(ZTRTN,ZTDESC,.ZTSAVE)

                           HANG 0

 +12                       LOCK -^XMBPOST(XMGROUP,XMQUEUE)

                       End DoDot:2

               End DoDot:1

 +13       QUIT 

TASKIT(ZTRTN,ZTDESC,ZTSAVE) ;

 +1        NEW X,ZTSK,ZTQUEUED,ZTCPU,ZTDTH,ZTIO

 +2        IF '$DATA(ZTCPU)

               IF $DATA(^XMB(1,1,0))

                   SET X=$PIECE(^(0),U,12)

                   IF X'=""

                       SET ZTCPU=$PIECE(X,",",2)

 +3        SET ZTIO=""

           SET ZTDTH=$HOROLOG

 +4        DO ^%ZTLOAD

 +5        QUIT 

JOB       ;Start background filer when TaskMan can't

JOBGO      SET IO=""

           SET IO(0)=""

           DO DT^DICRW

           GOTO GO^XMTDL

 +1        QUIT 

CHKQ      ; Input transform for file 4.3, fields 241 and 242

 +1        if $LENGTH(X)>120!($LENGTH(X)<1)

               KILL X

           if '$DATA(X)

               QUIT 

 +2        if X'?1.N.9(1","1.N)

               KILL X

           if '$DATA(X)

               QUIT 

 +3        NEW I

 +4        FOR I=1:1:$LENGTH(X,",")-1

               IF $PIECE(X,",",I)'<$PIECE(X,",",I+1)

                   KILL X

                   QUIT 

 +5        QUIT 

HELPQ     ; Executable help for file 4.3, fields 241 and 242

 +1       ;You determine the number of delivery queues (10 max.) ...

 +2        NEW XMTEXT

 +3        DO BLD^DIALOG(36232,"","","XMTEXT","F")

 +4        DO MSG^DIALOG("WM","",79,"","XMTEXT")

 +5        QUIT