XMAPBLOB ;(WASH ISC)/CAP-DISPLAY BLOBs ;04/18/2002 07:22
;;8.0;MailMan;;Jun 28, 2002
;BLOB display
BLOB Q:'$O(^XMB(3.9,XMZ,2005,0))
N %,I,XMA0,XMB0,MAGFILE2,MAGFILE
S XMA0=0,XMB0=0 I '$D(XMAPBLOB) S XMAPBLOB=1
B S XMA0=$O(^XMB(3.9,XMZ,2005,XMA0)) G BQ:'XMA0 S %=+^(XMA0,0)
S XMB0=XMB0+1,XMA0(XMB0)=%,MAGXX=%
I $L($T(IMPORT^MAGBAPI)) S %=$$IMPORT^MAGBAPI("MAIL^"_MAGXX)
D ^MAGFILE
S XMA0(XMB0)=XMA0(XMB0)_U_MAGFILE1(.01)_"^^^^^^^"_MAGFILE
G B
BQ S X=$O(XMA0(0)) I X,'$O(XMA0(X)) Q:$G(XMAPBLOB("DISPDONE"))
S XMAPBLOB("DISPDONE")=1
I XMB0=1 G CLRQ:$$ASK()="",PRTQ:$G(XMAPBLOB)>99 S (X,XMA0)=+XMA0(1) I 1
E I $S($G(IOT)="IMPC":1,1:0) S X=$$BLIST() G CLRQ:X="" S XMA0=X
D ^MAGOBJ(X,"DISPLAY","")
I $S(XMB0=1:1,$O(XMA0(XMA0))=""&$O(XMA0(0))="":1,1:0) Q
G BQ
CLRQ I $G(XMAPBLOB)>99 Q
G ERASE^MAGAPI
;
BLIST() ;List BLOBS in the message
I $G(IOT)="IMPC",$G(XMAPBLOB)>99 Q ""
N X,Y,DIR,DIRUT,DUOUT
I '$G(XMAPBLOB("D")),$Y>(IOSL-4) K DIR S DIR(0)="E" D ^DIR:$G(XMAPBLOB)<100 K DIR,DIRUT
I '$G(XMAPBLOB("D")) W !,"============================================================="
I W !!,"There are non-textual parts (BLOBs) included on this message"
S XMAPBLOB("D")=1 W !!,"Object Name",?70,"Filename"
F I=0:0 S I=$O(XMA0(I)) Q:'I W !,I_". "_$E($P(XMA0(I),U,2),1,68),?70,$E($P(XMA0(I),U,9),1,9)
A I $G(XMAPBLOB)>99 Q ""
W !!,"Pick a BLOB you wish to display from the above list (1-"_XMB0_"): NONE// " R X:DTIME
S X=$TR(X,"none","NONE") I $E("NONE",1,$L(X))=X!("^"[X) Q ""
I +X'=X W !!,"Choose the index number of the BLOB you wish to display or accept the default.",! G A
I '$D(XMA0(X)) W !!,"Please choose a listed item by typing in its index number." G A
Q +XMA0(X)
;Ask if user wants to display single BLOB
ASK() I $G(XMAPBLOB)>99 Q 2
N DIR,DIRUT,DUOUT
S DIR(0)="Y",DIR("A")="Execute Other Message Part ("_$P(XMA0(1),U,2)_") Attached ",DIR("B")="NO"
D ^DIR K DIRUT I 'Y!$D(DIRUT) Q ""
Q 1
NODISP ;If not proper terminal
Q:$G(XMAPBLOB("D")) S XMAPBLOB("D")=1 Q:'$D(^XMB(3.9,XMZ,2005))
W !!,"================================================================="
W !,"There are non-textual body parts (BLOBs) attached to this"
W !,"message. You may not execute them (display...) because you"
W !,"are not using the proper terminal."
W !!,"Query the message to see the list of BLOBs attached."
W !,"================================================================="
Q
PRT ;Print BLOB list
N MAGOBJ,MAGFILE,MAGFILE1,MAGROU,X,XMAPBLOB S XMAPBLOB=100
D BLOB Q
PRTQ S X=$$BLIST() Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMAPBLOB 2566 printed Oct 16, 2024@18:11:47 Page 2
XMAPBLOB ;(WASH ISC)/CAP-DISPLAY BLOBs ;04/18/2002 07:22
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ;BLOB display
BLOB if '$ORDER(^XMB(3.9,XMZ,2005,0))
QUIT
+1 NEW %,I,XMA0,XMB0,MAGFILE2,MAGFILE
+2 SET XMA0=0
SET XMB0=0
IF '$DATA(XMAPBLOB)
SET XMAPBLOB=1
B SET XMA0=$ORDER(^XMB(3.9,XMZ,2005,XMA0))
if 'XMA0
GOTO BQ
SET %=+^(XMA0,0)
+1 SET XMB0=XMB0+1
SET XMA0(XMB0)=%
SET MAGXX=%
+2 IF $LENGTH($TEXT(IMPORT^MAGBAPI))
SET %=$$IMPORT^MAGBAPI("MAIL^"_MAGXX)
+3 DO ^MAGFILE
+4 SET XMA0(XMB0)=XMA0(XMB0)_U_MAGFILE1(.01)_"^^^^^^^"_MAGFILE
+5 GOTO B
BQ SET X=$ORDER(XMA0(0))
IF X
IF '$ORDER(XMA0(X))
if $GET(XMAPBLOB("DISPDONE"))
QUIT
+1 SET XMAPBLOB("DISPDONE")=1
+2 IF XMB0=1
if $$ASK()=""
GOTO CLRQ
if $GET(XMAPBLOB)>99
GOTO PRTQ
SET (X,XMA0)=+XMA0(1)
IF 1
+3 IF '$TEST
IF $SELECT($GET(IOT)="IMPC":1,1:0)
SET X=$$BLIST()
if X=""
GOTO CLRQ
SET XMA0=X
+4 DO ^MAGOBJ(X,"DISPLAY","")
+5 IF $SELECT(XMB0=1:1,$ORDER(XMA0(XMA0))=""&$ORDER(XMA0(0))="":1,1:0)
QUIT
+6 GOTO BQ
CLRQ IF $GET(XMAPBLOB)>99
QUIT
+1 GOTO ERASE^MAGAPI
+2 ;
BLIST() ;List BLOBS in the message
+1 IF $GET(IOT)="IMPC"
IF $GET(XMAPBLOB)>99
QUIT ""
+2 NEW X,Y,DIR,DIRUT,DUOUT
+3 IF '$GET(XMAPBLOB("D"))
IF $Y>(IOSL-4)
KILL DIR
SET DIR(0)="E"
if $GET(XMAPBLOB)<100
DO ^DIR
KILL DIR,DIRUT
+4 IF '$GET(XMAPBLOB("D"))
WRITE !,"============================================================="
+5 IF $TEST
WRITE !!,"There are non-textual parts (BLOBs) included on this message"
+6 SET XMAPBLOB("D")=1
WRITE !!,"Object Name",?70,"Filename"
+7 FOR I=0:0
SET I=$ORDER(XMA0(I))
if 'I
QUIT
WRITE !,I_". "_$EXTRACT($PIECE(XMA0(I),U,2),1,68),?70,$EXTRACT($PIECE(XMA0(I),U,9),1,9)
A IF $GET(XMAPBLOB)>99
QUIT ""
+1 WRITE !!,"Pick a BLOB you wish to display from the above list (1-"_XMB0_"): NONE// "
READ X:DTIME
+2 SET X=$TRANSLATE(X,"none","NONE")
IF $EXTRACT("NONE",1,$LENGTH(X))=X!("^"[X)
QUIT ""
+3 IF +X'=X
WRITE !!,"Choose the index number of the BLOB you wish to display or accept the default.",!
GOTO A
+4 IF '$DATA(XMA0(X))
WRITE !!,"Please choose a listed item by typing in its index number."
GOTO A
+5 QUIT +XMA0(X)
+6 ;Ask if user wants to display single BLOB
ASK() IF $GET(XMAPBLOB)>99
QUIT 2
+1 NEW DIR,DIRUT,DUOUT
+2 SET DIR(0)="Y"
SET DIR("A")="Execute Other Message Part ("_$PIECE(XMA0(1),U,2)_") Attached "
SET DIR("B")="NO"
+3 DO ^DIR
KILL DIRUT
IF 'Y!$DATA(DIRUT)
QUIT ""
+4 QUIT 1
NODISP ;If not proper terminal
+1 if $GET(XMAPBLOB("D"))
QUIT
SET XMAPBLOB("D")=1
if '$DATA(^XMB(3.9,XMZ,2005))
QUIT
+2 WRITE !!,"================================================================="
+3 WRITE !,"There are non-textual body parts (BLOBs) attached to this"
+4 WRITE !,"message. You may not execute them (display...) because you"
+5 WRITE !,"are not using the proper terminal."
+6 WRITE !!,"Query the message to see the list of BLOBs attached."
+7 WRITE !,"================================================================="
+8 QUIT
PRT ;Print BLOB list
+1 NEW MAGOBJ,MAGFILE,MAGFILE1,MAGROU,X,XMAPBLOB
SET XMAPBLOB=100
+2 DO BLOB
QUIT
PRTQ SET X=$$BLIST()
QUIT
