- 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 Feb 18, 2025@23:37:13 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