- 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 Feb 18, 2025@23:37:29 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