Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMVSURR

XMVSURR.m

Go to the documentation of this file.
  1. XMVSURR ;ISC-SF/GMB-Surrogate management ;04/19/2002 11:32
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. ; Replaces ^XMA7 (ISC-WASH/RJ/THM/CAP)
  1. ; Entry points used by MailMan options (not covered by DBIA):
  1. ; SHARE XMSHARE - Become SHARED,MAIL
  1. ; ASSUME XMASSUME - Become another user
  1. SHARE ; Assume the identity of SHARED,MAIL
  1. Q:'$$CHKOK
  1. S XMDUZ=.6
  1. D SURROGAT^XMVVITAE(XMDUZ,.XMV,.XMDUN,"",.XMPRIV)
  1. D HEADER^XM
  1. D MANAGE^XMJBM
  1. D SELF
  1. Q
  1. CHKOK() ;
  1. I $D(^XUSEC("XMNOPRIV",DUZ)) D Q 0
  1. . N XMTEXT ;You have been given the XMNOPRIV key
  1. . W $C(7) ;and may not become anyone's surrogate.
  1. . D BLD^DIALOG(38053,"","","XMTEXT","F")
  1. . D MSG^DIALOG("WE","","","","XMTEXT")
  1. D CHECK^XMVVITAE
  1. Q 1
  1. SELF ;
  1. D SELF^XMVVITAE
  1. W $C(7),!,$$EZBLD^DIALOG(38054),! ;You are now yourself again.
  1. D HEADER^XM
  1. Q
  1. ASSUME ; Assume someone else's identity
  1. I '$D(^XMB(3.7,"AB",DUZ)) D SHARE Q
  1. Q:'$$CHKOK
  1. D LISTEM
  1. N DIC,Y
  1. S DIC(0)="AEMQZ"
  1. S D="B^BB^C^D"
  1. S DIC="^VA(200,"
  1. S DIC("W")="D SHOWPRIV^XMVSURR(Y)"
  1. S DIC("S")="I Y=.6!$D(^XMB(3.7,""AB"",DUZ,Y))"
  1. I XMDUZ=DUZ D
  1. . S DIC("B")=$$NAME^XMXUTIL(.6) ; SHARED,MAIL
  1. E D
  1. . N XMTEXT
  1. . S DIC("S")=DIC("S")_"!(Y=DUZ),Y'=XMDUZ"
  1. . S DIC("B")=XMV("DUZ NAME")
  1. . ;You may select yourself to resume your own identity.
  1. . D BLD^DIALOG(38055,"","","XMTEXT","F")
  1. . D MSG^DIALOG("WE","","","","XMTEXT")
  1. D MIX^DIC1 I Y=-1!$D(DUOUT)!$D(DTOUT) Q
  1. S XMDUZ=+Y
  1. I XMDUZ=DUZ D SELF Q
  1. I XMDUZ=.6 D SHARE Q
  1. D OTHER^XMVVITAE
  1. D HEADER^XM
  1. Q
  1. LISTEM ; List surrogates a user may become
  1. N XMDUZ
  1. W !,$$EZBLD^DIALOG(38056) ;Choose from:
  1. S XMDUZ=0
  1. F S XMDUZ=$O(^XMB(3.7,"AB",DUZ,XMDUZ)) Q:'XMDUZ W !,?3,$E($$NAME^XMXUTIL(XMDUZ),1,32) D SHOWPRIV(XMDUZ)
  1. W !,?3,$$NAME^XMXUTIL(.6) D SHOWPRIV(.6) W !
  1. Q
  1. SHOWPRIV(XMDUZ) ;
  1. Q:XMDUZ=DUZ
  1. I XMDUZ=.6 W ?37,$$EZBLD^DIALOG(38048) Q ;Read Privilege
  1. N XMPRIV,XMNEW
  1. S XMPRIV=$P($G(^XMB(3.7,XMDUZ,9,+$O(^XMB(3.7,"AB",DUZ,XMDUZ,0)),0)),U,2,3)
  1. I XMPRIV'["y" W ?37,$$EZBLD^DIALOG(38046) Q ;No Privileges
  1. I $L(XMPRIV,"y")>2 W ?37,$$EZBLD^DIALOG(38047) ;Read and Send Privileges
  1. E W ?37,$$EZBLD^DIALOG($S($P(XMPRIV,U)["y":38048,1:38049)) ; Read/Send Privilege
  1. S XMNEW=$$TNMSGCT^XMXUTIL(XMDUZ)
  1. W " ",$J($$EZBLD^DIALOG($S(XMNEW:38052,1:38051),XMNEW),79-$X) ; x/No New Msgs
  1. Q