source: GuiMail/trunk/p/CWMAIL2.m@ 1751

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

version 2.3 of GuiMail
File size: 4.9 KB
Line 
1CWMAIL2 ;INDPLS/PLS- DELPHI VISTA MAIL SERVER, CONT'D ;21-Jun-2005 06:34;CLC
2 ;;2.3;CWMAIL;;Jul 19, 2005
3 ;Input - CWINPUT : 1 - Subject
4 ; : 2 - Flags
5 ; : 3 - Attachment Flag
6 ;
7 Q ;ROUTINE CAN'T BE CALLED DIRECTLY
8%CREATE(CWDATA,CWINPUT,CWTEXT) ;CREATE A NEW MESSAGE
9 N CWSDATA,CWSEDATA,CWLP,CWTXTARY,DA,DIE,DR,Y,XMTEXT,CWMSGABS,CWTMP,CWFILE,CWIEN,CWNAM
10 N XMBODY,XMSUBJ,XMY,XMINSTR,XMZ
11 S CWDATA(1)="0^99- UNDEFINED ERROR"
12 ;INPUT CONTAINS SUBJECT;PARAMETER ARRAY (IE. TESTING API;PCSI
13 ;P=PRIORITY, X=CLOSED, C=CONFIDENTIAL, I=INFORMATIONAL, R=CONFIRMATION
14 ;TEXT ARRAY CONTAINS RECIPIENT LIST AND MESSAGE TEXT LOADED FROM BMSGD call
15 ;BUILD XMY ARRAY
16 S CWTEXT=$NA(^TMP($J,"CWMAILLOAD"))
17 S CWSDATA=$G(@CWTEXT@(-9902),"[START XMY]"),CWSEDATA=$G(@CWTEXT@(-9903),"[END XMY]")
18 S CWLP=-1 D GFNDLP^CWMAILB(.CWLP,CWSDATA)
19 I $G(CWLP)="" S CWDATA(1)="0^1- NO RECIPIENTS LISTED" G CRTEND
20 ;RETRIEVE RECIPIENTS
21 F S CWLP=$O(@CWTEXT@(CWLP)) Q:CWLP="" Q:@CWTEXT@(CWLP)=CWSEDATA D
22 .S CWTMP=$G(@CWTEXT@(CWLP)) Q:CWTMP=""
23 .S CWFILE=+$P(CWTMP,"^"),CWIEN=+$P(CWTMP,"^",2),CWNAM=$P(CWTMP,"^",3)
24 .I CWFILE=200 S XMY(CWIEN)=""
25 .E I CWFILE=3.8 S XMY("G."_CWNAM)=""
26 .E S XMY(CWNAM)=""
27 I '$D(XMY) S CWDATA(1)="0^1- NO RECIPIENTS LISTED" G CRTEND ; NO RECIPIENTS LISTED
28 ;BUILD MESSAGE @TEXT@ ARRAY
29 S CWSDATA=$G(@CWTEXT@(-9900),"[START DATA]"),CWSEDATA=$G(@CWTEXT@(-9901),"[END DATA]")
30 S CWLP=-1 D GFNDLP^CWMAILB(.CWLP,CWSDATA)
31 I $G(CWLP)="" S CWDATA(1)="0^3- NO MESSAGE TEXT" G CRTEND
32 F S CWLP=$O(@CWTEXT@(CWLP)) Q:CWLP="" Q:@CWTEXT@(CWLP)=CWSEDATA D
33 .S ^TMP($J,"CWMAILOUT",CWLP)=$G(@CWTEXT@(CWLP))
34 I '$D(^TMP($J,"CWMAILOUT")) S CWDATA(1)="0^3- NO MESSAGE TEXT" G CRTEND ;NO MESSAGE @CWTEXT@
35 ;I '$L($P($G(CWINPUT),";")) S CWDATA(1)="0^4- MESSAGE SUBJECT NOT GIVEN" G CRTEND
36 ;E
37 S XMSUBJ=$P($G(CWINPUT),";")
38 ;subject can be null or between 3-65 characters. Length is handled on client side.
39 I $L(XMSUBJ),$L(XMSUBJ)<3 S XMSUBJ=XMSUBJ_$E("__",1,3-$L(XMSUBJ))
40 ;PROCESS MESSAGE
41 S XMBODY=$NA(^TMP($J,"CWMAILOUT"))
42 D CNVTAB(XMBODY) ;convert tabs to spaces
43 S XMINSTR("FLAGS")=$P(CWINPUT,";",2) ;GET MESSAGE ATTRIBUTES
44 I '$P($G(CWINPUT),";",3) D
45 . D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMY,.XMINSTR,.XMZ)
46 E D
47 . D CRE8XMZ^XMXAPI(XMSUBJ,.XMZ) ;create message stub
48 . I +$G(XMZ) D
49 . . D TEXT^XMXEDIT(XMZ,XMBODY) ;stuff message text
50 . . D BLDNETI(XMZ,XMSUBJ) ;stuff network header information
51 . . D ADDRNSND^XMXAPI(XMDUZ,XMZ,.XMY,.XMINSTR) ;send message
52 I +$G(XMZ)<1 S CWDATA(1)="0^5- MESSAGE CREATION FAILED" G CRTEND
53 I +$G(XMZ)>0 S CWDATA(1)="1^^"_$G(XMZ)
54CRTEND K ^TMP($J,"CWMAILOUT"),^TMP($J,"CWMAILLOAD")
55 Q
56CNVTAB(CWSRC) ;Convert TABS to spaces (use 6 char per tab)
57 ;PASS $NA() VARIABLE NAME CONTAINING DATA
58 N CWLP,CWLINE
59 S CWLP=+$G(CWLP)
60 F S CWLP=$O(@CWSRC@(CWLP)) Q:CWLP="" D
61 . S CWLINE=@CWSRC@(CWLP)
62 . S @CWSRC@(CWLP)=$$LNCNV(CWLINE)
63 Q
64LNCNV(CWL) ; data line tab extracter
65 N CWTMP,CWTMPL,CWP,CWPR,CWPADL
66 Q:'$F(CWL,$C(9)) CWL ; no tabs to convert
67 S CWTMP=CWL,CWTMPL=""
68 F D Q:CWTMP'[$C(9)
69 . S CWP=$P(CWTMP,$C(9)) ; left portion of string
70 . S CWPR=$P(CWTMP,$C(9),2,999) ; remainder of string
71 . S CWPADL=6-($L(CWP)#6) ; pad length
72 . I ($L(CWP)+CWPADL+$L(CWPR))>250 Q ;line is to long
73 . S CWTMP=CWP_$$REPEAT^XLFSTR(" ",CWPADL)_CWPR
74 Q CWTMP
75 ;
76BLDNETI(CWXMZ,CWSUBJ) ;build network header information
77 ;From: <user@domain>
78 ;Subject:
79 ;Date: 9 Jul 1999 09:02:27 -0500 (EST)
80 ;X-Mailer: VISTA Mail
81 N CWCNT
82 I $L($$ZNODE^XMXUTIL2(CWXMZ)) D
83 . S ^XMB(3.9,CWXMZ,2,.001,0)="From: "_$$LOW^XLFSTR($G(XMV("NETNAME")))
84 . ;S ^XMB(3.9,CWXMZ,2,.002,0)="To:" ;refet to bldnetit api
85 . S ^XMB(3.9,CWXMZ,2,.003,0)="Subject: "_$G(CWSUBJ)
86 . S ^XMB(3.9,CWXMZ,2,.004,0)="Date:"_$$INDT^XMXUTIL1($$NOW^XLFDT)
87 . S ^XMB(3.9,CWXMZ,2,.005,0)="X-Mailer: Vista GuiMail" ;VISTA MAIL"
88 . S ^XMB(3.9,CWXMZ,2,.006,0)="Encoding: x-uuencode" ;X-UUENCODE"
89 . S CWCNT=.007
90 . D BLDNETIT(CWXMZ,.XMY,.CWCNT)
91 Q
92BLDNETIT(CWXMZ,CWXMY,CWCTN) ; build To: section
93 ;Input - CWXMZ - Message Number
94 ; CWXMY - Array of Recipients
95 ; CWCTN - Counter
96 ;
97 N LP,CWINSTR,CWFULL,CWSET,CWTO,CWTO1,CWRHDR
98 K ^TMP($J,"CWNETH")
99 S CWINSTR("ADDR FLAGS")="RX"
100 S CWFLG=0,CWTO="To: ",CWTO1=" ",CWRHDR=""
101 S LP="" F S LP=$O(CWXMY(LP)) Q:LP="" D
102 . D TOWHOM^XMXAPI(XMDUZ,,"S",LP,.CWINSTR,.CWFULL)
103 . I $L($G(CWFULL)) D
104 . . I CWFULL'["@" D
105 . . .S CWFULL=$TR(CWFULL,", .","._+") ; set internet naming convention
106 . . .S CWFULL=CWFULL_"@"_$G(^XMB("NETNAME"))
107 . . I ($L(CWRHDR)+$L(CWFULL)+1)<140 D ;line not full
108 . . . S CWRHDR=CWRHDR_$S($L(CWRHDR)>0&($E(CWRHDR,$L(CWRHDR))'=","):",",1:"")_CWFULL
109 . . E D
110 . . . S ^TMP($J,"CWNETH",CWCTN)=CWRHDR
111 . . . S CWCTN=CWCTN+.001
112 . . . S CWRHDR=CWFULL
113 I $L(CWRHDR) S ^TMP($J,"CWNETH",CWCTN)=CWRHDR ;set remaining data
114 S LP=0 F S LP=$O(^TMP($J,"CWNETH",LP)) Q:LP<.001 D
115 . S ^XMB(3.9,CWXMZ,2,LP,0)=$S(CWFLG:" "_^TMP($J,"CWNETH",LP),1:"To: "_^TMP($J,"CWNETH",LP))
116 K ^TMP($J,"CWNETH") ;KILL TEMP GLOBAL BUFFER
117 Q
Note: See TracBrowser for help on using the repository browser.