XMHIU ;ISC-SF/GMB-User Info ;04/17/2002 09:52
;;8.0;MailMan;;Jun 28, 2002
; Replaces UHELP^XMA7 (ISC-WASH/RJ/THM/CAP)
; Entry points used by MailMan options (not covered by DBIA):
; HELP XMHELPUSER - Get user info
HELP ; User Info
N DIC,Y,D,XMHDUZ
D CHECK^XMVVITAE
S DIC=200,DIC(0)="AEQMZN",DIC("A")=$$EZBLD^DIALOG(38009) ;User name:
S DIC("S")="I $S('$D(^VA(200,Y,0)):0,Y<1:1,$L($P(^(0),U,3)):1,1:0)"
S DIC("W")="D USERINFO^XMXADDR1(Y)"
S D="B^BB^C^D" ; name^alias^initial^nickname
F W ! D MIX^DIC1 Q:Y<0 D
. S XMHDUZ=+Y
. W @IOF,$$NAME^XMXUTIL(XMHDUZ,1)
. D DISPUSER(XMHDUZ)
. S DIC("W")="D USERINFO^XMXADDR1(Y)"
Q
DISPUSER(XMUSER) ;
N XMABORT
S XMABORT=0
D GENERAL(XMUSER,.XMABORT) Q:XMABORT ; General info
D GROUPS(XMUSER,.XMABORT) Q:XMABORT ; Groups in which this user is a member
D SURRBEU(XMUSER,.XMABORT) Q:XMABORT ; Surrogates who may be this user
D UBESURR(XMUSER,.XMABORT) ; Users for whom this user may be surrogate
Q
GENERAL(XMUSER,XMABORT) ;
N X,XMREC
I '$D(^XMB(3.7,XMUSER)) W !,$$EZBLD^DIALOG(38010) Q ;No Mailbox for this user!
S XMREC=$G(^XMB(3.7,XMUSER,0))
Q:XMREC=""&'$D(^XMB(3.8,"AB",XMUSER))
S X=$G(^XMB(3.7,XMUSER,"B")) W:$L(X) !,$$EZBLD^DIALOG(38011),X ;Current Banner:
S X=$P($G(^XMB(3.7,XMUSER,"L")),U) W:$L(X) !,$$EZBLD^DIALOG(38012),X ;Last used MailMan:
S X=$P(XMREC,U,6) I X D
. N XMPARM S XMPARM(1)=X,XMPARM(2)=+$P(^XMB(3.7,XMUSER,2,1,0),U,2)
. W !,$$EZBLD^DIALOG(38019,.XMPARM) ;NEW messages: |1| (|2| in the IN basket)
S X=$P(XMREC,U,2) I $L(X) W !,$$EZBLD^DIALOG(38004),X,$$EZBLD^DIALOG($S($P(XMREC,U,8):38005,1:38006)) ; Forwarding Address: / Local Delivery is ON / OFF
S XMREC=$G(^VA(200,XMUSER,.13))
S X=$P(XMREC,U,2) I X'="" W !!,$$EZBLD^DIALOG(38013),X ;Office phone:
S X=$P(XMREC,U,6) I X'="" W !,$$EZBLD^DIALOG(38014),X ;Fax:
S X=$P(XMREC,U,7) I X'="" W !,$$EZBLD^DIALOG(38015),X ;Voice pager:
S X=$P(XMREC,U,8) I X'="" W !,$$EZBLD^DIALOG(38016),X ;Digital pager:
S X=$P(XMREC,U,3) I X'="" W !,$$EZBLD^DIALOG(38017),X ;Add'l phone:
S X=$P(XMREC,U,4) I X'="" W !,$$EZBLD^DIALOG(38017),X ;Add'l phone:
S XMREC=$G(^VA(200,XMUSER,.11),"^^")
I $P(^XMB(1,1,0),U,10),$P(XMREC,U,1,3)'="^^" D ; Don't show address unless site OKs it.
. W !!,$$EZBLD^DIALOG(38018) ;Address:
. F X=1:1:3 I $P(XMREC,U,X)'="" W !," ",$P(XMREC,U,X)
. S X=$P(XMREC,U,4) I X'="" W !," ",X
. S X=$P(XMREC,U,5) I X W ", ",$P($G(^DIC(5,X,0)),U,2)
. S X=$P(XMREC,U,6) I X'="" W " ",X
I $D(^XMB(3.7,XMUSER,1,0)) D Q:XMABORT
. N XMI,XMLINE
. I $Y+5>IOSL D PAGE(.XMABORT) Q:XMABORT
. W !!,$$EZBLD^DIALOG(38050) ;Introduction:
. S XMI=0
. F S XMI=$O(^XMB(3.7,XMUSER,1,XMI)) Q:XMI'>0 S XMLINE=^(XMI,0) D Q:XMABORT
. . I $Y+4>IOSL D PAGE(.XMABORT) Q:XMABORT
. . W !," ",XMLINE
Q
GROUPS(XMUSER,XMABORT) ;
N XMGIEN,XMREC,XMTYPE
Q:'$D(^XMB(3.8,"AB",XMUSER))
I $Y+6>IOSL D PAGE(.XMABORT) Q:XMABORT
W !!,$$EZBLD^DIALOG(38040) ;Mail Groups:
S XMGIEN=""
F S XMGIEN=$O(^XMB(3.8,"AB",XMUSER,XMGIEN)) Q:XMGIEN="" D Q:XMABORT
. S XMREC=$G(^XMB(3.8,XMGIEN,0)) Q:XMREC=""
. S XMTYPE=$P(XMREC,U,2)
. ; Don't show private group membership, unless user is a member, too.
. I XMTYPE="PR",'$D(^XMB(3.8,"AB",DUZ,XMGIEN)) Q
. I $Y+4>IOSL D PAGE(.XMABORT) Q:XMABORT
. W !?2,$P(XMREC,U)
. W:$G(^XMB(3.8,XMGIEN,3))=XMUSER $$EZBLD^DIALOG(38041) ;(Organizer)
. W ?45,$$EZBLD^DIALOG($S(XMTYPE="PR":38042,1:38043)) ;(Private) / (Public)
Q
SURRBEU(XMUSER,XMABORT) ; List surrogates for this user
N XMSIEN
Q:'$O(^XMB(3.7,XMUSER,9,0))
I $Y+6>IOSL D PAGE(.XMABORT) Q:XMABORT
W !!,$$EZBLD^DIALOG(38044) ;This user's surrogates are:
S XMSIEN=0
F S XMSIEN=$O(^XMB(3.7,XMUSER,9,XMSIEN)) Q:XMSIEN="" D Q:XMABORT
. D DISPSURR(2,XMUSER,XMSIEN,.XMABORT)
Q
UBESURR(XMSURR,XMABORT) ; List users for whom this user may act as surrogate
N XMUSER,XMSIEN
Q:'$O(^XMB(3.7,"AB",XMSURR,0))
I $Y+6>IOSL D PAGE(.XMABORT) Q:XMABORT
W !!,$$EZBLD^DIALOG(38045) ;This user may act as a surrogate for:
S XMUSER=""
F S XMUSER=$O(^XMB(3.7,"AB",XMSURR,XMUSER)) Q:XMUSER="" D Q:XMABORT
. S XMSIEN=$O(^XMB(3.7,"AB",XMSURR,XMUSER,""))
. D DISPSURR(1,XMUSER,XMSIEN,.XMABORT)
Q
DISPSURR(XMFLAG,XMUSER,XMSIEN,XMABORT) ;
N XMPRIV,XMREC,XMNIEN
I $Y+4>IOSL D PAGE(.XMABORT) Q:XMABORT
S XMREC=$S(XMUSER=.6:".6^y^y",1:$G(^XMB(3.7,XMUSER,9,XMSIEN,0)))
S XMNIEN=$S(XMFLAG=1:XMUSER,1:$P(XMREC,U,1))
Q:'XMNIEN Q:'$D(^VA(200,XMNIEN,0))
W !,?2,$$NAME^XMXUTIL(XMNIEN)
S XMPRIV=$P(XMREC,U,2,3)
I XMPRIV'["y" W ?45,$$EZBLD^DIALOG(38046) Q ;No Privileges
I $L(XMPRIV,"y")>2 W ?45,$$EZBLD^DIALOG(38047) Q ;Read and Write Privileges
W ?45,$$EZBLD^DIALOG($S($P(XMPRIV,U)["y":38048,1:38049)) ;Read Privilege / Write Privilege
Q
PAGE(XMABORT) ;
D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
W @IOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMHIU 4860 printed Apr 09, 2024@21:15:39 Page 2
XMHIU ;ISC-SF/GMB-User Info ;04/17/2002 09:52
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Replaces UHELP^XMA7 (ISC-WASH/RJ/THM/CAP)
+3 ; Entry points used by MailMan options (not covered by DBIA):
+4 ; HELP XMHELPUSER - Get user info
HELP ; User Info
+1 NEW DIC,Y,D,XMHDUZ
+2 DO CHECK^XMVVITAE
+3 ;User name:
SET DIC=200
SET DIC(0)="AEQMZN"
SET DIC("A")=$$EZBLD^DIALOG(38009)
+4 SET DIC("S")="I $S('$D(^VA(200,Y,0)):0,Y<1:1,$L($P(^(0),U,3)):1,1:0)"
+5 SET DIC("W")="D USERINFO^XMXADDR1(Y)"
+6 ; name^alias^initial^nickname
SET D="B^BB^C^D"
+7 FOR
WRITE !
DO MIX^DIC1
if Y<0
QUIT
Begin DoDot:1
+8 SET XMHDUZ=+Y
+9 WRITE @IOF,$$NAME^XMXUTIL(XMHDUZ,1)
+10 DO DISPUSER(XMHDUZ)
+11 SET DIC("W")="D USERINFO^XMXADDR1(Y)"
End DoDot:1
+12 QUIT
DISPUSER(XMUSER) ;
+1 NEW XMABORT
+2 SET XMABORT=0
+3 ; General info
DO GENERAL(XMUSER,.XMABORT)
if XMABORT
QUIT
+4 ; Groups in which this user is a member
DO GROUPS(XMUSER,.XMABORT)
if XMABORT
QUIT
+5 ; Surrogates who may be this user
DO SURRBEU(XMUSER,.XMABORT)
if XMABORT
QUIT
+6 ; Users for whom this user may be surrogate
DO UBESURR(XMUSER,.XMABORT)
+7 QUIT
GENERAL(XMUSER,XMABORT) ;
+1 NEW X,XMREC
+2 ;No Mailbox for this user!
IF '$DATA(^XMB(3.7,XMUSER))
WRITE !,$$EZBLD^DIALOG(38010)
QUIT
+3 SET XMREC=$GET(^XMB(3.7,XMUSER,0))
+4 if XMREC=""&'$DATA(^XMB(3.8,"AB",XMUSER))
QUIT
+5 ;Current Banner:
SET X=$GET(^XMB(3.7,XMUSER,"B"))
if $LENGTH(X)
WRITE !,$$EZBLD^DIALOG(38011),X
+6 ;Last used MailMan:
SET X=$PIECE($GET(^XMB(3.7,XMUSER,"L")),U)
if $LENGTH(X)
WRITE !,$$EZBLD^DIALOG(38012),X
+7 SET X=$PIECE(XMREC,U,6)
IF X
Begin DoDot:1
+8 NEW XMPARM
SET XMPARM(1)=X
SET XMPARM(2)=+$PIECE(^XMB(3.7,XMUSER,2,1,0),U,2)
+9 ;NEW messages: |1| (|2| in the IN basket)
WRITE !,$$EZBLD^DIALOG(38019,.XMPARM)
End DoDot:1
+10 ; Forwarding Address: / Local Delivery is ON / OFF
SET X=$PIECE(XMREC,U,2)
IF $LENGTH(X)
WRITE !,$$EZBLD^DIALOG(38004),X,$$EZBLD^DIALOG($SELECT($PIECE(XMREC,U,8):38005,1:38006))
+11 SET XMREC=$GET(^VA(200,XMUSER,.13))
+12 ;Office phone:
SET X=$PIECE(XMREC,U,2)
IF X'=""
WRITE !!,$$EZBLD^DIALOG(38013),X
+13 ;Fax:
SET X=$PIECE(XMREC,U,6)
IF X'=""
WRITE !,$$EZBLD^DIALOG(38014),X
+14 ;Voice pager:
SET X=$PIECE(XMREC,U,7)
IF X'=""
WRITE !,$$EZBLD^DIALOG(38015),X
+15 ;Digital pager:
SET X=$PIECE(XMREC,U,8)
IF X'=""
WRITE !,$$EZBLD^DIALOG(38016),X
+16 ;Add'l phone:
SET X=$PIECE(XMREC,U,3)
IF X'=""
WRITE !,$$EZBLD^DIALOG(38017),X
+17 ;Add'l phone:
SET X=$PIECE(XMREC,U,4)
IF X'=""
WRITE !,$$EZBLD^DIALOG(38017),X
+18 SET XMREC=$GET(^VA(200,XMUSER,.11),"^^")
+19 ; Don't show address unless site OKs it.
IF $PIECE(^XMB(1,1,0),U,10)
IF $PIECE(XMREC,U,1,3)'="^^"
Begin DoDot:1
+20 ;Address:
WRITE !!,$$EZBLD^DIALOG(38018)
+21 FOR X=1:1:3
IF $PIECE(XMREC,U,X)'=""
WRITE !," ",$PIECE(XMREC,U,X)
+22 SET X=$PIECE(XMREC,U,4)
IF X'=""
WRITE !," ",X
+23 SET X=$PIECE(XMREC,U,5)
IF X
WRITE ", ",$PIECE($GET(^DIC(5,X,0)),U,2)
+24 SET X=$PIECE(XMREC,U,6)
IF X'=""
WRITE " ",X
End DoDot:1
+25 IF $DATA(^XMB(3.7,XMUSER,1,0))
Begin DoDot:1
+26 NEW XMI,XMLINE
+27 IF $Y+5>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+28 ;Introduction:
WRITE !!,$$EZBLD^DIALOG(38050)
+29 SET XMI=0
+30 FOR
SET XMI=$ORDER(^XMB(3.7,XMUSER,1,XMI))
if XMI'>0
QUIT
SET XMLINE=^(XMI,0)
Begin DoDot:2
+31 IF $Y+4>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+32 WRITE !," ",XMLINE
End DoDot:2
if XMABORT
QUIT
End DoDot:1
if XMABORT
QUIT
+33 QUIT
GROUPS(XMUSER,XMABORT) ;
+1 NEW XMGIEN,XMREC,XMTYPE
+2 if '$DATA(^XMB(3.8,"AB",XMUSER))
QUIT
+3 IF $Y+6>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+4 ;Mail Groups:
WRITE !!,$$EZBLD^DIALOG(38040)
+5 SET XMGIEN=""
+6 FOR
SET XMGIEN=$ORDER(^XMB(3.8,"AB",XMUSER,XMGIEN))
if XMGIEN=""
QUIT
Begin DoDot:1
+7 SET XMREC=$GET(^XMB(3.8,XMGIEN,0))
if XMREC=""
QUIT
+8 SET XMTYPE=$PIECE(XMREC,U,2)
+9 ; Don't show private group membership, unless user is a member, too.
+10 IF XMTYPE="PR"
IF '$DATA(^XMB(3.8,"AB",DUZ,XMGIEN))
QUIT
+11 IF $Y+4>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+12 WRITE !?2,$PIECE(XMREC,U)
+13 ;(Organizer)
if $GET(^XMB(3.8,XMGIEN,3))=XMUSER
WRITE $$EZBLD^DIALOG(38041)
+14 ;(Private) / (Public)
WRITE ?45,$$EZBLD^DIALOG($SELECT(XMTYPE="PR":38042,1:38043))
End DoDot:1
if XMABORT
QUIT
+15 QUIT
SURRBEU(XMUSER,XMABORT) ; List surrogates for this user
+1 NEW XMSIEN
+2 if '$ORDER(^XMB(3.7,XMUSER,9,0))
QUIT
+3 IF $Y+6>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+4 ;This user's surrogates are:
WRITE !!,$$EZBLD^DIALOG(38044)
+5 SET XMSIEN=0
+6 FOR
SET XMSIEN=$ORDER(^XMB(3.7,XMUSER,9,XMSIEN))
if XMSIEN=""
QUIT
Begin DoDot:1
+7 DO DISPSURR(2,XMUSER,XMSIEN,.XMABORT)
End DoDot:1
if XMABORT
QUIT
+8 QUIT
UBESURR(XMSURR,XMABORT) ; List users for whom this user may act as surrogate
+1 NEW XMUSER,XMSIEN
+2 if '$ORDER(^XMB(3.7,"AB",XMSURR,0))
QUIT
+3 IF $Y+6>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+4 ;This user may act as a surrogate for:
WRITE !!,$$EZBLD^DIALOG(38045)
+5 SET XMUSER=""
+6 FOR
SET XMUSER=$ORDER(^XMB(3.7,"AB",XMSURR,XMUSER))
if XMUSER=""
QUIT
Begin DoDot:1
+7 SET XMSIEN=$ORDER(^XMB(3.7,"AB",XMSURR,XMUSER,""))
+8 DO DISPSURR(1,XMUSER,XMSIEN,.XMABORT)
End DoDot:1
if XMABORT
QUIT
+9 QUIT
DISPSURR(XMFLAG,XMUSER,XMSIEN,XMABORT) ;
+1 NEW XMPRIV,XMREC,XMNIEN
+2 IF $Y+4>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+3 SET XMREC=$SELECT(XMUSER=.6:".6^y^y",1:$GET(^XMB(3.7,XMUSER,9,XMSIEN,0)))
+4 SET XMNIEN=$SELECT(XMFLAG=1:XMUSER,1:$PIECE(XMREC,U,1))
+5 if 'XMNIEN
QUIT
if '$DATA(^VA(200,XMNIEN,0))
QUIT
+6 WRITE !,?2,$$NAME^XMXUTIL(XMNIEN)
+7 SET XMPRIV=$PIECE(XMREC,U,2,3)
+8 ;No Privileges
IF XMPRIV'["y"
WRITE ?45,$$EZBLD^DIALOG(38046)
QUIT
+9 ;Read and Write Privileges
IF $LENGTH(XMPRIV,"y")>2
WRITE ?45,$$EZBLD^DIALOG(38047)
QUIT
+10 ;Read Privilege / Write Privilege
WRITE ?45,$$EZBLD^DIALOG($SELECT($PIECE(XMPRIV,U)["y":38048,1:38049))
+11 QUIT
PAGE(XMABORT) ;
+1 DO PAGE^XMXUTIL(.XMABORT)
if XMABORT
QUIT
+2 WRITE @IOF
+3 QUIT
