- 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 Feb 18, 2025@23:39:40 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