source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMCQ.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1XMCQ ;ISC-SF/GMB-Transmit Queue Status Report ;12/04/2002 13:43
2 ;;8.0;MailMan;**10**;Jun 28, 2002
3 ; Was (WASH ISC)/THM
4 ;
5 ; Entry points used by MailMan options (not covered by DBIA):
6 ; STATUS XMQDISP (was ENTER^XMS5A)
7 ; SHOWQ XMQSHOW (was QUEUE^XMC4)
8STATUS ;
9 D RESEQ^XMCQA
10 D EN^XUTMDEVQ("QZTLOOP^XMCQ",$$EZBLD^DIALOG(42135)) ; MailMan: Transmission Queue Status Report
11 Q
12QZTLOOP ;
13 I $E($G(IOST),1,2)'="C-" D Q
14 . D QZTSK
15 . I $D(ZTQUEUED) S ZTREQ="@"
16 F D Q:'(Y!$D(DTOUT))
17 . D QZTSK
18 . W !
19 . N DIR,X,DTIME
20 . S DTIME=5
21 . S DIR(0)="Y",DIR("A")=$$EZBLD^DIALOG(42116) ; Refresh
22 . S DIR("B")=$$EZBLD^DIALOG(39054) ; YES
23 . ;Answer YES if you want the display refreshed.
24 . ;Answer NO if you don't.
25 . ;If you don't answer, the display will be refreshed every five seconds
26 . D BLD^DIALOG(42117,"","","DIR(""?"")")
27 . D ^DIR
28 Q
29QZTSK ;
30 N XMRPT,XMNAME,XMIEN,XMREC,XMQD,XMCNT,XMABORT,XMTSK,XMDT,XMTM
31 ;Transmission Queue Status
32 ;Domain Queued Device/Protocol Message S/R Time Line Err Rate
33 D INIT^XMCQA(.XMRPT,42136,42137)
34 S (XMABORT,XMCNT)=0
35 S XMNAME=""
36 F S XMNAME=$O(^DIC(4.2,"B",XMNAME)) Q:XMNAME="" D Q:XMABORT
37 . S XMIEN=0
38 . F S XMIEN=$O(^DIC(4.2,"B",XMNAME,XMIEN)) Q:'XMIEN D Q:XMABORT
39 . . S XMREC=$G(^XMBS(4.2999,XMIEN,3))
40 . . S XMTSK=$$TSKEXIST^XMKPR(XMIEN,$P(XMREC,U,7))
41 . . I +XMREC,$$HDIFF^XLFDT($H,$P(XMREC,U,1),2)>180 S XMREC=""
42 . . S XMQD=$$BMSGCT^XMXUTIL(.5,XMIEN+1000)
43 . . I 'XMQD,'XMTSK,'XMREC Q
44 . . I $Y+3>IOSL D Q:XMABORT
45 . . . D PAGE^XMCQA(.XMABORT) Q:XMABORT
46 . . . D HDR^XMCQA(.XMRPT)
47 . . S XMCNT=XMCNT+1
48 . . W !,$$MELD^XMXUTIL1(XMNAME,XMQD,21) ; domain, queued
49 . . I +XMREC D Q
50 . . . S XMDT=$P($$HTE^XLFDT($P(XMREC,U,1),"2Z"),":",1,2)
51 . . . S XMTM=$P(XMDT,"@",2)
52 . . . ; device, msg #, R/S, time, line, errors, rate
53 . . . 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)
54 . . I 'XMTSK D Q
55 . . . W ?26,$$EZBLD^DIALOG(42138,$P($G(^DIC(4.2,XMIEN,0)),U,2)) ; No task scheduled, FLAGS=|1|
56 . . I XMTSK[U D Q
57 . . . N XMPARM ; Task |1| scheduled for |2|
58 . . . S XMPARM(1)=$P(XMTSK,U),XMPARM(2)=$P($$HTE^XLFDT($P(XMTSK,U,2),"2Z"),":",1,2)
59 . . . W ?26,$$EZBLD^DIALOG(42139,.XMPARM)
60 . . W ?26,$$EZBLD^DIALOG(42140,XMTSK) ; Task |1| just started
61 I 'XMCNT W !,$$EZBLD^DIALOG(42141) ; No messages queued or in active transmission.
62 Q
63SHOWQ ; Display messages in queue
64 N XMDUZ,XMINST,XMSITE,XMABORT
65 D CHECK^XMVVITAE
66 S XMABORT=0 ; Choose queue w/msgs
67 D ASKINST^XMCXU(.XMINST,.XMSITE,.XMABORT,"M") Q:XMABORT
68 I DUZ=.5 D LIST^XMJMLR(.5,XMINST+1000,XMSITE,1,.XMABORT) Q
69 I $D(^XUSEC("XMNOPRIV",DUZ))!'$D(^XMB(3.7,"AB",DUZ,.5)) D Q
70 . ; not a postmaster surrogate, so look only - no touch!
71 . D LIST^XMJML(.5,XMINST+1000,XMSITE,"",1)
72 S XMDUZ=.5
73 D OTHER^XMVVITAE
74 D LIST^XMJMLR(XMDUZ,XMINST+1000,XMSITE,1,.XMABORT)
75 D SELF^XMVVITAE
76 Q
Note: See TracBrowser for help on using the repository browser.