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