source: GuiMail/trunk/p/CWMAILD.m@ 1742

Last change on this file since 1742 was 1139, checked in by George Lilly, 14 years ago

version 2.3 of GuiMail

File size: 4.7 KB
Line 
1CWMAILD ;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"
9BMSGDE 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
22PERPREFE 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"
40USRLOGE 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"
48CHKMAILE 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"
72PRTMSGE 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"
89SUPREND Q
90 ;
91SETPARM(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
121TIMERVAL(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
Note: See TracBrowser for help on using the repository browser.