XMVSURR ;ISC-SF/GMB-Surrogate management ;04/19/2002 11:32
;;8.0;MailMan;;Jun 28, 2002
; Replaces ^XMA7 (ISC-WASH/RJ/THM/CAP)
; Entry points used by MailMan options (not covered by DBIA):
; SHARE XMSHARE - Become SHARED,MAIL
; ASSUME XMASSUME - Become another user
SHARE ; Assume the identity of SHARED,MAIL
Q:'$$CHKOK
S XMDUZ=.6
D SURROGAT^XMVVITAE(XMDUZ,.XMV,.XMDUN,"",.XMPRIV)
D HEADER^XM
D MANAGE^XMJBM
D SELF
Q
CHKOK() ;
I $D(^XUSEC("XMNOPRIV",DUZ)) D Q 0
. N XMTEXT ;You have been given the XMNOPRIV key
. W $C(7) ;and may not become anyone's surrogate.
. D BLD^DIALOG(38053,"","","XMTEXT","F")
. D MSG^DIALOG("WE","","","","XMTEXT")
D CHECK^XMVVITAE
Q 1
SELF ;
D SELF^XMVVITAE
W $C(7),!,$$EZBLD^DIALOG(38054),! ;You are now yourself again.
D HEADER^XM
Q
ASSUME ; Assume someone else's identity
I '$D(^XMB(3.7,"AB",DUZ)) D SHARE Q
Q:'$$CHKOK
D LISTEM
N DIC,Y
S DIC(0)="AEMQZ"
S D="B^BB^C^D"
S DIC="^VA(200,"
S DIC("W")="D SHOWPRIV^XMVSURR(Y)"
S DIC("S")="I Y=.6!$D(^XMB(3.7,""AB"",DUZ,Y))"
I XMDUZ=DUZ D
. S DIC("B")=$$NAME^XMXUTIL(.6) ; SHARED,MAIL
E D
. N XMTEXT
. S DIC("S")=DIC("S")_"!(Y=DUZ),Y'=XMDUZ"
. S DIC("B")=XMV("DUZ NAME")
. ;You may select yourself to resume your own identity.
. D BLD^DIALOG(38055,"","","XMTEXT","F")
. D MSG^DIALOG("WE","","","","XMTEXT")
D MIX^DIC1 I Y=-1!$D(DUOUT)!$D(DTOUT) Q
S XMDUZ=+Y
I XMDUZ=DUZ D SELF Q
I XMDUZ=.6 D SHARE Q
D OTHER^XMVVITAE
D HEADER^XM
Q
LISTEM ; List surrogates a user may become
N XMDUZ
W !,$$EZBLD^DIALOG(38056) ;Choose from:
S XMDUZ=0
F S XMDUZ=$O(^XMB(3.7,"AB",DUZ,XMDUZ)) Q:'XMDUZ W !,?3,$E($$NAME^XMXUTIL(XMDUZ),1,32) D SHOWPRIV(XMDUZ)
W !,?3,$$NAME^XMXUTIL(.6) D SHOWPRIV(.6) W !
Q
SHOWPRIV(XMDUZ) ;
Q:XMDUZ=DUZ
I XMDUZ=.6 W ?37,$$EZBLD^DIALOG(38048) Q ;Read Privilege
N XMPRIV,XMNEW
S XMPRIV=$P($G(^XMB(3.7,XMDUZ,9,+$O(^XMB(3.7,"AB",DUZ,XMDUZ,0)),0)),U,2,3)
I XMPRIV'["y" W ?37,$$EZBLD^DIALOG(38046) Q ;No Privileges
I $L(XMPRIV,"y")>2 W ?37,$$EZBLD^DIALOG(38047) ;Read and Send Privileges
E W ?37,$$EZBLD^DIALOG($S($P(XMPRIV,U)["y":38048,1:38049)) ; Read/Send Privilege
S XMNEW=$$TNMSGCT^XMXUTIL(XMDUZ)
W " ",$J($$EZBLD^DIALOG($S(XMNEW:38052,1:38051),XMNEW),79-$X) ; x/No New Msgs
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMVSURR 2307 printed Oct 16, 2024@18:14:35 Page 2
XMVSURR ;ISC-SF/GMB-Surrogate management ;04/19/2002 11:32
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Replaces ^XMA7 (ISC-WASH/RJ/THM/CAP)
+3 ; Entry points used by MailMan options (not covered by DBIA):
+4 ; SHARE XMSHARE - Become SHARED,MAIL
+5 ; ASSUME XMASSUME - Become another user
SHARE ; Assume the identity of SHARED,MAIL
+1 if '$$CHKOK
QUIT
+2 SET XMDUZ=.6
+3 DO SURROGAT^XMVVITAE(XMDUZ,.XMV,.XMDUN,"",.XMPRIV)
+4 DO HEADER^XM
+5 DO MANAGE^XMJBM
+6 DO SELF
+7 QUIT
CHKOK() ;
+1 IF $DATA(^XUSEC("XMNOPRIV",DUZ))
Begin DoDot:1
+2 ;You have been given the XMNOPRIV key
NEW XMTEXT
+3 ;and may not become anyone's surrogate.
WRITE $CHAR(7)
+4 DO BLD^DIALOG(38053,"","","XMTEXT","F")
+5 DO MSG^DIALOG("WE","","","","XMTEXT")
End DoDot:1
QUIT 0
+6 DO CHECK^XMVVITAE
+7 QUIT 1
SELF ;
+1 DO SELF^XMVVITAE
+2 ;You are now yourself again.
WRITE $CHAR(7),!,$$EZBLD^DIALOG(38054),!
+3 DO HEADER^XM
+4 QUIT
ASSUME ; Assume someone else's identity
+1 IF '$DATA(^XMB(3.7,"AB",DUZ))
DO SHARE
QUIT
+2 if '$$CHKOK
QUIT
+3 DO LISTEM
+4 NEW DIC,Y
+5 SET DIC(0)="AEMQZ"
+6 SET D="B^BB^C^D"
+7 SET DIC="^VA(200,"
+8 SET DIC("W")="D SHOWPRIV^XMVSURR(Y)"
+9 SET DIC("S")="I Y=.6!$D(^XMB(3.7,""AB"",DUZ,Y))"
+10 IF XMDUZ=DUZ
Begin DoDot:1
+11 ; SHARED,MAIL
SET DIC("B")=$$NAME^XMXUTIL(.6)
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 NEW XMTEXT
+14 SET DIC("S")=DIC("S")_"!(Y=DUZ),Y'=XMDUZ"
+15 SET DIC("B")=XMV("DUZ NAME")
+16 ;You may select yourself to resume your own identity.
+17 DO BLD^DIALOG(38055,"","","XMTEXT","F")
+18 DO MSG^DIALOG("WE","","","","XMTEXT")
End DoDot:1
+19 DO MIX^DIC1
IF Y=-1!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
+20 SET XMDUZ=+Y
+21 IF XMDUZ=DUZ
DO SELF
QUIT
+22 IF XMDUZ=.6
DO SHARE
QUIT
+23 DO OTHER^XMVVITAE
+24 DO HEADER^XM
+25 QUIT
LISTEM ; List surrogates a user may become
+1 NEW XMDUZ
+2 ;Choose from:
WRITE !,$$EZBLD^DIALOG(38056)
+3 SET XMDUZ=0
+4 FOR
SET XMDUZ=$ORDER(^XMB(3.7,"AB",DUZ,XMDUZ))
if 'XMDUZ
QUIT
WRITE !,?3,$EXTRACT($$NAME^XMXUTIL(XMDUZ),1,32)
DO SHOWPRIV(XMDUZ)
+5 WRITE !,?3,$$NAME^XMXUTIL(.6)
DO SHOWPRIV(.6)
WRITE !
+6 QUIT
SHOWPRIV(XMDUZ) ;
+1 if XMDUZ=DUZ
QUIT
+2 ;Read Privilege
IF XMDUZ=.6
WRITE ?37,$$EZBLD^DIALOG(38048)
QUIT
+3 NEW XMPRIV,XMNEW
+4 SET XMPRIV=$PIECE($GET(^XMB(3.7,XMDUZ,9,+$ORDER(^XMB(3.7,"AB",DUZ,XMDUZ,0)),0)),U,2,3)
+5 ;No Privileges
IF XMPRIV'["y"
WRITE ?37,$$EZBLD^DIALOG(38046)
QUIT
+6 ;Read and Send Privileges
IF $LENGTH(XMPRIV,"y")>2
WRITE ?37,$$EZBLD^DIALOG(38047)
+7 ; Read/Send Privilege
IF '$TEST
WRITE ?37,$$EZBLD^DIALOG($SELECT($PIECE(XMPRIV,U)["y":38048,1:38049))
+8 SET XMNEW=$$TNMSGCT^XMXUTIL(XMDUZ)
+9 ; x/No New Msgs
WRITE " ",$JUSTIFY($$EZBLD^DIALOG($SELECT(XMNEW:38052,1:38051),XMNEW),79-$X)
+10 QUIT
