| 1 | XMUT6 ;(WASH ISC)/CAP-Check delivery queue ;04/17/2002  12:07 | 
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002 | 
|---|
| 3 | W !!,"Checking Delivery Queue: " S %H=$H D YX^%DTC W Y | 
|---|
| 4 | D GO^XMUT5B I M("T")+R("T")<1 W !!,"NOTHING IS IN THE DELIVERY QUEUE !!" Q | 
|---|
| 5 | ; | 
|---|
| 6 | GO ;Go through the queues and see if the data in them is correct | 
|---|
| 7 | K M,R,T | 
|---|
| 8 | 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 | 
|---|
| 9 | F I="M","R" F J=1:1:10 D COUNT | 
|---|
| 10 | W !!,"Total items Waiting to be delivered: ",T | 
|---|
| 11 | W !,"Messages: "_M,"   Responses: "_R | 
|---|
| 12 | W !,"Message Deliveries: "_M("D")_"   Response Deliveries: "_R("D") | 
|---|
| 13 | I M>0 W !!,"Message Group      # Messages    # Deliveries" | 
|---|
| 14 | I  F I=1:1:10 Q:'$D(M(I))  W !,?5,I,?25,M(I),?40,M("D",I),?53 | 
|---|
| 15 | I R>0 W !!,"Response Group     # Responses   # Deliveries" | 
|---|
| 16 | I  F I=1:1:10 Q:'$D(R(I))  W !,?5,I,?25,R(I),?40,R("D",I),?53 | 
|---|
| 17 | Q D ^XMUT5 | 
|---|
| 18 | Q | 
|---|
| 19 | ; | 
|---|
| 20 | ;Count the actual stuff in the queues | 
|---|
| 21 | COUNT S (A,B,C)=0 ; I=group, J=queue, A=timestamp, B=id | 
|---|
| 22 | A S A=$O(^XMBPOST(I,J,A)) Q:A'>0  S B="" | 
|---|
| 23 | B S B=$O(^XMBPOST(I,J,A,B)) G A:B="" | 
|---|
| 24 | ; | 
|---|
| 25 | ;Messages | 
|---|
| 26 | I I="R" S C="" G C | 
|---|
| 27 | I B[U D FWD | 
|---|
| 28 | E  S %=+$G(^(B)) | 
|---|
| 29 | 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")+% | 
|---|
| 30 | G B | 
|---|
| 31 | ; | 
|---|
| 32 | ;Responses | 
|---|
| 33 | C S C=$O(^XMBPOST(I,J,A,B,C)) G B:C="" S %=+$G(^(C)) G C:'% | 
|---|
| 34 | 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")+% | 
|---|
| 35 | G C | 
|---|
| 36 | ; | 
|---|
| 37 | ;Sum up forwards | 
|---|
| 38 | FWD S (%,K)=0 F  S K=$O(^XMBPOST("FWD",B_U_A,K)) Q:'K  S %=%+$L($G(^(K)),U) | 
|---|
| 39 | Q | 
|---|
| 40 | MOVE ;Move queue 1 to queue 3 | 
|---|
| 41 | S A="^XMBPOST(""R"",1)",B=0 | 
|---|
| 42 | MA S A=$Q(@A) Q:$P(A,$C(34),2)'="R" | 
|---|
| 43 | S B=B+1 G MA:B<2 S C=@A,D=A,$P(D,",",2)=3,@D=C K @A G MA | 
|---|
| 44 | ; | 
|---|
| 45 | KILL ;Kill off X-ref of Responses | 
|---|
| 46 | S A="R" | 
|---|
| 47 | KA S A=$O(^XMBPOST("R",A)) Q:A=""  W A,"  " K ^(A) G KA | 
|---|