- 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 Feb 18, 2025@23:37:53 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