XMCQA ;ISC-SF/GMB-Transmit Queue Status Report (others) ;12/04/2002 13:44
;;8.0;MailMan;**8,10**;Jun 28, 2002
; Was (WASH ISC)/CAP/RM/AML
;
; Entry points used by MailMan options (not covered by DBIA):
; ACTIVE XMQACTIVE (was GO^XMS5)
; ALL XMQUEUED (was ENT^XMS5)
;
ACTIVE ; Show queues actively transmitting.
D EN^XUTMDEVQ("AZTLOOP^XMCQA",$$EZBLD^DIALOG(42110)) ; MailMan: Active Transmission Queues Report
Q
AZTLOOP ;
I $E($G(IOST),1,2)'="C-" D Q
. D AZTSK
. I $D(ZTQUEUED) S ZTREQ="@"
F D Q:'(Y!$D(DTOUT))
. D AZTSK
. W !
. N DIR,X,DTIME
. S DTIME=5
. S DIR(0)="Y",DIR("A")=$$EZBLD^DIALOG(42116) ; Refresh
. S DIR("B")=$$EZBLD^DIALOG(39054) ; YES
. ;Answer YES if you want the display refreshed.
. ;Answer NO if you don't.
. ;If you don't answer, the display will be refreshed every five seconds.
. D BLD^DIALOG(42117,"","","DIR(""?"")")
. D ^DIR
Q
AZTSK ;
N XMIEN,XMSITE,XMABORT,XMRPT,XMCNT,XMREC,XMSECS,XMQD
S (XMABORT,XMCNT,XMCNT("QD"))=0
;Active Transmission Queues
;Domain Queued Device/Protocol Message Line ZTSK Err Rate
D INIT(.XMRPT,42111,42112)
S XMSITE=""
F S XMSITE=$O(^DIC(4.2,"B",XMSITE)) Q:XMSITE="" D Q:XMABORT
. S XMIEN=0
. F S XMIEN=$O(^DIC(4.2,"B",XMSITE,XMIEN)) Q:'XMIEN D Q:XMABORT
. . S XMREC=$P($G(^XMBS(4.2999,XMIEN,3)),U,1,7)
. . Q:"^^^^^^"[XMREC
. . S XMSECS=$$HDIFF^XLFDT($H,$P(XMREC,U),2)
. . Q:XMSECS>599
. . Q:$P(XMREC,U,1,6)?.P
. . S XMQD=$$BMSGCT^XMXUTIL(.5,XMIEN+1000)
. . I $Y+3+(XMSECS>180)>IOSL D Q:XMABORT
. . . D PAGE(.XMABORT) Q:XMABORT
. . . D HDR(.XMRPT)
. . W !,$$MELD^XMXUTIL1(XMSITE,XMQD,21)," " ; domain, q'd msgs
. . I XMSECS>180 D
. . . W $E($P(XMREC,U,6),1,16)
. . . W ?40,$$EZBLD^DIALOG(42113,XMSECS\60) ; == Appears Inactive - |1| Minutes
. . E D
. . . I '$P(XMREC,U,2) D Q
. . . . W $E($P(XMREC,U,6),1,16)
. . . . W ?44,$$EZBLD^DIALOG(42114) ; Connecting/Disconnecting
. . . ; Device, Msg #, xmit line, ztsk, errors, xmit rate
. . . W $$MELD^XMXUTIL1($P(XMREC,U,6),$P(XMREC,U,2),29),$J($P(XMREC,U,3),6),$J($P(XMREC,U,7),10),$J($P(XMREC,U,4),3),$J($P(XMREC,U,5),9)
. . S XMCNT=XMCNT+1
. . S XMCNT("QD")=XMCNT("QD")+XMQD
Q:XMABORT
I 'XMCNT W !,$$EZBLD^DIALOG(42115) Q ; No queues actively transmitting
;I $Y+5>IOSL D Q:XMABORT
;. D PAGE(.XMABORT) Q:XMABORT
;. D HDR(.XMRPT)
;W !!,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42103),XMCNT,27) ; Total Domains:
;W !,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42104),XMCNT("QD"),27) ; Total Queued:
Q
INIT(XMRPT,XMTITLE,XMHDR) ;
S XMRPT("PAGE")=0
S XMRPT("DATE")=$$MMDT^XMXUTIL1($$NOW^XLFDT)
S XMRPT("TITLE")=$S(+XMTITLE=XMTITLE:$$EZBLD^DIALOG(XMTITLE),1:XMTITLE)
S XMRPT("HDR")=$S(+XMHDR=XMHDR:$$EZBLD^DIALOG(XMHDR),1:XMHDR)
W:$E($G(IOST),1,2)="C-" @IOF
D HDR(.XMRPT)
Q
PAGE(XMABORT) ;
I $E($G(IOST),1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
W @IOF
Q
HDR(XMRPT) ;
N XMPAGE
S XMRPT("PAGE")=XMRPT("PAGE")+1
W !,XMRPT("TITLE")
W ?79-$L(XMRPT("DATE")),XMRPT("DATE")
S XMPAGE=$$EZBLD^DIALOG(34542,$J(XMRPT("PAGE"),2))
W !,^XMB("NETNAME"),?79-$L(XMPAGE),XMPAGE
W !!,XMRPT("HDR"),!
Q
ALL ; Show all queues which have messages, whether transmitting or not.
D RESEQ
D EN^XUTMDEVQ("QZTSK^XMCQA",$$EZBLD^DIALOG(42120)) ; MailMan: Transmission Queues with Messages Report
Q
RESEQ ; Resequence the messages in the transmit queues. This also has the
; effect of doing an integrity check on the queues.
N XMK
S XMK=999
F S XMK=$O(^XMB(3.7,.5,2,XMK)) Q:XMK'>0 Q:XMK>9999 I $O(^(XMK,1,0)) W:'$D(ZTQUEUED) "." D RSEQ^XMXBSKT(.5,XMK)
Q
QZTSK ;
N XMRPT,XMIEN,XMSITE,XMABORT,XMCNT,XMREC,XMQD
S (XMABORT,XMCNT,XMCNT("QD"))=0
;Transmission Queues with Messages
;Domain Queued Physical Link
D INIT(.XMRPT,42121,42122)
S XMSITE=""
F S XMSITE=$O(^DIC(4.2,"B",XMSITE)) Q:XMSITE="" D Q:XMABORT
. S XMIEN=0
. F S XMIEN=$O(^DIC(4.2,"B",XMSITE,XMIEN)) Q:'XMIEN D Q:XMABORT
. . S XMQD=$$BMSGCT^XMXUTIL(.5,XMIEN+1000)
. . Q:'XMQD
. . S XMREC=^DIC(4.2,XMIEN,0)
. . I $Y+3>IOSL D Q:XMABORT
. . . D PAGE(.XMABORT) Q:XMABORT
. . . D HDR(.XMRPT)
. . W !,$$MELD^XMXUTIL1($P(XMREC,U),XMQD,47)," ",$P(XMREC,U,17)
. . S XMCNT=XMCNT+1
. . S XMCNT("QD")=XMCNT("QD")+XMQD
Q:XMABORT
I 'XMCNT W !,$$EZBLD^DIALOG(42123) Q ; No messages queued
I $Y+5>IOSL D Q:XMABORT
. D PAGE(.XMABORT) Q:XMABORT
. D HDR(.XMRPT)
W !!,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42103),XMCNT,27) ; Total Domains:
W !,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42104),XMCNT("QD"),27) ; Total Queued:
I $D(ZTQUEUED) S ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMCQA 4664 printed Apr 09, 2024@21:12:34 Page 2
XMCQA ;ISC-SF/GMB-Transmit Queue Status Report (others) ;12/04/2002 13:44
+1 ;;8.0;MailMan;**8,10**;Jun 28, 2002
+2 ; Was (WASH ISC)/CAP/RM/AML
+3 ;
+4 ; Entry points used by MailMan options (not covered by DBIA):
+5 ; ACTIVE XMQACTIVE (was GO^XMS5)
+6 ; ALL XMQUEUED (was ENT^XMS5)
+7 ;
ACTIVE ; Show queues actively transmitting.
+1 ; MailMan: Active Transmission Queues Report
DO EN^XUTMDEVQ("AZTLOOP^XMCQA",$$EZBLD^DIALOG(42110))
+2 QUIT
AZTLOOP ;
+1 IF $EXTRACT($GET(IOST),1,2)'="C-"
Begin DoDot:1
+2 DO AZTSK
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
End DoDot:1
QUIT
+4 FOR
Begin DoDot:1
+5 DO AZTSK
+6 WRITE !
+7 NEW DIR,X,DTIME
+8 SET DTIME=5
+9 ; Refresh
SET DIR(0)="Y"
SET DIR("A")=$$EZBLD^DIALOG(42116)
+10 ; YES
SET DIR("B")=$$EZBLD^DIALOG(39054)
+11 ;Answer YES if you want the display refreshed.
+12 ;Answer NO if you don't.
+13 ;If you don't answer, the display will be refreshed every five seconds.
+14 DO BLD^DIALOG(42117,"","","DIR(""?"")")
+15 DO ^DIR
End DoDot:1
if '(Y!$DATA(DTOUT))
QUIT
+16 QUIT
AZTSK ;
+1 NEW XMIEN,XMSITE,XMABORT,XMRPT,XMCNT,XMREC,XMSECS,XMQD
+2 SET (XMABORT,XMCNT,XMCNT("QD"))=0
+3 ;Active Transmission Queues
+4 ;Domain Queued Device/Protocol Message Line ZTSK Err Rate
+5 DO INIT(.XMRPT,42111,42112)
+6 SET XMSITE=""
+7 FOR
SET XMSITE=$ORDER(^DIC(4.2,"B",XMSITE))
if XMSITE=""
QUIT
Begin DoDot:1
+8 SET XMIEN=0
+9 FOR
SET XMIEN=$ORDER(^DIC(4.2,"B",XMSITE,XMIEN))
if 'XMIEN
QUIT
Begin DoDot:2
+10 SET XMREC=$PIECE($GET(^XMBS(4.2999,XMIEN,3)),U,1,7)
+11 if "^^^^^^"[XMREC
QUIT
+12 SET XMSECS=$$HDIFF^XLFDT($HOROLOG,$PIECE(XMREC,U),2)
+13 if XMSECS>599
QUIT
+14 if $PIECE(XMREC,U,1,6)?.P
QUIT
+15 SET XMQD=$$BMSGCT^XMXUTIL(.5,XMIEN+1000)
+16 IF $Y+3+(XMSECS>180)>IOSL
Begin DoDot:3
+17 DO PAGE(.XMABORT)
if XMABORT
QUIT
+18 DO HDR(.XMRPT)
End DoDot:3
if XMABORT
QUIT
+19 ; domain, q'd msgs
WRITE !,$$MELD^XMXUTIL1(XMSITE,XMQD,21)," "
+20 IF XMSECS>180
Begin DoDot:3
+21 WRITE $EXTRACT($PIECE(XMREC,U,6),1,16)
+22 ; == Appears Inactive - |1| Minutes
WRITE ?40,$$EZBLD^DIALOG(42113,XMSECS\60)
End DoDot:3
+23 IF '$TEST
Begin DoDot:3
+24 IF '$PIECE(XMREC,U,2)
Begin DoDot:4
+25 WRITE $EXTRACT($PIECE(XMREC,U,6),1,16)
+26 ; Connecting/Disconnecting
WRITE ?44,$$EZBLD^DIALOG(42114)
End DoDot:4
QUIT
+27 ; Device, Msg #, xmit line, ztsk, errors, xmit rate
+28 WRITE $$MELD^XMXUTIL1($PIECE(XMREC,U,6),$PIECE(XMREC,U,2),29),$JUSTIFY($PIECE(XMREC,U,3),6),$JUSTIFY($PIECE(XMREC,U,7),10),$JUSTIFY($PIECE(XMREC,U,4),3),$JUSTIFY($PIECE(XMREC,U,5),9)
End DoDot:3
+29 SET XMCNT=XMCNT+1
+30 SET XMCNT("QD")=XMCNT("QD")+XMQD
End DoDot:2
if XMABORT
QUIT
End DoDot:1
if XMABORT
QUIT
+31 if XMABORT
QUIT
+32 ; No queues actively transmitting
IF 'XMCNT
WRITE !,$$EZBLD^DIALOG(42115)
QUIT
+33 ;I $Y+5>IOSL D Q:XMABORT
+34 ;. D PAGE(.XMABORT) Q:XMABORT
+35 ;. D HDR(.XMRPT)
+36 ;W !!,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42103),XMCNT,27) ; Total Domains:
+37 ;W !,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42104),XMCNT("QD"),27) ; Total Queued:
+38 QUIT
INIT(XMRPT,XMTITLE,XMHDR) ;
+1 SET XMRPT("PAGE")=0
+2 SET XMRPT("DATE")=$$MMDT^XMXUTIL1($$NOW^XLFDT)
+3 SET XMRPT("TITLE")=$SELECT(+XMTITLE=XMTITLE:$$EZBLD^DIALOG(XMTITLE),1:XMTITLE)
+4 SET XMRPT("HDR")=$SELECT(+XMHDR=XMHDR:$$EZBLD^DIALOG(XMHDR),1:XMHDR)
+5 if $EXTRACT($GET(IOST),1,2)="C-"
WRITE @IOF
+6 DO HDR(.XMRPT)
+7 QUIT
PAGE(XMABORT) ;
+1 IF $EXTRACT($GET(IOST),1,2)="C-"
DO PAGE^XMXUTIL(.XMABORT)
if XMABORT
QUIT
+2 WRITE @IOF
+3 QUIT
HDR(XMRPT) ;
+1 NEW XMPAGE
+2 SET XMRPT("PAGE")=XMRPT("PAGE")+1
+3 WRITE !,XMRPT("TITLE")
+4 WRITE ?79-$LENGTH(XMRPT("DATE")),XMRPT("DATE")
+5 SET XMPAGE=$$EZBLD^DIALOG(34542,$JUSTIFY(XMRPT("PAGE"),2))
+6 WRITE !,^XMB("NETNAME"),?79-$LENGTH(XMPAGE),XMPAGE
+7 WRITE !!,XMRPT("HDR"),!
+8 QUIT
ALL ; Show all queues which have messages, whether transmitting or not.
+1 DO RESEQ
+2 ; MailMan: Transmission Queues with Messages Report
DO EN^XUTMDEVQ("QZTSK^XMCQA",$$EZBLD^DIALOG(42120))
+3 QUIT
RESEQ ; Resequence the messages in the transmit queues. This also has the
+1 ; effect of doing an integrity check on the queues.
+2 NEW XMK
+3 SET XMK=999
+4 FOR
SET XMK=$ORDER(^XMB(3.7,.5,2,XMK))
if XMK'>0
QUIT
if XMK>9999
QUIT
IF $ORDER(^(XMK,1,0))
if '$DATA(ZTQUEUED)
WRITE "."
DO RSEQ^XMXBSKT(.5,XMK)
+5 QUIT
QZTSK ;
+1 NEW XMRPT,XMIEN,XMSITE,XMABORT,XMCNT,XMREC,XMQD
+2 SET (XMABORT,XMCNT,XMCNT("QD"))=0
+3 ;Transmission Queues with Messages
+4 ;Domain Queued Physical Link
+5 DO INIT(.XMRPT,42121,42122)
+6 SET XMSITE=""
+7 FOR
SET XMSITE=$ORDER(^DIC(4.2,"B",XMSITE))
if XMSITE=""
QUIT
Begin DoDot:1
+8 SET XMIEN=0
+9 FOR
SET XMIEN=$ORDER(^DIC(4.2,"B",XMSITE,XMIEN))
if 'XMIEN
QUIT
Begin DoDot:2
+10 SET XMQD=$$BMSGCT^XMXUTIL(.5,XMIEN+1000)
+11 if 'XMQD
QUIT
+12 SET XMREC=^DIC(4.2,XMIEN,0)
+13 IF $Y+3>IOSL
Begin DoDot:3
+14 DO PAGE(.XMABORT)
if XMABORT
QUIT
+15 DO HDR(.XMRPT)
End DoDot:3
if XMABORT
QUIT
+16 WRITE !,$$MELD^XMXUTIL1($PIECE(XMREC,U),XMQD,47)," ",$PIECE(XMREC,U,17)
+17 SET XMCNT=XMCNT+1
+18 SET XMCNT("QD")=XMCNT("QD")+XMQD
End DoDot:2
if XMABORT
QUIT
End DoDot:1
if XMABORT
QUIT
+19 if XMABORT
QUIT
+20 ; No messages queued
IF 'XMCNT
WRITE !,$$EZBLD^DIALOG(42123)
QUIT
+21 IF $Y+5>IOSL
Begin DoDot:1
+22 DO PAGE(.XMABORT)
if XMABORT
QUIT
+23 DO HDR(.XMRPT)
End DoDot:1
if XMABORT
QUIT
+24 ; Total Domains:
WRITE !!,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42103),XMCNT,27)
+25 ; Total Queued:
WRITE !,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42104),XMCNT("QD"),27)
+26 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+27 QUIT
