- 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 Mar 13, 2025@21:18:20 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
