1 | CWMAILD ;INDPLS/PLS- DELPHI VISTA MAIL SERVER CONT'D ;22-Jul-2005 07:10;CLC
|
---|
2 | ;;2.3;CWMAIL;;Jul 19, 2005
|
---|
3 | Q ;ROUTINE CAN'T BE CALLED DIRECTLY
|
---|
4 | ;
|
---|
5 | %BMSGD(CWDATA,CWINPUT,CWTEXT) ;BUILD MESSAGE DATA INTO GLOBAL
|
---|
6 | ;USE CREATE OR REPLY TO SEND ACTUAL MESSAGE OR REPLY
|
---|
7 | M ^TMP($J,"CWMAILLOAD")=CWTEXT
|
---|
8 | S CWDATA(1)="1^1^DATA SET"
|
---|
9 | BMSGDE Q
|
---|
10 | ;
|
---|
11 | %PERPREF(CWDATA,CWPARAM) ;retrieve personal preferences
|
---|
12 | ;CWPARAM is not used
|
---|
13 | N CWNAME,CWCNT
|
---|
14 | S CWCNT=2
|
---|
15 | S CWDATA(1)="0^^AN ERROR HAS OCCURRED"
|
---|
16 | I $$GETPKPM^CWMAILE(.CWDATA) D
|
---|
17 | .S CWCNT=$G(CWDATA(-9900))
|
---|
18 | .K CWDATA(-9900)
|
---|
19 | .S CWDATA(1)="1^1^Preferences have been retrieved"
|
---|
20 | E S CWDATA(1)="0^0^Unable to retrieve preferences"
|
---|
21 | S $P(CWDATA(1),U,2)=CWCNT-2
|
---|
22 | PERPREFE Q
|
---|
23 | ;
|
---|
24 | %USRLOG(CWDATA,DUZ) ;SET-UP USER PARTITION
|
---|
25 | ;
|
---|
26 | I +DUZ>0 D
|
---|
27 | . N XMDISPI,XMDUN,XMDUZ,CWNAME,CWNKNM,CWNMAIL,CWPMAIL
|
---|
28 | . S CWNKNM=$P($G(^VA(200,DUZ,.1)),U,4)
|
---|
29 | . D INIT^XMVVITAE
|
---|
30 | . S CWNMAIL=+$P($G(^XMB(3.7,DUZ,0)),U,6)
|
---|
31 | . S CWDATA(1)="1^"
|
---|
32 | . S $P(CWDATA(1),U,2)=XMV("DUZ NAME") ; SET USER NAME
|
---|
33 | . S $P(CWDATA(1),U,3)=CWNKNM ;SET USER NICKNAME
|
---|
34 | . S $P(CWDATA(1),U,4)=XMV("NEW MSGS") ;SET # OF NEW MSGS
|
---|
35 | . S $P(CWDATA(1),U,5)=$G(XMV("WARNING",1))="Priority Mail" ;SET PRIORITY MAIL FLAG
|
---|
36 | . S $P(CWDATA(1),U,6)=$P($G(XMV("NETNAME")),"@",2) ;get domain name for mail server
|
---|
37 | . S $P(CWDATA(1),U,7)=$S($P($G(^VA(200,DUZ,200)),U,10)>0:$P($G(^VA(200,DUZ,200)),U,10),1:300) ;Timed read used for GuiMail timeout. -clc
|
---|
38 | ;$G(^XMB("NETNAME")) ;get domain name for mail server
|
---|
39 | E S CWDATA(1)="0^USER NOT FOUND"
|
---|
40 | USRLOGE Q
|
---|
41 | %CHKMAIL(CWDATA,DUZ) ;CHECK FOR NEW MAIL
|
---|
42 | ;
|
---|
43 | N CWPMAIL,CWNMAIL,CWDAT
|
---|
44 | I +DUZ>0 D
|
---|
45 | . S CWDAT=$$NEWS^XMXUTIL(DUZ) ;FORMAT #NEWMSGS^PRIORITY^#NMSGIN^DT LAST MSG^
|
---|
46 | . S CWDATA(1)="1^"_U_U_+CWDAT_U_+$P(CWDAT,U,2)
|
---|
47 | E S CWDATA(1)="0^USER NOT FOUND"
|
---|
48 | CHKMAILE Q
|
---|
49 | ;
|
---|
50 | %PRTMSG(CWDATA,CWINPUT) ;PRINT A MESSAGE
|
---|
51 | ; CWINPUT - 1st piece: XMZ message number
|
---|
52 | ; 2nd piece: XMK message basket number
|
---|
53 | ; 3rd piece: Print from response number 0=all
|
---|
54 | ; 4th piece: null = no recpts 0=summary; 1=detail
|
---|
55 | ; 5th piece: printer name
|
---|
56 | ; 6th piece: 1=header, 0=headerless
|
---|
57 | N XMZ,XMK,XMKN
|
---|
58 | N XMINSTR,CWDAT1,CWDAT2,CWRESP,CWRECP,CWPRTN,XMMSG,XMTASK
|
---|
59 | S XMZ=+$P(CWINPUT,";")
|
---|
60 | S CWRESP=$P(CWINPUT,";",3)
|
---|
61 | S CWRECP=$P(CWINPUT,";",4),CWRECP=$S($L(CWRECP):+CWRECP,1:-1)
|
---|
62 | S CWPRTN=$P(CWINPUT,";",5)
|
---|
63 | ;D INMSG1^XMXUTIL2(XMDUZ,XMZ,,.CWDAT1,.CWDAT2) ;GET # OF RESPONSES - NOT CURRENTLY NEEDED
|
---|
64 | S XMINSTR("HDR")=$S('$L($P(CWINPUT,";",6)):1,1:+$P(CWINPUT,";",6)) ;DEFAULT TO PRINTING HEADER
|
---|
65 | S XMINSTR("RESPS")=$S(+CWRESP:+CWRESP_"-",1:"*") ;DEFINE RANGE TO PRINT +$G((CWDAT("RESPS"))) HOLDS TOTAL # OF RESPONSES
|
---|
66 | I CWRECP>-1 D
|
---|
67 | . S XMINSTR("RECIPS")=$S(+CWRECP:2,1:1) ;CONVERT CWMA TO XM NOMENCLATURE
|
---|
68 | E S XMINSTR("RECIPS")=0 ;Don't print recipient list
|
---|
69 | D:$L($G(CWPRTN)) PRTMSG^XMXAPI(XMDUZ,,XMZ,CWPRTN,.XMINSTR,,.XMTASK)
|
---|
70 | I +$G(XMTASK) S CWDATA(1)="1^1^"_$G(XMTASK)
|
---|
71 | E S CWDATA(1)="1^0^Message could not be printed"
|
---|
72 | PRTMSGE Q
|
---|
73 | ;
|
---|
74 | %SUPREF(CWDATA,CWINPUT,CWTEXT) ;Set user preferences
|
---|
75 | ;
|
---|
76 | N CWSDATA,CWSEDATA,CWLP
|
---|
77 | N CWPRM,CWVAL,CWLP1,CWERR
|
---|
78 | S CWDATA(1)="0^^AN ERROR HAS OCCURRED"
|
---|
79 | S CWSDATA=$G(CWTEXT(-9902),"[START DATA]"),CWSEDATA=$G(CWTEXT(-9903),"[END DATA]")
|
---|
80 | S CWLP=-1 D FNDLP^CWMAILB(.CWLP,CWSDATA)
|
---|
81 | G:$G(CWLP)="" SUPREND
|
---|
82 | F S CWLP=$O(CWTEXT(CWLP)) Q:CWLP="" Q:CWTEXT(CWLP)=CWSEDATA D
|
---|
83 | . I CWTEXT(CWLP)'?1"[".E1"]" D
|
---|
84 | . . S CWPRM=$$GETPRM^CWMAILE($P(CWTEXT(CWLP),"=")) ;get parameter
|
---|
85 | . . I $L(CWPRM) D
|
---|
86 | . . . S CWVAL=$P(CWTEXT(CWLP),"=",2) ;get value
|
---|
87 | . . . S CWERR=$$SETPARM(XMDUZ,CWPRM,CWVAL) ;set value into parameter
|
---|
88 | S CWDATA(1)="1^1^Preferences have been stored"
|
---|
89 | SUPREND Q
|
---|
90 | ;
|
---|
91 | SETPARM(CWDUZ,CWPARM,CWVALUE) ;Set value into parameter instance
|
---|
92 | ;Input: CWPARM - holds the return value of $$GETPRM^CWMAILE
|
---|
93 | ; CWVALUE - value to stuff (single value or comma delimited string)
|
---|
94 | ; CWDUZ - user
|
---|
95 | Q:'CWDUZ 1 ;must have a valid user
|
---|
96 | K CWERR
|
---|
97 | I 'CWPARM D ;single instance
|
---|
98 | . D EN^XPAR("USR.`"_CWDUZ,$P(CWPARM,"|",2),1,CWVALUE,.CWERR)
|
---|
99 | E D ;multiple instances
|
---|
100 | . N CWLP,CWX,CWXA
|
---|
101 | . S CWX=CWVALUE,CWLP=0
|
---|
102 | . F Q:$L(CWX,";")<(CWLP+1) D
|
---|
103 | . . S CWLP=CWLP+1
|
---|
104 | . . S CWXA=$P(CWX,";",CWLP) ;CWXA holds the column,width pair
|
---|
105 | . . D EN^XPAR("USR.`"_CWDUZ,$P(CWPARM,"|",2),CWLP,CWXA,.CWERR) ;stuff value
|
---|
106 | Q CWERR
|
---|
107 | ;
|
---|
108 | %GETSVER(CWDATA,CWPARAM) ;GET SERVER VERSION
|
---|
109 | S CWDATA(1)="1^1^"_+$$VERSION^XPDUTL("CWMA")
|
---|
110 | Q
|
---|
111 | %OPENATT(CWDATA,CWPARAM) ;OPEN ATTACHMENTS
|
---|
112 | N X
|
---|
113 | S X=$$GET^XPAR("ALL","CWMA ALLOW ATTACHMENTS OPEN")
|
---|
114 | S CWDATA(1)="1^1^"_$S(X=0:X,1:1)
|
---|
115 | Q
|
---|
116 | %TIMEROF(CWDATA,CWPARAM) ;DISABLE TIMER
|
---|
117 | N X
|
---|
118 | S X=$$GET^XPAR("ALL","CWMA DISABLE GUIMAIL TIMEOUT")
|
---|
119 | S CWDATA(1)="1^1^"_$S(X=0:X,1:1)
|
---|
120 | Q
|
---|
121 | TIMERVAL(CWDATA,CWPARAM) ;TIMEOUT VALUE
|
---|
122 | N X
|
---|
123 | S X=$$GET^XPAR("ALL","CWMA GUIMAIL TIMEOUT VALUE")
|
---|
124 | S CWDATA(1)="1^1^"_$S(X>0:X,1:0)
|
---|
125 | Q
|
---|