XMVVITAE ;ISC-SF/GMB-Initialize User's MailMan Variables ;04/19/2002 13:26
;;8.0;MailMan;**36**;Jun 28, 2002;Build 1
; Replaces ^XMGAPI1,FWD^XMA21,FWD,BANNER^XMA6,EDIT^XMA7 (ISC-WASH/CAP)
; Entry points (DBIA 2728):
; INIT Set up variables for DUZ or XMDUZ.
; OTHER Set up variables to become a surrogate of someone else.
; SELF Return from being a surrogate to being oneself again.
Q
INIT ; Set up one's variables (for yourself or as a surrogate).
N XMAPI
INIT2 K XMV
D SYSTEM(.XMV)
S:'$D(XMDUZ) XMDUZ=DUZ
D DUZ(DUZ,.XMV,.XMDUN,.XMDISPI,.XMNOSEND)
D:XMDUZ'=DUZ SURROGAT(XMDUZ,.XMV,.XMDUN,.XMNOSEND,.XMPRIV)
Q
INITAPI ; (For MailMan use only) Set up variables for an API call.
N XMAPI
S XMAPI=1 ; "last used MailMan" will not be recorded.
G INIT2
CHECK ; Check to make sure one's variables exist.
I '$D(XMV("NAME"))!'$D(XMV("RDR DEF")) D INIT
Q
OTHER ; Become someone else. INIT should have been called previously.
I '$D(XMV) D INIT Q
N XMAPI
D SURROGAT(XMDUZ,.XMV,.XMDUN,.XMNOSEND,.XMPRIV)
Q
SELF ; Return to oneself after having become someone else.
; INIT should have been called previously.
S XMDUZ=DUZ
I '$D(XMV) D INIT Q
N XMAPI
D USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN)
D LASTUSE(XMDUZ,.XMV)
Q
SYSTEM(XMV) ;
; XMV("VERSION")
I '$D(DT) D DT^DICRW
S XMV("VERSION")="VA MailMan "_$P($T(XMVVITAE+1),";",3)
; Check to make sure that important variables are defined correctly.
I +$G(^XMB("NUM")),$G(^XMB("NAME"))=$G(^XMB("NETNAME")),$G(^XMB("NETNAME"))=$P($G(^DIC(4.2,+$G(^XMB("NUM")),0)),U,1),$G(^XMB("NUM"))=$P($G(^XMB(1,1,0)),U,1) Q
N XMPARM ; The domain for this facility is not christened correctly.
S XMPARM(1)=$G(^XMB("NUM"))
S XMPARM(2)=$P($G(^XMB(1,1,0)),U,1)
S XMPARM(3)=$P($G(^DIC(4.2,+$G(^XMB("NUM")),0)),U,1)
S XMPARM(4)=$P($G(^DIC(4.2,+XMPARM(2),0)),U,1)
S XMPARM(5)=$G(^XMB("NETNAME"))
S XMPARM(6)=$G(^XMB("NAME"))
F I=1:1:6 I XMPARM(I)="" S XMPARM(I)="?"
;The domain for this facility is not christened correctly.
;IRM must correct this for network mail to function properly.
;The following pointers should contain the same numbers,
;which should point to this facility's domain in ^DIC(4.2:
;^XMB("NUM")=|1| ==> |3|
;$P(^XMB(1,1,0),U,1)=|2| ==> |4|
;The following globals should contain the domain name of this facility:
;^XMB("NETNAME")= |5|
;^XMB("NAME")= |6|
D BLD^DIALOG(38100,.XMPARM,"","XMV(""SYSERR"")")
Q
DUZ(XMDUZ,XMV,XMDUN,XMDISPI,XMNOSEND) ;
; XMV("DUZ NAME")
K XMV("ERROR")
I $G(DUZ,0)=0 S XMV("ERROR",1)=$$EZBLD^DIALOG(38105) Q ;You do not have a DUZ.
D USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN) Q:$D(XMV("ERROR"))
S XMV("DUZ NAME")=XMV("NAME")
D LASTUSE(XMDUZ,.XMV)
D PREFER(XMDUZ,.XMV,.XMDISPI)
Q
SURROGAT(XMDUZ,XMV,XMDUN,XMNOSEND,XMPRIV) ;
; XMV("PRIV")
; XMPRIV
Q:XMDUZ=DUZ
K XMV("ERROR"),XMV("WARNING")
I XMDUZ=.6 D Q
. S XMV("PRIV")="R",XMPRIV="y^n"
. S (XMDUN,XMV("NAME"))=$$NAME^XMXUTIL(.6)
. D SETNET(XMDUZ,.XMV)
. S XMV("NEW MSGS")=+$P(^XMB(3.7,XMDUZ,0),U,6)
E D Q:$D(XMV("ERROR"))
. N XMIEN
. S XMIEN=+$O(^XMB(3.7,"AB",DUZ,XMDUZ,0))
. ;Commented out because we shouldn't be here if not a valid surrogate
. ;I 'XMIEN S XMV("ERROR",5)=$$EZBLD^DIALOG(38106,XMDUZ) Q ;You are not a surrogate of DUZ |1|.
. S XMPRIV=$G(^XMB(3.7,XMDUZ,9,XMIEN,0))
. S XMV("PRIV")=$S($P(XMPRIV,U,2)="y":"R",1:"")_$S($P(XMPRIV,U,3)="y":"W",1:"")
D USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN) Q:$D(XMV("ERROR"))
D LASTUSE(XMDUZ,.XMV)
Q
USER(XMDUZ,XMV,XMNOSEND,XMDUN) ;
; XMV("WARNING")
; XMV("ERROR")
; XMV("NEW MSGS")
; XMV("NAME")
; XMV("NOSEND")
; XMNOSEND
; XMDUN
N XMREC
K XMV("ERROR"),XMV("WARNING")
S XMREC=$G(^VA(200,XMDUZ,0))
I XMREC="" S XMV("ERROR",2)=$$EZBLD^DIALOG(38107,XMDUZ) Q ;There is no person with DUZ |1|.
;I $P(XMREC,U,3)="" S XMV("ERROR",3)=$$EZBLD^DIALOG(38108,XMDUZ) Q ; There is no Access Code for DUZ XMDUZ
I $P(XMREC,U,3)="",'$$USERTYPE^XUSAP(XMDUZ,"APPLICATION PROXY") S XMV("ERROR",3)=$$EZBLD^DIALOG(38108,XMDUZ) Q ; There is no Access Code for DUZ XMDUZ
;I '$D(^XMB(3.7,XMDUZ,0)) S XMV("ERROR",4)=$$EZBLD^DIALOG(38109,XMDUZ) Q ;There is no mailbox for DUZ |1|.
I '$D(^XMB(3.7,XMDUZ,0)),'$$USERTYPE^XUSAP(XMDUZ,"APPLICATION PROXY") S XMV("ERROR",4)=$$EZBLD^DIALOG(38109,XMDUZ) Q ;There is no mailbox for DUZ |1|.
S XMV("NOSEND")=0
S (XMDUN,XMV("NAME"))=$$NAME^XMXUTIL(XMDUZ)
D SETNET(XMDUZ,.XMV)
Q:$D(ZTQUEUED)!$G(XMAPI)
I $D(^XTMP("XM","MAKENEW",XMDUZ)) D NEWAGAIN^XMJBN1(XMDUZ)
I '$D(DUZ("SAV")),$D(XMMENU(0)) L +^XMB(3.7,"AD",DUZ):0 E S (XMV("NOSEND"),XMNOSEND)=1,XMV("WARNING",4)=$$EZBLD^DIALOG(38110) ;Multiple Signon
S:$D(^XMB(3.7,XMDUZ,"N")) XMV("WARNING",1)=$$EZBLD^DIALOG(38111) ;Priority Mail
I '$D(DUZ("SAV")),'XMV("NOSEND"),$D(^XMB(3.7,"AD",XMDUZ)) D
. I XMDUZ='DUZ,$G(XMV("PRIV"))'["W" Q
. N XMZ
. S XMREC=$G(^XMB(3.7,XMDUZ,"T"))
. S XMZ=$P(XMREC,U,1) I XMZ="" K ^XMB(3.7,"AD",XMDUZ) Q
. I '$D(^XMB(3.9,XMZ,0)) K ^XMB(3.7,XMDUZ,"T"),^XMB(3.7,"AD",XMDUZ) Q
. S XMZ=$P(XMREC,U,3)
. I XMZ,'$D(^XMB(3.9,XMZ,0)) K ^XMB(3.7,XMDUZ,"T"),^XMB(3.7,"AD",XMDUZ) Q
. S XMV("WARNING",2)=$$EZBLD^DIALOG(38112) ;Message in Buffer
S XMV("NEW MSGS")=+$P(^XMB(3.7,XMDUZ,0),U,6)
I XMDUZ=.5 D
. N I,XMK
. S XMK=.99
. F I=1:1 S XMK=$O(^XMB(3.7,.5,2,XMK)) Q:XMK>999!'XMK
. S:I>900 XMV("WARNING",5)=$$EZBLD^DIALOG(38113,I) ;POSTMASTER has |1| baskets.
D SETBAN(XMDUZ,.XMV)
Q
SETNET(XMDUZ,XMV) ;
; XMV("NETNAME")
S XMV("NETNAME")=$$NETNAME^XMXUTIL(XMDUZ)
Q
SETBAN(XMDUZ,XMV) ;
; XMV("BANNER")
N XMBANNER
S XMBANNER=$G(^XMB(3.7,XMDUZ,"B"))
I XMBANNER="" K XMV("BANNER")
E S XMV("BANNER")=XMBANNER
Q
PREFER(XMDUZ,XMV,XMDISPI) ;
; XMV("SHOW INST")
; XMV("SHOW TITL")
; XMV("SHOW DUZ")
; XMV("ASK BSKT")
; XMV("MSG DEF")
; XMV("RDR DEF")
; XMV("RDR ASK")
; XMV("ORDER")
; XMV("PREVU")
; XMV("NEW OPT")
; XMV("NEW ORDER")
; XMDISPI
N XMUREC,XMSREC
S XMSREC=$G(^XMB(1,1,0)) ; Site's preferences
;S XMUREC=^XMB(3.7,DUZ,0) ; User's preferences
S XMUREC=$G(^XMB(3.7,DUZ,0)) ; User's preferences
S XMV("SHOW INST")=$S($P(XMSREC,U,5)["y":1,1:0) ; Show Institution
S XMV("SHOW TITL")=$S($P(XMUREC,U,10)=1:1,1:0) ; Show Titles
I XMV("SHOW TITL") S XMV("TITL SRC")=$S($P(XMSREC,U,11)'="":$P(XMSREC,U,11),1:"T") ; Title Source (Signature Block or Title)
Q:$D(ZTQUEUED)
S XMV("SHOW DUZ")=+$P(XMSREC,U,8) ; Show DUZ when addressing messages
S XMV("PREVU")=$S($P(XMUREC,U,4)="Y":1,1:0)
S XMV("ASK BSKT")=$S($P(XMUREC,U,5)'["n":1,1:0)
; User's default message action (Delete, Ignore). If user doesn't have one, take site's. If site doesn't have one, make it Ignore.
S XMV("MSG DEF")=$S($P(XMUREC,U,9)'="":$P(XMUREC,U,9),$P(XMSREC,U,15)'="":$P(XMSREC,U,15),1:"I")
S XMV("ORDER")=$S($P(XMUREC,U,13)="N":-1,1:1)
S XMV("RDR DEF")=$S($P(XMUREC,U,16)'="":$P(XMUREC,U,16),1:"C")
S XMV("RDR ASK")=$S($P(XMUREC,U,17)'="":$P(XMUREC,U,17),1:"Y")
S XMV("NEW OPT")=$S($P(XMUREC,U,18)'="":$P(XMUREC,U,18),1:"R")
S XMV("NEW ORDER")=$S($P(XMUREC,U,19)="N":-1,1:1)
Q:$G(XMAPI)
I $P(XMSREC,U,6)["y",'$D(^XMB(3.7,XMDUZ,1,1,0)) S XMV("WARNING",3)=$$EZBLD^DIALOG(38114) ;No Introduction
S XMDISPI="X" ; Show Help (Not used?)
I XMV("SHOW INST") S XMDISPI=XMDISPI_"I"
I XMV("SHOW TITL") S XMDISPI=XMDISPI_"T"
I XMV("ASK BSKT") S XMDISPI=XMDISPI_"A"
S XMDISPI=XMDISPI_U_XMV("MSG DEF")
Q
LASTUSE(XMDUZ,XMV) ;
; XMV("LAST USE")
I XMDUZ=.6!$D(ZTQUEUED)!$G(XMAPI) Q
S XMV("LAST USE")=$P($G(^XMB(3.7,XMDUZ,"L"),$$EZBLD^DIALOG(38002)),U,1) ;Never
Q:$D(DUZ("SAV"))
S ^XMB(3.7,XMDUZ,"L")=$$MMDT^XMXUTIL1($$NOW^XLFDT)_$S(XMDUZ'=DUZ:$$EZBLD^DIALOG(38008,XMV("DUZ NAME")),1:"")_U_DT_U_DUZ ; (Surrogate: |1|)
Q
XMVVITAE ;ISC-SF/GMB-Initialize User's MailMan Variables ;04/19/2002 13:26
+1 ;;8.0;MailMan;**36**;Jun 28, 2002;Build 1
+2 ; Replaces ^XMGAPI1,FWD^XMA21,FWD,BANNER^XMA6,EDIT^XMA7 (ISC-WASH/CAP)
+3 ; Entry points (DBIA 2728):
+4 ; INIT Set up variables for DUZ or XMDUZ.
+5 ; OTHER Set up variables to become a surrogate of someone else.
+6 ; SELF Return from being a surrogate to being oneself again.
+7 QUIT
INIT ; Set up one's variables (for yourself or as a surrogate).
+1 NEW XMAPI
INIT2 KILL XMV
+1 DO SYSTEM(.XMV)
+2 IF '$DATA(XMDUZ)
SET XMDUZ=DUZ
+3 DO DUZ(DUZ,.XMV,.XMDUN,.XMDISPI,.XMNOSEND)
+4 IF XMDUZ'=DUZ
DO SURROGAT(XMDUZ,.XMV,.XMDUN,.XMNOSEND,.XMPRIV)
+5 QUIT
INITAPI ; (For MailMan use only) Set up variables for an API call.
+1 NEW XMAPI
+2 ; "last used MailMan" will not be recorded.
SET XMAPI=1
+3 GOTO INIT2
CHECK ; Check to make sure one's variables exist.
+1 IF '$DATA(XMV("NAME"))!'$DATA(XMV("RDR DEF"))
DO INIT
+2 QUIT
OTHER ; Become someone else. INIT should have been called previously.
+1 IF '$DATA(XMV)
DO INIT
QUIT
+2 NEW XMAPI
+3 DO SURROGAT(XMDUZ,.XMV,.XMDUN,.XMNOSEND,.XMPRIV)
+4 QUIT
SELF ; Return to oneself after having become someone else.
+1 ; INIT should have been called previously.
+2 SET XMDUZ=DUZ
+3 IF '$DATA(XMV)
DO INIT
QUIT
+4 NEW XMAPI
+5 DO USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN)
+6 DO LASTUSE(XMDUZ,.XMV)
+7 QUIT
SYSTEM(XMV) ;
+1 ; XMV("VERSION")
+2 IF '$DATA(DT)
DO DT^DICRW
+3 SET XMV("VERSION")="VA MailMan "_$PIECE($TEXT(XMVVITAE+1),";",3)
+4 ; Check to make sure that important variables are defined correctly.
+5 IF +$GET(^XMB("NUM"))
IF $GET(^XMB("NAME"))=$GET(^XMB("NETNAME"))
IF $GET(^XMB("NETNAME"))=$PIECE($GET(^DIC(4.2,+$GET(^XMB("NUM")),0)),U,1)
IF $GET(^XMB("NUM"))=$PIECE($GET(^XMB(1,1,0)),U,1)
QUIT
+6 ; The domain for this facility is not christened correctly.
NEW XMPARM
+7 SET XMPARM(1)=$GET(^XMB("NUM"))
+8 SET XMPARM(2)=$PIECE($GET(^XMB(1,1,0)),U,1)
+9 SET XMPARM(3)=$PIECE($GET(^DIC(4.2,+$GET(^XMB("NUM")),0)),U,1)
+10 SET XMPARM(4)=$PIECE($GET(^DIC(4.2,+XMPARM(2),0)),U,1)
+11 SET XMPARM(5)=$GET(^XMB("NETNAME"))
+12 SET XMPARM(6)=$GET(^XMB("NAME"))
+13 FOR I=1:1:6
IF XMPARM(I)=""
SET XMPARM(I)="?"
+14 ;The domain for this facility is not christened correctly.
+15 ;IRM must correct this for network mail to function properly.
+16 ;The following pointers should contain the same numbers,
+17 ;which should point to this facility's domain in ^DIC(4.2:
+18 ;^XMB("NUM")=|1| ==> |3|
+19 ;$P(^XMB(1,1,0),U,1)=|2| ==> |4|
+20 ;The following globals should contain the domain name of this facility:
+21 ;^XMB("NETNAME")= |5|
+22 ;^XMB("NAME")= |6|
+23 DO BLD^DIALOG(38100,.XMPARM,"","XMV(""SYSERR"")")
+24 QUIT
DUZ(XMDUZ,XMV,XMDUN,XMDISPI,XMNOSEND) ;
+1 ; XMV("DUZ NAME")
+2 KILL XMV("ERROR")
+3 ;You do not have a DUZ.
IF $GET(DUZ,0)=0
SET XMV("ERROR",1)=$$EZBLD^DIALOG(38105)
QUIT
+4 DO USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN)
IF $DATA(XMV("ERROR"))
QUIT
+5 SET XMV("DUZ NAME")=XMV("NAME")
+6 DO LASTUSE(XMDUZ,.XMV)
+7 DO PREFER(XMDUZ,.XMV,.XMDISPI)
+8 QUIT
SURROGAT(XMDUZ,XMV,XMDUN,XMNOSEND,XMPRIV) ;
+1 ; XMV("PRIV")
+2 ; XMPRIV
+3 IF XMDUZ=DUZ
QUIT
+4 KILL XMV("ERROR"),XMV("WARNING")
+5 IF XMDUZ=.6
Begin DoDot:1
+6 SET XMV("PRIV")="R"
SET XMPRIV="y^n"
+7 SET (XMDUN,XMV("NAME"))=$$NAME^XMXUTIL(.6)
+8 DO SETNET(XMDUZ,.XMV)
+9 SET XMV("NEW MSGS")=+$PIECE(^XMB(3.7,XMDUZ,0),U,6)
End DoDot:1
QUIT
+10 IF '$TEST
Begin DoDot:1
+11 NEW XMIEN
+12 SET XMIEN=+$ORDER(^XMB(3.7,"AB",DUZ,XMDUZ,0))
+13 ;Commented out because we shouldn't be here if not a valid surrogate
+14 ;I 'XMIEN S XMV("ERROR",5)=$$EZBLD^DIALOG(38106,XMDUZ) Q ;You are not a surrogate of DUZ |1|.
+15 SET XMPRIV=$GET(^XMB(3.7,XMDUZ,9,XMIEN,0))
+16 SET XMV("PRIV")=$SELECT($PIECE(XMPRIV,U,2)="y":"R",1:"")_$SELECT($PIECE(XMPRIV,U,3)="y":"W",1:"")
End DoDot:1
IF $DATA(XMV("ERROR"))
QUIT
+17 DO USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN)
IF $DATA(XMV("ERROR"))
QUIT
+18 DO LASTUSE(XMDUZ,.XMV)
+19 QUIT
USER(XMDUZ,XMV,XMNOSEND,XMDUN) ;
+1 ; XMV("WARNING")
+2 ; XMV("ERROR")
+3 ; XMV("NEW MSGS")
+4 ; XMV("NAME")
+5 ; XMV("NOSEND")
+6 ; XMNOSEND
+7 ; XMDUN
+8 NEW XMREC
+9 KILL XMV("ERROR"),XMV("WARNING")
+10 SET XMREC=$GET(^VA(200,XMDUZ,0))
+11 ;There is no person with DUZ |1|.
IF XMREC=""
SET XMV("ERROR",2)=$$EZBLD^DIALOG(38107,XMDUZ)
QUIT
+12 ;I $P(XMREC,U,3)="" S XMV("ERROR",3)=$$EZBLD^DIALOG(38108,XMDUZ) Q ; There is no Access Code for DUZ XMDUZ
+13 ; There is no Access Code for DUZ XMDUZ
IF $PIECE(XMREC,U,3)=""
IF '$$USERTYPE^XUSAP(XMDUZ,"APPLICATION PROXY")
SET XMV("ERROR",3)=$$EZBLD^DIALOG(38108,XMDUZ)
QUIT
+14 ;I '$D(^XMB(3.7,XMDUZ,0)) S XMV("ERROR",4)=$$EZBLD^DIALOG(38109,XMDUZ) Q ;There is no mailbox for DUZ |1|.
+15 ;There is no mailbox for DUZ |1|.
IF '$DATA(^XMB(3.7,XMDUZ,0))
IF '$$USERTYPE^XUSAP(XMDUZ,"APPLICATION PROXY")
SET XMV("ERROR",4)=$$EZBLD^DIALOG(38109,XMDUZ)
QUIT
+16 SET XMV("NOSEND")=0
+17 SET (XMDUN,XMV("NAME"))=$$NAME^XMXUTIL(XMDUZ)
+18 DO SETNET(XMDUZ,.XMV)
+19 IF $DATA(ZTQUEUED)!$GET(XMAPI)
QUIT
+20 IF $DATA(^XTMP("XM","MAKENEW",XMDUZ))
DO NEWAGAIN^XMJBN1(XMDUZ)
+21 ;Multiple Signon
IF '$DATA(DUZ("SAV"))
IF $DATA(XMMENU(0))
LOCK +^XMB(3.7,"AD",DUZ):0
IF '$TEST
SET (XMV("NOSEND"),XMNOSEND)=1
SET XMV("WARNING",4)=$$EZBLD^DIALOG(38110)
+22 ;Priority Mail
IF $DATA(^XMB(3.7,XMDUZ,"N"))
SET XMV("WARNING",1)=$$EZBLD^DIALOG(38111)
+23 IF '$DATA(DUZ("SAV"))
IF 'XMV("NOSEND")
IF $DATA(^XMB(3.7,"AD",XMDUZ))
Begin DoDot:1
+24 IF XMDUZ='DUZ
IF $GET(XMV("PRIV"))'["W"
QUIT
+25 NEW XMZ
+26 SET XMREC=$GET(^XMB(3.7,XMDUZ,"T"))
+27 SET XMZ=$PIECE(XMREC,U,1)
IF XMZ=""
KILL ^XMB(3.7,"AD",XMDUZ)
QUIT
+28 IF '$DATA(^XMB(3.9,XMZ,0))
KILL ^XMB(3.7,XMDUZ,"T"),^XMB(3.7,"AD",XMDUZ)
QUIT
+29 SET XMZ=$PIECE(XMREC,U,3)
+30 IF XMZ
IF '$DATA(^XMB(3.9,XMZ,0))
KILL ^XMB(3.7,XMDUZ,"T"),^XMB(3.7,"AD",XMDUZ)
QUIT
+31 ;Message in Buffer
SET XMV("WARNING",2)=$$EZBLD^DIALOG(38112)
End DoDot:1
+32 SET XMV("NEW MSGS")=+$PIECE(^XMB(3.7,XMDUZ,0),U,6)
+33 IF XMDUZ=.5
Begin DoDot:1
+34 NEW I,XMK
+35 SET XMK=.99
+36 FOR I=1:1
SET XMK=$ORDER(^XMB(3.7,.5,2,XMK))
IF XMK>999!'XMK
QUIT
+37 ;POSTMASTER has |1| baskets.
IF I>900
SET XMV("WARNING",5)=$$EZBLD^DIALOG(38113,I)
End DoDot:1
+38 DO SETBAN(XMDUZ,.XMV)
+39 QUIT
SETNET(XMDUZ,XMV) ;
+1 ; XMV("NETNAME")
+2 SET XMV("NETNAME")=$$NETNAME^XMXUTIL(XMDUZ)
+3 QUIT
SETBAN(XMDUZ,XMV) ;
+1 ; XMV("BANNER")
+2 NEW XMBANNER
+3 SET XMBANNER=$GET(^XMB(3.7,XMDUZ,"B"))
+4 IF XMBANNER=""
KILL XMV("BANNER")
+5 IF '$TEST
SET XMV("BANNER")=XMBANNER
+6 QUIT
PREFER(XMDUZ,XMV,XMDISPI) ;
+1 ; XMV("SHOW INST")
+2 ; XMV("SHOW TITL")
+3 ; XMV("SHOW DUZ")
+4 ; XMV("ASK BSKT")
+5 ; XMV("MSG DEF")
+6 ; XMV("RDR DEF")
+7 ; XMV("RDR ASK")
+8 ; XMV("ORDER")
+9 ; XMV("PREVU")
+10 ; XMV("NEW OPT")
+11 ; XMV("NEW ORDER")
+12 ; XMDISPI
+13 NEW XMUREC,XMSREC
+14 ; Site's preferences
SET XMSREC=$GET(^XMB(1,1,0))
+15 ;S XMUREC=^XMB(3.7,DUZ,0) ; User's preferences
+16 ; User's preferences
SET XMUREC=$GET(^XMB(3.7,DUZ,0))
+17 ; Show Institution
SET XMV("SHOW INST")=$SELECT($PIECE(XMSREC,U,5)["y":1,1:0)
+18 ; Show Titles
SET XMV("SHOW TITL")=$SELECT($PIECE(XMUREC,U,10)=1:1,1:0)
+19 ; Title Source (Signature Block or Title)
IF XMV("SHOW TITL")
SET XMV("TITL SRC")=$SELECT($PIECE(XMSREC,U,11)'="":$PIECE(XMSREC,U,11),1:"T")
+20 IF $DATA(ZTQUEUED)
QUIT
+21 ; Show DUZ when addressing messages
SET XMV("SHOW DUZ")=+$PIECE(XMSREC,U,8)
+22 SET XMV("PREVU")=$SELECT($PIECE(XMUREC,U,4)="Y":1,1:0)
+23 SET XMV("ASK BSKT")=$SELECT($PIECE(XMUREC,U,5)'["n":1,1:0)
+24 ; User's default message action (Delete, Ignore). If user doesn't have one, take site's. If site doesn't have one, make it Ignore.
+25 SET XMV("MSG DEF")=$SELECT($PIECE(XMUREC,U,9)'="":$PIECE(XMUREC,U,9),$PIECE(XMSREC,U,15)'="":$PIECE(XMSREC,U,15),1:"I")
+26 SET XMV("ORDER")=$SELECT($PIECE(XMUREC,U,13)="N":-1,1:1)
+27 SET XMV("RDR DEF")=$SELECT($PIECE(XMUREC,U,16)'="":$PIECE(XMUREC,U,16),1:"C")
+28 SET XMV("RDR ASK")=$SELECT($PIECE(XMUREC,U,17)'="":$PIECE(XMUREC,U,17),1:"Y")
+29 SET XMV("NEW OPT")=$SELECT($PIECE(XMUREC,U,18)'="":$PIECE(XMUREC,U,18),1:"R")
+30 SET XMV("NEW ORDER")=$SELECT($PIECE(XMUREC,U,19)="N":-1,1:1)
+31 IF $GET(XMAPI)
QUIT
+32 ;No Introduction
IF $PIECE(XMSREC,U,6)["y"
IF '$DATA(^XMB(3.7,XMDUZ,1,1,0))
SET XMV("WARNING",3)=$$EZBLD^DIALOG(38114)
+33 ; Show Help (Not used?)
SET XMDISPI="X"
+34 IF XMV("SHOW INST")
SET XMDISPI=XMDISPI_"I"
+35 IF XMV("SHOW TITL")
SET XMDISPI=XMDISPI_"T"
+36 IF XMV("ASK BSKT")
SET XMDISPI=XMDISPI_"A"
+37 SET XMDISPI=XMDISPI_U_XMV("MSG DEF")
+38 QUIT
LASTUSE(XMDUZ,XMV) ;
+1 ; XMV("LAST USE")
+2 IF XMDUZ=.6!$DATA(ZTQUEUED)!$GET(XMAPI)
QUIT
+3 ;Never
SET XMV("LAST USE")=$PIECE($GET(^XMB(3.7,XMDUZ,"L"),$$EZBLD^DIALOG(38002)),U,1)
+4 IF $DATA(DUZ("SAV"))
QUIT
+5 ; (Surrogate: |1|)
SET ^XMB(3.7,XMDUZ,"L")=$$MMDT^XMXUTIL1($$NOW^XLFDT)_$S(XMDUZ'=DUZ:$$EZBLD^DIALOG(38008,XMV("DUZ NAME")),1:"")_U_DT_U_DUZ
+6 QUIT
