- 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
- 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