XMHIG ;ISC-SF/GMB-Mail Group Info ;12/05/2002 10:39
;;8.0;MailMan;**10**;Jun 28, 2002
; Replaces ENTQ^XMA5,GHELP^XMA7G (ISC-WASH/THM/CAP/RJ)
;
; Entry points used by MailMan options (not covered by DBIA):
; HELP XMHELPGROUP - Get info on a group
HELP ; Group Info
N DIC,Y
D CHECK^XMVVITAE
S DIC="^XMB(3.8,",DIC(0)="AEQMZ"
; Screen: Group is public OR user is organizer OR user is member
S DIC("S")="I $P(^(0),U,2)=""PU""!($G(^(3))=XMDUZ)!($D(^(1,""B"",XMDUZ)))"
F W ! D ^DIC Q:Y<0 D
. D DISPLAY(+Y)
Q
DISPLAY(XMGIEN) ;
N XMABORT
S XMABORT=0
W @IOF
D FIELDS(XMGIEN)
D AUTHSEND(XMGIEN,.XMABORT) Q:XMABORT
D MEMBERS(XMGIEN,.XMABORT) Q:XMABORT
D GROUP(XMGIEN,.XMABORT) Q:XMABORT
D REMOTE(XMGIEN,.XMABORT) Q:XMABORT
D DISTR(XMGIEN,.XMABORT) Q:XMABORT
D FAXMEMBR(XMGIEN,.XMABORT) Q:XMABORT
D FAXGROUP(XMGIEN,.XMABORT) Q:XMABORT
D MEMBEROF(XMGIEN,.XMABORT) Q:XMABORT
Q
FIELDS(DA) ;
N DIC,DR
S DIC="^XMB(3.8,"
F DR=0,2,3 D EN^DIQ
Q
AUTHSEND(XMGIEN,XMABORT) ;
Q:'$O(^XMB(3.8,XMGIEN,4,0))
N XMI,XMMIEN
S XMI=0
F S XMI=$O(^XMB(3.8,XMGIEN,4,XMI)) Q:XMI'>0 D Q:XMABORT
. I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
. S XMMIEN=$P(^XMB(3.8,XMGIEN,4,XMI,0),U)
. I '$D(^VA(200,XMMIEN,0)) D DELETE(XMGIEN,4,XMI) Q
. W !,$$EZBLD^DIALOG(39089),$$NAME^XMXUTIL(XMMIEN) ;Authorized Sender:
Q
MEMBERS(XMGIEN,XMABORT) ;
Q:'$O(^XMB(3.8,XMGIEN,1,0))
N XMI,XMMIEN,XMNAME,XMTITLE,XMREC,XMINST,XMTYPE
I $Y+5>IOSL D Q:XMABORT
. D PAGE(.XMABORT)
E W !!
D HEADER
S XMI=0
F S XMI=$O(^XMB(3.8,XMGIEN,1,XMI)) Q:XMI'>0 D Q:XMABORT
. I $Y+3>IOSL D PAGE(.XMABORT,1) Q:XMABORT
. S XMREC=^XMB(3.8,XMGIEN,1,XMI,0)
. S XMMIEN=$P(XMREC,U)
. S XMTYPE=$P(XMREC,U,2)
. I '$D(^VA(200,XMMIEN,0)) D DELETE(XMGIEN,1,XMI) Q
. S XMNAME=$$NAME^XMXUTIL(XMMIEN,1)
. I XMTYPE'="" S XMNAME=XMTYPE_":"_XMNAME
. 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
Q
DELETE(XMGIEN,XMNODE,DA) ;
N DIK
L +^XMB(3.8,XMGIEN,XMNODE):1
S DA(1)=XMGIEN
S DIK="^XMB(3.8,"_DA(1)_","_XMNODE_","
D ^DIK
L -^XMB(3.8,XMGIEN,XMNODE)
Q
GROUP(XMGIEN,XMABORT) ; Member Groups
Q:'$O(^XMB(3.8,XMGIEN,5,0))
N XMI,XMMIEN,XMNAME,XMREC
W !
S XMI=0
F S XMI=$O(^XMB(3.8,XMGIEN,5,XMI)) Q:XMI'>0 D Q:XMABORT
. I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
. S XMREC=^XMB(3.8,XMGIEN,5,XMI,0)
. S XMMIEN=$P(XMREC,U)
. S XMTYPE=$P(XMREC,U,2)
. S XMNAME=$P($G(^XMB(3.8,XMMIEN,0)),U)
. I XMNAME="" D DELETE(XMGIEN,5,XMI) Q
. I XMTYPE'="" S XMNAME=XMTYPE_":"_XMNAME
. W !,$$EZBLD^DIALOG(39090),XMNAME ;Member Group:
Q
REMOTE(XMGIEN,XMABORT) ; Remote Members
Q:'$O(^XMB(3.8,XMGIEN,6,0))
N XMI,XMNAME
W !
S XMI=0
F S XMI=$O(^XMB(3.8,XMGIEN,6,XMI)) Q:XMI'>0 D Q:XMABORT
. I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
. S XMNAME=$P(^XMB(3.8,XMGIEN,6,XMI,0),U)
. W !,$$EZBLD^DIALOG(39085),XMNAME ;Remote Member:
Q
DISTR(XMGIEN,XMABORT) ; Distribution list
Q:'$O(^XMB(3.8,XMGIEN,7,0))
N XMI,XMMIEN,XMNAME
W !
S XMI=0
F S XMI=$O(^XMB(3.8,XMGIEN,7,XMI)) Q:XMI'>0 D Q:XMABORT
. I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
. S XMMIEN=$P(^XMB(3.8,XMGIEN,7,XMI,0),U)
. S XMNAME=$P($G(^XMB(3.816,XMMIEN,0)),U)
. I XMNAME="" D DELETE(XMGIEN,7,XMI) Q
. W !,$$EZBLD^DIALOG(39080),XMNAME ;Distribution List:
. W:$D(^XMB(3.816,XMMIEN,1,0)) $$EZBLD^DIALOG(39092,$P(^(0),U,4)) ; (To |1| Domains)
Q
FAXGROUP(XMGIEN,XMABORT) ; Fax Groups
Q:'$O(^XMB(3.8,XMGIEN,9,0))
N XMI,XMMIEN,XMNAME
W !
S XMI=0
F S XMI=$O(^XMB(3.8,XMGIEN,9,XMI)) Q:XMI'>0 D Q:XMABORT
. I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
. S XMMIEN=$P(^XMB(3.8,XMGIEN,9,XMI,0),U)
. S XMNAME=$P($G(^AKF("FAXG",XMMIEN,0)),U)
. I XMNAME="" D DELETE(XMGIEN,9,XMI) Q
. W !,$$EZBLD^DIALOG(39081),XMNAME ;Fax Group:
Q
FAXMEMBR(XMGIEN,XMABORT) ; Fax Members
Q:'$O(^XMB(3.8,XMGIEN,8,0))
N XMI,XMMIEN,XMNAME
W !
S XMI=0
F S XMI=$O(^XMB(3.8,XMGIEN,8,XMI)) Q:XMI'>0 D Q:XMABORT
. I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
. S XMMIEN=$P(^XMB(3.8,XMGIEN,8,XMI,0),U)
. S XMNAME=$P($G(^AKF("FAXR",XMMIEN,0)),U)
. I XMNAME="" D DELETE(XMGIEN,8,XMI) Q
. W !,$$EZBLD^DIALOG(39082),XMNAME ;Fax Recipient:
Q
MEMBEROF(XMGIEN,XMABORT) ; This group is a member of what other Groups
Q:'$D(^XMB(3.8,"AD",XMGIEN))
N XMMIEN,XMNAME
W !
S XMMIEN=0
F S XMMIEN=$O(^XMB(3.8,"AD",XMGIEN,XMMIEN)) Q:'XMMIEN D Q:XMABORT
. I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
. S XMNAME=$P($G(^XMB(3.8,XMMIEN,0)),U)
. I XMNAME="" D Q
. . N XMI
. . S XMI=$O(^XMB(3.8,"AD",XMGIEN,XMMIEN,0))
. . I XMI D DELETE(XMMIEN,5,XMI) Q
. . K ^XMB(3.8,"AD",XMGIEN,XMMIEN)
. W !,$$EZBLD^DIALOG(39093),XMNAME ; member of group:
Q
GSCREEN ; This routine is a screen [DIC("S")] for a fileman lookup
; The naked reference is set to ^XMB(3.8,Y,0)
I $P(^(0),U,2)="PU" Q ; Group is public
I $G(^(3))=XMDUZ Q ; User is organizer of the group
I $D(^(1,"B",XMDUZ)) Q ; User is a member of the group
; *** But this doesn't handle the case in which a user might not be
; *** a member of this group, but is a member of a member group.
Q
PAGE(XMABORT,XMHDR) ;
D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
W @IOF
D:$G(XMHDR) HEADER
Q
W $$EZBLD^DIALOG(39091) ;Member Last Used MailMan
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMHIG 5372 printed Dec 13, 2024@02:11:42 Page 2
XMHIG ;ISC-SF/GMB-Mail Group Info ;12/05/2002 10:39
+1 ;;8.0;MailMan;**10**;Jun 28, 2002
+2 ; Replaces ENTQ^XMA5,GHELP^XMA7G (ISC-WASH/THM/CAP/RJ)
+3 ;
+4 ; Entry points used by MailMan options (not covered by DBIA):
+5 ; HELP XMHELPGROUP - Get info on a group
HELP ; Group Info
+1 NEW DIC,Y
+2 DO CHECK^XMVVITAE
+3 SET DIC="^XMB(3.8,"
SET DIC(0)="AEQMZ"
+4 ; Screen: Group is public OR user is organizer OR user is member
+5 SET DIC("S")="I $P(^(0),U,2)=""PU""!($G(^(3))=XMDUZ)!($D(^(1,""B"",XMDUZ)))"
+6 FOR
WRITE !
DO ^DIC
if Y<0
QUIT
Begin DoDot:1
+7 DO DISPLAY(+Y)
End DoDot:1
+8 QUIT
DISPLAY(XMGIEN) ;
+1 NEW XMABORT
+2 SET XMABORT=0
+3 WRITE @IOF
+4 DO FIELDS(XMGIEN)
+5 DO AUTHSEND(XMGIEN,.XMABORT)
if XMABORT
QUIT
+6 DO MEMBERS(XMGIEN,.XMABORT)
if XMABORT
QUIT
+7 DO GROUP(XMGIEN,.XMABORT)
if XMABORT
QUIT
+8 DO REMOTE(XMGIEN,.XMABORT)
if XMABORT
QUIT
+9 DO DISTR(XMGIEN,.XMABORT)
if XMABORT
QUIT
+10 DO FAXMEMBR(XMGIEN,.XMABORT)
if XMABORT
QUIT
+11 DO FAXGROUP(XMGIEN,.XMABORT)
if XMABORT
QUIT
+12 DO MEMBEROF(XMGIEN,.XMABORT)
if XMABORT
QUIT
+13 QUIT
FIELDS(DA) ;
+1 NEW DIC,DR
+2 SET DIC="^XMB(3.8,"
+3 FOR DR=0,2,3
DO EN^DIQ
+4 QUIT
AUTHSEND(XMGIEN,XMABORT) ;
+1 if '$ORDER(^XMB(3.8,XMGIEN,4,0))
QUIT
+2 NEW XMI,XMMIEN
+3 SET XMI=0
+4 FOR
SET XMI=$ORDER(^XMB(3.8,XMGIEN,4,XMI))
if XMI'>0
QUIT
Begin DoDot:1
+5 IF $Y+3>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+6 SET XMMIEN=$PIECE(^XMB(3.8,XMGIEN,4,XMI,0),U)
+7 IF '$DATA(^VA(200,XMMIEN,0))
DO DELETE(XMGIEN,4,XMI)
QUIT
+8 ;Authorized Sender:
WRITE !,$$EZBLD^DIALOG(39089),$$NAME^XMXUTIL(XMMIEN)
End DoDot:1
if XMABORT
QUIT
+9 QUIT
MEMBERS(XMGIEN,XMABORT) ;
+1 if '$ORDER(^XMB(3.8,XMGIEN,1,0))
QUIT
+2 NEW XMI,XMMIEN,XMNAME,XMTITLE,XMREC,XMINST,XMTYPE
+3 IF $Y+5>IOSL
Begin DoDot:1
+4 DO PAGE(.XMABORT)
End DoDot:1
if XMABORT
QUIT
+5 IF '$TEST
WRITE !!
+6 DO HEADER
+7 SET XMI=0
+8 FOR
SET XMI=$ORDER(^XMB(3.8,XMGIEN,1,XMI))
if XMI'>0
QUIT
Begin DoDot:1
+9 IF $Y+3>IOSL
DO PAGE(.XMABORT,1)
if XMABORT
QUIT
+10 SET XMREC=^XMB(3.8,XMGIEN,1,XMI,0)
+11 SET XMMIEN=$PIECE(XMREC,U)
+12 SET XMTYPE=$PIECE(XMREC,U,2)
+13 IF '$DATA(^VA(200,XMMIEN,0))
DO DELETE(XMGIEN,1,XMI)
QUIT
+14 SET XMNAME=$$NAME^XMXUTIL(XMMIEN,1)
+15 IF XMTYPE'=""
SET XMNAME=XMTYPE_":"_XMNAME
+16 ;Never Used MailMan
WRITE !,$EXTRACT(XMNAME,1,IOM-36),?IOM-35,$SELECT($DATA(^XMB(3.7,XMMIEN,"L")):$EXTRACT($PIECE(^("L"),U),1,35),1:$$EZBLD^DIALOG(38007))
End DoDot:1
if XMABORT
QUIT
+17 QUIT
DELETE(XMGIEN,XMNODE,DA) ;
+1 NEW DIK
+2 LOCK +^XMB(3.8,XMGIEN,XMNODE):1
+3 SET DA(1)=XMGIEN
+4 SET DIK="^XMB(3.8,"_DA(1)_","_XMNODE_","
+5 DO ^DIK
+6 LOCK -^XMB(3.8,XMGIEN,XMNODE)
+7 QUIT
GROUP(XMGIEN,XMABORT) ; Member Groups
+1 if '$ORDER(^XMB(3.8,XMGIEN,5,0))
QUIT
+2 NEW XMI,XMMIEN,XMNAME,XMREC
+3 WRITE !
+4 SET XMI=0
+5 FOR
SET XMI=$ORDER(^XMB(3.8,XMGIEN,5,XMI))
if XMI'>0
QUIT
Begin DoDot:1
+6 IF $Y+3>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+7 SET XMREC=^XMB(3.8,XMGIEN,5,XMI,0)
+8 SET XMMIEN=$PIECE(XMREC,U)
+9 SET XMTYPE=$PIECE(XMREC,U,2)
+10 SET XMNAME=$PIECE($GET(^XMB(3.8,XMMIEN,0)),U)
+11 IF XMNAME=""
DO DELETE(XMGIEN,5,XMI)
QUIT
+12 IF XMTYPE'=""
SET XMNAME=XMTYPE_":"_XMNAME
+13 ;Member Group:
WRITE !,$$EZBLD^DIALOG(39090),XMNAME
End DoDot:1
if XMABORT
QUIT
+14 QUIT
REMOTE(XMGIEN,XMABORT) ; Remote Members
+1 if '$ORDER(^XMB(3.8,XMGIEN,6,0))
QUIT
+2 NEW XMI,XMNAME
+3 WRITE !
+4 SET XMI=0
+5 FOR
SET XMI=$ORDER(^XMB(3.8,XMGIEN,6,XMI))
if XMI'>0
QUIT
Begin DoDot:1
+6 IF $Y+3>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+7 SET XMNAME=$PIECE(^XMB(3.8,XMGIEN,6,XMI,0),U)
+8 ;Remote Member:
WRITE !,$$EZBLD^DIALOG(39085),XMNAME
End DoDot:1
if XMABORT
QUIT
+9 QUIT
DISTR(XMGIEN,XMABORT) ; Distribution list
+1 if '$ORDER(^XMB(3.8,XMGIEN,7,0))
QUIT
+2 NEW XMI,XMMIEN,XMNAME
+3 WRITE !
+4 SET XMI=0
+5 FOR
SET XMI=$ORDER(^XMB(3.8,XMGIEN,7,XMI))
if XMI'>0
QUIT
Begin DoDot:1
+6 IF $Y+3>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+7 SET XMMIEN=$PIECE(^XMB(3.8,XMGIEN,7,XMI,0),U)
+8 SET XMNAME=$PIECE($GET(^XMB(3.816,XMMIEN,0)),U)
+9 IF XMNAME=""
DO DELETE(XMGIEN,7,XMI)
QUIT
+10 ;Distribution List:
WRITE !,$$EZBLD^DIALOG(39080),XMNAME
+11 ; (To |1| Domains)
if $DATA(^XMB(3.816,XMMIEN,1,0))
WRITE $$EZBLD^DIALOG(39092,$PIECE(^(0),U,4))
End DoDot:1
if XMABORT
QUIT
+12 QUIT
FAXGROUP(XMGIEN,XMABORT) ; Fax Groups
+1 if '$ORDER(^XMB(3.8,XMGIEN,9,0))
QUIT
+2 NEW XMI,XMMIEN,XMNAME
+3 WRITE !
+4 SET XMI=0
+5 FOR
SET XMI=$ORDER(^XMB(3.8,XMGIEN,9,XMI))
if XMI'>0
QUIT
Begin DoDot:1
+6 IF $Y+3>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+7 SET XMMIEN=$PIECE(^XMB(3.8,XMGIEN,9,XMI,0),U)
+8 SET XMNAME=$PIECE($GET(^AKF("FAXG",XMMIEN,0)),U)
+9 IF XMNAME=""
DO DELETE(XMGIEN,9,XMI)
QUIT
+10 ;Fax Group:
WRITE !,$$EZBLD^DIALOG(39081),XMNAME
End DoDot:1
if XMABORT
QUIT
+11 QUIT
FAXMEMBR(XMGIEN,XMABORT) ; Fax Members
+1 if '$ORDER(^XMB(3.8,XMGIEN,8,0))
QUIT
+2 NEW XMI,XMMIEN,XMNAME
+3 WRITE !
+4 SET XMI=0
+5 FOR
SET XMI=$ORDER(^XMB(3.8,XMGIEN,8,XMI))
if XMI'>0
QUIT
Begin DoDot:1
+6 IF $Y+3>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+7 SET XMMIEN=$PIECE(^XMB(3.8,XMGIEN,8,XMI,0),U)
+8 SET XMNAME=$PIECE($GET(^AKF("FAXR",XMMIEN,0)),U)
+9 IF XMNAME=""
DO DELETE(XMGIEN,8,XMI)
QUIT
+10 ;Fax Recipient:
WRITE !,$$EZBLD^DIALOG(39082),XMNAME
End DoDot:1
if XMABORT
QUIT
+11 QUIT
MEMBEROF(XMGIEN,XMABORT) ; This group is a member of what other Groups
+1 if '$DATA(^XMB(3.8,"AD",XMGIEN))
QUIT
+2 NEW XMMIEN,XMNAME
+3 WRITE !
+4 SET XMMIEN=0
+5 FOR
SET XMMIEN=$ORDER(^XMB(3.8,"AD",XMGIEN,XMMIEN))
if 'XMMIEN
QUIT
Begin DoDot:1
+6 IF $Y+3>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+7 SET XMNAME=$PIECE($GET(^XMB(3.8,XMMIEN,0)),U)
+8 IF XMNAME=""
Begin DoDot:2
+9 NEW XMI
+10 SET XMI=$ORDER(^XMB(3.8,"AD",XMGIEN,XMMIEN,0))
+11 IF XMI
DO DELETE(XMMIEN,5,XMI)
QUIT
+12 KILL ^XMB(3.8,"AD",XMGIEN,XMMIEN)
End DoDot:2
QUIT
+13 ; member of group:
WRITE !,$$EZBLD^DIALOG(39093),XMNAME
End DoDot:1
if XMABORT
QUIT
+14 QUIT
GSCREEN ; This routine is a screen [DIC("S")] for a fileman lookup
+1 ; The naked reference is set to ^XMB(3.8,Y,0)
+2 ; Group is public
IF $PIECE(^(0),U,2)="PU"
QUIT
+3 ; User is organizer of the group
IF $GET(^(3))=XMDUZ
QUIT
+4 ; User is a member of the group
IF $DATA(^(1,"B",XMDUZ))
QUIT
+5 ; *** But this doesn't handle the case in which a user might not be
+6 ; *** a member of this group, but is a member of a member group.
+7 QUIT
PAGE(XMABORT,XMHDR) ;
+1 DO PAGE^XMXUTIL(.XMABORT)
if XMABORT
QUIT
+2 WRITE @IOF
+3 if $GET(XMHDR)
DO HEADER
+4 QUIT
+1 ;Member Last Used MailMan
WRITE $$EZBLD^DIALOG(39091)
+2 QUIT
