Index: /ccr/trunk/p/C0CMIME.m =================================================================== --- /ccr/trunk/p/C0CMIME.m (revision 1184) +++ /ccr/trunk/p/C0CMIME.m (revision 1184) @@ -0,0 +1,275 @@ +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