XMCQ ;ISC-SF/GMB-Transmit Queue Status Report ;12/04/2002 13:43
;;8.0;MailMan;**10**;Jun 28, 2002
; Was (WASH ISC)/THM
;
; Entry points used by MailMan options (not covered by DBIA):
; STATUS XMQDISP (was ENTER^XMS5A)
; SHOWQ XMQSHOW (was QUEUE^XMC4)
STATUS ;
D RESEQ^XMCQA
D EN^XUTMDEVQ("QZTLOOP^XMCQ",$$EZBLD^DIALOG(42135)) ; MailMan: Transmission Queue Status Report
Q
QZTLOOP ;
I $E($G(IOST),1,2)'="C-" D Q
. D QZTSK
. I $D(ZTQUEUED) S ZTREQ="@"
F D Q:'(Y!$D(DTOUT))
. D QZTSK
. 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
QZTSK ;
N XMRPT,XMNAME,XMIEN,XMREC,XMQD,XMCNT,XMABORT,XMTSK,XMDT,XMTM
;Transmission Queue Status
;Domain Queued Device/Protocol Message S/R Time Line Err Rate
D INIT^XMCQA(.XMRPT,42136,42137)
S (XMABORT,XMCNT)=0
S XMNAME=""
F S XMNAME=$O(^DIC(4.2,"B",XMNAME)) Q:XMNAME="" D Q:XMABORT
. S XMIEN=0
. F S XMIEN=$O(^DIC(4.2,"B",XMNAME,XMIEN)) Q:'XMIEN D Q:XMABORT
. . S XMREC=$G(^XMBS(4.2999,XMIEN,3))
. . S XMTSK=$$TSKEXIST^XMKPR(XMIEN,$P(XMREC,U,7))
. . I +XMREC,$$HDIFF^XLFDT($H,$P(XMREC,U,1),2)>180 S XMREC=""
. . S XMQD=$$BMSGCT^XMXUTIL(.5,XMIEN+1000)
. . I 'XMQD,'XMTSK,'XMREC Q
. . I $Y+3>IOSL D Q:XMABORT
. . . D PAGE^XMCQA(.XMABORT) Q:XMABORT
. . . D HDR^XMCQA(.XMRPT)
. . S XMCNT=XMCNT+1
. . W !,$$MELD^XMXUTIL1(XMNAME,XMQD,21) ; domain, queued
. . I +XMREC D Q
. . . S XMDT=$P($$HTE^XLFDT($P(XMREC,U,1),"2Z"),":",1,2)
. . . S XMTM=$P(XMDT,"@",2)
. . . ; device, msg #, R/S, time, line, errors, rate
. . . W " ",$$MELD^XMXUTIL1($P(XMREC,U,6),$P(XMREC,U,2),29)," ",$J($P(XMREC,U,8),1)," ",XMTM,$J($P(XMREC,U,3),7),$J($P(XMREC,U,4),3),$J($P(XMREC,U,5),9)
. . I 'XMTSK D Q
. . . W ?26,$$EZBLD^DIALOG(42138,$P($G(^DIC(4.2,XMIEN,0)),U,2)) ; No task scheduled, FLAGS=|1|
. . I XMTSK[U D Q
. . . N XMPARM ; Task |1| scheduled for |2|
. . . S XMPARM(1)=$P(XMTSK,U),XMPARM(2)=$P($$HTE^XLFDT($P(XMTSK,U,2),"2Z"),":",1,2)
. . . W ?26,$$EZBLD^DIALOG(42139,.XMPARM)
. . W ?26,$$EZBLD^DIALOG(42140,XMTSK) ; Task |1| just started
I 'XMCNT W !,$$EZBLD^DIALOG(42141) ; No messages queued or in active transmission.
Q
SHOWQ ; Display messages in queue
N XMDUZ,XMINST,XMSITE,XMABORT
D CHECK^XMVVITAE
S XMABORT=0 ; Choose queue w/msgs
D ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT,"M") Q:XMABORT
I DUZ=.5 D LIST^XMJMLR(.5,XMINST+1000,XMSITE,1,.XMABORT) Q
I $D(^XUSEC("XMNOPRIV",DUZ))!'$D(^XMB(3.7,"AB",DUZ,.5)) D Q
. ; not a postmaster surrogate, so look only - no touch!
. D LIST^XMJML(.5,XMINST+1000,XMSITE,"",1)
S XMDUZ=.5
D OTHER^XMVVITAE
D LIST^XMJMLR(XMDUZ,XMINST+1000,XMSITE,1,.XMABORT)
D SELF^XMVVITAE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMCQ 3001 printed Apr 09, 2024@21:12:50 Page 2
XMCQ ;ISC-SF/GMB-Transmit Queue Status Report ;12/04/2002 13:43
+1 ;;8.0;MailMan;**10**;Jun 28, 2002
+2 ; Was (WASH ISC)/THM
+3 ;
+4 ; Entry points used by MailMan options (not covered by DBIA):
+5 ; STATUS XMQDISP (was ENTER^XMS5A)
+6 ; SHOWQ XMQSHOW (was QUEUE^XMC4)
STATUS ;
+1 DO RESEQ^XMCQA
+2 ; MailMan: Transmission Queue Status Report
DO EN^XUTMDEVQ("QZTLOOP^XMCQ",$$EZBLD^DIALOG(42135))
+3 QUIT
QZTLOOP ;
+1 IF $EXTRACT($GET(IOST),1,2)'="C-"
Begin DoDot:1
+2 DO QZTSK
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
End DoDot:1
QUIT
+4 FOR
Begin DoDot:1
+5 DO QZTSK
+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
QZTSK ;
+1 NEW XMRPT,XMNAME,XMIEN,XMREC,XMQD,XMCNT,XMABORT,XMTSK,XMDT,XMTM
+2 ;Transmission Queue Status
+3 ;Domain Queued Device/Protocol Message S/R Time Line Err Rate
+4 DO INIT^XMCQA(.XMRPT,42136,42137)
+5 SET (XMABORT,XMCNT)=0
+6 SET XMNAME=""
+7 FOR
SET XMNAME=$ORDER(^DIC(4.2,"B",XMNAME))
if XMNAME=""
QUIT
Begin DoDot:1
+8 SET XMIEN=0
+9 FOR
SET XMIEN=$ORDER(^DIC(4.2,"B",XMNAME,XMIEN))
if 'XMIEN
QUIT
Begin DoDot:2
+10 SET XMREC=$GET(^XMBS(4.2999,XMIEN,3))
+11 SET XMTSK=$$TSKEXIST^XMKPR(XMIEN,$PIECE(XMREC,U,7))
+12 IF +XMREC
IF $$HDIFF^XLFDT($HOROLOG,$PIECE(XMREC,U,1),2)>180
SET XMREC=""
+13 SET XMQD=$$BMSGCT^XMXUTIL(.5,XMIEN+1000)
+14 IF 'XMQD
IF 'XMTSK
IF 'XMREC
QUIT
+15 IF $Y+3>IOSL
Begin DoDot:3
+16 DO PAGE^XMCQA(.XMABORT)
if XMABORT
QUIT
+17 DO HDR^XMCQA(.XMRPT)
End DoDot:3
if XMABORT
QUIT
+18 SET XMCNT=XMCNT+1
+19 ; domain, queued
WRITE !,$$MELD^XMXUTIL1(XMNAME,XMQD,21)
+20 IF +XMREC
Begin DoDot:3
+21 SET XMDT=$PIECE($$HTE^XLFDT($PIECE(XMREC,U,1),"2Z"),":",1,2)
+22 SET XMTM=$PIECE(XMDT,"@",2)
+23 ; device, msg #, R/S, time, line, errors, rate
+24 WRITE " ",$$MELD^XMXUTIL1($PIECE(XMREC,U,6),$PIECE(XMREC,U,2),29)," ",$JUSTIFY($PIECE(XMREC,U,8),1)," ",XMTM,$JUSTIFY($PIECE(XMREC,U,3),7),$JUSTIFY($PIECE(XMREC,U,4),3),$JUSTIFY($PIECE(XMREC,U,5),9)
End DoDot:3
QUIT
+25 IF 'XMTSK
Begin DoDot:3
+26 ; No task scheduled, FLAGS=|1|
WRITE ?26,$$EZBLD^DIALOG(42138,$PIECE($GET(^DIC(4.2,XMIEN,0)),U,2))
End DoDot:3
QUIT
+27 IF XMTSK[U
Begin DoDot:3
+28 ; Task |1| scheduled for |2|
NEW XMPARM
+29 SET XMPARM(1)=$PIECE(XMTSK,U)
SET XMPARM(2)=$PIECE($$HTE^XLFDT($PIECE(XMTSK,U,2),"2Z"),":",1,2)
+30 WRITE ?26,$$EZBLD^DIALOG(42139,.XMPARM)
End DoDot:3
QUIT
+31 ; Task |1| just started
WRITE ?26,$$EZBLD^DIALOG(42140,XMTSK)
End DoDot:2
if XMABORT
QUIT
End DoDot:1
if XMABORT
QUIT
+32 ; No messages queued or in active transmission.
IF 'XMCNT
WRITE !,$$EZBLD^DIALOG(42141)
+33 QUIT
SHOWQ ; Display messages in queue
+1 NEW XMDUZ,XMINST,XMSITE,XMABORT
+2 DO CHECK^XMVVITAE
+3 ; Choose queue w/msgs
SET XMABORT=0
+4 DO ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT,"M")
if XMABORT
QUIT
+5 IF DUZ=.5
DO LIST^XMJMLR(.5,XMINST+1000,XMSITE,1,.XMABORT)
QUIT
+6 IF $DATA(^XUSEC("XMNOPRIV",DUZ))!'$DATA(^XMB(3.7,"AB",DUZ,.5))
Begin DoDot:1
+7 ; not a postmaster surrogate, so look only - no touch!
+8 DO LIST^XMJML(.5,XMINST+1000,XMSITE,"",1)
End DoDot:1
QUIT
+9 SET XMDUZ=.5
+10 DO OTHER^XMVVITAE
+11 DO LIST^XMJMLR(XMDUZ,XMINST+1000,XMSITE,1,.XMABORT)
+12 DO SELF^XMVVITAE
+13 QUIT
