source: FOIAVistA/trunk/r/MAILMAN-XM/XMCXU.m@ 1540

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

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1XMCXU ;ISC-SF/GMB- Select Domains/Scripts ;04/17/2002 08:43
2 ;;8.0;MailMan;;Jun 28, 2002
3ASK(XMINST,XMSITE,XMB,XMABORT,XMSCREEN,XMOKTYPE) ;
4 D ASKINST(.XMINST,.XMSITE,.XMABORT,.XMSCREEN) Q:XMABORT
5 D ASKSCR(XMINST,XMSITE,.XMB,.XMABORT,.XMOKTYPE)
6 Q
7ASKINST(XMINST,XMSITE,XMABORT,XMSCREEN) ; Lookup domain, perhaps using screen
8 N DIC,X,Y,D,XMCX,XMCXC,XMCXM
9 S XMCXM=$$EZBLD^DIALOG(34007.2) ; msgs
10 S XMCXC=$$EZBLD^DIALOG(42281) ;* Closed *
11 S DIC=4.2,DIC(0)="AEQM",D="B^C"
12 S DIC("W")="S XMCX=($P(^(0),U,2)[""C"") W ?50,$J($$BMSGCT^XMXUTIL(.5,Y+1000),6),XMCXM W:XMCX ?65,XMCXC"
13 I $G(XMSCREEN)'="" D
14 . I $L(XMSCREEN)>1 S DIC("S")=XMSCREEN
15 . I XMSCREEN="M" D
16 . . N XMTEXT
17 . . W !
18 . . ;This option lets you select only those queues which have messages.
19 . . ;If you can't select a queue, it either doesn't exist or it has no messages.
20 . . D BLD^DIALOG(42282,"","","XMTEXT","F")
21 . . D MSG^DIALOG("WM","","","","XMTEXT")
22 . . W !
23 . . S DIC("S")="I $O(^XMB(3.7,.5,2,Y+1000,1,0))"
24 . . ;Select queue. Only queues with messages are shown.
25 . . D BLD^DIALOG(42283,"","","DIC(""?"")")
26 D MIX^DIC1 I Y=-1 S XMABORT=1 Q
27 S XMINST=+Y
28 S XMSITE=$P(Y,U,2)
29 Q
30ASKSCR(XMINST,XMSITE,XMB,XMABORT,XMOKTYPE) ;
31 D SCRIPT^XMKPR1(XMINST,XMSITE,.XMB,.XMOKTYPE)
32 I 'XMB("SCR IEN") W !,$$EZBLD^DIALOG(42284) S XMABORT=1 Q ;No valid script for this domain!
33 D SCRIPT(XMINST,XMSITE,.XMB,.XMABORT) Q:XMABORT
34 Q
35SCRIPT(XMINST,XMSITE,XMB,XMABORT) ; Ask user to select the script.
36 ; List valid entries.
37 N I,XMREC,XMTEXT
38 W !
39 ; # Script Name Type Priority
40 ; -- ----------- ---- --------
41 D BLD^DIALOG(42285,"","","XMTEXT","F")
42 D MSG^DIALOG("WM","","","","XMTEXT")
43 S I=0
44 F S I=$O(^DIC(4.2,XMINST,1,I)) Q:'I S XMREC=^(I,0) W !,$J(I,3),?5,$P(XMREC,U),?30,$P(XMREC,U,4),?40,$J($P(XMREC,U,2),2) I $P(XMREC,U,7) W ?50,$$EZBLD^DIALOG(42286) ;* Out of Service *
45 W !
46 I $O(^DIC(4.2,XMINST,1,0))=XMB("SCR IEN"),+$O(^(XMB("SCR IEN")))=0 Q
47 N DIC,X,Y
48 S DIC="^DIC(4.2,XMINST,1,"
49 S DIC(0)="AEQMNZ"
50 S DIC("A")=$$EZBLD^DIALOG(42287) ;Select Script:
51 S DIC("B")=XMB("SCR IEN")
52 S DIC("W")="W ?30,$P(^(0),U,4),?40,$J($P(^(0),U,2),2) W:$P(^(0),U,7) ?60,$$EZBLD^DIALOG(42286)" ;* Out of Service *
53 D ^DIC I Y=-1 S XMABORT=1 Q
54 Q:+Y=XMB("SCR IEN")
55 S (XMB("SCR IEN"),XMB("FIRST SCRIPT"))=+Y
56 D INITSCR^XMKPR1(XMINST,XMSITE,.XMB)
57 Q
58CHKTSK(XMINST,XMCHOOSE,XMABORT) ;
59 N XMTSK,XMTEXT,XMPARM
60 S XMTSK=$$TSKEXIST^XMKPR(XMINST) Q:'XMTSK
61 I +XMTSK=XMTSK D Q
62 . W !,$C(7) ;Task |1| is transmitting this domain's messages now.
63 . D BLD^DIALOG(42288,XMTSK,"","XMTEXT","F")
64 . D MSG^DIALOG("WM","","","","XMTEXT")
65 . S XMABORT=1
66 W !,$C(7) ;Task |1| is scheduled to transmit this domain's messages
67 ;on |2|.
68 S XMPARM(1)=+XMTSK,XMPARM(2)=$$HTE^XLFDT($P(XMTSK,U,2),5)
69 D BLD^DIALOG(42288.1,.XMPARM,"","XMTEXT","F")
70 D MSG^DIALOG("WM","","","","XMTEXT")
71 S XMTSK=+XMTSK
72 N DIR,X,Y
73 S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ;NO
74 D BLD^DIALOG($S(XMCHOOSE=1:42289,1:42289.1),XMTSK,"","DIR(""A"")")
75 ;1: Do you want to kill task |1| and queue up a new one
76 ;2: Do you want to kill task |1| before we play the script
77 D ^DIR I $D(DIRUT) S XMABORT=1 Q
78 I 'Y S:XMCHOOSE=1 XMABORT=1 Q
79 D KILLTSK^XMKPR(XMINST,XMTSK)
80 Q
Note: See TracBrowser for help on using the repository browser.