| 1 | XM ;ISC-SF/GMB-MailMan Main Driver ;04/22/2002 14:31
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; Replaces ^XM,EN^XMA01,INTRO^XMA6,REC^XMA22,MULTI^XM0,^XMAK (ISC-WASH/CAP/THM)
|
|---|
| 4 | ;
|
|---|
| 5 | ; Entry points (DBIA 10064):
|
|---|
| 6 | ; ^XM Programmer entry into MailMan
|
|---|
| 7 | ; CHECKIN Meant to be included in option ENTRY ACTION
|
|---|
| 8 | ; CHECKOUT Meant to be included in option EXIT ACTION
|
|---|
| 9 | ; EN Option entry point into MailMan
|
|---|
| 10 | ; HEADER Displays user intro when entering MailMan
|
|---|
| 11 | ; KILL Kill MailMan variables
|
|---|
| 12 | ; N1 Create a mailbox
|
|---|
| 13 | ; NEW Create a mailbox
|
|---|
| 14 | ; $$NU Tell user how many new messages he has
|
|---|
| 15 | ;
|
|---|
| 16 | ; Entry points used by MailMan options (not covered by DBIA):
|
|---|
| 17 | ; NEWMBOX XMMGR-NEW-MAIL-BOX - Create a mailbox
|
|---|
| 18 | D KILL^XUSCLEAN
|
|---|
| 19 | N XMXUSEC,XMABORT,XMMENU
|
|---|
| 20 | S XMMENU(0)="^XM"
|
|---|
| 21 | I '$D(IOF) D HOME^%ZIS
|
|---|
| 22 | D EN
|
|---|
| 23 | I $D(XQUIT)!'$D(XMDUZ) K XQUIT D CLEANUP Q
|
|---|
| 24 | D:'$D(^DOPT("XM")) OPTIONS
|
|---|
| 25 | S XMABORT=0
|
|---|
| 26 | F D Q:XMABORT ; Programmer option choices
|
|---|
| 27 | . N DIC,X,Y
|
|---|
| 28 | . S XMXUSEC=$S($G(DUZ(0))="@":1,$D(^XUSEC("XUPROG",XMDUZ)):1,$D(^XUSEC("XUPROGMODE",XMDUZ)):1,1:0)
|
|---|
| 29 | . S DIC="^DOPT(""XM"","
|
|---|
| 30 | . S DIC(0)="AEQMZ"
|
|---|
| 31 | . S DIC("S")="Q:XMXUSEC I ^(0)'[""LOAD"""
|
|---|
| 32 | . W !!
|
|---|
| 33 | . D ^DIC I Y<0 S XMABORT=1 Q
|
|---|
| 34 | . K DIC,X
|
|---|
| 35 | . X $P(Y(0),U,2,999)
|
|---|
| 36 | D CLEANUP
|
|---|
| 37 | Q
|
|---|
| 38 | EN ;Initialize
|
|---|
| 39 | ;N XMDUZ,XMDISPI,XMDUN,XMNOSEND,XMV
|
|---|
| 40 | Q:$D(DUZ("SAV")) ; Set by option XUTESTUSER
|
|---|
| 41 | D SETUP
|
|---|
| 42 | D HEADER
|
|---|
| 43 | Q
|
|---|
| 44 | SETUP ;
|
|---|
| 45 | I $G(IO)'=$G(IO(0))!'$D(IO(0)) D HOME^%ZIS U IO
|
|---|
| 46 | D CHECK^XMKPL ; Make sure background filers are running.
|
|---|
| 47 | I '$D(IOF)!'$D(IOM)!'$D(IOSL) S IOP="" D ^%ZIS K IOP
|
|---|
| 48 | S XMDUZ=DUZ
|
|---|
| 49 | D INIT^XMVVITAE
|
|---|
| 50 | K XMERR,^TMP("XMERR",$J)
|
|---|
| 51 | Q
|
|---|
| 52 | HEADER ;
|
|---|
| 53 | N XMPERSON,XMPARM,XMTEXT
|
|---|
| 54 | I $D(XMV("SYSERR")) D ERROR(.XMV,"SYSERR") S:$D(XMMENU) XQUIT="" Q ; Fatal Errors
|
|---|
| 55 | I $D(XMV("ERROR")) D ERROR(.XMV,"ERROR") S:$D(XMMENU) XQUIT="" Q ; Fatal Errors
|
|---|
| 56 | I $D(XMV("WARNING")) D WARNING(XMDUZ,.XMV)
|
|---|
| 57 | S XMPARM(1)=XMV("VERSION"),XMPARM(2)=XMV("NETNAME")
|
|---|
| 58 | W !!,$$EZBLD^DIALOG(38150,.XMPARM) ; |1| service for |2|
|
|---|
| 59 | I XMDUZ'=DUZ W !,$$EZBLD^DIALOG(38008,XMV("DUZ NAME")) ; (Surrogate: |1|)
|
|---|
| 60 | I XMDUZ'=.6 D
|
|---|
| 61 | . S XMPARM(1)=XMV("LAST USE"),XMPARM(2)=XMV("NAME")
|
|---|
| 62 | . W !,$$EZBLD^DIALOG($S(XMDUZ=DUZ:38151,1:38152),.XMPARM) ; You/|2| last used MailMan: |1|
|
|---|
| 63 | . Q:'$D(XMV("BANNER"))
|
|---|
| 64 | . S XMPARM(1)=XMV("BANNER"),XMPARM(2)=XMV("NAME")
|
|---|
| 65 | . D BLD^DIALOG($S(XMDUZ=DUZ:38153,1:38154),.XMPARM,"","XMTEXT","F")
|
|---|
| 66 | . D MSG^DIALOG("WM","","","","XMTEXT")
|
|---|
| 67 | . ; Your/|2|'s current banner: |1|
|
|---|
| 68 | . ;E W !,$S(XMDUZ=DUZ:"You have",1:XMV("NAME")_" has")," no banner."
|
|---|
| 69 | S XMPARM(1)=XMV("NEW MSGS"),XMPARM(2)=XMV("NAME")
|
|---|
| 70 | W !,$$EZBLD^DIALOG($S(XMDUZ=DUZ:38155,1:38156)+$S(XMV("NEW MSGS")>1:0,'XMV("NEW MSGS"):.2,1:.1),.XMPARM) ; You have/|2| has |1|/no new message(s).
|
|---|
| 71 | I XMV("NEW MSGS")<0!(XMV("NEW MSGS")&'$D(^XMB(3.7,XMDUZ,"N0")))!('XMV("NEW MSGS")&$D(^XMB(3.7,XMDUZ,"N0"))) D
|
|---|
| 72 | . D MSG(38160)
|
|---|
| 73 | . ; There's a discrepancy in the 'new message' count. Checking the mailbox...
|
|---|
| 74 | . D USER^XMUT4(XMDUZ)
|
|---|
| 75 | Q
|
|---|
| 76 | ERROR(XMV,XMTYPE) ;
|
|---|
| 77 | N I
|
|---|
| 78 | S I=0
|
|---|
| 79 | F S I=$O(XMV(XMTYPE,I)) Q:I="" W !,$C(7),XMV(XMTYPE,I)
|
|---|
| 80 | K XMDUZ
|
|---|
| 81 | Q
|
|---|
| 82 | WARNING(XMDUZ,XMV) ;
|
|---|
| 83 | D:$D(XMV("WARNING",5)) POST(XMV("WARNING",5))
|
|---|
| 84 | D:$D(XMV("WARNING",4)) MULTI
|
|---|
| 85 | D:$D(XMV("WARNING",3)) INTRO(XMDUZ)
|
|---|
| 86 | D:$D(XMV("WARNING",2)) UNSENT(XMDUZ)
|
|---|
| 87 | D:$D(XMV("WARNING",1)) LISTPRI^XMJML(XMDUZ)
|
|---|
| 88 | ;D:$D(XMV("WARNING",1)) PRIO^XMJML(XMDUZ)
|
|---|
| 89 | K XMV("WARNING")
|
|---|
| 90 | Q
|
|---|
| 91 | MSG(XMDIALOG) ;
|
|---|
| 92 | N XMTEXT
|
|---|
| 93 | W !
|
|---|
| 94 | D BLD^DIALOG(XMDIALOG,"","","XMTEXT","F")
|
|---|
| 95 | D MSG^DIALOG("WM","","","","XMTEXT")
|
|---|
| 96 | Q
|
|---|
| 97 | POST(XMMSG) ;
|
|---|
| 98 | W !!,$C(7),XMMSG ; "POSTMASTER has X baskets."
|
|---|
| 99 | D MSG(38113.1)
|
|---|
| 100 | ;POSTMASTER may not have more than 999 baskets.
|
|---|
| 101 | ;Baskets numbered above 999 are reserved for network transmission
|
|---|
| 102 | ;queues and for server queues.
|
|---|
| 103 | Q
|
|---|
| 104 | MULTI ;
|
|---|
| 105 | ;It appears someone is signed on as you/|1| already.
|
|---|
| 106 | ;You may not send mail or respond to mail in this session.
|
|---|
| 107 | ;(Only the 1st of multiple MailMan sessions may send or respond to mail.)
|
|---|
| 108 | N XMTEXT
|
|---|
| 109 | W !
|
|---|
| 110 | D BLD^DIALOG($S(XMDUZ=DUZ:38110.1,1:38110.2),XMV("NAME"),"","XMTEXT","F")
|
|---|
| 111 | D BLD^DIALOG(38110.3,"","","XMTEXT","F")
|
|---|
| 112 | D MSG^DIALOG("WM","","","","XMTEXT")
|
|---|
| 113 | Q
|
|---|
| 114 | INTRO(XMDUZ) ;
|
|---|
| 115 | D MSG(38114.1)
|
|---|
| 116 | ;You have not yet introduced yourself to the group.
|
|---|
| 117 | ;Please enter a short introduction, so that others may use
|
|---|
| 118 | ;the HELP option to find out more about you.
|
|---|
| 119 | ;You may change your INTRODUCTION later
|
|---|
| 120 | ;under 'Personal Preferences|User Options Edit.
|
|---|
| 121 | W !!
|
|---|
| 122 | N DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT)
|
|---|
| 123 | N DWPK,DIC
|
|---|
| 124 | S DWPK=1,DIC="^XMB(3.7,XMDUZ,1,"
|
|---|
| 125 | D EN^DIWE
|
|---|
| 126 | Q
|
|---|
| 127 | UNSENT(XMDUZ) ;
|
|---|
| 128 | N XMREC,XMZ
|
|---|
| 129 | L +^XMB(3.7,"AD",XMDUZ):0 E D Q
|
|---|
| 130 | . S XMV("NOSEND")=1
|
|---|
| 131 | . D MULTI
|
|---|
| 132 | S XMREC=^XMB(3.7,XMDUZ,"T")
|
|---|
| 133 | S XMZ=$P(XMREC,U) Q:'XMZ
|
|---|
| 134 | I $P(XMREC,U,3) D RECOVER^XMJMR(XMDUZ,XMZ,$P(XMREC,U,3)) Q ; Reply
|
|---|
| 135 | D RECOVER^XMJMS(XMDUZ,XMZ,$P(XMREC,U,4)) ; Original Message (w/BLOB)
|
|---|
| 136 | Q
|
|---|
| 137 | CHECKIN ;
|
|---|
| 138 | Q:$D(XMMENU(0)) ; Set by option XMUSER or other options using MailMan
|
|---|
| 139 | Q:$D(DUZ("SAV")) ; Set by option XUTESTUSER
|
|---|
| 140 | D SETUP
|
|---|
| 141 | I $D(XMV("WARNING")) D WARNING(XMDUZ,.XMV)
|
|---|
| 142 | Q
|
|---|
| 143 | CHECKOUT ;
|
|---|
| 144 | K XMERR,^TMP("XMERR",$J)
|
|---|
| 145 | Q:$D(XMMENU(0))
|
|---|
| 146 | K XMDISPI,XMDUN,XMDUZ,XMNOSEND,XMPRIV,XMV
|
|---|
| 147 | L -^XMB(3.7,"AD",DUZ)
|
|---|
| 148 | Q
|
|---|
| 149 | LOCK ;
|
|---|
| 150 | S Y=1
|
|---|
| 151 | Q:'$D(XMMENU(0))
|
|---|
| 152 | L +^XMB(3.7,"AD",DUZ):0 E D MULTI S Y=-1
|
|---|
| 153 | Q
|
|---|
| 154 | UNLOCK ;
|
|---|
| 155 | Q:'$D(XMMENU(0))
|
|---|
| 156 | L -^XMB(3.7,"AD",DUZ)
|
|---|
| 157 | Q
|
|---|
| 158 | CHK ; Entry used by Kernel
|
|---|
| 159 | K ^TMP("XMY",$J),^TMP("XMY0",$J)
|
|---|
| 160 | S XMDUZ=$G(XMDUZ,DUZ)
|
|---|
| 161 | Q:XMDUZ=.6
|
|---|
| 162 | D NUS(0)
|
|---|
| 163 | Q
|
|---|
| 164 | NU(XMFORCE) ;API for new message display
|
|---|
| 165 | ; XMFORCE (in) 1=force new display; 0=display only if recent receipt
|
|---|
| 166 | N XMNEW
|
|---|
| 167 | D NUS(XMFORCE,.XMNEW)
|
|---|
| 168 | Q XMNEW
|
|---|
| 169 | NUS(XMFORCE,XMNEW) ; new message display
|
|---|
| 170 | ; XMFORCE (in) 1=force new display; 0=display only if recent receipt
|
|---|
| 171 | ; XMNEW (out) number of new messages
|
|---|
| 172 | ; XMLAST last message arrival date (FM format)
|
|---|
| 173 | N XMREC,XMNEW2U,XMLAST
|
|---|
| 174 | S XMDUZ=$G(XMDUZ,DUZ)
|
|---|
| 175 | S XMREC=$$NEWS^XMXUTIL(XMDUZ,$D(DUZ("SAV")))
|
|---|
| 176 | Q:XMREC=-1
|
|---|
| 177 | S XMNEW=$P(XMREC,U,1)
|
|---|
| 178 | I 'XMFORCE,'XMNEW Q
|
|---|
| 179 | S XMLAST=$P(XMREC,U,4)
|
|---|
| 180 | S XMNEW2U=$P(XMREC,U,5)
|
|---|
| 181 | I XMNEW2U!XMFORCE D
|
|---|
| 182 | . N XMPARM,XMDIALOG
|
|---|
| 183 | . S XMPARM(1)=XMNEW
|
|---|
| 184 | . I XMDUZ=DUZ S XMDIALOG=38155
|
|---|
| 185 | . E S XMDIALOG=38156,XMPARM(2)=$$NAME^XMXUTIL(XMDUZ)
|
|---|
| 186 | . W !,$$EZBLD^DIALOG(XMDIALOG+$S(XMNEW>1:0,'XMNEW:.2,1:.1),.XMPARM) ; You have/|2| has |1|/no new message(s).
|
|---|
| 187 | . Q:'XMNEW
|
|---|
| 188 | . W " ",$$EZBLD^DIALOG(38158,$$MMDT^XMXUTIL1(XMLAST)) ; (Last arrival: |1|)
|
|---|
| 189 | D:$P(XMREC,U,2) NOTEPRIO
|
|---|
| 190 | Q
|
|---|
| 191 | NOTEPRIO ;
|
|---|
| 192 | N XMDIALOG,XMPARM
|
|---|
| 193 | I XMDUZ=DUZ S XMDIALOG=38159 ;You've got PRIORITY Mail!
|
|---|
| 194 | E S XMDIALOG=38159.1,XMPARM(1)=$$NAME^XMXUTIL(XMDUZ) ;|1| has PRIORITY Mail!
|
|---|
| 195 | D ZIS
|
|---|
| 196 | W $C(7),!!,$G(IORVON),$$EZBLD^DIALOG(XMDIALOG,.XMPARM),!!,$G(IORVOFF)
|
|---|
| 197 | Q
|
|---|
| 198 | ZIS ;
|
|---|
| 199 | Q:$D(IORVON)
|
|---|
| 200 | N X
|
|---|
| 201 | S X="IORVON;IORVOFF;IOBON;IOBOFF"
|
|---|
| 202 | D ENDR^%ZISS
|
|---|
| 203 | Q
|
|---|
| 204 | NEWMBOX ; Create a mailbox for a user
|
|---|
| 205 | N DIC,XMZ
|
|---|
| 206 | D MSG(38165)
|
|---|
| 207 | ;Ready to create a mailbox for a user.
|
|---|
| 208 | ;You will only be able to select a user who does not already have a mailbox.
|
|---|
| 209 | S DIC="^VA(200,"
|
|---|
| 210 | S DIC(0)="AEQM"
|
|---|
| 211 | S DIC("S")="I '$D(^XMB(3.7,Y,0))"
|
|---|
| 212 | D ^DIC Q:Y=-1
|
|---|
| 213 | S Y=+Y
|
|---|
| 214 | D NEW
|
|---|
| 215 | W !,$$EZBLD^DIALOG(38165.1) ; Mailbox created.
|
|---|
| 216 | Q
|
|---|
| 217 | N1 S Y=XMDUZ
|
|---|
| 218 | NEW ; CREATE MAILBOX 4 NEW USER
|
|---|
| 219 | N L +^XMB(3.7,0):0 E H 1 G N
|
|---|
| 220 | D CRE8MBOX^XMXMBOX(Y,$S($D(XMZ):DT,1:""))
|
|---|
| 221 | L -^XMB(3.7,0)
|
|---|
| 222 | D:$D(XMERR) SHOW^XMJERR
|
|---|
| 223 | Q
|
|---|
| 224 | KILL ;
|
|---|
| 225 | CLEANUP ;
|
|---|
| 226 | K XMV,XMDISPI,XMDUN,XMDUZ,XMPRIV,XMNOSEND,XMERR
|
|---|
| 227 | K:$D(^TMP("XMERR",$J)) ^TMP("XMERR",$J)
|
|---|
| 228 | D KILLALL
|
|---|
| 229 | D UNLOCK
|
|---|
| 230 | Q
|
|---|
| 231 | KILLALL ;All variables except XMDISPI,XMDUZ,XMDUN and XMPRIV are killed here on
|
|---|
| 232 | ;exit from the MailMan package or by calls to this code.
|
|---|
| 233 | K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Z,%,%0,%1,%2,%3,%4
|
|---|
| 234 | K XM,XMA,XMA0,XMAPBLOB,XMB,XMB0
|
|---|
| 235 | K XMC,XMC0,XMCH,XMCI,XMCL,XMCNT,XMCT
|
|---|
| 236 | K XMD,XMD0,XMDATE,XMDI,XMDT,XME,XME0,XMF,XMF0,XMG,XMG0
|
|---|
| 237 | K XMK,XMKM,XMKN,XMI,XMJ
|
|---|
| 238 | K XML,XMLOAD,XMLOC,XMLOCK,XMM,XMMG,XMN,XMOUT,XMP
|
|---|
| 239 | K XMR,XMRES,XMS,XMSEN,XMSUB
|
|---|
| 240 | K XMT,XMTYPE,XMU,XMY,XMZ,XMZ1,XMZ2
|
|---|
| 241 | Q
|
|---|
| 242 | DSP ;
|
|---|
| 243 | D INIT^XMVVITAE
|
|---|
| 244 | Q
|
|---|
| 245 | OPTIONS ; Set up options
|
|---|
| 246 | N DIK,I,X
|
|---|
| 247 | K ^DOPT("XM")
|
|---|
| 248 | S DIK="^DOPT(""XM"","
|
|---|
| 249 | S ^DOPT("XM",0)="MailMan Option^1N^"
|
|---|
| 250 | F I=1:1 S X=$P($T(T+I)," ",1,3) Q:X=" ;;" S X=$E(X,4,255),^DOPT("XM",I,0)=$$UP^XLFSTR($$EZBLD^DIALOG(+X))_U_$P(X,U,2,3)
|
|---|
| 251 | D IXALL^DIK
|
|---|
| 252 | Q
|
|---|
| 253 | T ;;TABLE
|
|---|
| 254 | ;;38170^D SEND^XMJMS ; SEND A MESSAGE
|
|---|
| 255 | ;;38171^D MANAGE^XMJBM ; READ/MANAGE MESSAGES
|
|---|
| 256 | ;;38172^D NEW^XMJBN ; NEW MESSAGES AND RESPONSES
|
|---|
| 257 | ;;38173^D PAKMAN^XMJMS ; LOAD PACKMAN MESSAGE
|
|---|
| 258 | ;;38174^D EDIT^XMVVITA ; EDIT USER OPTIONS
|
|---|
| 259 | ;;38175^D PERSONAL^XMVGROUP ; PERSONAL MAIL GROUP EDIT
|
|---|
| 260 | ;;38176^D ENROLL^XMVGROUP ; JOIN MAIL GROUP
|
|---|
| 261 | ;;38177^D LISTMBOX^XMJBL ; MAILBOX CONTENTS LIST
|
|---|
| 262 | ;;38178^D TALK^XMC ; LOG-IN TO ANOTHER SYSTEM (TalkMan)
|
|---|
| 263 | ;;38179^D FIND^XMJMF ; QUERY/SEARCH FOR MESSAGES
|
|---|
| 264 | ;;
|
|---|
| 265 | ;;**OBSOLETE**
|
|---|
| 266 | ;;BLOB SEND^D BLOB^XMA2B
|
|---|
| 267 | ;;
|
|---|
