source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMHIG.m@ 1226

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

initial load of WorldVistAEHR
File size: 5.1 KB
Line 
1XMHIG ;ISC-SF/GMB-Mail Group Info ;12/05/2002 10:39
2 ;;8.0;MailMan;**10**;Jun 28, 2002
3 ; Replaces ENTQ^XMA5,GHELP^XMA7G (ISC-WASH/THM/CAP/RJ)
4 ;
5 ; Entry points used by MailMan options (not covered by DBIA):
6 ; HELP XMHELPGROUP - Get info on a group
7HELP ; Group Info
8 N DIC,Y
9 D CHECK^XMVVITAE
10 S DIC="^XMB(3.8,",DIC(0)="AEQMZ"
11 ; Screen: Group is public OR user is organizer OR user is member
12 S DIC("S")="I $P(^(0),U,2)=""PU""!($G(^(3))=XMDUZ)!($D(^(1,""B"",XMDUZ)))"
13 F W ! D ^DIC Q:Y<0 D
14 . D DISPLAY(+Y)
15 Q
16DISPLAY(XMGIEN) ;
17 N XMABORT
18 S XMABORT=0
19 W @IOF
20 D FIELDS(XMGIEN)
21 D AUTHSEND(XMGIEN,.XMABORT) Q:XMABORT
22 D MEMBERS(XMGIEN,.XMABORT) Q:XMABORT
23 D GROUP(XMGIEN,.XMABORT) Q:XMABORT
24 D REMOTE(XMGIEN,.XMABORT) Q:XMABORT
25 D DISTR(XMGIEN,.XMABORT) Q:XMABORT
26 D FAXMEMBR(XMGIEN,.XMABORT) Q:XMABORT
27 D FAXGROUP(XMGIEN,.XMABORT) Q:XMABORT
28 D MEMBEROF(XMGIEN,.XMABORT) Q:XMABORT
29 Q
30FIELDS(DA) ;
31 N DIC,DR
32 S DIC="^XMB(3.8,"
33 F DR=0,2,3 D EN^DIQ
34 Q
35AUTHSEND(XMGIEN,XMABORT) ;
36 Q:'$O(^XMB(3.8,XMGIEN,4,0))
37 N XMI,XMMIEN
38 S XMI=0
39 F S XMI=$O(^XMB(3.8,XMGIEN,4,XMI)) Q:XMI'>0 D Q:XMABORT
40 . I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
41 . S XMMIEN=$P(^XMB(3.8,XMGIEN,4,XMI,0),U)
42 . I '$D(^VA(200,XMMIEN,0)) D DELETE(XMGIEN,4,XMI) Q
43 . W !,$$EZBLD^DIALOG(39089),$$NAME^XMXUTIL(XMMIEN) ;Authorized Sender:
44 Q
45MEMBERS(XMGIEN,XMABORT) ;
46 Q:'$O(^XMB(3.8,XMGIEN,1,0))
47 N XMI,XMMIEN,XMNAME,XMTITLE,XMREC,XMINST,XMTYPE
48 I $Y+5>IOSL D Q:XMABORT
49 . D PAGE(.XMABORT)
50 E W !!
51 D HEADER
52 S XMI=0
53 F S XMI=$O(^XMB(3.8,XMGIEN,1,XMI)) Q:XMI'>0 D Q:XMABORT
54 . I $Y+3>IOSL D PAGE(.XMABORT,1) Q:XMABORT
55 . S XMREC=^XMB(3.8,XMGIEN,1,XMI,0)
56 . S XMMIEN=$P(XMREC,U)
57 . S XMTYPE=$P(XMREC,U,2)
58 . I '$D(^VA(200,XMMIEN,0)) D DELETE(XMGIEN,1,XMI) Q
59 . S XMNAME=$$NAME^XMXUTIL(XMMIEN,1)
60 . I XMTYPE'="" S XMNAME=XMTYPE_":"_XMNAME
61 . W !,$E(XMNAME,1,IOM-36),?IOM-35,$S($D(^XMB(3.7,XMMIEN,"L")):$E($P(^("L"),U),1,35),1:$$EZBLD^DIALOG(38007)) ;Never Used MailMan
62 Q
63DELETE(XMGIEN,XMNODE,DA) ;
64 N DIK
65 L +^XMB(3.8,XMGIEN,XMNODE):1
66 S DA(1)=XMGIEN
67 S DIK="^XMB(3.8,"_DA(1)_","_XMNODE_","
68 D ^DIK
69 L -^XMB(3.8,XMGIEN,XMNODE)
70 Q
71GROUP(XMGIEN,XMABORT) ; Member Groups
72 Q:'$O(^XMB(3.8,XMGIEN,5,0))
73 N XMI,XMMIEN,XMNAME,XMREC
74 W !
75 S XMI=0
76 F S XMI=$O(^XMB(3.8,XMGIEN,5,XMI)) Q:XMI'>0 D Q:XMABORT
77 . I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
78 . S XMREC=^XMB(3.8,XMGIEN,5,XMI,0)
79 . S XMMIEN=$P(XMREC,U)
80 . S XMTYPE=$P(XMREC,U,2)
81 . S XMNAME=$P($G(^XMB(3.8,XMMIEN,0)),U)
82 . I XMNAME="" D DELETE(XMGIEN,5,XMI) Q
83 . I XMTYPE'="" S XMNAME=XMTYPE_":"_XMNAME
84 . W !,$$EZBLD^DIALOG(39090),XMNAME ;Member Group:
85 Q
86REMOTE(XMGIEN,XMABORT) ; Remote Members
87 Q:'$O(^XMB(3.8,XMGIEN,6,0))
88 N XMI,XMNAME
89 W !
90 S XMI=0
91 F S XMI=$O(^XMB(3.8,XMGIEN,6,XMI)) Q:XMI'>0 D Q:XMABORT
92 . I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
93 . S XMNAME=$P(^XMB(3.8,XMGIEN,6,XMI,0),U)
94 . W !,$$EZBLD^DIALOG(39085),XMNAME ;Remote Member:
95 Q
96DISTR(XMGIEN,XMABORT) ; Distribution list
97 Q:'$O(^XMB(3.8,XMGIEN,7,0))
98 N XMI,XMMIEN,XMNAME
99 W !
100 S XMI=0
101 F S XMI=$O(^XMB(3.8,XMGIEN,7,XMI)) Q:XMI'>0 D Q:XMABORT
102 . I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
103 . S XMMIEN=$P(^XMB(3.8,XMGIEN,7,XMI,0),U)
104 . S XMNAME=$P($G(^XMB(3.816,XMMIEN,0)),U)
105 . I XMNAME="" D DELETE(XMGIEN,7,XMI) Q
106 . W !,$$EZBLD^DIALOG(39080),XMNAME ;Distribution List:
107 . W:$D(^XMB(3.816,XMMIEN,1,0)) $$EZBLD^DIALOG(39092,$P(^(0),U,4)) ; (To |1| Domains)
108 Q
109FAXGROUP(XMGIEN,XMABORT) ; Fax Groups
110 Q:'$O(^XMB(3.8,XMGIEN,9,0))
111 N XMI,XMMIEN,XMNAME
112 W !
113 S XMI=0
114 F S XMI=$O(^XMB(3.8,XMGIEN,9,XMI)) Q:XMI'>0 D Q:XMABORT
115 . I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
116 . S XMMIEN=$P(^XMB(3.8,XMGIEN,9,XMI,0),U)
117 . S XMNAME=$P($G(^AKF("FAXG",XMMIEN,0)),U)
118 . I XMNAME="" D DELETE(XMGIEN,9,XMI) Q
119 . W !,$$EZBLD^DIALOG(39081),XMNAME ;Fax Group:
120 Q
121FAXMEMBR(XMGIEN,XMABORT) ; Fax Members
122 Q:'$O(^XMB(3.8,XMGIEN,8,0))
123 N XMI,XMMIEN,XMNAME
124 W !
125 S XMI=0
126 F S XMI=$O(^XMB(3.8,XMGIEN,8,XMI)) Q:XMI'>0 D Q:XMABORT
127 . I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
128 . S XMMIEN=$P(^XMB(3.8,XMGIEN,8,XMI,0),U)
129 . S XMNAME=$P($G(^AKF("FAXR",XMMIEN,0)),U)
130 . I XMNAME="" D DELETE(XMGIEN,8,XMI) Q
131 . W !,$$EZBLD^DIALOG(39082),XMNAME ;Fax Recipient:
132 Q
133MEMBEROF(XMGIEN,XMABORT) ; This group is a member of what other Groups
134 Q:'$D(^XMB(3.8,"AD",XMGIEN))
135 N XMMIEN,XMNAME
136 W !
137 S XMMIEN=0
138 F S XMMIEN=$O(^XMB(3.8,"AD",XMGIEN,XMMIEN)) Q:'XMMIEN D Q:XMABORT
139 . I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
140 . S XMNAME=$P($G(^XMB(3.8,XMMIEN,0)),U)
141 . I XMNAME="" D Q
142 . . N XMI
143 . . S XMI=$O(^XMB(3.8,"AD",XMGIEN,XMMIEN,0))
144 . . I XMI D DELETE(XMMIEN,5,XMI) Q
145 . . K ^XMB(3.8,"AD",XMGIEN,XMMIEN)
146 . W !,$$EZBLD^DIALOG(39093),XMNAME ; member of group:
147 Q
148GSCREEN ; This routine is a screen [DIC("S")] for a fileman lookup
149 ; The naked reference is set to ^XMB(3.8,Y,0)
150 I $P(^(0),U,2)="PU" Q ; Group is public
151 I $G(^(3))=XMDUZ Q ; User is organizer of the group
152 I $D(^(1,"B",XMDUZ)) Q ; User is a member of the group
153 ; *** But this doesn't handle the case in which a user might not be
154 ; *** a member of this group, but is a member of a member group.
155 Q
156PAGE(XMABORT,XMHDR) ;
157 D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
158 W @IOF
159 D:$G(XMHDR) HEADER
160 Q
161HEADER ;
162 W $$EZBLD^DIALOG(39091) ;Member Last Used MailMan
163 Q
Note: See TracBrowser for help on using the repository browser.