Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMA32A

XMA32A.m

Go to the documentation of this file. 
  1. XMA32A ;ISC-SF/GMB-Purge Messages by Date (cont.) ;12/04/2002  13:42
  1.  ;;8.0;MailMan;**10**;Jun 28, 2002
  1.  ; Was (WASH ISC)/CAP
  1.  ;
  1.  ; XMPARM("PDATE") Purge all messages older than this date
  1.  ; XMCNT           Total messages processed
  1.  ; XMKILL("START") Messages in ^XMB(3.9 before purge started
  1.  ; XMKILL("MSG")   Messages purged
  1.  ; XMKILL("RESP")  Responses killed
  1.  ; XMDUZ           Pointer to mailbox
  1.  ; XMZ             Current message being processed
  1. ENT ;
  1.  N XMCRE8,XMIEN,XMCNT,XMKILL,XMHDR,XMABORT
  1.  D INIT(.XMIEN,.XMPARM,.XMKILL,.XMHDR,.XMABORT)
  1.  D PROCESS(XMIEN,.XMCRE8,.XMPARM,.XMKILL,.XMCNT,.XMHDR,.XMABORT)
  1.  D FINISH(XMIEN,XMCRE8,.XMPARM,.XMKILL,XMCNT,.XMHDR,.XMABORT)
  1.  Q
  1. INIT(XMIEN,XMPARM,XMKILL,XMHDR,XMABORT) ;
  1.  I IO'=IO(0) U IO
  1.  S (XMHDR("PAGE"),XMKILL("MSG"),XMKILL("RESP"),XMABORT)=0
  1.  S XMKILL("START")=$P(^XMB(3.9,0),U,4)
  1.  D INITAUDT(.XMIEN,.XMPARM,.XMHDR)
  1.  S XMHDR("PDATE")=$$FMTE^XLFDT(XMPARM("PDATE"),5)
  1.  S XMHDR("NOW")=$$FMTE^XLFDT(XMHDR("NOW"),5)
  1.  Q:IO=""
  1.  W:$E(IOST,1,2)="C-" @IOF D PRTHDR(.XMPARM,.XMHDR)
  1.  Q
  1. INITAUDT(XMIEN,XMPARM,XMHDR) ;
  1.  N XMFDA
  1.  S XMHDR("NOW")=$$NOW^XLFDT
  1.  S XMFDA(4.302,"+1,1,",.01)=XMHDR("NOW")
  1.  S:$D(XMPARM("START")) XMFDA(4.302,"+1,1,",3)=XMPARM("START")
  1.  S:$D(XMPARM("END")) XMFDA(4.302,"+1,1,",4)=XMPARM("END")
  1.  S XMFDA(4.302,"+1,1,",5)=$S(XMPARM("TYPE")=2:"1TEST",1:XMPARM("TYPE"))
  1.  S XMFDA(4.302,"+1,1,",6)=XMPARM("PDATE")
  1.  D UPDATE^DIE("","XMFDA","XMIEN")
  1.  S XMIEN=XMIEN(1)
  1.  Q
  1. PROCESS(XMIEN,XMCRE8,XMPARM,XMKILL,XMCNT,XMHDR,XMABORT) ;
  1.  N XMZ,XMZREC
  1.  S (XMCRE8,XMZ)="",XMCNT=0
  1.  F  S XMCRE8=$O(^XMB(3.9,"C",XMCRE8)) Q:'XMCRE8  Q:XMCRE8'<XMPARM("PDATE")  D  Q:XMABORT
  1.  . F  S XMZ=$O(^XMB(3.9,"C",XMCRE8,XMZ)) Q:'XMZ  D  Q:XMABORT
  1.  . . S XMCNT=XMCNT+1 I XMCNT#5000=0 D CHK(XMIEN,XMCRE8,.XMPARM,.XMKILL,XMCNT,.XMHDR,.XMABORT)
  1.  . . I '$D(^XMB(3.9,XMZ)) K ^XMB(3.9,"C",XMCRE8,XMZ) Q
  1.  . . S XMZREC=$G(^XMB(3.9,XMZ,0))
  1.  . . Q:$P(XMZREC,U,8)  ; Don't kill responses (they'll be purged when their original msg is)
  1.  . . I "^^^^^^^^"[XMZREC D KILL(XMZ,.XMKILL,.XMABORT,.XMPARM,.XMHDR) Q
  1.  . . Q:$D(^XMB(3.7,"M",XMZ,.6))  ; Do nothing if owned by SHARED,MAIL
  1.  . . Q:$O(^XMB(3.7,"M",XMZ,.5,999))  ; Do nothing if in Transmit queues or Server basket.
  1.  . . D KILL(XMZ,.XMKILL,.XMABORT,.XMPARM,.XMHDR)
  1.  . . ; Old msg; old response without original msg;
  1.  . . ; Old msg which thinks it's also a response;
  1.  . . ; Old response which thinks it's also the original msg.
  1.  Q
  1. KILL(XMZ,XMKILL,XMABORT,XMPARM,XMHDR) ;
  1.  I $G(XMPARM("TEST")) D  Q:XMABORT
  1.  . D HDR(2,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
  1.  . W !,XMZ,?20,$$EZBLD^DIALOG(36416),$$FMTE^XLFDT(XMCRE8,5) ; " <<< Purge!  Date = "
  1.  D KBASKETS(XMZ,.XMKILL,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
  1.  D KMSG(XMZ,.XMKILL,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
  1.  D KLATER(XMZ,.XMPARM)
  1.  Q
  1. KBASKETS(XMZ,XMKILL,XMPARM,XMHDR,XMABORT) ;
  1.  N XMDUZ,XMK
  1.  S XMDUZ="",XMKILL("MSG")=XMKILL("MSG")+1
  1.  F  S XMDUZ=$O(^XMB(3.7,"M",XMZ,XMDUZ)) Q:XMDUZ=""!XMABORT  D
  1.  . S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,0))
  1.  . Q:'XMK
  1.  . Q:'$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ))
  1.  . I $G(XMPARM("TEST")) D  Q
  1.  . . D HDR(2,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
  1.  . . W !?25,$$EZBLD^DIALOG(36417),?50,$J(XMDUZ,12),?79 ; Message deleted for DUZ:
  1.  . D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) ; Delete from user's basket
  1.  Q
  1. KMSG(XMZ,XMKILL,XMPARM,XMHDR,XMABORT) ;
  1.  N XMZR,XMIEN,X
  1.  S XMIEN=0
  1.  F  S XMIEN=$O(^XMB(3.9,XMZ,3,XMIEN)) Q:XMIEN'>0!XMABORT  D
  1.  . S XMZR=$P($G(^XMB(3.9,XMZ,3,XMIEN,0)),U)
  1.  . S XMKILL("RESP")=XMKILL("RESP")+1
  1.  . I $G(XMPARM("TEST")) D  Q
  1.  . . D HDR(2,.XMPARM,.XMHDR,.XMABORT) Q:XMABORT
  1.  . . W !?25,$$EZBLD^DIALOG(36418),?50,$J(XMZR,20),?79 ; Response deleted:
  1.  . D KILLMSG^XMXUTIL(XMZR)  ; Kill response
  1.  D:'$G(XMPARM("TEST")) KILLMSG^XMXUTIL(XMZ)  ; Kill original message
  1.  Q
  1. KLATER(XMZ,XMPARM) ;
  1.  Q:$G(XMPARM("TEST"))
  1.  N DIK,DA,XMDUZ
  1.  S DIK="^XMB(3.73,"
  1.  S (XMDUZ,DA)=""
  1.  F  S XMDUZ=$O(^XMB(3.73,"AC",XMZ,XMDUZ)) Q:'XMDUZ  D
  1.  . F  S DA=$O(^XMB(3.73,"AC",XMZ,XMDUZ,DA)) Q:'DA  D ^DIK
  1.  Q
  1. HDR(XMLINES,XMPARM,XMHDR,XMABORT) ;
  1.  Q:$Y+XMLINES<IOSL
  1.  I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
  1.  W @IOF D PRTHDR(.XMPARM,.XMHDR)
  1.  Q
  1. PRTHDR(XMPARM,XMHDR) ;
  1.  S XMHDR("PAGE")=XMHDR("PAGE")+1
  1.  W $$EZBLD^DIALOG(36419),XMHDR("PDATE") ; Message purge, local create date < 
  1.  W ?70,$$EZBLD^DIALOG(34542,XMHDR("PAGE")) ; Page |1|
  1.  W !,$$EZBLD^DIALOG(36420),XMHDR("NOW") ; Started:
  1.  W:XMPARM("TEST") ?60,$$EZBLD^DIALOG(36421) ; *TEST RUN*
  1.  W !
  1.  Q
  1. FINISH(XMIEN,XMCRE8,XMPARM,XMKILL,XMCNT,XMHDR,XMABORT) ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  I XMABORT,IO'="" W @IOF D PRTHDR(.XMPARM,.XMHDR)
  1.  D CHK(XMIEN,XMCRE8,.XMPARM,.XMKILL,XMCNT,.XMHDR,.XMABORT)
  1.  Q:IO=""!'XMCNT
  1.  D HDR(5+(2*$G(ZTSTOP)),.XMPARM,.XMHDR,.XMABORT)
  1.  I $G(ZTSTOP) W !,$$EZBLD^DIALOG(36422) ; *** Stopping prematurely per user request ***
  1.  N XMVAR,XMTEXT
  1.  S XMVAR(1)=$$FMTE^XLFDT($$NOW^XLFDT,5),XMVAR(2)=XMCNT
  1.  S XMVAR(3)=XMKILL("MSG"),XMVAR(4)=XMKILL("RESP")
  1.  W !
  1.  D BLD^DIALOG(36423,.XMVAR,"","XMTEXT","F")
  1.  D MSG^DIALOG("WM","","","","XMTEXT")
  1.  ;Message purge finished on |1|.
  1.  ;|2| messages processed.
  1.  ;|3| original messages and |4| responses purged.
  1.  Q
  1. CHK(XMIEN,XMCRE8,XMPARM,XMKILL,XMCNT,XMHDR,XMABORT) ;
  1.  D CHKAUDT(XMIEN,XMCRE8,.XMKILL)
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 Q  ; User has asked the task to stop
  1.  Q:$E(IOST,1,2)'="C-"
  1.  I $X+$L(XMCNT)+1>IOM D
  1.  . D HDR(2,.XMPARM,.XMHDR,.XMABORT)
  1.  . W !
  1.  E  W " "
  1.  W XMCNT
  1.  Q
  1. CHKAUDT(XMIEN,XMCRE8,XMKILL) ;
  1.  N XMFDA
  1.  S XMFDA(4.302,XMIEN_",1,",1)=XMKILL("START")-XMKILL("MSG")-XMKILL("RESP")
  1.  S XMFDA(4.302,XMIEN_",1,",2)=XMKILL("MSG")+XMKILL("RESP")
  1.  S XMFDA(4.302,XMIEN_",1,",7)=$$NOW^XLFDT
  1.  S XMFDA(4.302,XMIEN_",1,",8)=XMCRE8
  1.  D FILE^DIE("","XMFDA")
  1.  Q