XMUT1A ;(WASH ISC)/CAP-Recover msgs for a user (cont.) ;04/17/2002 11:50
;;8.0;MailMan;;Jun 28, 2002
; Entry points used by MailMan options (not covered by DBIA):
; DEL XMUT-REC-DELETE
; LIST XMUT-REC-RPT
NOKL G FX:$D(^DOPT("XMUT1",1)) S DIK="^DOPT(""XMUT1"","
GO S ^DOPT("XMUT1",0)="Recover Messages Function^1N^"
F I=1:1 S X=$E($T(TABLE+I),4,99) Q:X="" S ^DOPT("XMUT1",I,0)=X
D IXALL^DIK
FX S DIC="^DOPT(""XMUT1"",",DIC(0)="AEQZ" D ^DIC K DIC Q:Y<0
S X=$P(Y(0),U,2,99) K DD,DO,Y D @X
D ^%ZISC
W ! K DIE,DIF G FX
TABLE ;;;DESCRIPTION^PROGRAM OR TAG^PROGRAM
;;FIND MESSAGES FOR USER^A^XMUT1
;;LIST MESSAGES IN USER'S BASKETS^M^XMUT1
;;LOAD MESSAGES INTO IN-BASKET^G^XMUT1
;;LIST MESSAGES FOUND^LIST^XMUT1A
;;DELETE LIST OF RECOVERED MESSAGES FROM THE UTILITY GLOBAL^DEL^XMUT1A
;;
LIST ;LIST MESSAGES FOUND
N J,C,F,I,X,XME0
S (J,C,F)="" W !!,"CHOOSE FROM:",!
F I=0:0 S I=$O(^TMP("XMUT1",I)) Q:'I I $D(^VA(200,I,0)) W !,$J(I,8)," ",$$NAME^XMXUTIL(I) I 'J S J=I
I 'J G NO
L W !!,"WHICH ONE: ",J,"//" R X:DTIME I X="" S X=J
Q:"^"[$E(X) I X="?" D H1 G L
I X="??" G LIST
I '$D(^TMP("XMUT1",X)) D H1 G LIST
S XME0=X,ZTSAVE("XME0")=""
D EN^XUTMDEVQ("ZTSK^XMUT1A","MailMan List Messages Found (XMUT-REC-RPT)",.ZTSAVE)
Q
ZTSK ;
D NOW^%DTC S Y=%,XMF0=^DD("DD") K %,%I,%H X XMF0
S XMC0=0,XMB0=0 S XMA0=$$NAME^XMXUTIL(XME0)_" - "_Y D H
N S XMC0=$O(^TMP("XMUT1",XME0,XMC0)) G NQ:'XMC0
S I=$G(^XMB(3.9,XMC0,0))
I I="" W !!,"Message removed from list - no longer in 3.9 file.",! K ^TMP("XMUT1",XME0,XMC0) G N
S XMD0=XMD0+1,Y=$P(I,"^",3) I Y?7N!(Y?7N1"."1N.N) X XMF0
W !?2,Y,?22,$P(I,"^")
G N:IOSL-6>XMD0 I $E(IOST,1,2)'="C-" D H G N
I '$D(ZTQUEUED) U IO(0) K DIR S DIR(0)="E" D ^DIR K DIR,DIRUT G NQ:X["^" U IO
D H G N
H S XMB0=XMB0+1,XMD0=5
W @IOF,!,"CONTENTS OF MAILBOXES FOR ",XMA0,?60,"PAGE: ",XMB0,!!
W " DATE@TIME",?22,"SUBJECT",!!
Q
NQ K XMA0,XMB0,XMD0,XMC0,XME0,XMF0
I $D(ZTQUEUED) W @IOF K ZTSK S ZTREQ="@" Q
D ^%ZISC
Q
;
DEL ;DELETE LIST FROM ^TMP("XMUT1"...
S (J,C,F)="" W !!,"CHOOSE FROM:",!
F I=0:0 S I=$O(^TMP("XMUT1",I)) Q:'I I $D(^VA(200,I,0)) W !,$J(I,8)," ",$$NAME^XMXUTIL(I) I 'J S J=I
I 'J G NO
D W !!,"WHICH ONE ",J,"//" R X:DTIME I X="" S X=J
Q:"^"[$E(X) I X="?" D H1 G D
I X="??" D H1 G DEL
I '$D(^TMP("XMUT1",X)) D H1 G DEL
S XME0=X,XMB0=$G(^VA(200,XME0,0))
I XMB0="" W !," NO SUCH USER !!!",$C(7) G DQ
S DIR(0)="Y",DIR("B")="NO",DIR("A")="DO YOU MEAN '"_$$NAME^XMXUTIL(XME0)_"' "
D ^DIR K DIR,DIRUT Q:"^"[X!("yY"'[X)
DQ K ^TMP("XMUT1",XME0) W " << DELETED !!!" K XME0 Q
H1 W !!,"Choose NUMBER from list. Or enter '??' for a list.",!,$C(7) Q
NO W !!!,"NO MESSAGES RECOVERED FOR ANYBODY !!!" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMUT1A 2742 printed Nov 22, 2024@17:23:36 Page 2
XMUT1A ;(WASH ISC)/CAP-Recover msgs for a user (cont.) ;04/17/2002 11:50
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Entry points used by MailMan options (not covered by DBIA):
+3 ; DEL XMUT-REC-DELETE
+4 ; LIST XMUT-REC-RPT
NOKL if $DATA(^DOPT("XMUT1",1))
GOTO FX
SET DIK="^DOPT(""XMUT1"","
GO SET ^DOPT("XMUT1",0)="Recover Messages Function^1N^"
+1 FOR I=1:1
SET X=$EXTRACT($TEXT(TABLE+I),4,99)
if X=""
QUIT
SET ^DOPT("XMUT1",I,0)=X
+2 DO IXALL^DIK
FX SET DIC="^DOPT(""XMUT1"","
SET DIC(0)="AEQZ"
DO ^DIC
KILL DIC
if Y<0
QUIT
+1 SET X=$PIECE(Y(0),U,2,99)
KILL DD,DO,Y
DO @X
+2 DO ^%ZISC
+3 WRITE !
KILL DIE,DIF
GOTO FX
TABLE ;;;DESCRIPTION^PROGRAM OR TAG^PROGRAM
+1 ;;FIND MESSAGES FOR USER^A^XMUT1
+2 ;;LIST MESSAGES IN USER'S BASKETS^M^XMUT1
+3 ;;LOAD MESSAGES INTO IN-BASKET^G^XMUT1
+4 ;;LIST MESSAGES FOUND^LIST^XMUT1A
+5 ;;DELETE LIST OF RECOVERED MESSAGES FROM THE UTILITY GLOBAL^DEL^XMUT1A
+6 ;;
LIST ;LIST MESSAGES FOUND
+1 NEW J,C,F,I,X,XME0
+2 SET (J,C,F)=""
WRITE !!,"CHOOSE FROM:",!
+3 FOR I=0:0
SET I=$ORDER(^TMP("XMUT1",I))
if 'I
QUIT
IF $DATA(^VA(200,I,0))
WRITE !,$JUSTIFY(I,8)," ",$$NAME^XMXUTIL(I)
IF 'J
SET J=I
+4 IF 'J
GOTO NO
L WRITE !!,"WHICH ONE: ",J,"//"
READ X:DTIME
IF X=""
SET X=J
+1 if "^"[$EXTRACT(X)
QUIT
IF X="?"
DO H1
GOTO L
+2 IF X="??"
GOTO LIST
+3 IF '$DATA(^TMP("XMUT1",X))
DO H1
GOTO LIST
+4 SET XME0=X
SET ZTSAVE("XME0")=""
+5 DO EN^XUTMDEVQ("ZTSK^XMUT1A","MailMan List Messages Found (XMUT-REC-RPT)",.ZTSAVE)
+6 QUIT
ZTSK ;
+1 DO NOW^%DTC
SET Y=%
SET XMF0=^DD("DD")
KILL %,%I,%H
XECUTE XMF0
+2 SET XMC0=0
SET XMB0=0
SET XMA0=$$NAME^XMXUTIL(XME0)_" - "_Y
DO H
N SET XMC0=$ORDER(^TMP("XMUT1",XME0,XMC0))
if 'XMC0
GOTO NQ
+1 SET I=$GET(^XMB(3.9,XMC0,0))
+2 IF I=""
WRITE !!,"Message removed from list - no longer in 3.9 file.",!
KILL ^TMP("XMUT1",XME0,XMC0)
GOTO N
+3 SET XMD0=XMD0+1
SET Y=$PIECE(I,"^",3)
IF Y?7N!(Y?7N1"."1N.N)
XECUTE XMF0
+4 WRITE !?2,Y,?22,$PIECE(I,"^")
+5 if IOSL-6>XMD0
GOTO N
IF $EXTRACT(IOST,1,2)'="C-"
DO H
GOTO N
+6 IF '$DATA(ZTQUEUED)
USE IO(0)
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR,DIRUT
if X["^"
GOTO NQ
USE IO
+7 DO H
GOTO N
H SET XMB0=XMB0+1
SET XMD0=5
+1 WRITE @IOF,!,"CONTENTS OF MAILBOXES FOR ",XMA0,?60,"PAGE: ",XMB0,!!
+2 WRITE " DATE@TIME",?22,"SUBJECT",!!
+3 QUIT
NQ KILL XMA0,XMB0,XMD0,XMC0,XME0,XMF0
+1 IF $DATA(ZTQUEUED)
WRITE @IOF
KILL ZTSK
SET ZTREQ="@"
QUIT
+2 DO ^%ZISC
+3 QUIT
+4 ;
DEL ;DELETE LIST FROM ^TMP("XMUT1"...
+1 SET (J,C,F)=""
WRITE !!,"CHOOSE FROM:",!
+2 FOR I=0:0
SET I=$ORDER(^TMP("XMUT1",I))
if 'I
QUIT
IF $DATA(^VA(200,I,0))
WRITE !,$JUSTIFY(I,8)," ",$$NAME^XMXUTIL(I)
IF 'J
SET J=I
+3 IF 'J
GOTO NO
D WRITE !!,"WHICH ONE ",J,"//"
READ X:DTIME
IF X=""
SET X=J
+1 if "^"[$EXTRACT(X)
QUIT
IF X="?"
DO H1
GOTO D
+2 IF X="??"
DO H1
GOTO DEL
+3 IF '$DATA(^TMP("XMUT1",X))
DO H1
GOTO DEL
+4 SET XME0=X
SET XMB0=$GET(^VA(200,XME0,0))
+5 IF XMB0=""
WRITE !," NO SUCH USER !!!",$CHAR(7)
GOTO DQ
+6 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="DO YOU MEAN '"_$$NAME^XMXUTIL(XME0)_"' "
+7 DO ^DIR
KILL DIR,DIRUT
if "^"[X!("yY"'[X)
QUIT
DQ KILL ^TMP("XMUT1",XME0)
WRITE " << DELETED !!!"
KILL XME0
QUIT
H1 WRITE !!,"Choose NUMBER from list. Or enter '??' for a list.",!,$CHAR(7)
QUIT
NO WRITE !!!,"NO MESSAGES RECOVERED FOR ANYBODY !!!"
QUIT
