source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMXADDR2.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: 6.6 KB
Line 
1XMXADDR2 ;ISC-SF/GMB-XMXADDR (cont.) ;04/17/2002 13:42
2 ;;8.0;MailMan;;Jun 28, 2002
3BRODCAST(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMFULL) ;
4 I $D(XMRESTR("NET RECEIVE")) D SETERR^XMXADDR4(0,"",39035) Q ;Broadcast messages are not accepted from remote sites.
5 I DUZ'=.5,'$D(^XUSEC("XMSTAR",DUZ)),'$D(^XUSEC("XMSTAR LIMITED",DUZ)) D Q
6 . ;Only the Postmaster or XMSTAR key holders may broadcast messages.
7 . D SETERR^XMXADDR4($G(XMIA),"!",39036)
8 I $D(XMRESTR("NOBCAST")) D SETERR^XMXADDR4($G(XMIA),"P",39036.5) Q ; Messages with replies may not be broadcast.
9 N XMCAST
10 I DUZ=.5!$D(^XUSEC("XMSTAR",DUZ)) D Q:$D(XMERROR)
11 . I '$G(XMIA) S XMCAST=$S(XMADDR="*":"F",1:"L") Q
12 . I XMADDR'="*" S XMCAST="L" Q
13 . D TYPECAST(.XMCAST)
14 E S XMCAST="L"
15 I XMCAST="F" D FULLCAST(XMSTRIKE,XMPREFIX,XMLATER,.XMFULL) Q
16 ; Doing a limited broadcast...
17 N XMLTD
18 I XMADDR'="*" D
19 . D CHECKIT(XMADDR,.XMLTD)
20 E D
21 . D TYPELTD(.XMLTD) Q:$D(XMERROR)
22 . D PARMLTD(.XMLTD) Q:$D(XMERROR)
23 Q:$D(XMERROR)
24 ;S XMFULL="* (Limited Broadcast)"
25 S XMFULL="*;"_XMLTD("TYPE")_";"_XMLTD("PARM")
26 I $G(XMINSTR("ADDR FLAGS"))["X" Q
27 I XMSTRIKE Q:$D(^TMP("XMY0",$J,XMFULL,"L")) W:$G(XMIA) $$EZBLD^DIALOG(39037) ;Deleting limited broadcast recipients
28 I $G(XMIA),'XMSTRIKE,XMLATER="?" D QLATER^XMXADDR(XMFULL,.XMLATER) Q:$D(XMERROR)
29 I XMLATER,'$G(XMIA) Q
30 I 'XMSTRIKE,$G(XMIA) W !,$$EZBLD^DIALOG(39038),! ;Limited broadcast recipients:
31 N XMSCREEN
32 ; User must have access code, verify code, primary menu, and mailbox
33 S XMSCREEN="I $L($P(^(0),U,3)),$L($P($G(^(.1)),U,2)),$L($P($G(^(201)),U,1)),$D(^XMB(3.7,+Y,2))"
34 D FIND^DIC(200,"","@","QX",XMLTD("PARM IEN"),"",XMLTD("XREF"),XMSCREEN)
35 I '$D(^TMP("DILIST",$J)) D Q
36 . D SETERR^XMXADDR4($G(XMIA),"",39039) ;No matches. No recipients.
37 D SHOWLTD(XMDUZ,XMSTRIKE,XMPREFIX,XMLATER,$G(XMIA))
38 Q
39TYPECAST(XMCAST) ;
40 N DIR,XMALL
41 S XMALL=$$EZBLD^DIALOG(39040) ;Broadcast to all local users
42 S DIR(0)="S^"_XMALL_";"_$$EZBLD^DIALOG(39041) ;Limited broadcast to local users
43 D BLD^DIALOG(39042,"","","DIR(""A"")") ;Broadcast type
44 S DIR("B")=$P(XMALL,":",2,9)
45 ;Enter B to broadcast to all local users.
46 ;Enter L to broadcast to a subset of local users. Limited broadcasts
47 ;are to local users who have something in common, such as belonging
48 ;to the same DIVISION, or holding the same PRIMARY MENU.
49 ;The LIMITED BROADCASTs from which you may choose are defined by
50 ;your IRM in the MAILMAN SITE PARAMETERS file.
51 D BLD^DIALOG(39043,"","","DIR(""?"")")
52 D ^DIR I $D(DIRUT) D SETERR^XMXADDR4(0,"",37002) Q ;up-arrow or time out.
53 S XMCAST=$S(Y=$P(XMALL,":",1):"F",1:"L")
54 Q
55FULLCAST(XMSTRIKE,XMPREFIX,XMLATER,XMFULL) ;
56 S XMFULL=$$EZBLD^DIALOG(39006) ;* (Broadcast to all local users)
57 W:$G(XMIA) $E(XMFULL,2,99)
58 D SETEXP^XMXADDR(XMFULL,"",XMSTRIKE,XMPREFIX,XMLATER)
59 Q
60TYPELTD(XMLTD) ;
61 N DIC,DA,X,Y,DIR,XMDEF
62 S DA(1)=1
63 S DIC="^XMB(1,1,5,"
64 S XMDEF=$P(^XMB(1,1,0),U,20) I XMDEF S XMDEF=$P($G(^XMB(1,1,5,XMDEF,0)),U,1) I XMDEF'="" S DIC("B")=XMDEF
65 S DIC(0)="AEQZ"
66 D ^DIC I Y=-1!$D(DTOUT)!$D(DUOUT) D SETERR^XMXADDR4(0,"",37002) Q ;up-arrow or time out.
67 S XMLTD("TYPE IEN")=+Y
68 S XMLTD("TYPE")=$P(Y(0),U,1)
69 S XMLTD("FILE")=$P(Y(0),U,2)
70 S XMLTD("XREF")=$P(Y(0),U,3)
71 D CHKFILE(.XMLTD) Q:$D(XMERROR)
72 D CHKXREF(.XMLTD) Q:$D(XMERROR)
73 Q
74CHKFILE(XMLTD) ;
75 I XMLTD("FILE")="" D Q
76 . ;Limited Broadcast entry |1|, field |2| is null.
77 . D SETERR^XMXADDR4($G(XMIA),"!",39044,XMLTD("TYPE IEN"),1)
78 I '$$VFILE^DILFD(XMLTD("FILE")) D Q
79 . ;Limited Broadcast entry |1|, field |2|: '|3|' does not exist.
80 . D SETERR^XMXADDR4($G(XMIA),"!",39045,XMLTD("TYPE IEN"),1,XMLTD("FILE"))
81 Q
82CHKXREF(XMLTD) ;
83 I XMLTD("XREF")="" D Q
84 . ;Limited Broadcast entry |1|, field |2| is null.
85 . D SETERR^XMXADDR4($G(XMIA),"!",39044,XMLTD("TYPE IEN"),2)
86 I '$D(^VA(200,XMLTD("XREF"))) D Q
87 . ;Limited Broadcast entry |1|, field |2|: '|3|' does not exist.
88 . D SETERR^XMXADDR4($G(XMIA),"!",39045,XMLTD("TYPE IEN"),2,XMLTD("XREF"))
89 Q
90PARMLTD(XMLTD) ;
91 N DIC,DIR,X,Y
92 S DIC=$$ROOT^DILFD(XMLTD("FILE"))
93 S DIC(0)="AEQZ"
94 S DIC("S")="I $D(^VA(200,"""_XMLTD("XREF")_""",+Y))"
95 S DIC("A")=$$EZBLD^DIALOG(39046,XMLTD("TYPE")) ;Select Limited Broadcast |1|:
96 D ^DIC I Y=-1!$D(DTOUT)!$D(DUOUT) D SETERR^XMXADDR4(0,"",37002) Q ;up-arrow or time out.
97 S XMLTD("PARM IEN")=+Y
98 S XMLTD("PARM")=Y(0,0)
99 Q
100CHECKIT(XMADDR,XMLTD) ;
101 S XMLTD("TYPE")=$P(XMADDR,";",2) I XMLTD("TYPE")="" D SETERR^XMXADDR4($G(XMIA),"!",39047) Q ;Limited Broadcast selection is null.
102 S XMLTD("PARM")=$P(XMADDR,";",3) I XMLTD("PARM")="" D SETERR^XMXADDR4($G(XMIA),"!",39047.5) Q ;Limited Broadcast selection value is null.
103 S XMLTD("TYPE IEN")=$$FIND1^DIC(4.32,",1,","OQ",XMLTD("TYPE"))
104 I 'XMLTD("TYPE IEN") D SETERR^XMXADDR4($G(XMIA),"!",$S(XMLTD("TYPE IEN")=0:39048,1:39049),XMLTD("TYPE")) Q ;Limited Broadcast selection not found: |1| / Limited Broadcast selection ambiguous: |1|
105 N XMREC
106 S XMREC=$G(^XMB(1,1,5,XMLTD("TYPE IEN"),0))
107 S XMLTD("TYPE")=$P(XMREC,U,1)
108 S XMLTD("FILE")=$P(XMREC,U,2)
109 S XMLTD("XREF")=$P(XMREC,U,3)
110 D CHKFILE(.XMLTD) Q:$D(XMERROR)
111 D CHKXREF(.XMLTD) Q:$D(XMERROR)
112 S XMLTD("PARM IEN")=$$FIND1^DIC(XMLTD("FILE"),"","OQ",XMLTD("PARM"))
113 I XMLTD("PARM IEN") S XMLTD("PARM")=$$GET1^DIQ(XMLTD("FILE"),XMLTD("PARM IEN")_",",.01) Q
114 N XMPARM S XMPARM(1)=XMLTD("PARM"),XMPARM(2)=XMLTD("FILE")
115 D SETERR^XMXADDR4($G(XMIA),"!",$S(XMLTD("PARM IEN")=0:39050,1:39051),.XMPARM) ;Limited Broadcast value '|1|' not found / Limited Broadcast value '|1|' ambiguous
116 Q
117SHOWLTD(XMDUZ,XMSTRIKE,XMPREFIX,XMLATER,XMIA) ;
118 N XMI,XMGM,XMCNT
119 S (XMI,XMCNT)=0
120 F S XMI=$O(^TMP("DILIST",$J,2,XMI)) Q:'XMI S XMGM=^(XMI) D
121 . N XMERROR,XMFWDADD
122 . I 'XMLATER D INDIV^XMXADDR(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER)
123 . Q:'XMIA
124 . I XMCNT,XMCNT#16=0 D Q:'XMIA
125 . . N DIR,Y ;Do you want to see more Limited Broadcast recipients
126 . . S DIR("A")=$$EZBLD^DIALOG(39052)
127 . . S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ;No
128 . . D ^DIR
129 . . S XMIA=+Y ; The '+' takes care of $D(DIRUT)
130 . S XMCNT=XMCNT+1
131 . W:XMCNT#4-1=0 !
132 . W ?XMCNT-1#4*20,$E($S(XMPREFIX="":"",1:XMPREFIX_":")_$$NAME^XMXUTIL(XMGM),1,19)
133 K ^TMP("DILIST",$J)
134 Q
135INXFORM(X) ; Input transform for file 4.3, field 51 LIMITED BROADCAST DEFAULT
136 N DIC,DA,Y,DIR,XMERROR,XMLTD,XMIA
137 I '$D(ZTQUEUED) S XMIA=1
138 S DA(1)=1
139 S DIC="^XMB(1,1,5,"
140 S DIC(0)="EQZ"
141 D ^DIC I Y=-1!$D(DTOUT)!$D(DUOUT) K X Q
142 S XMLTD("TYPE IEN")=+Y
143 S XMLTD("TYPE")=$P(Y(0),U,1)
144 S XMLTD("FILE")=$P(Y(0),U,2)
145 S XMLTD("XREF")=$P(Y(0),U,3)
146 D CHKFILE(.XMLTD) I $D(XMERROR) K X Q
147 D CHKXREF(.XMLTD) I $D(XMERROR) K X Q
148 S X=XMLTD("TYPE IEN")
149 Q
150EXHELP ; Executable help for file 4.3, field 51 LIMITED BROADCAST DEFAULT
151 N I
152 D EN^DDIOL($$EZBLD^DIALOG(38056)) ; Choose from:
153 S I=0
154 F S I=$O(^XMB(1,1,5,I)) Q:'I D EN^DDIOL($P(^(I,0),U,1))
155 Q
Note: See TracBrowser for help on using the repository browser.