source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMAPBLOB.m@ 810

Last change on this file since 810 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1XMAPBLOB ;(WASH ISC)/CAP-DISPLAY BLOBs ;04/18/2002 07:22
2 ;;8.0;MailMan;;Jun 28, 2002
3 ;BLOB display
4BLOB Q:'$O(^XMB(3.9,XMZ,2005,0))
5 N %,I,XMA0,XMB0,MAGFILE2,MAGFILE
6 S XMA0=0,XMB0=0 I '$D(XMAPBLOB) S XMAPBLOB=1
7B S XMA0=$O(^XMB(3.9,XMZ,2005,XMA0)) G BQ:'XMA0 S %=+^(XMA0,0)
8 S XMB0=XMB0+1,XMA0(XMB0)=%,MAGXX=%
9 I $L($T(IMPORT^MAGBAPI)) S %=$$IMPORT^MAGBAPI("MAIL^"_MAGXX)
10 D ^MAGFILE
11 S XMA0(XMB0)=XMA0(XMB0)_U_MAGFILE1(.01)_"^^^^^^^"_MAGFILE
12 G B
13BQ S X=$O(XMA0(0)) I X,'$O(XMA0(X)) Q:$G(XMAPBLOB("DISPDONE"))
14 S XMAPBLOB("DISPDONE")=1
15 I XMB0=1 G CLRQ:$$ASK()="",PRTQ:$G(XMAPBLOB)>99 S (X,XMA0)=+XMA0(1) I 1
16 E I $S($G(IOT)="IMPC":1,1:0) S X=$$BLIST() G CLRQ:X="" S XMA0=X
17 D ^MAGOBJ(X,"DISPLAY","")
18 I $S(XMB0=1:1,$O(XMA0(XMA0))=""&$O(XMA0(0))="":1,1:0) Q
19 G BQ
20CLRQ I $G(XMAPBLOB)>99 Q
21 G ERASE^MAGAPI
22 ;
23BLIST() ;List BLOBS in the message
24 I $G(IOT)="IMPC",$G(XMAPBLOB)>99 Q ""
25 N X,Y,DIR,DIRUT,DUOUT
26 I '$G(XMAPBLOB("D")),$Y>(IOSL-4) K DIR S DIR(0)="E" D ^DIR:$G(XMAPBLOB)<100 K DIR,DIRUT
27 I '$G(XMAPBLOB("D")) W !,"============================================================="
28 I W !!,"There are non-textual parts (BLOBs) included on this message"
29 S XMAPBLOB("D")=1 W !!,"Object Name",?70,"Filename"
30 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)
31A I $G(XMAPBLOB)>99 Q ""
32 W !!,"Pick a BLOB you wish to display from the above list (1-"_XMB0_"): NONE// " R X:DTIME
33 S X=$TR(X,"none","NONE") I $E("NONE",1,$L(X))=X!("^"[X) Q ""
34 I +X'=X W !!,"Choose the index number of the BLOB you wish to display or accept the default.",! G A
35 I '$D(XMA0(X)) W !!,"Please choose a listed item by typing in its index number." G A
36 Q +XMA0(X)
37 ;Ask if user wants to display single BLOB
38ASK() I $G(XMAPBLOB)>99 Q 2
39 N DIR,DIRUT,DUOUT
40 S DIR(0)="Y",DIR("A")="Execute Other Message Part ("_$P(XMA0(1),U,2)_") Attached ",DIR("B")="NO"
41 D ^DIR K DIRUT I 'Y!$D(DIRUT) Q ""
42 Q 1
43NODISP ;If not proper terminal
44 Q:$G(XMAPBLOB("D")) S XMAPBLOB("D")=1 Q:'$D(^XMB(3.9,XMZ,2005))
45 W !!,"================================================================="
46 W !,"There are non-textual body parts (BLOBs) attached to this"
47 W !,"message. You may not execute them (display...) because you"
48 W !,"are not using the proper terminal."
49 W !!,"Query the message to see the list of BLOBs attached."
50 W !,"================================================================="
51 Q
52PRT ;Print BLOB list
53 N MAGOBJ,MAGFILE,MAGFILE1,MAGROU,X,XMAPBLOB S XMAPBLOB=100
54 D BLOB Q
55PRTQ S X=$$BLIST() Q
Note: See TracBrowser for help on using the repository browser.