C0CMIME ; CCDCCR/GPL - MIME manipulation utilities; 3/8/11 ;;1.0;C0C;;Mar 8, 2011; ;Copyright 2008 George Lilly. Licensed under the terms of the GNU ;General Public License See attached copy of the License. ; ;This program is free software; you can redistribute it and/or modify ;it under the terms of the GNU General Public License as published by ;the Free Software Foundation; either version 2 of the License, or ;(at your option) any later version. ; ;This program is distributed in the hope that it will be useful, ;but WITHOUT ANY WARRANTY; without even the implied warranty of ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;GNU General Public License for more details. ; ;You should have received a copy of the GNU General Public License along ;with this program; if not, write to the Free Software Foundation, Inc., ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ; Q ; TEST(ZDFN) ; D CCRRPC^C0CCCR(.ZCCR,ZDFN) ; GET A CCR TO WORK WITH ;M ZCOPY=ZCCR S ZCOPY(1)="" N ZI S ZI=0 F S ZI=$O(ZCCR(ZI)) Q:ZI="" D ; FOR EACH LINE . S ZCOPY(1)=ZCOPY(1)_ZCCR(ZI) ;D ENCODE("ZCOPY",1,ZCOPY(1)) S G(1)=$$ENCODE^RGUTUU(ZCOPY(1)) D CHUNK("G2","G",45) Q ENCODE(ZRTN,ZARY) ; ; ROUTINE TO ENCODE AN XML DOCUMENT FOR SENDING ; ZARY IS PASSED BY NAME ; ZRTN IS PASSED BY REFERENCE AND IS THE RETURN ; S ZCOPY(1)="" N ZI S ZI=0 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH LINE . S ZCOPY(1)=ZCOPY(1)_@ZARY@(ZI) N G S G(1)=$$ENCODE^RGUTUU(ZCOPY(1)) D CHUNK(ZRTN,"G",45) Q ; THIS ROUTINE WAS COPIED FROM LRSRVR4 AND THEN MODIFIED . THANKS JOHN ENCODEOLD(IARY,LRNODE,LRSTR) ; Encode a string, keep remainder for next line ; Call with LRSTR by reference, Remainder returned in LRSTR ; IARY IS PASSED BY NAME S LRQUIT=0,LRLEN=$L(LRSTR) F D Q:LRQUIT . I $L(LRSTR)<45 S LRQUIT=1 Q . S LRX=$E(LRSTR,1,45) . S LRNODE=LRNODE+1,@IARY@(LRNODE)=$$UUEN^LRSRVR4(LRX) . S LRSTR=$E(LRSTR,46,LRLEN) Q ; TESTMAIL ; ; TEST OF MAILSEND ;S ZTO("glilly@glilly.net")="" S ZTO("mish@nhin.openforum.opensourcevista.net")="" ;S ZTO("martijn@djigzo.com")="" ;S ZTO("profmish@gmail.com")="" ;S ZTO("nanthracite@earthlink.net")="" S ZFROM="ANTHRACITE.NANCY" S ZATTACH=$NA(^GPL("CCR")) I $G(@ZATTACH@(1))="" D ; NO CCR THERE . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2 . M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE" D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,,ZATTACH) ZWR GR Q ; TESTMAIL2 ; ; TEST OF MAILSEND TO gpl.mdc-crew.net ;S ZTO("glilly@glilly.net")="" S ZTO("LILLY.GEORGE@mdc-crew.net")="" ;S ZTO("martijn@djigzo.com")="" ;S ZTO("profmish@gmail.com")="" ;S ZTO("nanthracite@earthlink.net")="" S ZFROM="ANTHRACITE.NANCY" S ZATTACH=$NA(^GPL("CCR")) I $G(@ZATTACH@(1))="" D ; NO CCR THERE . D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2 . M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE" D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,,ZATTACH) ZWR GR Q ; MAILSEND(RTN,FROM,TO,CC,SUBJECT,MESSAGE,ATTACH,FLAGS) ; MAIL SENDING INTERFACE ; RTN IS THE RETURN ARRAY PASSED BY REFERENCE ; FROM IS PASSED BY VALUE AND IS THE EMAIL ADDRESS OF THE SENDER ; IF NULL, WILL SEND FROM THE CURRENT DUZ ; TO AND CC ARE RECIEPIENT EMAIL ADDRESSES PASSED BY NAME ; @TO@("addr1@domain1.net") ; @CC@("addr2@domain2.com") both can be multiples ; SUBJECT IS PASSED BY VALUE AND WILL GO IN THE SUBJECT LINE ; MESSAGE IS PASSED BY NAME AND IS AN ARRAY OF TEXT ; ATTACH IS PASSED BY NAME AND IS AN XML OR HTML FILE TO BE ATTACHED ; N GN S GN=$NA(^TMP($J,"C0CMIME")) K @GN S GM(1)="MIME-Version: 1.0" S GM(2)="Content-Type: multipart/mixed; boudary=""1234567""" S GM(3)=" " S GM(4)=" " S GM(5)="--1234567" ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X)) S GM(6)="Content-Type: text/xml; name=""ccr.xml""" S GM(7)="Content-Transfer-Encoding: base64" S GM(8)="Content-Disposition: attachment; filename=""ccr.xml""" S GM(9)=" " S GM(10)=" " ; FOR THE END S GM(11)="--1234567--" S GM(12)=" " S GM(13)=" " K GBLD D QUEUE^C0CXPATH("GBLD","GM",5,9) I $D(ATTACH)'="" D ; IF WE HAVE AN ATTACHMENT . D ENCODE("G2",ATTACH) ; ENCODE FOR SENDING . D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1)) D QUEUE^C0CXPATH("GBLD","GM",10,12) D BUILD^C0CXPATH("GBLD",GN) ;S GGG=$NA(^GPL("MIME2")) K @GN@(0) ; KILL THE LINE COUNT K LRINSTR,LRTASK,LRTO,XMERR,XMZ M LRTO=@TO I $D(CC) M LRTO=@CC S LRINSTR("ADDR FLAGS")="R" S LRINSTR("FROM")=$G(FROM) S LRMSUBJ=$G(SUBJECT) S LRMSUBJ=$E(LRMSUBJ,1,65) D SENDMSG^XMXAPI(DUZ,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK) I $G(XMERR)=1 S RTN(1)="ERROR SENDING MESSAGE" Q ; S RTN(1)="OK" Q ; MAILSEND0(LRMSUBJ) ; Send extract back to requestor. ; ;D TEST S GN=$NA(^TMP($J,"C0CMIME")) K @GN ;M @GN=G2 S GM(1)="MIME-Version: 1.0" S GM(2)="Content-Type: multipart/mixed; boudary=""1234567""" S GM(3)=" " S GM(4)=" " S GM(5)="--1234567" ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X)) S GM(6)="Content-Type: text/xml; name=""ccr.xml""" S GM(7)="Content-Transfer-Encoding: base64" S GM(8)="Content-Disposition: attachment; filename=""ccr.xml""" ;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml") S GM(9)=" " S GM(10)=" " ; FOR THE END S GM(11)="--frontier--" S GM(12)="." S GM(13)=" " K GBLD ;D QUEUE^C0CXPATH("GBLD","GM",1,9) ;D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1)) ;D QUEUE^C0CXPATH("GBLD","GM",10,13) ;D BUILD^C0CXPATH("GBLD",GN) S GGG=$NA(^GPL("MIME2")) ;D QUEUE^C0CXPATH("GBLD","GM",1,1) D QUEUE^C0CXPATH("GBLD",GGG,21,159) D BUILD^C0CXPATH("GBLD",GN) K @GN@(0) ; KILL THE LINE COUNT K LRINSTR,LRTASK,LRTO,XMERR,XMZ S XQSND="glilly@glilly.net" ;S XQSND="nanthracite@earthlink.net" ;S XQSND="dlefevre@orohosp.com" ;S XQSND="gregwoodhouse@me.com" ;S XQSND="rick.marshall@vistaexpertise.net" S LRTO(XQSND)="" S LRINSTR("ADDR FLAGS")="R" S LRINSTR("FROM")="CCR_PACKAGE" S LRMSUBJ="A SAMPLE CCR" S LRMSUBJ=$E(LRMSUBJ,1,65) D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK) I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q ; ;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0" ;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9" Q ; MAILSEND2(UDFN,ADDR) ; Send extract back to requestor. ; I +$G(UDFN)=0 S UDFN=2 ; D TEST(UDFN) S GN=$NA(^TMP($J,"C0CMIME")) K @GN ;M @GN=G2 S GM(1)="MIME-Version: 1.0" S GM(2)="Content-Type: multipart/mixed; boudary=""1234567""" S GM(3)=" " S GM(4)=" " S GM(5)="--1234567" ;S GM(5)=$$REPEAT^XLFSTR("-",$L(X)) S GM(6)="Content-Type: text/xml; name=""ccr.xml""" S GM(7)="Content-Transfer-Encoding: base64" S GM(8)="Content-Disposition: attachment; filename=""ccr.xml""" ;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml") S GM(9)=" " S GM(10)=" " ; FOR THE END S GM(11)="--1234567--" S GM(12)=" " S GM(13)=" " K GBLD D QUEUE^C0CXPATH("GBLD","GM",5,9) D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1)) D QUEUE^C0CXPATH("GBLD","GM",10,12) D BUILD^C0CXPATH("GBLD",GN) S GGG=$NA(^GPL("MIME2")) ;D QUEUE^C0CXPATH("GBLD","GM",1,1) ;D QUEUE^C0CXPATH("GBLD",GGG,21,159) ;D BUILD^C0CXPATH("GBLD",GN) K @GN@(0) ; KILL THE LINE COUNT K LRINSTR,LRTASK,LRTO,XMERR,XMZ I $G(ADDR)'="" S XQSND=ADDR E S XQSND="glilly@glilly.net" ;S XQSND="nanthracite@earthlink.net" ;S XQSND="dlefevre@orohosp.com" ;S XQSND="gregwoodhouse@me.com" ;S XQSND="rick.marshall@vistaexpertise.net" S LRTO(XQSND)="" ;S LRTO("glilly@glilly.net")="" S LRINSTR("ADDR FLAGS")="R" S LRINSTR("FROM")="ANTHRACITE.NANCY" S LRMSUBJ="Sending a CCR with Mailman" S LRMSUBJ=$E(LRMSUBJ,1,65) D SENDMSG^XMXAPI(9,LRMSUBJ,GN,.LRTO,.LRINSTR,.LRTASK) I $G(XMERR)=1 W !,"ERROR SENDING MESSAGE" Q ; ;S ^XMB(3.9,LRTASK,1,.1130590,0)="MIME-Version: 1.0" ;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9" Q ; SIMPLE ; S GN(1)="SIMPLE TEST MESSAGE" K LRINSTR,LRTASK,LRTO,XMERR,XMZ S XQSND="glilly@glilly.net" S LRTO(XQSND)="" S LRINSTR("ADDR FLAGS")="R" S LRINSTR("FROM")="CCR_PACKAGE" S LRMSUBJ="A SAMPLE CCR" S LRMSUBJ=$E(LRMSUBJ,1,65) D SENDMSG^XMXAPI(9,LRMSUBJ,"GN",.LRTO,.LRINSTR,.LRTASK) Q CHUNK(OUTXML,INXML,ZSIZE) ; BREAKS INXML INTO ZSIZE BLOCKS ; INXML IS AN ARRAY PASSED BY NAME OF STRINGS ; OUTXML IS ALSO PASSED BY NAME ; IF ZSIZE IS NOT PASSED, 1000 IS USED I '$D(ZSIZE) S ZSIZE=1000 ; DEFAULT BLOCK SIZE N ZB,ZI,ZJ,ZK,ZL,ZN S ZB=ZSIZE-1 S ZN=1 S ZI=0 ; BEGINNING OF INDEX TO INXML F S ZI=$O(@INXML@(ZI)) Q:+ZI=0 D ; FOR EACH STRING IN INXML . S ZL=$L(@INXML@(ZI)) ; LENGTH OF THE STRING . F ZJ=1:ZSIZE:ZL D ; . . S ZK=$S(ZJ+ZB