| 1 | XMA2B ;(WASH ISC)/CAP/THM-Send BLOB ;06/22/99 14:44
|
---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
---|
| 3 | ; Entry points used by MailMan options (not covered by DBIA):
|
---|
| 4 | ; BLOB XMBLOBSEND - Send Imaging Package message
|
---|
| 5 | BLOB ;Send BLOBs [Other Body Parts] in a message.
|
---|
| 6 | ;Do not allow option to be used if Imaging is not set up.
|
---|
| 7 | I '$O(^MAG(2005,0)) W !!,"Imaging is not installed here. You can not send multimedia messages.",$C(7) Q
|
---|
| 8 | ;
|
---|
| 9 | ;First message is created with text.
|
---|
| 10 | K XMA2BT
|
---|
| 11 | D BLOB^XMJMS
|
---|
| 12 | Q
|
---|
| 13 | ADD ;Then this entry point is called
|
---|
| 14 | ;Called from ^XMJMS for adding BLOBS to message as other body parts
|
---|
| 15 | ;
|
---|
| 16 | W !,"Do you want to attach "_$S('$D(XMA2BT):"a",1:"another")_" patient's image to this message? N// " R X:DTIME
|
---|
| 17 | I X="Y"!(X="y") S MAGBLOB=1 G SEL
|
---|
| 18 | I $D(MAGBLOB) I X="N"!(X="n")!(X="^")!(X="") S X="" G ADDCHK
|
---|
| 19 | SEL D SELIM^MAGAPI G ADDBLOB
|
---|
| 20 | ADDCHK G CHK:X=""
|
---|
| 21 | I X["?" D HLP G ADD
|
---|
| 22 | ;
|
---|
| 23 | ;Remove a BLOB
|
---|
| 24 | S XMN=$E(X)="-"
|
---|
| 25 | I XMN S X=$E(X,2,99) D LK G ER:+Y<1 S %=$O(^XMB(3.9,XMZ,2005,"B",+Y,0)) I % K ^(%) S I=^XMB(3.9,XMZ,2005,0),%0=$P(I,U,4)-1,$P(I,U,3,4)=%0_U_%0,^(0)=I K ^(%) G ADD
|
---|
| 26 | ;
|
---|
| 27 | ;Add a BLOB
|
---|
| 28 | K S Y=-1 D LK
|
---|
| 29 | ADDBLOB G:$S(X["^":1,X="":1,+Y<1:1,1:0) CHK
|
---|
| 30 | S %=$S($D(^XMB(3.9,XMZ,2005,0)):^(0),1:"^3.92005P"),I=$P(%,U,3)+1,$P(%,U,3)=I,$P(%,U,4)=$P(%,U,4)+1,^(0)=%,^(I,0)=+Y
|
---|
| 31 | S ^XMB(3.9,XMZ,2005,"B",+Y,I)="",XMA2BT=1
|
---|
| 32 | G ADD
|
---|
| 33 | CHK K XMA2BT Q:$S($O(^XMB(3.9,XMZ,2005,0)):1,'$O(^XMB(3.9,XMZ,2,0)):1,1:0)
|
---|
| 34 | W !!,"You did not add any 'Other Body Parts' (files) to this message."
|
---|
| 35 | R !!,"Do you wish to deliver just the text ? N// ",Y:DTIME
|
---|
| 36 | K XMOUT
|
---|
| 37 | S Y=$TR(Y,"yesno","YESNO")
|
---|
| 38 | I $L(Y) Q:$E("YES",1,$L(Y))=Y
|
---|
| 39 | I $E("NO",1,$L(Y))=Y G ADD
|
---|
| 40 | W $C(7)," <<< Please answer 'YES' or 'NO'"
|
---|
| 41 | G CHK
|
---|
| 42 | ;
|
---|
| 43 | LK S DIC=2005,DIC(0)="NOQFEM",DIC("S")="N % S %=^(0) I $P(%,U,6)'=9,$P(%,U,3)" D ^DIC K DIC Q
|
---|
| 44 | ER W " ??",$C(7) G ADD
|
---|
| 45 | ;
|
---|
| 46 | HLP ;Help for adding/removing BLOBS
|
---|
| 47 | W !!,"You may add or remove a BLOB from the message. To add a BLOB"
|
---|
| 48 | W !,"enter the name of the BLOB you wish to add to the message. This"
|
---|
| 49 | W !,"BLOB must already be in the * file. To remove on, preceed the"
|
---|
| 50 | W !,"name of the BLOB with a '-'. Example: To add the BLOB named"
|
---|
| 51 | W !,"ZZTEMP, enter 'ZZTEMP'. To remove it enter '-ZZTEMP'."
|
---|
| 52 | Q:'$O(^XMB(3.9,XMZ,2005,0))
|
---|
| 53 | W !!,"The following BLOBs have already been added to this message:",!!
|
---|
| 54 | ;
|
---|
| 55 | ;List BLOBS in a message
|
---|
| 56 | L S I=0 F S I=$O(^XMB(3.9,XMZ,2005,I)) Q:+I'=I S %=+^(I,0),X=$P(^MAG(2005,%,0),U) W:$L(X)+$X>79 ! W X,?$X\10*10+10
|
---|
| 57 | Q
|
---|
| 58 | ;
|
---|
| 59 | ;Entry point to list non-textual body parts for Query.
|
---|
| 60 | LIST N I,X W !,"This message has non-textual body-parts: "
|
---|
| 61 | G L
|
---|