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

XMVVITAE.m

Go to the documentation of this file. 
  1. XMVVITAE ;ISC-SF/GMB-Initialize User's MailMan Variables ;04/19/2002  13:26
  1.  ;;8.0;MailMan;**36**;Jun 28, 2002;Build 1
  1.  ; Replaces ^XMGAPI1,FWD^XMA21,FWD,BANNER^XMA6,EDIT^XMA7 (ISC-WASH/CAP)
  1.  ; Entry points (DBIA 2728):
  1.  ; INIT     Set up variables for DUZ or XMDUZ.
  1.  ; OTHER    Set up variables to become a surrogate of someone else.
  1.  ; SELF     Return from being a surrogate to being oneself again.
  1.  Q
  1. INIT ; Set up one's variables (for yourself or as a surrogate).
  1.  N XMAPI
  1. INIT2 K XMV
  1.  D SYSTEM(.XMV)
  1.  S:'$D(XMDUZ) XMDUZ=DUZ
  1.  D DUZ(DUZ,.XMV,.XMDUN,.XMDISPI,.XMNOSEND)
  1.  D:XMDUZ'=DUZ SURROGAT(XMDUZ,.XMV,.XMDUN,.XMNOSEND,.XMPRIV)
  1.  Q
  1. INITAPI ; (For MailMan use only) Set up variables for an API call.
  1.  N XMAPI
  1.  S XMAPI=1 ; "last used MailMan" will not be recorded.
  1.  G INIT2
  1. CHECK ; Check to make sure one's variables exist.
  1.  I '$D(XMV("NAME"))!'$D(XMV("RDR DEF")) D INIT
  1.  Q
  1. OTHER ; Become someone else.  INIT should have been called previously.
  1.  I '$D(XMV) D INIT Q
  1.  N XMAPI
  1.  D SURROGAT(XMDUZ,.XMV,.XMDUN,.XMNOSEND,.XMPRIV)
  1.  Q
  1. SELF ; Return to oneself after having become someone else.
  1.  ; INIT should have been called previously.
  1.  S XMDUZ=DUZ
  1.  I '$D(XMV) D INIT Q
  1.  N XMAPI
  1.  D USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN)
  1.  D LASTUSE(XMDUZ,.XMV)
  1.  Q
  1. SYSTEM(XMV) ;
  1.  ; XMV("VERSION")
  1.  I '$D(DT) D DT^DICRW
  1.  S XMV("VERSION")="VA MailMan "_$P($T(XMVVITAE+1),";",3)
  1.  ; Check to make sure that important variables are defined correctly.
  1.  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
  1.  N XMPARM  ; The domain for this facility is not christened correctly.
  1.  S XMPARM(1)=$G(^XMB("NUM"))
  1.  S XMPARM(2)=$P($G(^XMB(1,1,0)),U,1)
  1.  S XMPARM(3)=$P($G(^DIC(4.2,+$G(^XMB("NUM")),0)),U,1)
  1.  S XMPARM(4)=$P($G(^DIC(4.2,+XMPARM(2),0)),U,1)
  1.  S XMPARM(5)=$G(^XMB("NETNAME"))
  1.  S XMPARM(6)=$G(^XMB("NAME"))
  1.  F I=1:1:6 I XMPARM(I)="" S XMPARM(I)="?"
  1.  ;The domain for this facility is not christened correctly.
  1.  ;IRM must correct this for network mail to function properly.
  1.  ;The following pointers should contain the same numbers,
  1.  ;which should point to this facility's domain in ^DIC(4.2:
  1.  ;^XMB("NUM")=|1|          ==> |3|
  1.  ;$P(^XMB(1,1,0),U,1)=|2|  ==> |4|
  1.  ;The following globals should contain the domain name of this facility:
  1.  ;^XMB("NETNAME")=           |5|
  1.  ;^XMB("NAME")=              |6|
  1.  D BLD^DIALOG(38100,.XMPARM,"","XMV(""SYSERR"")")
  1.  Q
  1. DUZ(XMDUZ,XMV,XMDUN,XMDISPI,XMNOSEND) ;
  1.  ; XMV("DUZ NAME")
  1.  K XMV("ERROR")
  1.  I $G(DUZ,0)=0 S XMV("ERROR",1)=$$EZBLD^DIALOG(38105) Q  ;You do not have a DUZ.
  1.  D USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN) Q:$D(XMV("ERROR"))
  1.  S XMV("DUZ NAME")=XMV("NAME")
  1.  D LASTUSE(XMDUZ,.XMV)
  1.  D PREFER(XMDUZ,.XMV,.XMDISPI)
  1.  Q
  1. SURROGAT(XMDUZ,XMV,XMDUN,XMNOSEND,XMPRIV) ;
  1.  ; XMV("PRIV")
  1.  ; XMPRIV
  1.  Q:XMDUZ=DUZ
  1.  K XMV("ERROR"),XMV("WARNING")
  1.  I XMDUZ=.6 D  Q
  1.  . S XMV("PRIV")="R",XMPRIV="y^n"
  1.  . S (XMDUN,XMV("NAME"))=$$NAME^XMXUTIL(.6)
  1.  . D SETNET(XMDUZ,.XMV)
  1.  . S XMV("NEW MSGS")=+$P(^XMB(3.7,XMDUZ,0),U,6)
  1.  E  D  Q:$D(XMV("ERROR"))
  1.  . N XMIEN
  1.  . S XMIEN=+$O(^XMB(3.7,"AB",DUZ,XMDUZ,0))
  1.  . ;Commented out because we shouldn't be here if not a valid surrogate
  1.  . ;I 'XMIEN S XMV("ERROR",5)=$$EZBLD^DIALOG(38106,XMDUZ) Q  ;You are not a surrogate of DUZ |1|.
  1.  . S XMPRIV=$G(^XMB(3.7,XMDUZ,9,XMIEN,0))
  1.  . S XMV("PRIV")=$S($P(XMPRIV,U,2)="y":"R",1:"")_$S($P(XMPRIV,U,3)="y":"W",1:"")
  1.  D USER(XMDUZ,.XMV,.XMNOSEND,.XMDUN) Q:$D(XMV("ERROR"))
  1.  D LASTUSE(XMDUZ,.XMV)
  1.  Q
  1. USER(XMDUZ,XMV,XMNOSEND,XMDUN) ;
  1.  ; XMV("WARNING")
  1.  ; XMV("ERROR")
  1.  ; XMV("NEW MSGS")
  1.  ; XMV("NAME")
  1.  ; XMV("NOSEND")
  1.  ; XMNOSEND
  1.  ; XMDUN
  1.  N XMREC
  1.  K XMV("ERROR"),XMV("WARNING")
  1.  S XMREC=$G(^VA(200,XMDUZ,0))
  1.  I XMREC="" S XMV("ERROR",2)=$$EZBLD^DIALOG(38107,XMDUZ) Q  ;There is no person with DUZ |1|.
  1.  ;I $P(XMREC,U,3)="" S XMV("ERROR",3)=$$EZBLD^DIALOG(38108,XMDUZ) Q  ; There is no Access Code for DUZ XMDUZ
  1.  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
  1.  ;I '$D(^XMB(3.7,XMDUZ,0)) S XMV("ERROR",4)=$$EZBLD^DIALOG(38109,XMDUZ) Q  ;There is no mailbox for DUZ |1|.
  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|.
  1.  S XMV("NOSEND")=0
  1.  S (XMDUN,XMV("NAME"))=$$NAME^XMXUTIL(XMDUZ)
  1.  D SETNET(XMDUZ,.XMV)
  1.  Q:$D(ZTQUEUED)!$G(XMAPI)
  1.  I $D(^XTMP("XM","MAKENEW",XMDUZ)) D NEWAGAIN^XMJBN1(XMDUZ)
  1.  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
  1.  S:$D(^XMB(3.7,XMDUZ,"N")) XMV("WARNING",1)=$$EZBLD^DIALOG(38111) ;Priority Mail
  1.  I '$D(DUZ("SAV")),'XMV("NOSEND"),$D(^XMB(3.7,"AD",XMDUZ)) D
  1.  . I XMDUZ='DUZ,$G(XMV("PRIV"))'["W" Q
  1.  . N XMZ
  1.  . S XMREC=$G(^XMB(3.7,XMDUZ,"T"))
  1.  . S XMZ=$P(XMREC,U,1) I XMZ="" K ^XMB(3.7,"AD",XMDUZ) Q
  1.  . I '$D(^XMB(3.9,XMZ,0)) K ^XMB(3.7,XMDUZ,"T"),^XMB(3.7,"AD",XMDUZ) Q
  1.  . S XMZ=$P(XMREC,U,3)
  1.  . I XMZ,'$D(^XMB(3.9,XMZ,0)) K ^XMB(3.7,XMDUZ,"T"),^XMB(3.7,"AD",XMDUZ) Q
  1.  . S XMV("WARNING",2)=$$EZBLD^DIALOG(38112) ;Message in Buffer
  1.  S XMV("NEW MSGS")=+$P(^XMB(3.7,XMDUZ,0),U,6)
  1.  I XMDUZ=.5 D
  1.  . N I,XMK
  1.  . S XMK=.99
  1.  . F I=1:1 S XMK=$O(^XMB(3.7,.5,2,XMK)) Q:XMK>999!'XMK
  1.  . S:I>900 XMV("WARNING",5)=$$EZBLD^DIALOG(38113,I) ;POSTMASTER has |1| baskets.
  1.  D SETBAN(XMDUZ,.XMV)
  1.  Q
  1. SETNET(XMDUZ,XMV) ;
  1.  ; XMV("NETNAME")
  1.  S XMV("NETNAME")=$$NETNAME^XMXUTIL(XMDUZ)
  1.  Q
  1. SETBAN(XMDUZ,XMV) ;
  1.  ; XMV("BANNER")
  1.  N XMBANNER
  1.  S XMBANNER=$G(^XMB(3.7,XMDUZ,"B"))
  1.  I XMBANNER="" K XMV("BANNER")
  1.  E  S XMV("BANNER")=XMBANNER
  1.  Q
  1. PREFER(XMDUZ,XMV,XMDISPI) ;
  1.  ; XMV("SHOW INST")
  1.  ; XMV("SHOW TITL")
  1.  ; XMV("SHOW DUZ")
  1.  ; XMV("ASK BSKT")
  1.  ; XMV("MSG DEF")
  1.  ; XMV("RDR DEF")
  1.  ; XMV("RDR ASK")
  1.  ; XMV("ORDER")
  1.  ; XMV("PREVU")
  1.  ; XMV("NEW OPT")
  1.  ; XMV("NEW ORDER")
  1.  ; XMDISPI
  1.  N XMUREC,XMSREC
  1.  S XMSREC=$G(^XMB(1,1,0)) ; Site's preferences
  1.  ;S XMUREC=^XMB(3.7,DUZ,0) ; User's preferences
  1.  S XMUREC=$G(^XMB(3.7,DUZ,0)) ; User's preferences
  1.  S XMV("SHOW INST")=$S($P(XMSREC,U,5)["y":1,1:0)  ; Show Institution
  1.  S XMV("SHOW TITL")=$S($P(XMUREC,U,10)=1:1,1:0)   ; Show Titles
  1.  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)
  1.  Q:$D(ZTQUEUED)
  1.  S XMV("SHOW DUZ")=+$P(XMSREC,U,8)  ; Show DUZ when addressing messages
  1.  S XMV("PREVU")=$S($P(XMUREC,U,4)="Y":1,1:0)
  1.  S XMV("ASK BSKT")=$S($P(XMUREC,U,5)'["n":1,1:0)
  1.  ; 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.
  1.  S XMV("MSG DEF")=$S($P(XMUREC,U,9)'="":$P(XMUREC,U,9),$P(XMSREC,U,15)'="":$P(XMSREC,U,15),1:"I")
  1.  S XMV("ORDER")=$S($P(XMUREC,U,13)="N":-1,1:1)
  1.  S XMV("RDR DEF")=$S($P(XMUREC,U,16)'="":$P(XMUREC,U,16),1:"C")
  1.  S XMV("RDR ASK")=$S($P(XMUREC,U,17)'="":$P(XMUREC,U,17),1:"Y")
  1.  S XMV("NEW OPT")=$S($P(XMUREC,U,18)'="":$P(XMUREC,U,18),1:"R")
  1.  S XMV("NEW ORDER")=$S($P(XMUREC,U,19)="N":-1,1:1)
  1.  Q:$G(XMAPI)
  1.  I $P(XMSREC,U,6)["y",'$D(^XMB(3.7,XMDUZ,1,1,0)) S XMV("WARNING",3)=$$EZBLD^DIALOG(38114) ;No Introduction
  1.  S XMDISPI="X"  ; Show Help (Not used?)
  1.  I XMV("SHOW INST") S XMDISPI=XMDISPI_"I"
  1.  I XMV("SHOW TITL") S XMDISPI=XMDISPI_"T"
  1.  I XMV("ASK BSKT") S XMDISPI=XMDISPI_"A"
  1.  S XMDISPI=XMDISPI_U_XMV("MSG DEF")
  1.  Q
  1. LASTUSE(XMDUZ,XMV) ;
  1.  ; XMV("LAST USE")
  1.  I XMDUZ=.6!$D(ZTQUEUED)!$G(XMAPI) Q
  1.  S XMV("LAST USE")=$P($G(^XMB(3.7,XMDUZ,"L"),$$EZBLD^DIALOG(38002)),U,1) ;Never
  1.  Q:$D(DUZ("SAV"))
  1.  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|)
  1.  Q