version 2.1 of GuiMail source code

This commit is contained in:
george 2011-04-10 18:13:17 +00:00
parent ea2d8b6396
commit e1897190e4
17 changed files with 5779 additions and 0 deletions

4468
KIDS/CWMA_GuiMail_V2_1.KID Normal file

File diff suppressed because it is too large Load Diff

35
p/CWMACPPI.m Normal file
View File

@ -0,0 +1,35 @@
CWMACPPI ;RVAMC/PLS - Convert Personal Preferences to Parameters Utility;26-Aug-1999 12:44;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
;Call EN to convert Personal Preferences from File 890
;to the Kernel Toolkit Parameter File.
EN ;entry point
N CWLP,CWCNT,DTOUT,DUOUT,DIR,X,Y
;check for existing CWMAIL1 global containing preferences
I '$D(^CWMAIL1) D BMES^XPDUTL("CWMAIL1 Global doesn't exist! Conversion of preferences not needed.") Q
S (CWCNT,CWLP)=0 F S CWLP=$O(^CWMAIL1(CWLP)) Q:CWLP<1 D
. I $D(^CWMAIL1(CWLP,1,1,0)) S CWCNT=CWCNT+1
D BMES^XPDUTL("There are "_CWCNT_" user(s) to convert")
D UPDATE^XPDID(0) ;init progress bar
D MES^XPDUTL("Beginning conversion of preferences...")
D LOOP
Q
LOOP ;loop thru users
N CWUSR,CWLP,CWTXT,CWVAL,CWPREF,CWCNTC,XPDIDTOT
S CWUSR=0
S XPDIDTOT=CWCNT ;set total number
F S CWUSR=$O(^CWMAIL1(CWUSR)) Q:CWUSR<1 D
. S CWCNTC=+$G(CWCNTC)+1
. I CWCNTC#10=0 D UPDATE^XPDID(CWCNTC)
. S CWPREF=$O(^CWMAIL1(CWUSR,1,"B","PREFERENCES",0)) ;get node
. Q:'CWPREF ;no preferences stored
. S CWLP=0 F S CWLP=$O(^CWMAIL1(CWUSR,1,CWPREF,1,CWLP)) Q:CWLP<1 D
. . S CWTXT=^CWMAIL1(CWUSR,1,CWPREF,1,CWLP,0) ;get node text
. . I CWTXT'?1"[".E1"]" D
. . . S CWPRM=$$GETPRM^CWMAILE($P(CWTXT,"=")) ;get parameter
. . . I $L(CWPRM) D
. . . . S CWVAL=$$STRIP^XLFSTR($P(CWTXT,"=",2)," ") ;get value
. . . . I CWPRM="1|CWMA GENERAL MD COL" D
. . . . . S CWVAL=CWVAL_$S($E(CWVAL,$L(CWVAL))=";":"6,38",1:";6,38") ;add data for new column
. . . . S CWERR=$$SETPARM^CWMAILD(CWUSR,CWPRM,CWVAL) ;set value into parameter
D BMES^XPDUTL("Preference conversion is finished.")
Q

134
p/CWMAIL.m Normal file
View File

@ -0,0 +1,134 @@
CWMAIL ;INDPLS/PLS- DELPHI VISTA MAIL SERVER ;16-Sep-1999 07:47;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
Q ;ROUTINE CAN'T BE CALLED DIRECTLY
ENTRY(CWDATA,CWINPUT,CWTEXT) ;CALL WITH CWINPUT=CALL;DUZ;MSG;BASKET;NEW BASKET;NEWMAIL, TEXT=TEXT ARRAY
N CWCALL,X,DUZ,CWMHDR,CWMST,U,CWSVER
;REMOVED XMDUZ FROM BEING NEW STATEMENT
I $$NEWERR^%ZTER N $ET S $ET=""
S U="^"
S $ZT="ERR^CWMAIL"
K CWDATA
S CWDATA(1)="0^^AN ERROR HAS OCCURRED"
S CWCALL="%"_$$UP^XLFSTR($P(CWINPUT,";")) ;HOLDS TAG
S DUZ=$P(CWINPUT,";",2)
D DUZ^XUP(DUZ) ;SETUP DUZ ARRAY
D INIT^XMVVITAE ;UPDATE MAILMAN STATUS
S CWINPUT=$P(CWINPUT,";",3,999)
D PURGNAM
I CWCALL?1"%"1.7A,$T(@CWCALL)'="" D @(CWCALL_"(.CWDATA,CWINPUT,.CWTEXT)")
Q
ERR D @^%ZOSF("ERRTN")
D RETGNAM
Q ;
%READ(CWDATA,CWINPUT,CWTEXT) ;
D %READ^CWMAILA(.CWDATA,CWINPUT)
Q
%LIST(CWDATA,CWINPUT,CWTEXT) ;
;CWINPUT = MAIL TYPE OR MAILBOX NUMBER;
D %LIST^CWMAILA(.CWDATA,CWINPUT),RETGNAM
Q
%DELETE(CWDATA,CWINPUT,CWTEXT) ;
D %DELETE^CWMAILA(.CWDATA,CWINPUT),RETGNAM
Q
%SAVE(CWDATA,CWINPUT,CWTEXT) ;
D %SAVE^CWMAILA(.CWDATA,CWINPUT),RETGNAM
Q
%MAKNEW(CWDATA,CWINPUT,CWTEXT) ;
D %MAKNEW^CWMAILA(.CWDATA,CWINPUT),RETGNAM
Q
%NEWBSK(CWDATA,CWINPUT,CWTEXT) ;CREATE A NEW MAIL BASKET
D %NEWBSK^CWMAILA(.CWDATA,CWINPUT),RETGNAM
Q
%RESEQ(CWDATA,CWINPUT,CWTEXT) ;RESEQUENCE A VISTA MAIL BASKET
D %RESEQ^CWMAILA(.CWDATA,CWINPUT),RETGNAM
Q
%REPLY(CWDATA,CWINPUT,CWTEXT) ;
D %REPLY^CWMAILB(.CWDATA,CWINPUT,.CWTEXT),RETGNAM
Q
%FORWARD(CWDATA,CWINPUT,CWTEXT) ;
;M ^TMP("CWMAIL","FORWARD",$H)=CWTEXT
;S ^TMP("CWMAIL","CWINPUT",$J)=CWINPUT
D %FORWARD^CWMAILB(.CWDATA,CWINPUT,.CWTEXT),RETGNAM
Q
%ANSWER(CWDATA,CWINPUT,CWTEXT) ;
D %ANSWER^CWMAILB(.CWDATA,CWINPUT,.CWTEXT),RETGNAM
Q
%TERMIN(CWDATA,CWINPUT,CWTEXT) ;TERMINATE A MESSAGE THREAD
D %TERMIN^CWMAILB(.CWDATA,CWINPUT),RETGNAM
Q
%CREATE(CWDATA,CWINPUT,CWTEXT) ;CREATE A NEW MESSAGE
D %CREATE^CWMAIL2(.CWDATA,CWINPUT,.CWTEXT),RETGNAM
Q
%LATER(CWDATA,CWINPUT,CWTEXT) ;LATER A MESSAGE
D %LATER^CWMAILC(.CWDATA,CWINPUT),RETGNAM
Q
;
%MBOX(CWDATA,CWINPUT,CWTEXT) ;RETRIEVE MAILBOXES
D %MBOX^CWMAILC(.CWDATA,CWINPUT),RETGNAM
Q
%PMBOX(CWDATA,CWINPUT,CWTEXT) ;PURGE ENTIRE MAIL BOX
D %PMBOX^CWMAILC(.CWDATA,CWINPUT),RETGNAM
Q
%RNMBOX(CWDATA,CWINPUT,CWTEXT) ;RENAME EXISTING MAILBOX
D %RNMBOX^CWMAILC(.CWDATA,CWINPUT),RETGNAM
Q
%MSGRCP(CWDATA,CWINPUT,CWTEXT) ; RETURNS A LIST OF MESSAGE RECIPIENTS
D %MSGRCP^CWMAILC(.CWDATA,CWINPUT) ;,RETGNAM
Q
%NETINFO(CWDATA,CWINPUT,CWTEXT) ; RETURNS NETWORK TRANSMISSION INFO
D %NETINFO^CWMAILC(.CWDATA,CWINPUT) ;,RETGNAM
Q
%ADRSTO(CWDATA,CWINPUT,CWTEXT) ;RETURNS ARRAY OF ADDRESSED TO
D %ADRSTO^CWMAILC(.CWDATA,CWINPUT) ;,RETGNAM
Q
%GRPINF(CWDATA,CWINPUT,CWTEXT) ;MAIL GROUP INFO
D %GRPINF^CWMAILC(.CWDATA,CWINPUT),RETGNAM
Q
%USRINF(CWDATA,CWINPUT,CWTEXT) ; MAIL USER INFO
;CWINPUT = MAIL USER IEN
D %USRINF^CWMAILC(.CWDATA,CWINPUT),RETGNAM
Q
%PERPREF(CWDATA,CWINPUT,CWTEXT) ;RETRIEVE PERSONAL PREFERENCES
;CWINPUT = MAIL USER IEN;SAVE NAME
D %PERPREF^CWMAILD(.CWDATA,CWINPUT),RETGNAM
Q
%USRLOG(CWDATA,CWINPUT,CWTEXT) ;LOG USER INTO GUI MAIL LOG
;CWINPUT = DUZ
D %USRLOG^CWMAILD(.CWDATA,DUZ),RETGNAM
Q
%BMSGD(CWDATA,CWINPUT,CWTEXT) ;BUILD MSG INFO INTO GLOBAL
;
D %BMSGD^CWMAILD(.CWDATA,CWINPUT,.CWTEXT),RETGNAM
Q
%SUPREF(CWDATA,CWINPUT,CWTEXT) ;SET USER PREFERENCES
;
D %SUPREF^CWMAILD(.CWDATA,CWINPUT,.CWTEXT),RETGNAM
Q
RETGNAM ;RETURNS A $NAME FOR GLOBAL AFTER MERGING
M ^TMP($J,"CWMAIL")=CWDATA
K CWDATA S CWDATA=$NA(^TMP($J,"CWMAIL"))
Q
PURGNAM ;PURGE GLOBAL ARRAY USED FOR DATA RETURN
K ^TMP($J,"CWMAIL")
Q
%CHKMAIL(CWDATA,CWINPUT,CWTEXT) ;CHECK FOR NEW MAIL
;CWINPUT = DUZ
D %CHKMAIL^CWMAILD(.CWDATA,DUZ),RETGNAM
Q
%PRINT(CWDATA,CWINPUT,CWTEXT) ;PRINT A MESSAGE
;
D %PRTMSG^CWMAILD(.CWDATA,CWINPUT),RETGNAM
Q
%GETSVER(CWDATA,CWINPUT,CWTEXT) ;GET SERVER VERSION
;
D %GETSVER^CWMAILD(.CWDATA,CWINPUT),RETGNAM
Q
%MSGSRC(CWDATA,CWINPUT,CWTEXT) ;SEARCH AND RETURN SELECTED MESSAGES
;
D %MSGSRC^CWMAILA(.CWDATA,CWINPUT,.CWTEXT),RETGNAM
Q
%MSGISRC(CWDATA,CWINPUT,CWTEXT) ;SEARCH FOR A SPECIFIC MESSAGE NUMBER
;
D %MSGISRC^CWMAILF(.CWDATA,CWINPUT),RETGNAM
Q
;

87
p/CWMAIL0.m Normal file
View File

@ -0,0 +1,87 @@
CWMAIL0 ;INDPLS/PLS- DELPHI MAIL SERVER, CONT'D ;04-Jun-1999 14:54;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
Q ;ROUTINE CAN'T BE CALLED DIRECTLY
;
PROCMS(CWDATA,CWMSGN,CWNMFLG) ;PROCESS MAIL MESSAGE THREAD
N CWRE,CWCNT,CWRSP,CWNWMSG,CWDATT,CWLCNT,CWLP,CWCONFRM,CW
N CWIM,CWIU,CWINSTR,CWFLAGS,CWIR
D INMSG^XMXUTIL2(XMDUZ,$$BSKT^XMXUTIL2(XMDUZ,CWMSGN),CWMSGN,,"F",.CWIM,.CWINSTR,.CWIU) ;SET-UP MESSAGE INFO
S CWDATA=$NA(^TMP($J,"CWMAIL"))
S CWNWMSG=$G(CWIM("FROM"))["@" ;NETWORK MESSAGE
S CWCNT=2,CWLCNT=0
S @CWDATA@(CWCNT)="Mail Message From: "_$G(CWIM("FROM NAME"))_" "_"Dated: "_$$FMDTE^CWMAIL4(CWIM("DATE FM"),"5MZ")
S CWCNT=$$INCNT(CWCNT),@CWDATA@(CWCNT)="Subject: "_$G(CWIM("SUBJ"))
S CWCNT=$$INCNT(CWCNT),@CWDATA@(CWCNT)=""
;I 'CWNMFLG!(CWNMFLG&($G(CWIM("RESP"))<1))!(CWNMFLG&(+$G(CWIM("RESP"))=+$G(CWIM("RESPS"))))
I 'CWNMFLG!(CWNMFLG&(+$G(CWIU("RESP"))<1))!(CWNMFLG&(+$G(CWIU("RESP"))=+$G(CWIM("RESPS")))) D READM(.CWDATA,CWMSGN,.CWCNT)
S CWCONFRM=""
D LASTACC(CWMSGN,$$BSKT^XMXUTIL2(XMDUZ,CWMSGN),0,.CWCONFRM) ;UPDATE LAST ACCESS DATE/TIME
;PROCESS RESPONSES
I $G(CWIM("RESPS"))>0 D
. S CWLP=$S(+$G(CWIU("RESP"))=+$G(CWIM("RESPS")):1,+$G(CWIU("RESP"))<1:1,CWNMFLG:+$G(CWIU("RESP")),1:1) F CWLP=CWLP:1:CWIM("RESPS") D
. . D INRESP^XMXUTIL2(CWMSGN,CWLP,"F",.CWIR) ;gather details on specific response
. . S CWCNT=$$INCNT(CWCNT),@CWDATA@(CWCNT)=""
. . S CWCNT=$$INCNT(CWCNT),@CWDATA@(CWCNT)="Response: "_CWLP_") "_$G(CWIR("FROM NAME"))_" "_$$FMDTE^CWMAIL4($G(CWIR("DATE FM")),"5MZ")
. . S CWCNT=$$INCNT(CWCNT),@CWDATA@(CWCNT)=""
. . D READM(.CWDATA,CWIR("XMZ"),.CWCNT)
. . D LASTACC(CWMSGN,$$BSKT^XMXUTIL2(XMDUZ,CWMSGN),CWLP) ;UPDATES LAST RESPONSE READ
D NONEW^XMXUTIL(XMDUZ,$$BSKT^XMXUTIL2(XMDUZ,CWMSGN),CWMSGN,1) ;UNNEW MESSAGE
I +CWCONFRM D ;SEND CONFIRMATION IF NEEDED
. S CWCNT=$$INCNT(CWCNT),@CWDATA@(CWCNT)=""
. S CWCNT=$$INCNT(CWCNT),@CWDATA@(CWCNT)=">>Confirmation Message Sent to Sender.<<"
I $O(@CWDATA@(1)) D
. S @CWDATA@(1)="1^^DATA HAS BEEN FOUND"
E S @CWDATA@(1)="1^^Message text could not be found."
S $P(@CWDATA@(1),U,2)=CWCNT-2
Q
;
LASTACC(XMZ,CWBIEN,CWLRSP,XMCONFRM) ;UPDATE LAST RESPONSE READ DATE
;INPUT XMZ = MESSAGE NUMBER
; CWBIEN = BASKET IEN
; CWLRSP = LAST RESPONSE READ
;
N CWIM,CWIU,CWINSTR,CWXINSTR,CWFLAGS
D INMSG1^XMXUTIL2(XMDUZ,XMZ,,.CWFLAGS,.CWIM,.CWIU) ;SET-UP FOR CALL
D INMSG2^XMXUTIL2(XMDUZ,XMZ,,.CWIM,.CWXINSTR,.CWIU)
S CWINSTR("FLAGS")=$S($G(CWXINSTR("FLAGS"))["R":"R",1:"")
D LASTACC^XMXUTIL(XMDUZ,CWBIEN,XMZ,CWLRSP,.CWIM,.CWINSTR,.CWIU,.XMCONFRM)
Q
;
READM(CWDATA,CWINPUT,CWCNT) ;OUTPUT MAIL MESSAGE IN ARRAY
S $ZT="READMER^CWMAIL"
N CWRDATA,XMZ,CWMTYPE,CWTFLG,XMER,XMPOS
S XMZ=+$G(CWINPUT),CWTFLG=0,CWMTYPE=$G(CWINSTR("TYPE"))
F S CWRDATA=$$READ^XMGAPI1() Q:XMER<0!(CWTFLG) S CWCNT=CWCNT+1,@CWDATA@(CWCNT)=CWRDATA I CWMTYPE="K"!(CWMTYPE="X") S:CWRDATA["$END TXT" CWTFLG=1
;
READMER Q
;
INCNT(CWCNT) ;INCREMENT COUNTER
Q CWCNT+1
;
ADDMP(CWXMZ,CWVAL) ;set data into DAT based on subscripted CWVAL
;INPUT - CWXMZ = message ien
; CWVAL = input array (i.e. CWVAL(1)=first piece...CWVAL(n)=last piece
;OUTPUT - data string holding delimited ('^') data
S CWXMZ=$G(CWXMZ,0)
I +$G(CWXMZ) D
. N X,CWCONFRM,CWTYPE,CWCLOSED,CWINFO,CWCONFID,CWSDRDUZ,CWBRDCAS,CWSDRNAM,CWTRECPT,CWTREPLY
. N CWIM,CWIU,CWINSTR,CWPMSG,CWLP,CWDAT
. D INMSG^XMXUTIL2(XMDUZ,$$BSKT^XMXUTIL2(XMDUZ,CWXMZ),CWXMZ,,"F",.CWIM,.CWINSTR,.CWIU) ;SET-UP MESSAGE INFO
. S CWVAL(6)=$$UP^XLFSTR($G(CWINSTR("TYPE"))) ;message type(s)
. S:$G(CWINSTR("FLAGS"))["P" CWVAL(6)="P"_CWVAL(6) ;add priority flag as a type
. S CWVAL(7)=$G(CWINSTR("FLAGS"))["R" ;confirmation flag
. S CWVAL(8)=$G(CWINSTR("FLAGS"))["X" ;closed flag
. S CWVAL(9)=$G(CWINSTR("FLAGS"))["I" ;informational flag
. S CWVAL(10)=$G(CWINSTR("FLAGS"))["C" ;confidential flag
. S CWVAL(11)=$G(CWIM("FROM DUZ")) ;sender ien
. S CWVAL(13)=$G(CWIM("FROM NAME")) ;sender full name
. S CWVAL(12)=$$BCAST^XMXSEC(CWXMZ) ;broadcast flag
. S CWVAL(14)=$G(CWIM("RECIPS")) ;total # of recipients
. S CWVAL(15)=$G(CWIM("RESPS")) ;total # of replies
. S CWVAL(16)=$G(CWINSTR("FLAGS"))["P" ;priority flag
. S CWVAL(17)=+$G(CWIU("RESP")) ;# of last response read
. S CWVAL(20)=+$$ANSWER^XMXSEC(XMDUZ,CWXMZ,$$ZNODE^XMXUTIL2(CWXMZ)) ;can user answer message
;set data into node
S CWLP="" F S CWLP=$O(CWVAL(CWLP)) Q:CWLP<1 D
. S $P(CWDAT,U,CWLP)=CWVAL(CWLP)
Q CWDAT

80
p/CWMAIL1.m Normal file
View File

@ -0,0 +1,80 @@
CWMAIL1 ;INDPLS/PLS- GUI MAIL UTILITIES ;30-Jul-1999 09:30;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
;MODIFIED FOR XM*7.1*50
LATER(CWXMZ,CWXMA) ;LATER A MESSAGE
S $ZT="LATERE^CWMAIL1"
N CWFLG,X,Y,%H,NOW,CWINSTR,CWXMMSG,CWTMDF
S CWFLG=0
G:'CWXMZ!('$G(CWXMA)) LATERE
;S CWTMDF=$G(^XMB("TIMEDIFF")) ;get time diff for site
;I CWXMA[":" D
;. I '$L(CWTMDF) S CWXMA=$P(CWXMA," ") ;use date and not date/time
;. E S CWXMA=CWXMA_" "_CWTMDF ;append time zone diff
S CWXMA=$$CONVERT^XMXUTIL1(CWXMA,$S(CWXMA[":":1,1:0)) ;convert to fileman date/time
CK S NOW=$$NOW^XLFDT S CWXMA=$S(CWXMA>NOW:CWXMA,1:(NOW+.0010)) ;DEFAULT TO 10 MINUTES IN FUTURE
I CWXMA>0 D
. S CWINSTR("LATER")=CWXMA
. D LATERMSG^XMXAPI(XMDUZ,"",CWXMZ,.CWINSTR,.CWXMMSG)
. I CWXMMSG S CWFLG=1
LATERE ;
Q CWFLG
;
;
NETINFO(CWDAT,XMZ) ;RETRIEVE NETWORK TRANMISSION INFORMATION
;
K CWDAT
S CWDAT=$NA(^TMP($J,"CWMAIL"))
S $ZT="NETINFOE^CWMAIL1"
N CWLP,CWCNT
S CWLP=0,CWCNT=2
D QN^XMXUTIL3(XMZ,,,) ;DEFAULTS TO ALL LINES;START AT 0 AND SET TO ^TMP("XMLIST",$J)
F S CWLP=$O(^TMP("XMLIST",$J,CWLP)) Q:CWLP<1 D
. S @CWDAT@(CWCNT)=^TMP("XMLIST",$J,CWLP),CWCNT=CWCNT+1
NETINFOE ;
I $O(@CWDAT@(1)) D
. S @CWDAT@(1)="1^^DATA HAS BEEN FOUND"
E S @CWDAT@(1)="1^^There was no Transmission Information available."
S $P(@CWDAT@(1),U,2)=CWCNT-2
Q
;
ADRSTO(CWDAT,XMZ) ;RETRIEVE ADDRESSED TO INFO
;
K CWDAT
S CWDAT=$NA(^TMP($J,"CWMAIL"))
N CWLP,CWCNT
S CWLP=0,CWCNT=2
D Q^XMXUTIL3(XMZ) ;DEFAULTS TO ALL LINES;START AT 0 AND SET TO ^TMP("XMLIST",$J)
F S CWLP=$O(^TMP("XMLIST",$J,CWLP)) Q:CWLP<1 D
. S @CWDAT@(CWCNT)=$G(^TMP("XMLIST",$J,CWLP,"TO NAME")),CWCNT=CWCNT+1
I $O(@CWDAT@(1)) D
. S @CWDAT@(1)="1^^DATA HAS BEEN FOUND"
E S @CWDAT@(1)="1^^There was no ADDRESSED TO recipients found."
S $P(@CWDAT@(1),U,2)=CWCNT-2
ADRSTOE Q
;
RECPT(CWDAT,XMZ) ;BUILD RECIPIENT LIST
K CWDAT
S CWDAT=$NA(^TMP($J,"CWMAIL"))
N CWLP,CWCNT,CWIM,CWIU,CWINSTR
N CWRECPT,CWLR,CWLRSPRD,CWFR,CWFWD,CWTERM,CWRMI,CWNTT,CWSNT
S CWLP=0,CWCNT=2
D QD^XMXUTIL3(XMZ) ;
F S CWLP=$O(^TMP("XMLIST",$J,CWLP)) Q:CWLP<1 D
. S CWRECPT=$G(^TMP("XMLIST",$J,CWLP,"TO NAME")) ;recipient name
. S CWLR=$$FMDTE^CWMAIL4($G(^("LREAD")),"5MZ") ;last read date/time
. S CWLRSPRD=$G(^("RESP")) ;last response read
. S CWFR=$$FMDTE^CWMAIL4($G(^("FREAD")),"5MZ") ;first read date/time
. S CWFWD=$S($D(^("FWD ON")):"*",1:"") ;forwarded message
. S CWTERM=$S($D(^("TERM")):"*",1:"") ;terminated message
. S CWRMI=$G(^("ID")) ;remote message id
. S CWNTT=$G(^("SECS")) ;network trans time
. S CWSNT=$$FMDTE^CWMAIL4($G(^("XDATE")),"5MZ") ;network sent date/time
. S @CWDAT@(CWCNT)=U_CWRECPT_U_CWLR_U_CWFR_U_CWFWD_U_CWTERM_U_CWRMI_U_CWNTT_U_CWSNT_U_CWLRSPRD_U
. S CWCNT=CWCNT+1
D INMSG1^XMXUTIL2(XMDUZ,XMZ,,"F",.CWIM,.CWIU) ;retrieve total recipients
D INMSG2^XMXUTIL2(XMDUZ,XMZ,,.CWIM,.CWINSTR,.CWIU) ;and responses.
RECPTE I $O(@CWDAT@(1)) D
. S @CWDAT@(1)="1^^DATA HAS BEEN FOUND"_U_+$G(CWIM("RECIPS"))_U_+$G(CWIM("RESPS"))
E S @CWDAT@(1)="1^^There were no recipients found."_U_0_U_0
S $P(@CWDAT@(1),U,2)=CWCNT-2
Q

117
p/CWMAIL2.m Normal file
View File

@ -0,0 +1,117 @@
CWMAIL2 ;INDPLS/PLS- DELPHI VISTA MAIL SERVER, CONT'D ;20-Sep-1999 08:00;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
;Input - CWINPUT : 1 - Subject
; : 2 - Flags
; : 3 - Attachment Flag
;
Q ;ROUTINE CAN'T BE CALLED DIRECTLY
%CREATE(CWDATA,CWINPUT,CWTEXT) ;CREATE A NEW MESSAGE
N CWSDATA,CWSEDATA,CWLP,CWTXTARY,DA,DIE,DR,Y,XMTEXT,CWMSGABS,CWTMP,CWFILE,CWIEN,CWNAM
N XMBODY,XMSUBJ,XMY,XMINSTR,XMZ
S CWDATA(1)="0^99- UNDEFINED ERROR"
;INPUT CONTAINS SUBJECT;PARAMETER ARRAY (IE. TESTING API;PCSI
;P=PRIORITY, X=CLOSED, C=CONFIDENTIAL, I=INFORMATIONAL, R=CONFIRMATION
;TEXT ARRAY CONTAINS RECIPIENT LIST AND MESSAGE TEXT LOADED FROM BMSGD call
;BUILD XMY ARRAY
S CWTEXT=$NA(^TMP($J,"CWMAILLOAD"))
S CWSDATA=$G(@CWTEXT@(-9902),"[START XMY]"),CWSEDATA=$G(@CWTEXT@(-9903),"[END XMY]")
S CWLP=-1 D GFNDLP^CWMAILB(.CWLP,CWSDATA)
I $G(CWLP)="" S CWDATA(1)="0^1- NO RECIPIENTS LISTED" G CRTEND
;RETRIEVE RECIPIENTS
F S CWLP=$O(@CWTEXT@(CWLP)) Q:CWLP="" Q:@CWTEXT@(CWLP)=CWSEDATA D
.S CWTMP=$G(@CWTEXT@(CWLP)) Q:CWTMP=""
.S CWFILE=+$P(CWTMP,"^"),CWIEN=+$P(CWTMP,"^",2),CWNAM=$P(CWTMP,"^",3)
.I CWFILE=200 S XMY(CWIEN)=""
.E I CWFILE=3.8 S XMY("G."_CWNAM)=""
.E S XMY(CWNAM)=""
I '$D(XMY) S CWDATA(1)="0^1- NO RECIPIENTS LISTED" G CRTEND ; NO RECIPIENTS LISTED
;BUILD MESSAGE @TEXT@ ARRAY
S CWSDATA=$G(@CWTEXT@(-9900),"[START DATA]"),CWSEDATA=$G(@CWTEXT@(-9901),"[END DATA]")
S CWLP=-1 D GFNDLP^CWMAILB(.CWLP,CWSDATA)
I $G(CWLP)="" S CWDATA(1)="0^3- NO MESSAGE TEXT" G CRTEND
F S CWLP=$O(@CWTEXT@(CWLP)) Q:CWLP="" Q:@CWTEXT@(CWLP)=CWSEDATA D
.S ^TMP($J,"CWMAILOUT",CWLP)=$G(@CWTEXT@(CWLP))
I '$D(^TMP($J,"CWMAILOUT")) S CWDATA(1)="0^3- NO MESSAGE TEXT" G CRTEND ;NO MESSAGE @CWTEXT@
;I '$L($P($G(CWINPUT),";")) S CWDATA(1)="0^4- MESSAGE SUBJECT NOT GIVEN" G CRTEND
;E
S XMSUBJ=$P($G(CWINPUT),";")
;subject can be null or between 3-65 characters. Length is handled on client side.
I $L(XMSUBJ),$L(XMSUBJ)<3 S XMSUBJ=XMSUBJ_$E("__",1,3-$L(XMSUBJ))
;PROCESS MESSAGE
S XMBODY=$NA(^TMP($J,"CWMAILOUT"))
D CNVTAB(XMBODY) ;convert tabs to spaces
S XMINSTR("FLAGS")=$P(CWINPUT,";",2) ;GET MESSAGE ATTRIBUTES
I '$P($G(CWINPUT),";",3) D
. D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMY,.XMINSTR,.XMZ)
E D
. D CRE8XMZ^XMXAPI(XMSUBJ,.XMZ) ;create message stub
. I +$G(XMZ) D
. . D TEXT^XMXEDIT(XMZ,XMBODY) ;stuff message text
. . D BLDNETI(XMZ,XMSUBJ) ;stuff network header information
. . D ADDRNSND^XMXAPI(XMDUZ,XMZ,.XMY,.XMINSTR) ;send message
I +$G(XMZ)<1 S CWDATA(1)="0^5- MESSAGE CREATION FAILED" G CRTEND
I +$G(XMZ)>0 S CWDATA(1)="1^^"_$G(XMZ)
CRTEND K ^TMP($J,"CWMAILOUT"),^TMP($J,"CWMAILLOAD")
Q
CNVTAB(CWSRC) ;Convert TABS to spaces (use 6 char per tab)
;PASS $NA() VARIABLE NAME CONTAINING DATA
N CWLP,CWLINE
S CWLP=+$G(CWLP)
F S CWLP=$O(@CWSRC@(CWLP)) Q:CWLP="" D
. S CWLINE=@CWSRC@(CWLP)
. S @CWSRC@(CWLP)=$$LNCNV(CWLINE)
Q
LNCNV(CWL) ; data line tab extracter
N CWTMP,CWTMPL,CWP,CWPR,CWPADL
Q:'$F(CWL,$C(9)) CWL ; no tabs to convert
S CWTMP=CWL,CWTMPL=""
F D Q:CWTMP'[$C(9)
. S CWP=$P(CWTMP,$C(9)) ; left portion of string
. S CWPR=$P(CWTMP,$C(9),2,999) ; remainder of string
. S CWPADL=6-($L(CWP)#6) ; pad length
. I ($L(CWP)+CWPADL+$L(CWPR))>250 Q ;line is to long
. S CWTMP=CWP_$$REPEAT^XLFSTR(" ",CWPADL)_CWPR
Q CWTMP
;
BLDNETI(CWXMZ,CWSUBJ) ;build network header information
;From: <user@domain>
;Subject:
;Date: 9 Jul 1999 09:02:27 -0500 (EST)
;X-Mailer: VISTA Mail
N CWCNT
I $L($$ZNODE^XMXUTIL2(CWXMZ)) D
. S ^XMB(3.9,CWXMZ,2,.001,0)="From: "_$$LOW^XLFSTR($G(XMV("NETNAME")))
. ;S ^XMB(3.9,CWXMZ,2,.002,0)="To:" ;refet to bldnetit api
. S ^XMB(3.9,CWXMZ,2,.003,0)="Subject: "_$G(CWSUBJ)
. S ^XMB(3.9,CWXMZ,2,.004,0)="Date:"_$$INDT^XMXUTIL1($$NOW^XLFDT)
. S ^XMB(3.9,CWXMZ,2,.005,0)="X-Mailer: Vista GuiMail" ;VISTA MAIL"
. S ^XMB(3.9,CWXMZ,2,.006,0)="Encoding: x-uuencode" ;X-UUENCODE"
. S CWCNT=.007
. D BLDNETIT(CWXMZ,.XMY,.CWCNT)
Q
BLDNETIT(CWXMZ,CWXMY,CWCTN) ; build To: section
;Input - CWXMZ - Message Number
; CWXMY - Array of Recipients
; CWCTN - Counter
;
N LP,CWINSTR,CWFULL,CWSET,CWTO,CWTO1,CWRHDR
K ^TMP($J,"CWNETH")
S CWINSTR("ADDR FLAGS")="RX"
S CWFLG=0,CWTO="To: ",CWTO1=" ",CWRHDR=""
S LP="" F S LP=$O(CWXMY(LP)) Q:LP="" D
. D TOWHOM^XMXAPI(XMDUZ,,"S",LP,.CWINSTR,.CWFULL)
. I $L($G(CWFULL)) D
. . I CWFULL'["@" D
. . .S CWFULL=$TR(CWFULL,", .","._+") ; set internet naming convention
. . .S CWFULL=CWFULL_"@"_$G(^XMB("NETNAME"))
. . I ($L(CWRHDR)+$L(CWFULL)+1)<140 D ;line not full
. . . S CWRHDR=CWRHDR_$S($L(CWRHDR)>0&($E(CWRHDR,$L(CWRHDR))'=","):",",1:"")_CWFULL
. . E D
. . . S ^TMP($J,"CWNETH",CWCTN)=CWRHDR
. . . S CWCTN=CWCTN+.001
. . . S CWRHDR=CWFULL
I $L(CWRHDR) S ^TMP($J,"CWNETH",CWCTN)=CWRHDR ;set remaining data
S LP=0 F S LP=$O(^TMP($J,"CWNETH",LP)) Q:LP<.001 D
. S ^XMB(3.9,CWXMZ,2,LP,0)=$S(CWFLG:" "_^TMP($J,"CWNETH",LP),1:"To: "_^TMP($J,"CWNETH",LP))
K ^TMP($J,"CWNETH") ;KILL TEMP GLOBAL BUFFER
Q

51
p/CWMAIL3.m Normal file
View File

@ -0,0 +1,51 @@
CWMAIL3 ;INDPLS/PLS- DELPHI VISTA MAIL SERVER, CON'T ;03-Jun-1999 13:24;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
Q ;ROUTINE CAN'T BE CALLED DIRECTLY
;
GRPINFO(CWDAT,CWPARAM) ;Mail Group Information
;CWPARAM = Mail Group IEN
N CWFILE,IO,IOP,POP,DIC,DA,X,Y,CWFLG,CWNXT,IOSL,CWDEFDIR,CWDATFIL
S CWFILE="CWMAILGRP"_$J_".TXT"
S CWDEFDIR=$$PWD^%ZISH
D OPEN^%ZISH("CWDATFIL",CWDEFDIR,CWFILE,"W")
G:POP GRPINFOE
U IO S IOSL=99999
D DISPLAY^XMHIG(+CWPARAM)
D CLOSE^%ZISH("CWDATFIL")
I $$FTG^%ZISH(CWDEFDIR,CWFILE,$NA(CWDAT(2)),1) D
.S CWFILE(CWFILE)=""
.S X=$$DEL^%ZISH(CWDEFDIR,$NA(CWFILE))
.I $O(CWDAT(0))>0 D
..S CWFLG=0,CWNXT=1
..F S CWNXT=$O(CWDAT(CWNXT)) Q:CWNXT<1!(CWFLG) D
...I '$L(CWDAT(CWNXT)),'CWFLG K CWDAT(CWNXT)
...E I $A(CWDAT(CWNXT))=12 K CWDAT(CWNXT)
...E S CWDAT(CWNXT)=$$CTRL^XMXUTIL1(CWDAT(CWNXT)),CWFLG=1 ;remove control characters
.S CWDAT(-9900)=$O(CWDAT(9999999),-1)+1
E S CWDAT(-9900)=2
GRPINFOE D CLOSE^%ZISH("CWDATFIL")
Q $O(CWDAT(1))
USRINFO(CWDAT,CWPARAM) ;Mail User Information
;CWPARAM = Mail User IEN
N CWFILE,%ZIS,IOP,POP,IO,Y,X,CWDEFDIR,CWDATFIL,IOSL
N CWFLG,CWNXT
S CWFILE="CWMAILUSR"_$J_".TXT"
S CWDEFDIR=$$PWD^%ZISH
D OPEN^%ZISH("CWDATFIL",CWDEFDIR,CWFILE,"W")
G:POP USRINFOE
U IO S IOSL=99999
D DISPUSER^XMHIU(+CWPARAM)
D CLOSE^%ZISH("CWDATFIL")
FLG I $$FTG^%ZISH(CWDEFDIR,CWFILE,$NA(CWDAT(2)),1) D
.S CWFILE(CWFILE)=""
.S X=$$DEL^%ZISH(CWDEFDIR,$NA(CWFILE))
.I $O(CWDAT(0))>0 D
..S CWFLG=0,CWNXT=1
..F S CWNXT=$O(CWDAT(CWNXT)) Q:CWNXT<1!(CWFLG) D
...I '$L(CWDAT(CWNXT)),'CWFLG K CWDAT(CWNXT)
...E I $A(CWDAT(CWNXT))=12 K CWDAT(CWNXT)
...E S CWDAT(CWNXT)=$$CTRL^XMXUTIL1(CWDAT(CWNXT)),CWFLG=1 ;remove control characters
.S CWDAT(-9900)=$O(CWDAT(9999999),-1)+1
E S CWDAT(-9900)=2
USRINFOE D CLOSE^%ZISH("CWDATFIL")
Q $O(CWDAT(1))

28
p/CWMAIL4.m Normal file
View File

@ -0,0 +1,28 @@
CWMAIL4 ;INDPLS/PLS- DELPHI VISTA MAIL SERVER, CON'T ;05-May-1999 14:03;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
Q ;ROUTINE CAN'T BE CALLED DIRECTLY
;
GETMSGL(DAT,CWDUZ,CWBSK,CWSRC) ;
;API NOT CURRENTLY USED
;INPUT
; DAT : RETURN ARRAY
;CWDUZ : USER
;CWBSK : BASKET IEN OR NAME
;CWSRC : LOOKUP TYPE 0(IEN); 1("C" X-REF) ; DEFAULT TO ZERO
Q:'CWDUZ 0
I +CWBSK'=CWBSK D
. S CWBSK=+$O(^XMB(3.7,CWDUZ,2,"B",CWBSK,0))
S CWSRC=+$G(CWSRC,0)
N CWMSG,CWSEQ
S (CWSEQ,CWMSG)=0
I 'CWSRC D
. F S CWMSG=$O(^XMB(3.7,CWDUZ,2,CWBSK,1,CWMSG)) Q:CWMSG<1 S DAT(CWMSG)=""
ELSE E D
. F S CWSEQ=$O(^XMB(3.7,CWDUZ,2,CWBSK,1,"C",CWSEQ)) Q:CWSEQ<1 D
. . F S CWMSG=$O(^XMB(3.7,CWDUZ,2,CWBSK,1,"C",CWSEQ,CWMSG)) Q:CWMSG<1 D
. . . S DAT(CWMSG)=""
Q $O(DAT(0))>0
;
FMDTE(CWDT,CWPRM) ;API TO RETURN A FORMATTED DATE
;replaces '@' with " " between date and time
Q $TR($$FMTE^XLFDT(CWDT,CWPRM),"@"," ")

144
p/CWMAILA.m Normal file
View File

@ -0,0 +1,144 @@
CWMAILA ;INDPLS/PLS- DELPHI VISTA MAIL SERVER CONT'D ;02-Jul-1999 14:45;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
;MODIFIED FOR XM*7.1*50
Q ;ROUTINE CAN'T BE CALLED DIRECTLY
%READ(CWDATA,CWINPUT) ;
;CWINPUT FORMAT - DELIMITER ';'
; 1st - IEN of message
; 4th - New message (value >0 indicates new messages only)
K CWDATA
N CWMSGN,CWNMFLG
S CWMSGN=$P(CWINPUT,";")
S CWNMFLG=+$P(CWINPUT,";",4)
D:CWMSGN PROCMS^CWMAIL0(.CWDATA,CWMSGN,CWNMFLG)
Q
%LIST(CWDATA,CWINPUT) ;
;CWINPUT - MAIL TYPE OR MAILBOX NUMBER - DELIMITER ';'
; 2nd - IEN of MailBasket or non-numeric for new mail
;CWARY format: piece value
; 1 message basket
; 2 message ien
; 3 message subject
; 4 message date sent
; 5 not used
; 6 message type
; 7 confirmation flag
; 8 closed flag
; 9 info flag
; 10 confidential flag
; 11 sender ien
; 12 broadcast flag
; 13 sender name
; 14 total # of recipients
; 15 total # of replies
; 16 priority flag
; 17 last response read
; 18 message basket sequence number
; 19 new message flag
; 20 answer message flag
;
S CWDATA(1)="0^AN ERROR HAS OCCURRED"
N CWVAL,CWMSG,CWMSGSUB,CWMSGDT,CWDCNT,CWMAIB,CWMSGBX,CWMSGLP
N CWARY
S CWVAL=$P(CWINPUT,";",2)
S CWMSG=0,CWDCNT=2,CWMSGLP=0
S CWMAIB=CWVAL
;CALL API TO RETRIEVE MESSAGES
I CWVAL=+CWVAL D
. D LISTMSGS^XMXAPIB(XMDUZ,+CWMAIB,"BSKT;SUBJ;DATE;SEQN;NEW") ; data put in ^TMP("XMLIST",$J
. Q:'+$P($G(^TMP("XMLIST",$J,0)),U,1) ;NO DATA FOUND
. D BLDLST^CWMAILF(.CWDATA,$NA(^TMP("XMLIST",$J)),.CWDCNT)
E D ;PROCESS NEW MESSAGE REQUEST
. D LISTMSGS^XMXAPIB(XMDUZ,"*","BSKT;SUBJ;DATE;NEW","N") ;SEQN;NEW","N")
. Q:'+$P($G(^TMP("XMLIST",$J,0)),U,1) ;NO DATA FOUND
. D BLDLST^CWMAILF(.CWDATA,$NA(^TMP("XMLIST",$J)),.CWDCNT)
I $O(CWDATA(1)) S CWDATA(1)="1^^DATA HAS BEEN FOUND"
E S CWDATA(1)=$S(+CWVAL:"1^^No Messages Found in Specified Mail Box",1:"1^^"_"You have no NEW Messages")
S $P(CWDATA(1),U,2)=CWDCNT-2
Q
;
%DELETE(CWDATA,CWINPUT) ;
;CWINPUT - DELIMITER ';'
; 1st - IEN of message
; 2nd - IEN of mail basket
N XMZ,XMDUZ,XMK,XMKZA,XMMSG
S XMZ=$P(CWINPUT,";")
S XMDUZ=DUZ
S XMK=$P(CWINPUT,";",2)
S XMKZA(XMZ)=""
D DELMSG^XMXAPI(XMDUZ,"",.XMKZA,.XMMSG)
I +$G(XMMSG) D
. S CWDATA(1)="1^0^Message Deleted"
E S CWDATA(1)="0^0^Unable to delete message"
Q
%SAVE(CWDATA,CWINPUT) ;
;CWINPUT - DELIMITER ';'
; 1st - IEN of message
; 2nd - IEN of mail basket
; 3rd - IEN of new mail basket
N XMZ,XMK,XMKM,XMMSG,XMKZA
S XMZ=$P(CWINPUT,";"),XMK=$P(CWINPUT,";",2)
S XMKZA(XMZ)=""
S XMKM=$P(CWINPUT,";",3)
D MOVEMSG^XMXAPI(XMDUZ,"",.XMKZA,XMKM,.XMMSG)
S CWDATA(1)=+$G(XMMSG) ;Return Status
Q
%MAKNEW(CWDATA,CWINPUT) ;
;CWINPUT - DELIMITER ';'
; 1st - IEN of message
; 2nd - IEN of mail basket
N XMZ,XMK,XMKZA,XMMSG
S CWDATA(1)=0
S XMZ=$P(CWINPUT,";")
S XMK=+$P(CWINPUT,";",2)
D MAKENEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
I XMK<.6 D ;MUST MOVE MESSAGE FROM WASTE BASKET TO IN BASKET
. S XMKZA(XMZ)=""
. D MOVEMSG^XMXAPI(XMDUZ,"",.XMKZA,1,.XMMSG)
S CWDATA(1)="1^1" ;FORCE TO SUCCESS
Q
%NEWBSK(CWDATA,CWINPUT) ;CREATE A NEW MAIL BASKET
;CWINPUT - DELIMITER ';'
; 1st Piece - New basket name
N CWBASKET,CWBSKN,CWMSG
S CWBASKET=$$UP^XLFSTR($P(CWINPUT,";")) ;FORCE TO UPPER CASE
D CRE8BSKT^XMXAPIB(XMDUZ,CWBASKET,.CWBSKN)
I +$G(CWBSKN)>0 D
. D QBSKT^XMXAPIB(XMDUZ,+CWBSKN,.CWMSG)
. S CWDATA(1)="1"_U_CWBSKN_U_$P($G(CWMSG),U,2)
E S CWDATA(1)=0_U_"Error-unable to create basket."
Q
%RESEQ(CWDATA,CWINPUT) ;RESEQUENCE A VISTA MAIL BASKET
;CWINPUT - DELIMITER ';'
; 2nd - IEN of mail basket
N CWBASKET,CWDATT
S CWBASKET=$P(CWINPUT,";",2)
G:'CWBASKET RESEQE
D RSEQBSKT^XMXAPIB(XMDUZ,CWBASKET,.CWDATT)
I $L(CWDATT) S CWDATA(1)="1^1"
E S CWDATA(1)="0^0^Error-unable to resequence messages."
RESEQE Q
;
%MSGSRC(CWDATA,CWINPUT,CWTEXT) ;MESSAGE SEARCH
;INPUT - CWINPUT AND CWTEXT ARRAY HOLD CRITERIA
;OUTPUT - REFER TO %LIST
S CWDATA(1)="0^AN ERROR HAS OCCURRED"
N CWVAL,CWMSG,CWMSGSUB,CWMSGDT,CWDCNT,CWMAIB,CWMSGBX,CWMSGLP
N CWARY,CWFLAGS
S CWFLAGS=$P(CWINPUT,";") ;Processing Flags
S CWMAIB=$P(CWINPUT,";",2) ;MailBasket
S CWMSG=0,CWDCNT=2,CWMSGLP=0
S CWMAIB=$S($L(CWMAIB):CWMAIB,1:"*")
;Convert External dates to FM Dates
I $G(CWTEXT("FDATE")) D
. S CWTEXT("FDATE")=$$CONVERT^XMXUTIL1(CWTEXT("FDATE"))
I $G(CWTEXT("TDATE")) D
. S CWTEXT("TDATE")=$$CONVERT^XMXUTIL1(CWTEXT("TDATE"))
;CALL API TO RETRIEVE MESSAGES
D LISTMSGS^XMXAPIB(XMDUZ,CWMAIB,"BSKT;SUBJ;DATE;NEW",CWFLAGS,,,.CWTEXT) ; data put in ^TMP("XMLIST",$J
I +$P($G(^TMP("XMLIST",$J,0)),U,1) D ;
. D BLDLST^CWMAILF(.CWDATA,$NA(^TMP("XMLIST",$J)),.CWDCNT)
I $O(CWDATA(1)) S CWDATA(1)="1^^DATA HAS BEEN FOUND"
E S CWDATA(1)="1^^No Messages Found In Search"
S $P(CWDATA(1),U,2)=CWDCNT-2
MSGSRCE Q

123
p/CWMAILB.m Normal file
View File

@ -0,0 +1,123 @@
CWMAILB ;INDPLS/PLS- DELPHI VISTA MAIL SERVER CON'T ;03-Jun-1999 13:29;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
%FORWARD(CWDATA,CWINPUT,CWTEXT) ;
;Input: 1st Piece of CWINPUT holds IEN of Message
; CWTEXT holds recipient list
;
N XMZ,XMY,CWLP,CWSDATA,CWSEDATA,CWTMP,CWFILE,CWIEN,CWNAM,XMINSTR,CWMSG
N XMKZA
S XMZ=$P(CWINPUT,";")
S CWDATA(1)="0^^AN ERROR HAS OCCURRED"
G:'$G(XMZ) FOREND
S CWSDATA=$G(CWTEXT(-9902),"[START DATA]"),CWSEDATA=$G(CWTEXT(-9903),"[END DATA]")
S CWLP=-1 D FNDLP(.CWLP,CWSDATA)
G:$G(CWLP)="" FOREND
F S CWLP=$O(CWTEXT(CWLP)) Q:CWLP="" Q:CWTEXT(CWLP)=CWSEDATA D
.S CWTMP=$G(CWTEXT(CWLP)) Q:CWTMP=""
.S CWFILE=+$P(CWTMP,"^"),CWIEN=+$P(CWTMP,"^",2),CWNAM=$P(CWTMP,"^",3)
.I CWFILE=200 S XMY(CWIEN)=""
.E I CWFILE=3.8 S XMY("G."_CWNAM)=""
.E S XMY(CWNAM)=""
I $D(XMY) D
. S XMKZA(XMZ)=""
. D FWDMSG^XMXAPI(XMDUZ,"",.XMKZA,.XMY,.XMINSTR,.CWMSG)
;RETURNS <number of messages> forwarded.
S CWDATA(1)=+CWMSG_U_U_XMZ ;FORCE TO SUCCESS
FOREND Q
;
%TERMIN(CWDATA,CWINPUT) ;TERMINATE A MESSAGE THREAD
;Input: 1st piece = IEN of Message
; 2nd piece = IEN of Mail Basket
;
N XMRC,XMZ,XMK,Y,CWMSGNM,CWMSGR
S CWDATA(1)="0^^AN ERROR HAS OCCURRED"
S XMZ=$P($G(CWINPUT),";"),XMK=$P($G(CWINPUT),";",2)
S CWMSGNM(XMZ)=""
D TERMMSG^XMXAPI(XMDUZ,"",.CWMSGNM,.CWMSGR)
;RETURNS <number of messages> terminated.
S CWDATA(1)=+CWMSGR_U_U ;return 1 for success or 0
Q
FNDLP(CWLP,X) ;FIND A CHARACTER STRING ENTRY
F S CWLP=$O(CWTEXT(CWLP)) Q:CWLP="" Q:CWTEXT(CWLP)=X
Q
;
INCNT(CWCNT) ;INCREMENT COUNTER
Q CWCNT+1
;
%CREATE(DATA,INPUT,TEXT) ;CREATE A NEW MESSAGE
;BUILD RETURN CODES FOR ERROR MESSAGING
D %CREATE^CWMAIL2
Q
;
%REPLY(CWDATA,CWINPUT,CWTEXT) ; This API uses global array for text
;INPUT - Piece 1 : Message Number
; Piece 2-4 : Not Used
; Piece 5 : Network Reply Flag (0 = no; 1 = yes)
;
N CWMSGN,CWRESULT,CWSDATA,CWSEDATA,CWTMP,CWNWCHK,CWDATT
N CWMSGT,XMZR,CWLP,XMINSTR
S CWMSGN=$P(CWINPUT,";")
S CWNWCHK=$P(CWINPUT,";",5)
S CWDATA(1)="0^UNDEFINED ERROR"
S CWTEXT=$NA(^TMP($J,"CWMAILLOAD"))
G:'$G(CWMSGN) REPEND
S CWSDATA=$G(@CWTEXT@(-9900),"[START DATA]"),CWSEDATA=$G(@CWTEXT@(-9901),"[END DATA]")
S CWLP=-1 D GFNDLP(.CWLP,CWSDATA)
G:$G(CWLP)="" REPEND
F S CWLP=$O(@CWTEXT@(CWLP)) Q:CWLP="" Q:@CWTEXT@(CWLP)=CWSEDATA D
.S ^TMP($J,"CWMAILOUT",CWLP)=$G(@CWTEXT@(CWLP))
G:'$D(^TMP($J,"CWMAILOUT")) REPEND
S CWMSGT=$NA(^TMP($J,"CWMAILOUT"))
S XMINSTR("NET REPLY")=$S(+$G(CWNWCHK):1,1:0)
D REPLYMSG^XMXAPI(XMDUZ,"",CWMSGN,CWMSGT,.XMINSTR,.XMZR)
I +$G(XMZR)>0 S CWDATA(1)=$S(CWNWCHK:2,1:1)_"^NO ERRORS"_U_CWMSGN ;SUCCESS
E S CWDATA(1)="0^"_$G(CWDATA)_U_CWMSGN ;RETURN ERROR MESSAGE
REPEND K ^TMP($J,"CWMAILLOAD"),^TMP($J,"CWMAILOUT")
Q
GFNDLP(CWLP,X) ;FIND A CHARACTER STRING ENTRY IN GLOBAL
F S CWLP=$O(@CWTEXT@(CWLP)) Q:CWLP="" Q:@CWTEXT@(CWLP)=X
Q
;
%ANSWER(CWDATA,CWINPUT,CWTEXT) ; This API uses global array for text to answer a message
;INPUT - CWINPUT : Piece 1 : Message Number
; Piece 2 : Not Used
; Piece 3 : Message Attributes
; Pieces 4-5 : Not Used
; CWTEXT : Holds list of additional recipients
;
N CWSDATA,CWSEDATA,CWLP,CWTXTARY,DA,DIE,DR,Y,XMTEXT
N CWMSGABS,CWTMP,CWFILE,CWIEN,CWNAM
N XMBODY,CWMSGN,XMY,XMZ,XMINSTR
S CWMSGN=$P(CWINPUT,";") ;MESSAGE NUMBER
I $G(CWMSGN)<1 S CWDATA(1)="0^98- No message number given" G ANSEND
S CWDATA(1)="0^99- UNDEFINED ERROR"
;TEXT ARRAY CONTAINS RECIPIENT LIST AND MESSAGE TEXT LOADED FROM BMSGD call
;BUILD XMY ARRAY
S CWTEXT=$NA(^TMP($J,"CWMAILLOAD"))
S CWSDATA=$G(@CWTEXT@(-9902),"[START XMY]"),CWSEDATA=$G(@CWTEXT@(-9903),"[END XMY]")
S CWLP=-1 D GFNDLP^CWMAILB(.CWLP,CWSDATA)
;RETRIEVE RECIPIENTS
I $G(CWLP)'="" D
. F S CWLP=$O(@CWTEXT@(CWLP)) Q:CWLP="" Q:@CWTEXT@(CWLP)=CWSEDATA D
. . S CWTMP=$G(@CWTEXT@(CWLP)) Q:CWTMP=""
. . S CWFILE=+$P(CWTMP,"^"),CWIEN=+$P(CWTMP,"^",2),CWNAM=$P(CWTMP,"^",3)
. . I CWFILE=200 S XMY(CWIEN)=""
. . E I CWFILE=3.8 S XMY("G."_CWNAM)=""
. . E S XMY(CWNAM)="" ;treat address as internet address
;BUILD MESSAGE @TEXT@ ARRAY
S CWSDATA=$G(@CWTEXT@(-9900),"[START DATA]"),CWSEDATA=$G(@CWTEXT@(-9901),"[END DATA]")
S CWLP=-1 D GFNDLP^CWMAILB(.CWLP,CWSDATA)
I $G(CWLP)="" S CWDATA(1)="0^3- NO MESSAGE TEXT" G ANSEND
F S CWLP=$O(@CWTEXT@(CWLP)) Q:CWLP="" Q:@CWTEXT@(CWLP)=CWSEDATA D
.S ^TMP($J,"CWMAILOUT",CWLP)=$G(@CWTEXT@(CWLP))
;I '$D(^TMP($J,"CWMAILOUT")) S CWDATA(1)="0^3- NO MESSAGE TEXT" G ANSEND ;NO MESSAGE @CWTEXT@
;I '$L($P($G(CWINPUT),";")) S CWDATA(1)="0^4- MESSAGE SUBJECT NOT GIVEN" G ANSEND
;E S XMSUBJ=$P($G(CWINPUT),";")
;PROCESS MESSAGE
S XMBODY=$NA(^TMP($J,"CWMAILOUT"))
S XMINSTR("FLAGS")=$P(CWINPUT,";",3) ;GET MESSAGE ATTRIBUTES
D ANSRMSG^XMXAPI(XMDUZ,"",CWMSGN,"",XMBODY,.XMY,.XMINSTR,.XMZ)
I $G(XMZ)<1 S CWDATA(1)="0^5- MESSAGE ANSWER FAILED" G ANSEND
I +$G(XMZ)>0 S CWDATA(1)="1^^"_$G(XMZ)
ANSEND K ^TMP($J,"CWMAILOUT"),^TMP($J,"CWMAILLOAD")
Q

120
p/CWMAILC.m Normal file
View File

@ -0,0 +1,120 @@
CWMAILC ;INDPLS/PLS- DELPHI VISTA MAIL SERVER CONT'D ;03-Jun-1999 13:29;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
;MODIFIED FOR XM*7.1*50
Q ;ROUTINE CAN'T BE CALLED DIRECTLY
;
%LATER(CWDATA,CWINPUT) ;LATER A MESSAGE
;CWINPUT - HOLDS MESSAGE NUMBER AND LATER DATE/TIME - DELIMITER ';'
; 1st - IEN of message
; 2nd - Later date
N XMZ,XMDUZ,XMA
S CWDATA(1)="0^^AN ERROR HAS OCCURRED"
S XMZ=$P(CWINPUT,";")
S XMDUZ=DUZ
S XMA=$P(CWINPUT,";",2)
G:'XMZ!('$G(XMA)) LATERE
I $$LATER^CWMAIL1(XMZ,XMA) D
.S CWDATA(1)="1^1^Message has been latered"
E S CWDATA(1)="0^0^Unable to Later Message Number: "_XMZ
LATERE Q
;
%MBOX(CWDATA,CWINPUT) ;RETRIEVE MAILBOXES
;CWINPUT NOT USED
;VARIABLES : CWNMSG = NEW MESSAGES
; CWTMSG = TOTAL MESSAGE COUNT
K ^TMP($J,"CWMBSKT")
D LISTBSKT^XMXAPIB(XMDUZ,,,,,"^TMP($J,""CWMBSKT"")")
N CWLP,CWLP1,CWCNT,CWNMSG,CWTMSG,CWFPES,CWHSN,CWBNAME,CWBIEN
S CWDATA(1)="0^^AN ERROR HAS OCCURRED",CWCNT=2
S CWLP=0 F S CWLP=$O(^TMP($J,"CWMBSKT","XMLIST",CWLP)) Q:CWLP="" D
. S CWBIEN=+$G(^TMP($J,"CWMBSKT","XMLIST",CWLP))
. I CWBIEN D
. . S CWDATA(CWCNT)=$G(^TMP($J,"CWMBSKT","XMLIST",CWLP))
. . S CWCNT=CWCNT+1
I $O(CWDATA(1)) S CWDATA(1)="1^^DATA HAS BEEN FOUND"
E S CWDATA(1)="1^^No Mail Boxes could be found"
S $P(CWDATA(1),U,2)=CWCNT-2
MBOXE K ^TMP($J,"CWMBSKT")
Q
%PMBOX(CWDATA,CWINPUT) ;PURGE ENTIRE MAIL BOX
;CWINPUT = MAIL BOX IEN
N CWLP,XMZ,XMK,CWX,CWY,XMKZA,XMMSG,CWCNT
S XMK=$P(CWINPUT,";",2)
G PMBOXE:'XMK
S CWDATA(1)="0^^AN ERROR HAS OCCURRED",CWCNT=2
;delete basket regardless of content
D DELBSKT^XMXAPIB(XMDUZ,XMK,"D")
S CWDATA(1)="1^1"
;E S CWDATA(1)="0^0"
PMBOXE Q
%RNMBOX(CWDATA,CWINPUT) ;RENAME EXISTING MAILBOX
;CWINPUT - DELIMITER ';'
; 1st - IEN of mailbox
; 2nd - New name of mailbox
D NAMEBSKT^XMXAPIB(XMDUZ,$P(CWINPUT,";"),$P(CWINPUT,";",2))
S CWDATA(1)="1^1^MAILBOX NAME WAS CHANGED" ;FORCE TO SUCCESS
RNMBOXE Q
%MSGRCP(CWDATA,CWINPUT) ; RETURNS A LIST OF MESSAGE RECIPIENTS
;CWINPUT = IEN of message
N CWDAT,CWI,XMZ
K CWDATA
S XMZ=+$P($G(CWINPUT),";",2)
D RECPT^CWMAIL1(.CWDATA,XMZ)
MSGRCPE Q
%NETINFO(CWDATA,CWINPUT) ; RETURNS NETWORK TRANSMISSION INFO
;INPUT - IEN of message
N CWDAT,CWI,XMZ
K CWDATA
S XMZ=+$P($G(CWINPUT),";",2)
D NETINFO^CWMAIL1(.CWDATA,XMZ)
NETINFOE Q
;
%ADRSTO(CWDATA,CWINPUT) ;RETURNS ARRAY OF ADDRESSED TO
;CWINPUT - IEN of message
N CWDAT,CWI,XMZ
K CWDATA
S XMZ=+$P($G(CWINPUT),";",2)
D ADRSTO^CWMAIL1(.CWDATA,XMZ)
ADRSTOE Q
%GRPINF(CWDATA,CWINPUT) ;MAIL GROUP INFO
;CWINPUT - IEN of mail group
N CWDAT,CWI,XMZ
K CWDATA
S CWI=2
S CWIEN=+$P($G(CWINPUT),";",2)
I $$GRPINFO^CWMAIL3(.CWDAT,CWIEN) D
.S CWI=+$G(CWDAT(-9900)) K CWDAT(-9900)
.M CWDATA=CWDAT
.S CWDATA(1)="1^^DATA HAS BEEN FOUND"
E S CWDATA(1)="1^^There was no Mail Group information found."
S $P(CWDATA(1),U,2)=CWI-2
GRPINFE Q
%USRINF(CWDATA,CWINPUT) ;MAIL USER INFO
;CWINPUT - IEN of mail user
N CWDAT,CWI,CWIEN
K CWDATA
S CWI=2
S CWIEN=+$P($G(CWINPUT),";",2)
;G:'CWIEN USRINFE
I $$USRINFO^CWMAIL3(.CWDAT,CWIEN) D
.S CWI=+$G(CWDAT(-9900)) K CWDAT(-9900)
.M CWDATA=CWDAT
.S CWDATA(1)="1^^DATA HAS BEEN FOUND"
E S CWDATA(1)="1^^There was no Mail User information found."
S $P(CWDATA(1),U,2)=CWI-2
USRINFE Q
MBOXD(CWDAT,CWUSR,CWIEN) ;RETURN DATA FOR MAILBOX
;API NOT CURRENTLY USED
;INPUT CWDAT = RETURN ARRAY
; CWIEN = MAILBASKET IEN TO 3.7 FOR USER
;OUTPUT CWDAT("NAME")
; CWDAT("TMSG")
; CWDAT("NMSG")
; CWDAT("IEN")
N CWDATT
D QBSKT^XMXAPIB(CWUSR,CWIEN,.CWDATT)
S CWDAT("IEN")=$P(CWDATT,U)
S CWDAT("NAME")=$P(CWDATT,U,2)
S CWDAT("TMSG")=+$P(CWDATT,U,3)
S CWDAT("NMSG")=+$P(CWDATT,U,4)
Q

109
p/CWMAILD.m Normal file
View File

@ -0,0 +1,109 @@
CWMAILD ;INDPLS/PLS- DELPHI VISTA MAIL SERVER CONT'D ;16-Jul-1999 11:13;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
Q ;ROUTINE CAN'T BE CALLED DIRECTLY
;
%BMSGD(CWDATA,CWINPUT,CWTEXT) ;BUILD MESSAGE DATA INTO GLOBAL
;USE CREATE OR REPLY TO SEND ACTUAL MESSAGE OR REPLY
M ^TMP($J,"CWMAILLOAD")=CWTEXT
S CWDATA(1)="1^1^DATA SET"
BMSGDE Q
;
%PERPREF(CWDATA,CWPARAM) ;retrieve personal preferences
;CWPARAM is not used
N CWNAME,CWCNT
S CWCNT=2
S CWDATA(1)="0^^AN ERROR HAS OCCURRED"
I $$GETPKPM^CWMAILE(.CWDATA) D
.S CWCNT=$G(CWDATA(-9900))
.K CWDATA(-9900)
.S CWDATA(1)="1^1^Preferences have been retrieved"
E S CWDATA(1)="0^0^Unable to retrieve preferences"
S $P(CWDATA(1),U,2)=CWCNT-2
PERPREFE Q
;
%USRLOG(CWDATA,DUZ) ;SET-UP USER PARTITION
;
I +DUZ>0 D
. N XMDISPI,XMDUN,XMDUZ,CWNAME,CWNKNM,CWNMAIL,CWPMAIL
. S CWNKNM=$P($G(^VA(200,DUZ,.1)),U,4)
. D INIT^XMVVITAE
. S CWNMAIL=+$P($G(^XMB(3.7,DUZ,0)),U,6)
. S CWDATA(1)="1^"
. S $P(CWDATA(1),U,2)=XMV("DUZ NAME") ; SET USER NAME
. S $P(CWDATA(1),U,3)=CWNKNM ;SET USER NICKNAME
. S $P(CWDATA(1),U,4)=XMV("NEW MSGS") ;SET # OF NEW MSGS
. S $P(CWDATA(1),U,5)=$G(XMV("WARNING",1))="Priority Mail" ;SET PRIORITY MAIL FLAG
. S $P(CWDATA(1),U,6)=$P($G(XMV("NETNAME")),"@",2) ;get domain name for mail server
;$G(^XMB("NETNAME")) ;get domain name for mail server
E S CWDATA(1)="0^USER NOT FOUND"
USRLOGE Q
%CHKMAIL(CWDATA,DUZ) ;CHECK FOR NEW MAIL
;
N CWPMAIL,CWNMAIL,CWDAT
I +DUZ>0 D
. S CWDAT=$$NEWS^XMXUTIL(DUZ) ;FORMAT #NEWMSGS^PRIORITY^#NMSGIN^DT LAST MSG^
. S CWDATA(1)="1^"_U_U_+CWDAT_U_+$P(CWDAT,U,2)
E S CWDATA(1)="0^USER NOT FOUND"
CHKMAILE Q
;
%PRTMSG(CWDATA,CWINPUT) ;PRINT A MESSAGE
; CWINPUT - 1st piece: XMZ message number
; 2nd piece: XMK message basket number
; 3rd piece: Print from response number 0=all
; 4th piece: null = no recpts 0=summary; 1=detail
; 5th piece: printer name
; 6th piece: 1=header, 0=headerless
N XMZ,XMK,XMKN
N XMINSTR,CWDAT1,CWDAT2,CWRESP,CWRECP,CWPRTN,XMMSG,XMTASK
S XMZ=+$P(CWINPUT,";")
S CWRESP=$P(CWINPUT,";",3)
S CWRECP=$P(CWINPUT,";",4),CWRECP=$S($L(CWRECP):+CWRECP,1:-1)
S CWPRTN=$P(CWINPUT,";",5)
;D INMSG1^XMXUTIL2(XMDUZ,XMZ,,.CWDAT1,.CWDAT2) ;GET # OF RESPONSES - NOT CURRENTLY NEEDED
S XMINSTR("HDR")=$S('$L($P(CWINPUT,";",6)):1,1:+$P(CWINPUT,";",6)) ;DEFAULT TO PRINTING HEADER
S XMINSTR("RESPS")=$S(+CWRESP:+CWRESP_"-",1:"*") ;DEFINE RANGE TO PRINT +$G((CWDAT("RESPS"))) HOLDS TOTAL # OF RESPONSES
I CWRECP>-1 D
. S XMINSTR("RECIPS")=$S(+CWRECP:2,1:1) ;CONVERT CWMA TO XM NOMENCLATURE
E S XMINSTR("RECIPS")=0 ;Don't print recipient list
D:$L($G(CWPRTN)) PRTMSG^XMXAPI(XMDUZ,,XMZ,CWPRTN,.XMINSTR,,.XMTASK)
I +$G(XMTASK) S CWDATA(1)="1^1^"_$G(XMTASK)
E S CWDATA(1)="1^0^Message could not be printed"
PRTMSGE Q
;
%SUPREF(CWDATA,CWINPUT,CWTEXT) ;Set user preferences
;
N CWSDATA,CWSEDATA,CWLP
N CWPRM,CWVAL,CWLP1,CWERR
S CWDATA(1)="0^^AN ERROR HAS OCCURRED"
S CWSDATA=$G(CWTEXT(-9902),"[START DATA]"),CWSEDATA=$G(CWTEXT(-9903),"[END DATA]")
S CWLP=-1 D FNDLP^CWMAILB(.CWLP,CWSDATA)
G:$G(CWLP)="" SUPREND
F S CWLP=$O(CWTEXT(CWLP)) Q:CWLP="" Q:CWTEXT(CWLP)=CWSEDATA D
. I CWTEXT(CWLP)'?1"[".E1"]" D
. . S CWPRM=$$GETPRM^CWMAILE($P(CWTEXT(CWLP),"=")) ;get parameter
. . I $L(CWPRM) D
. . . S CWVAL=$P(CWTEXT(CWLP),"=",2) ;get value
. . . S CWERR=$$SETPARM(XMDUZ,CWPRM,CWVAL) ;set value into parameter
S CWDATA(1)="1^1^Preferences have been stored"
SUPREND Q
;
SETPARM(CWDUZ,CWPARM,CWVALUE) ;Set value into parameter instance
;Input: CWPARM - holds the return value of $$GETPRM^CWMAILE
; CWVALUE - value to stuff (single value or comma delimited string)
; CWDUZ - user
Q:'CWDUZ 1 ;must have a valid user
K CWERR
I 'CWPARM D ;single instance
. D EN^XPAR("USR.`"_CWDUZ,$P(CWPARM,"|",2),1,CWVALUE,.CWERR)
E D ;multiple instances
. N CWLP,CWX,CWXA
. S CWX=CWVALUE,CWLP=0
. F Q:$L(CWX,";")<(CWLP+1) D
. . S CWLP=CWLP+1
. . S CWXA=$P(CWX,";",CWLP) ;CWXA holds the column,width pair
. . D EN^XPAR("USR.`"_CWDUZ,$P(CWPARM,"|",2),CWLP,CWXA,.CWERR) ;stuff value
Q CWERR
;
%GETSVER(CWDATA,CWPARAM) ;GET SERVER VERSION
S CWDATA(1)="1^1^"_+$$VERSION^XPDUTL("CWMA")
Q

59
p/CWMAILE.m Normal file
View File

@ -0,0 +1,59 @@
CWMAILE ;INDPLS/PLS- DELPHI VISTA MAIL SERVER CONT'D ;07-Sep-1999 14:08;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
Q ;ROUTINE CAN'T BE CALLED DIRECTLY
;
GETPKPM(CWDAT) ;get package parameters and return in CWDAT
;called by CWMAILD
;This API uses the PRECEDENCE field of each parameter
N CWCNT,CWLP
S CWCNT=2
S CWDAT(CWCNT)="[Sound]",CWCNT=CWCNT+1
S CWDAT(CWCNT)="Sound="_+$$GET^XPAR("ALL","CWMA SOUND ENABLED"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="Message Open="_$$GET^XPAR("ALL","CWMA SOUND MESSAGE OPEN"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="Message Close="_$$GET^XPAR("ALL","CWMA SOUND MESSAGE CLOSE"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="New Mail="_$$GET^XPAR("ALL","CWMA SOUND NEW MAIL"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="Priority Mail="_$$GET^XPAR("ALL","CWMA SOUND PRIORITY MAIL"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="[StartUp]",CWCNT=CWCNT+1
S CWDAT(CWCNT)="StartUpNewMail="_$$GET^XPAR("ALL","CWMA STARTUP NEW MAIL",1,"E"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="StartUpOpenMailBox="_$$GET^XPAR("ALL","CWMA STARTUP OPEN MAIL BOX",1,"E"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="StartUpOpenMailBoxName="_$$GET^XPAR("ALL","CWMA STARTUP MAIL BOX NAME"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="[General]",CWCNT=CWCNT+1
S CWDAT(CWCNT)="CreateMessageAttributes="_$$GET^XPAR("ALL","CWMA GENERAL CMA STYLE"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="MessagePropertiesDefaultTab="_$$GET^XPAR("ALL","CWMA GENERAL MPD TAB"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="NewMailPollingFrequency="_$$GET^XPAR("ALL","CWMA GENERAL NMP FREQ"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="MessageDisplayCount="_$$GET^XPAR("ALL","CWMA GENERAL MD COUNT"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="DefaultVistaPrinter="_$$GET^XPAR("ALL","CWMA GENERAL VISTA PRT"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="DefaultPrintMode="_+$$GET^XPAR("ALL","CWMA GENERAL PRINTMODE"),CWCNT=CWCNT+1
S CWDAT(CWCNT)="MessageDisplayColumns="_$$GETCOL,CWCNT=CWCNT+1 ;get column information
S CWDAT(CWCNT)="AllowAttachments="_$$GET^XPAR("ALL","CWMA ALLOW ATTACHMENTS",1,"E"),CWCNT=CWCNT+1
S CWDAT(-9900)=CWCNT
Q $O(CWDAT(1))
;
GETCOL() ;retrieve column information for message display
N CWLP,CWDAA,CWTMP
S CWTMP=""
D GETLST^XPAR(.CWDAA,"ALL","CWMA GENERAL MD COL")
S CWLP=0 F S CWLP=$O(CWDAA(CWLP)) Q:CWLP<1 D
. S CWTMP=CWTMP_$P(CWDAA(CWLP),U,2)_";"
Q CWTMP
;
GETPRM(CWVAR) ;lookup parameter for a given variable
;returns set procedure|parameter
; set procedure: 0=single instance, 1=multiple instances
Q:CWVAR="Sound" "0|CWMA SOUND ENABLED"
Q:CWVAR="Message Open" "0|CWMA SOUND MESSAGE OPEN"
Q:CWVAR="Message Close" "0|CWMA SOUND MESSAGE CLOSE"
Q:CWVAR="Priority Mail" "0|CWMA SOUND PRIORITY MAIL"
Q:CWVAR="New Mail" "0|CWMA SOUND NEW MAIL"
Q:CWVAR="StartUpNewMail" "0|CWMA STARTUP NEW MAIL"
Q:CWVAR="StartUpOpenMailBox" "0|CWMA STARTUP OPEN MAIL BOX"
Q:CWVAR="StartUpOpenMailBoxName" "0|CWMA STARTUP MAIL BOX NAME"
Q:CWVAR="CreateMessageAttributes" "0|CWMA GENERAL CMA STYLE"
Q:CWVAR="MessagePropertiesDefaultTab" "0|CWMA GENERAL MPD TAB"
Q:CWVAR="NewMailPollingFrequency" "0|CWMA GENERAL NMP FREQ"
Q:CWVAR="MessageDisplayCount" "0|CWMA GENERAL MD COUNT"
Q:CWVAR="DefaultVistaPrinter" "0|CWMA GENERAL VISTA PRT"
Q:CWVAR="DefaultPrintMode" "0|CWMA GENERAL PRINTMODE"
Q:CWVAR="MessageDisplayColumns" "1|CWMA GENERAL MD COL"
Q ""
;

75
p/CWMAILF.m Normal file
View File

@ -0,0 +1,75 @@
CWMAILF ;INDPLS/PLS- DELPHI VISTA MAIL SERVER CONT'D ;02-Jul-1999 15:53;PS
;;2.1;CWMA GuiMail;;Jan 06, 1999
;MODIFIED FOR XM*7.1*50
Q ;ROUTINE CAN'T BE CALLED DIRECTLY
BLDLST(CWDATA,CWDATSRC,CWDCNT) ; build list of messages - called by CWMAILA
;Input: CWDATA - pass by reference
; CWDATSRC - $NA containing data
; CWDCNT - node counter
;Return: CWDATA array
;CWARY format: piece value
; 1 message basket
; 2 message ien
; 3 message subject
; 4 message date sent
; 5 not used
; 6 message type
; 7 confirmation flag
; 8 closed flag
; 9 info flag
; 10 confidential flag
; 11 sender ien
; 12 broadcast flag
; 13 sender name
; 14 total # of recipients
; 15 total # of replies
; 16 priority flag
; 17 last response read
; 18 message basket sequence number
; 19 new message flag
; 20 answer message flag
;
S CWDATA(1)="0^AN ERROR HAS OCCURRED"
N CWVAL,CWMSG,CWMSGSUB,CWMSGDT,CWMAIB,CWMSGBX,CWMSGLP
N CWARY
S CWMSG=0,CWDCNT=2,CWMSGLP=0
;CALL API TO RETRIEVE MESSAGES
F S CWMSGLP=$O(@CWDATSRC@(CWMSGLP)) Q:CWMSGLP<1 D
. S CWARY(1)=+$G(@CWDATSRC@(CWMSGLP,"BSKT"))
. S CWARY(2)=+$G(@CWDATSRC@(CWMSGLP))
. S CWARY(3)=$G(@CWDATSRC@(CWMSGLP,"SUBJ"))
. S CWARY(4)=$P($G(@CWDATSRC@(CWMSGLP,"DATE")),U)
. I CWARY(4)?1.N1".".N S CWARY(4)=$$FMDTE^CWMAIL4(CWARY(4),"5MZ")
. E S CWARY(4)=$$FMDTE^CWMAIL4($$CONVERT^XMXUTIL1(CWARY(4),1),"5MZ")
. S CWARY(18)=$G(@CWDATSRC@(CWMSGLP,"SEQN"))
. S CWARY(19)=+$G(@CWDATSRC@(CWMSGLP,"NEW"))
. S CWDATA(CWDCNT)=$$ADDMP^CWMAIL0(CWARY(2),.CWARY)
. S CWDCNT=CWDCNT+1
Q
;
%MSGISRC(CWDATA,CWINPUT) ;SEARCH FOR A PARTICULAR MESSAGE NUMBER
;CWINPUT - IEN of Message
N CWI,CWMIEN,CWDATT,CWDCNT
K CWDATA
S CWDCNT=2
S CWMIEN=+$P($G(CWINPUT),";")
I $$ACCESS^XMXSEC(XMDUZ,CWMIEN) D
. D MSGINIT(CWMIEN,.CWDATT)
. D BLDLST(.CWDATA,$NA(CWDATT),.CWDCNT)
. ;S CWDATA(1)="1^^DATA HAS BEEN FOUND"
;E S CWDATA(1)="1^^Message not found or you don't have access to it."
I $O(CWDATA(1)) S CWDATA(1)="1^^DATA HAS BEEN FOUND"
E S CWDATA(1)="1^^Message not found or you lack access to it."
S $P(CWDATA(1),U,2)=CWDCNT-2
MSGISRCE Q
;
MSGINIT(CWMIEN,CWDATT) ;Individual Message Pre-processor
N CWIM,CWINSTR,CWIU
D INMSG^XMXUTIL2(XMDUZ,"",CWMIEN,,,.CWIM,.CWINSTR,.CWIU)
S CWDATT(1)=CWMIEN
S CWDATT(1,"DATE")=$G(CWIM("DATE"))
S CWDATT(1,"SUBJ")=$G(CWIM("SUBJ"))
S CWDATT(1,"SEQN")=""
S CWDATT(1,"BSKT")=$$BSKT^XMXUTIL2(XMDUZ,CWMIEN,1)
S CWDATT(1,"NEW")=$G(CWIU("NEW"))>0
Q

64
p/CWMAINI.m Normal file
View File

@ -0,0 +1,64 @@
CWMAINI ;INDPLS/PLS - KIDS INITS FOR GUIMail INSTALL ;30-Jul-1999 10:42;PS;
;;2.1;CWMA GuiMail;;Jan 06, 1999
; Environment Check
EC D VCHK("RPC BROKER",1.1) ;RPC Broker
D PCHK("DI*21.0*34") ;Fileman/Delphi Components
D PCHK("XM*7.1*50") ;MailMan Patch
D PCHK("XM*7.1*73") ;MailMan Patch to $$CONVERT^XMXUTIL1
D PCHK("XU*8.0*71") ;Kernel date formatting patch
D PCHK("XT*7.3*26") ;Kernel Tool-Kit Generic Parameters
S:$G(XPDENV) XPDDIQ("XPZ1")=0 ;force Disable Options/Protocols prompt to NO
Q
VCHK(CWP,CWV) ;CHECK VERSION OF PASSED PACKAGE
D:$$VERSION^XPDUTL(CWP)<CWV MES("Requires at least version "_CWV_" of the "_CWP_".")
Q
PCHK(CWPATCH) ;CHECK PATCH INSTALLATION
D:'$$PATCH^XPDUTL(CWPATCH) MES("Requires that patch "_CWPATCH_" be installed.")
Q
MES(X) D BMES^XPDUTL(X)
S XPDQUIT=1
Q
;Post Installation
EN ;entry point for post installation functions
;
D ^CWMAPP ;populate package parameters
D EN^CWMACPPI ;convert CWMAIL1 to Generic Parameter Utility
D PDEL890 ;prompt for deletion of File 890 CW GUI VISTA MAIL USER
D MMSG ;send mail message indicating package installation
Q
MMSG ;send mail message to Indianapolis indicating CW GUIMail installation
;
N CWSUBJ,CWRECP,CWBODY
S CWBODY=$NA(^TMP($J,"CWBODY"))
S CWSUBJ="GUIMail Installation at "_$G(^XMB("NETNAME"))
S ^TMP($J,"CWBODY",1)="GUIMail has just been installed at: "_$G(^XMB("NETNAME"))_"."
S ^TMP($J,"CWBODY",2)="Version #: 2.1" ;_$$VERSION^XPDUTL("CWMA") ;set version number
S ^TMP($J,"CWBODY",3)="Installer: "_$P($G(^VA(200,+$G(DUZ),0)),U)
S CWRECP("G.GUIMAIL@INDIANAPOLIS.VA.GOV")=""
D SENDMSG^XMXAPI(DUZ,CWSUBJ,CWBODY,.CWRECP)
K ^TMP($J,"CWBODY")
Q
;
PDEL890 ;I $$READY("Do you wish to remove the file at this time","NO") D
;. N DIU
;. S DIU="^CWMAIL1(",DIU(0)="DST" D EN^DIU2
;E D
;. W !,"OK. You may delete later by executing D PDEL890^CWMAINI."
D BMES^XPDUTL("Removing CW GUI VISTA MAIL USER (890) File ...")
N DIU
S DIU="^CWMAIL1(",DIU(0)="DST" D EN^DIU2
Q
READY(CWPRMPT,CWDEF) ; Prompts user for input
;Input - CWPRMPT - will set DIR("A" to this value
; CWDEF - will set DIR("B" to this value
;Output - returns a 1(yes) or 0(no)
N DIR,X,Y
W !!," * * * * WARNING * * * *"
W !!," You are about to remove file 890. This file held"
W !!," personal preferences for GUIMail v2.0. All of the settings"
W !!," should have been moved to the Generic Parameter File"
W !!," during installation.",!!
S DIR("B")=$G(CWDEF,"NO")
S DIR(0)="Y"
D ^DIR Q:Y 1 ; answered YES
Q 0 ; answered NO

16
p/CWMAPP.m Normal file
View File

@ -0,0 +1,16 @@
CWMAPP ; Export Package Level Parameters ; Sep 07, 1999@14:11:55
;;2.1;CWMA GuiMail;;Jan 06, 1999
;;
MAIN ; main (initial) parameter transport routine
K ^TMP($J,"XPARRSTR")
N ENT,IDX,ROOT,REF,VAL,I
S ROOT=$NAME(^TMP($J,"XPARRSTR")),ROOT=$E(ROOT,1,$L(ROOT)-1)_","
D ^CWMAPP01
XX2 S IDX=0,ENT="PKG."_"CW GUIMail"
F S IDX=$O(^TMP($J,"XPARRSTR",IDX)) Q:'IDX D
. N PAR,INST,VAL,ERR
. S PAR=$P(^TMP($J,"XPARRSTR",IDX,"KEY"),U),INST=$P(^("KEY"),U,2)
. M VAL=^TMP($J,"XPARRSTR",IDX,"VAL")
. D EN^XPAR(ENT,PAR,INST,.VAL,.ERR)
K ^TMP($J,"XPARRSTR")
Q

69
p/CWMAPP01.m Normal file
View File

@ -0,0 +1,69 @@
CWMAPP01 ; ; Sep 07, 1999@14:11:55
;;2.1;CWMA GuiMail;;Jan 06, 1999
;;
LOAD ; load data into ^TMP (expects ROOT to be defined)
S I=1 F S REF=$T(DATA+I) Q:REF="" S VAL=$T(DATA+I+1) D
. S I=I+2,REF=$P(REF,";",3,999),VAL=$P(VAL,";",3,999)
. S @(ROOT_REF)=VAL
Q
DATA ; parameter data
;;2,"KEY")
;;CWMA STARTUP NEW MAIL^1
;;2,"VAL")
;;True
;;4,"KEY")
;;CWMA GENERAL MD COL^1
;;4,"VAL")
;;0,5
;;5,"KEY")
;;CWMA GENERAL MD COL^2
;;5,"VAL")
;;1,25
;;6,"KEY")
;;CWMA GENERAL MD COL^3
;;6,"VAL")
;;2,60
;;7,"KEY")
;;CWMA GENERAL MD COL^4
;;7,"VAL")
;;3,250
;;8,"KEY")
;;CWMA GENERAL MD COL^5
;;8,"VAL")
;;4,200
;;9,"KEY")
;;CWMA GENERAL MD COL^6
;;9,"VAL")
;;5,47
;;18,"KEY")
;;CWMA SOUND ENABLED^1
;;18,"VAL")
;;False
;;40,"KEY")
;;CWMA GENERAL MD COL^7
;;40,"VAL")
;;6,38
;;42,"KEY")
;;CWMA GENERAL CMA STYLE^1
;;42,"VAL")
;;Use Menu
;;43,"KEY")
;;CWMA GENERAL MPD TAB^1
;;43,"VAL")
;;Recipients
;;44,"KEY")
;;CWMA GENERAL NMP FREQ^1
;;44,"VAL")
;;5
;;45,"KEY")
;;CWMA GENERAL MD COUNT^1
;;45,"VAL")
;;8
;;46,"KEY")
;;CWMA GENERAL PRINTMODE^1
;;46,"VAL")
;;Vista
;;66,"KEY")
;;CWMA ALLOW ATTACHMENTS^1
;;66,"VAL")
;;True