- XMA2B ;(WASH ISC)/CAP/THM-Send BLOB ;06/22/99 14:44
- ;;8.0;MailMan;;Jun 28, 2002
- ; Entry points used by MailMan options (not covered by DBIA):
- ; BLOB XMBLOBSEND - Send Imaging Package message
- BLOB ;Send BLOBs [Other Body Parts] in a message.
- ;Do not allow option to be used if Imaging is not set up.
- I '$O(^MAG(2005,0)) W !!,"Imaging is not installed here. You can not send multimedia messages.",$C(7) Q
- ;
- ;First message is created with text.
- K XMA2BT
- D BLOB^XMJMS
- Q
- ADD ;Then this entry point is called
- ;Called from ^XMJMS for adding BLOBS to message as other body parts
- ;
- W !,"Do you want to attach "_$S('$D(XMA2BT):"a",1:"another")_" patient's image to this message? N// " R X:DTIME
- I X="Y"!(X="y") S MAGBLOB=1 G SEL
- I $D(MAGBLOB) I X="N"!(X="n")!(X="^")!(X="") S X="" G ADDCHK
- SEL D SELIM^MAGAPI G ADDBLOB
- ADDCHK G CHK:X=""
- I X["?" D HLP G ADD
- ;
- ;Remove a BLOB
- S XMN=$E(X)="-"
- 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
- ;
- ;Add a BLOB
- K S Y=-1 D LK
- ADDBLOB G:$S(X["^":1,X="":1,+Y<1:1,1:0) CHK
- 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
- S ^XMB(3.9,XMZ,2005,"B",+Y,I)="",XMA2BT=1
- G ADD
- CHK K XMA2BT Q:$S($O(^XMB(3.9,XMZ,2005,0)):1,'$O(^XMB(3.9,XMZ,2,0)):1,1:0)
- W !!,"You did not add any 'Other Body Parts' (files) to this message."
- R !!,"Do you wish to deliver just the text ? N// ",Y:DTIME
- K XMOUT
- S Y=$TR(Y,"yesno","YESNO")
- I $L(Y) Q:$E("YES",1,$L(Y))=Y
- I $E("NO",1,$L(Y))=Y G ADD
- W $C(7)," <<< Please answer 'YES' or 'NO'"
- G CHK
- ;
- 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
- ER W " ??",$C(7) G ADD
- ;
- HLP ;Help for adding/removing BLOBS
- W !!,"You may add or remove a BLOB from the message. To add a BLOB"
- W !,"enter the name of the BLOB you wish to add to the message. This"
- W !,"BLOB must already be in the * file. To remove on, preceed the"
- W !,"name of the BLOB with a '-'. Example: To add the BLOB named"
- W !,"ZZTEMP, enter 'ZZTEMP'. To remove it enter '-ZZTEMP'."
- Q:'$O(^XMB(3.9,XMZ,2005,0))
- W !!,"The following BLOBs have already been added to this message:",!!
- ;
- ;List BLOBS in a message
- 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
- Q
- ;
- ;Entry point to list non-textual body parts for Query.
- LIST N I,X W !,"This message has non-textual body-parts: "
- G L
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMA2B 2603 printed Feb 18, 2025@23:37:01 Page 2
- XMA2B ;(WASH ISC)/CAP/THM-Send BLOB ;06/22/99 14:44
- +1 ;;8.0;MailMan;;Jun 28, 2002
- +2 ; Entry points used by MailMan options (not covered by DBIA):
- +3 ; BLOB XMBLOBSEND - Send Imaging Package message
- BLOB ;Send BLOBs [Other Body Parts] in a message.
- +1 ;Do not allow option to be used if Imaging is not set up.
- +2 IF '$ORDER(^MAG(2005,0))
- WRITE !!,"Imaging is not installed here. You can not send multimedia messages.",$CHAR(7)
- QUIT
- +3 ;
- +4 ;First message is created with text.
- +5 KILL XMA2BT
- +6 DO BLOB^XMJMS
- +7 QUIT
- ADD ;Then this entry point is called
- +1 ;Called from ^XMJMS for adding BLOBS to message as other body parts
- +2 ;
- +3 WRITE !,"Do you want to attach "_$SELECT('$DATA(XMA2BT):"a",1:"another")_" patient's image to this message? N// "
- READ X:DTIME
- +4 IF X="Y"!(X="y")
- SET MAGBLOB=1
- GOTO SEL
- +5 IF $DATA(MAGBLOB)
- IF X="N"!(X="n")!(X="^")!(X="")
- SET X=""
- GOTO ADDCHK
- SEL DO SELIM^MAGAPI
- GOTO ADDBLOB
- ADDCHK if X=""
- GOTO CHK
- +1 IF X["?"
- DO HLP
- GOTO ADD
- +2 ;
- +3 ;Remove a BLOB
- +4 SET XMN=$EXTRACT(X)="-"
- +5 IF XMN
- SET X=$EXTRACT(X,2,99)
- DO LK
- if +Y<1
- GOTO ER
- SET %=$ORDER(^XMB(3.9,XMZ,2005,"B",+Y,0))
- IF %
- KILL ^(%)
- SET I=^XMB(3.9,XMZ,2005,0)
- SET %0=$PIECE(I,U,4)-1
- SET $PIECE(I,U,3,4)=%0_U_%0
- SET ^(0)=I
- KILL ^(%)
- GOTO ADD
- +6 ;
- +7 ;Add a BLOB
- K SET Y=-1
- DO LK
- ADDBLOB if $SELECT(X["^"
- GOTO CHK
- +1 SET %=$SELECT($DATA(^XMB(3.9,XMZ,2005,0)):^(0),1:"^3.92005P")
- SET I=$PIECE(%,U,3)+1
- SET $PIECE(%,U,3)=I
- SET $PIECE(%,U,4)=$PIECE(%,U,4)+1
- SET ^(0)=%
- SET ^(I,0)=+Y
- +2 SET ^XMB(3.9,XMZ,2005,"B",+Y,I)=""
- SET XMA2BT=1
- +3 GOTO ADD
- CHK KILL XMA2BT
- if $SELECT($ORDER(^XMB(3.9,XMZ,2005,0))
- QUIT
- +1 WRITE !!,"You did not add any 'Other Body Parts' (files) to this message."
- +2 READ !!,"Do you wish to deliver just the text ? N// ",Y:DTIME
- +3 KILL XMOUT
- +4 SET Y=$TRANSLATE(Y,"yesno","YESNO")
- +5 IF $LENGTH(Y)
- if $EXTRACT("YES",1,$LENGTH(Y))=Y
- QUIT
- +6 IF $EXTRACT("NO",1,$LENGTH(Y))=Y
- GOTO ADD
- +7 WRITE $CHAR(7)," <<< Please answer 'YES' or 'NO'"
- +8 GOTO CHK
- +9 ;
- LK SET DIC=2005
- SET DIC(0)="NOQFEM"
- SET DIC("S")="N % S %=^(0) I $P(%,U,6)'=9,$P(%,U,3)"
- DO ^DIC
- KILL DIC
- QUIT
- ER WRITE " ??",$CHAR(7)
- GOTO ADD
- +1 ;
- HLP ;Help for adding/removing BLOBS
- +1 WRITE !!,"You may add or remove a BLOB from the message. To add a BLOB"
- +2 WRITE !,"enter the name of the BLOB you wish to add to the message. This"
- +3 WRITE !,"BLOB must already be in the * file. To remove on, preceed the"
- +4 WRITE !,"name of the BLOB with a '-'. Example: To add the BLOB named"
- +5 WRITE !,"ZZTEMP, enter 'ZZTEMP'. To remove it enter '-ZZTEMP'."
- +6 if '$ORDER(^XMB(3.9,XMZ,2005,0))
- QUIT
- +7 WRITE !!,"The following BLOBs have already been added to this message:",!!
- +8 ;
- +9 ;List BLOBS in a message
- L SET I=0
- FOR
- SET I=$ORDER(^XMB(3.9,XMZ,2005,I))
- if +I'=I
- QUIT
- SET %=+^(I,0)
- SET X=$PIECE(^MAG(2005,%,0),U)
- if $LENGTH(X)+$X>79
- WRITE !
- WRITE X,?$X\10*10+10
- +1 QUIT
- +2 ;
- +3 ;Entry point to list non-textual body parts for Query.
- LIST NEW I,X
- WRITE !,"This message has non-textual body-parts: "
- +1 GOTO L
