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
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
