XMUT6.m

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

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