XMUT6 ;(WASH ISC)/CAP-Check delivery queue ;04/17/2002 12:07
;;8.0;MailMan;;Jun 28, 2002
W !!,"Checking Delivery Queue: " S %H=$H D YX^%DTC W Y
D GO^XMUT5B I M("T")+R("T")<1 W !!,"NOTHING IS IN THE DELIVERY QUEUE !!" Q
;
GO ;Go through the queues and see if the data in them is correct
K M,R,T
S (M,R,T,M("D"),R("D"),T("D"))=0 F I=1:1:10 S (M(I),M("D",I),R(I),R("D",I))=0
F I="M","R" F J=1:1:10 D COUNT
W !!,"Total items Waiting to be delivered: ",T
W !,"Messages: "_M," Responses: "_R
W !,"Message Deliveries: "_M("D")_" Response Deliveries: "_R("D")
I M>0 W !!,"Message Group # Messages # Deliveries"
I F I=1:1:10 Q:'$D(M(I)) W !,?5,I,?25,M(I),?40,M("D",I),?53
I R>0 W !!,"Response Group # Responses # Deliveries"
I F I=1:1:10 Q:'$D(R(I)) W !,?5,I,?25,R(I),?40,R("D",I),?53
Q D ^XMUT5
Q
;
;Count the actual stuff in the queues
COUNT S (A,B,C)=0 ; I=group, J=queue, A=timestamp, B=id
A S A=$O(^XMBPOST(I,J,A)) Q:A'>0 S B=""
B S B=$O(^XMBPOST(I,J,A,B)) G A:B=""
;
;Messages
I I="R" S C="" G C
I B[U D FWD
E S %=+$G(^(B))
S T=T+1,M=M+1,M(J)=M(J)+1,M("D")=M("D")+%,M("D",J)=M("D",J)+%,T("D")=T("D")+%
G B
;
;Responses
C S C=$O(^XMBPOST(I,J,A,B,C)) G B:C="" S %=+$G(^(C)) G C:'%
S T=T+1,R=R+1,R(J)=R(J)+1,R("D")=R("D")+%,R("D",J)=R("D",J)+%,T("D")=T("D")+%
G C
;
;Sum up forwards
FWD S (%,K)=0 F S K=$O(^XMBPOST("FWD",B_U_A,K)) Q:'K S %=%+$L($G(^(K)),U)
Q
MOVE ;Move queue 1 to queue 3
S A="^XMBPOST(""R"",1)",B=0
MA S A=$Q(@A) Q:$P(A,$C(34),2)'="R"
S B=B+1 G MA:B<2 S C=@A,D=A,$P(D,",",2)=3,@D=C K @A G MA
;
KILL ;Kill off X-ref of Responses
S A="R"
KA S A=$O(^XMBPOST("R",A)) Q:A="" W A," " K ^(A) G KA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMUT6 1713 printed Dec 13, 2024@02:13:43 Page 2
XMUT6 ;(WASH ISC)/CAP-Check delivery queue ;04/17/2002 12:07
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 WRITE !!,"Checking Delivery Queue: "
SET %H=$HOROLOG
DO YX^%DTC
WRITE Y
+3 DO GO^XMUT5B
IF M("T")+R("T")<1
WRITE !!,"NOTHING IS IN THE DELIVERY QUEUE !!"
QUIT
+4 ;
GO ;Go through the queues and see if the data in them is correct
+1 KILL M,R,T
+2 SET (M,R,T,M("D"),R("D"),T("D"))=0
FOR I=1:1:10
SET (M(I),M("D",I),R(I),R("D",I))=0
+3 FOR I="M","R"
FOR J=1:1:10
DO COUNT
+4 WRITE !!,"Total items Waiting to be delivered: ",T
+5 WRITE !,"Messages: "_M," Responses: "_R
+6 WRITE !,"Message Deliveries: "_M("D")_" Response Deliveries: "_R("D")
+7 IF M>0
WRITE !!,"Message Group # Messages # Deliveries"
+8 IF $TEST
FOR I=1:1:10
if '$DATA(M(I))
QUIT
WRITE !,?5,I,?25,M(I),?40,M("D",I),?53
+9 IF R>0
WRITE !!,"Response Group # Responses # Deliveries"
+10 IF $TEST
FOR I=1:1:10
if '$DATA(R(I))
QUIT
WRITE !,?5,I,?25,R(I),?40,R("D",I),?53
Q DO ^XMUT5
+1 QUIT
+2 ;
+3 ;Count the actual stuff in the queues
COUNT ; I=group, J=queue, A=timestamp, B=id
SET (A,B,C)=0
A SET A=$ORDER(^XMBPOST(I,J,A))
if A'>0
QUIT
SET B=""
B SET B=$ORDER(^XMBPOST(I,J,A,B))
if B=""
GOTO A
+1 ;
+2 ;Messages
+3 IF I="R"
SET C=""
GOTO C
+4 IF B[U
DO FWD
+5 IF '$TEST
SET %=+$GET(^(B))
+6 SET T=T+1
SET M=M+1
SET M(J)=M(J)+1
SET M("D")=M("D")+%
SET M("D",J)=M("D",J)+%
SET T("D")=T("D")+%
+7 GOTO B
+8 ;
+9 ;Responses
C SET C=$ORDER(^XMBPOST(I,J,A,B,C))
if C=""
GOTO B
SET %=+$GET(^(C))
if '%
GOTO C
+1 SET T=T+1
SET R=R+1
SET R(J)=R(J)+1
SET R("D")=R("D")+%
SET R("D",J)=R("D",J)+%
SET T("D")=T("D")+%
+2 GOTO C
+3 ;
+4 ;Sum up forwards
FWD SET (%,K)=0
FOR
SET K=$ORDER(^XMBPOST("FWD",B_U_A,K))
if 'K
QUIT
SET %=%+$LENGTH($GET(^(K)),U)
+1 QUIT
MOVE ;Move queue 1 to queue 3
+1 SET A="^XMBPOST(""R"",1)"
SET B=0
MA SET A=$QUERY(@A)
if $PIECE(A,$CHAR(34),2)'="R"
QUIT
+1 SET B=B+1
if B<2
GOTO MA
SET C=@A
SET D=A
SET $PIECE(D,",",2)=3
SET @D=C
KILL @A
GOTO MA
+2 ;
KILL ;Kill off X-ref of Responses
+1 SET A="R"
KA SET A=$ORDER(^XMBPOST("R",A))
if A=""
QUIT
WRITE A," "
KILL ^(A)
GOTO KA
