- 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 Feb 18, 2025@23:40:02 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