- XMJMD ;ISC-SF/GMB-Later Messages ;12/04/2002 13:46
- ;;8.0;MailMan;**10**;Jun 28, 2002
- ; Replaces ^XMB1 (ISC-WASH/THM/CAP)
- ; Entry points are:
- ; EDIT Change/Delete Later'd messages for a particular user
- ; REPORT Report on Later'd messages for a particular user
- ; LATER Add/Edit Later'd Dates for a particular user/message
- ; LTRADD Add Later'd delivery date for a particular user/message
- ; DELUSER Delete all Later'd messages for a particular user
- ; DELMSG Delete all Later'd dates for a particular message
- ;
- ; Entry points used by MailMan options (not covered by DBIA):
- ; EDIT XMLATER-EDIT
- ; REPORT XMLATER-REPORT
- REPORT ; Report on later'd messages
- N ZTSAVE,ZTDESC,ZTRTN,I
- D CHECK^XMVVITAE
- S ZTDESC=$$EZBLD^DIALOG(34639) ; MailMan: Report on Later'd Messages
- S ZTRTN="RPTLATER^XMJMD"
- F I="XMDUZ","XMV(""NAME"")" S ZTSAVE(I)=""
- D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
- Q
- RPTLATER ;
- ; XMDUZ,XMV("NAME") are provided
- N XMZ,XMABORT,XMWHEN,XMIEN,XMREC,XMZREC,XMPAGE,XMLEN,XMK,XMKN
- S XMLEN("DATE")=$L($$FMTE^XLFDT($E($$NOW^XLFDT,1,12),"5Z"))
- S XMLEN("XMZ")=$L($O(^XMB(3.9,":"),-1))
- S:XMLEN("XMZ")<7 XMLEN("XMZ")=7
- S XMLEN("BSKT")=10
- S XMLEN("SUBJ")=79-XMLEN("DATE")-XMLEN("XMZ")-XMLEN("BSKT")-6
- S (XMPAGE,XMABORT)=0
- W:$E(IOST,1,2)="C-" @IOF
- D RPTHDR(.XMLEN,.XMPAGE)
- S XMIEN=""
- F S XMIEN=$O(^XMB(3.73,"C",XMDUZ,XMIEN)) Q:XMIEN="" D Q:XMABORT
- . S XMREC=$G(^XMB(3.73,XMIEN,0)) I XMREC="" K ^XMB(3.73,"C",XMDUZ,XMIEN) Q
- . S XMZ=+$P(XMREC,U,3)
- . S XMZREC=$G(^XMB(3.9,XMZ,0)) I XMZREC="" D DELDATE(XMIEN) Q
- . S XMWHEN=$P(XMREC,U,1)
- . S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
- . S XMKN=$S('XMK:$$EZBLD^DIALOG(34014),1:$P($G(^XMB(3.7,XMDUZ,2,XMK,0)),U)) ; * N/A *
- . I $Y+3>IOSL D Q:XMABORT
- . . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
- . . W @IOF D RPTHDR(.XMLEN,.XMPAGE)
- . W !,$$LJ^XLFSTR($$FMTE^XLFDT($E(XMWHEN,1,12),"5Z"),XMLEN("DATE"))," ",$$LJ^XLFSTR($E(XMKN,1,XMLEN("BSKT")),XMLEN("BSKT"))," ",$J(XMZ,XMLEN("XMZ"))," ",$E($$SUBJ^XMXUTIL2(XMZREC),1,XMLEN("SUBJ"))
- W:$O(^XMB(3.73,"C",XMDUZ,""))="" !,$$EZBLD^DIALOG(34630) ; No Later'd Messages
- I $E(IOST,1,2)="C-",'XMABORT D WAIT^XMXUTIL
- I $D(ZTQUEUED) S ZTREQ="@"
- Q
- RPTHDR(XMLEN,XMPAGE) ;
- S XMPAGE=XMPAGE+1
- W $$EZBLD^DIALOG(34631,XMV("NAME")),?70,$$EZBLD^DIALOG(34542,XMPAGE) ; Later'd Messages Report for: / Page
- W !,$$LJ^XLFSTR($$EZBLD^DIALOG(34632),XMLEN("DATE"))," ",$$LJ^XLFSTR($$EZBLD^DIALOG(34011),XMLEN("BSKT"))," ",$$RJ^XLFSTR($$EZBLD^DIALOG(34633),XMLEN("XMZ"))," ",$$EZBLD^DIALOG(34002) ; Date / Basket / Msg ID / Subject
- W !,$$REPEAT^XLFSTR("-",79)
- Q
- DELUSER(XMDUZ) ; Delete all Later'd messages for a particular user
- N XMIEN
- S XMIEN=""
- F S XMIEN=$O(^XMB(3.73,"C",XMDUZ,XMIEN)) Q:XMIEN="" D DELDATE(XMIEN)
- Q
- DELDATE(XMIEN) ; Delete a particular Later'd message date
- N DIK
- S DIK="^XMB(3.73,",DA=XMIEN
- D ^DIK
- Q
- DELMSG(XMZ) ; Delete all Later'd dates for a particular message
- N XMDUZ,XMIEN
- S (XMDUZ,XMIEN)=""
- F S XMDUZ=$O(^XMB(3.73,"AC",XMZ,XMDUZ)) Q:XMDUZ="" D
- . F S XMIEN=$O(^XMB(3.73,"AC",XMZ,XMDUZ,XMIEN)) Q:XMIEN="" D DELDATE(XMIEN)
- Q
- LATER(XMDUZ,XMZ) ; For a particular message,
- ; let user edit any existing latered times or add a new one.
- N XMABORT,XMWHEN
- S XMABORT=0
- I $D(^XMB(3.73,"AC",XMZ,XMDUZ)) D
- . W @IOF
- . D LATER^XMJMQ1(XMDUZ,XMZ,"","","","",.XMABORT)
- . S XMABORT=0
- . N DIR,XMIEN,XMADD,XMCHG,XMDEL
- . S XMIEN=$O(^XMB(3.73,"AC",XMZ,XMDUZ,0))
- . I $O(^XMB(3.73,"AC",XMZ,XMDUZ,XMIEN)) S XMIEN=0
- . S XMADD=$$EZBLD^DIALOG(34634) ; A:Add another date on which this message should appear new
- . S XMCHG=$$EZBLD^DIALOG($S(XMIEN:34635,1:34635.1)) ; C:Change this / a date
- . S XMDEL=$$EZBLD^DIALOG($S(XMIEN:34636,1:34636.1)) ; D:Delete this / a date
- . S DIR(0)="SO^"_XMADD_";"_XMCHG_";"_XMDEL
- . D ^DIR I $D(DIRUT) S XMABORT=1 Q
- . I Y=$P(XMADD,":",1) D Q
- . . D LTRDATE(.XMWHEN,.XMABORT) Q:XMABORT
- . . D LTRADD(XMDUZ,XMZ,XMWHEN)
- . I 'XMIEN D WHICH(XMDUZ,XMZ,.XMIEN,.XMABORT) Q:XMABORT
- . I Y=$P(XMCHG,":",1) D CHGDATE(XMIEN) Q
- . D DELDATE(XMIEN) ; Delete this date
- . W $$EZBLD^DIALOG(34637) ; " ... deleted."
- E D
- . D LTRDATE(.XMWHEN,.XMABORT) Q:XMABORT
- . D LTRADD(XMDUZ,XMZ,XMWHEN)
- Q
- EDIT ; Change/delete later'd messages
- I '$D(^XMB(3.73,"C",XMDUZ)) W !!,$C(7),$$EZBLD^DIALOG(34638) Q ; You have no Later'd messages.
- D LTREDIT($G(XMDUZ,DUZ))
- Q
- LTREDIT(XMDUZ,XMZ) ;
- N X,Y,XMIEN,XMDEL,DIR,DIE,DR,DA,DIRUT,XMABORT
- S XMABORT=0
- D WHICH(XMDUZ,.XMZ,.XMIEN,.XMABORT) Q:XMABORT
- ; The user has chosen a record to edit (and change the later'd date)
- S XMDEL=$$EZBLD^DIALOG(34636) ; D:Delete this date
- S DIR(0)="S^"_$$EZBLD^DIALOG(34635)_";"_XMDEL ; C:Change this date
- D ^DIR Q:$D(DIRUT)
- I Y=$P(XMDEL,":",1) D Q
- . D DELDATE(XMIEN) ; Delete this date
- . W $$EZBLD^DIALOG(34637) ; " ... deleted."
- K DIR,X,Y,DIRUT
- D CHGDATE(XMIEN) ; Change this date
- Q
- WHICH(XMDUZ,XMZ,XMIEN,XMABORT) ;
- N DIC,D,X,Y
- W !
- S DIC="^XMB(3.73,"
- S DIC(0)="NEU"
- S D="C"
- I $D(XMZ) S DIC("S")="I $D(^XMB(3.73,""AC"","_XMZ_","_$G(XMDUZ,DUZ)_",Y))"
- E S DIC("S")="I $D(^XMB(3.73,""C"","_$G(XMDUZ,DUZ)_",Y))"
- S X=$G(XMDUZ,DUZ)
- D IX^DIC I Y=-1 S XMABORT=1 Q
- S XMIEN=+Y
- Q
- CHGDATE(DA) ; Change a date
- N DIE,DR,DIDEL
- S DIDEL=3.73
- S DIE=3.73
- S DR=.01
- D ^DIE
- Q
- LTRDATE(Y,XMABORT) ;
- N DIR
- S DIR(0)="3.73,.01"
- S DIR("B")="T+1"
- D ^DIR I $D(DIRUT) S XMABORT=1 Q
- Q
- LTRADD(XMDUZ,XMZ,XMWHEN) ;
- N XMFDA
- Q:$D(^XMB(3.73,"AB",XMWHEN,XMDUZ,XMZ)) ; Already scheduled?
- S XMFDA(3.73,"+1,",.01)=XMWHEN
- ;S XMFDA(3.73,"+1,",1)=XMDUZ Not needed, because done by trigger
- S XMFDA(3.73,"+1,",2)=XMZ
- D UPDATE^DIE("","XMFDA")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMD 5727 printed Feb 18, 2025@23:38:06 Page 2
- XMJMD ;ISC-SF/GMB-Later Messages ;12/04/2002 13:46
- +1 ;;8.0;MailMan;**10**;Jun 28, 2002
- +2 ; Replaces ^XMB1 (ISC-WASH/THM/CAP)
- +3 ; Entry points are:
- +4 ; EDIT Change/Delete Later'd messages for a particular user
- +5 ; REPORT Report on Later'd messages for a particular user
- +6 ; LATER Add/Edit Later'd Dates for a particular user/message
- +7 ; LTRADD Add Later'd delivery date for a particular user/message
- +8 ; DELUSER Delete all Later'd messages for a particular user
- +9 ; DELMSG Delete all Later'd dates for a particular message
- +10 ;
- +11 ; Entry points used by MailMan options (not covered by DBIA):
- +12 ; EDIT XMLATER-EDIT
- +13 ; REPORT XMLATER-REPORT
- REPORT ; Report on later'd messages
- +1 NEW ZTSAVE,ZTDESC,ZTRTN,I
- +2 DO CHECK^XMVVITAE
- +3 ; MailMan: Report on Later'd Messages
- SET ZTDESC=$$EZBLD^DIALOG(34639)
- +4 SET ZTRTN="RPTLATER^XMJMD"
- +5 FOR I="XMDUZ","XMV(""NAME"")"
- SET ZTSAVE(I)=""
- +6 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
- +7 QUIT
- RPTLATER ;
- +1 ; XMDUZ,XMV("NAME") are provided
- +2 NEW XMZ,XMABORT,XMWHEN,XMIEN,XMREC,XMZREC,XMPAGE,XMLEN,XMK,XMKN
- +3 SET XMLEN("DATE")=$LENGTH($$FMTE^XLFDT($EXTRACT($$NOW^XLFDT,1,12),"5Z"))
- +4 SET XMLEN("XMZ")=$LENGTH($ORDER(^XMB(3.9,":"),-1))
- +5 if XMLEN("XMZ")<7
- SET XMLEN("XMZ")=7
- +6 SET XMLEN("BSKT")=10
- +7 SET XMLEN("SUBJ")=79-XMLEN("DATE")-XMLEN("XMZ")-XMLEN("BSKT")-6
- +8 SET (XMPAGE,XMABORT)=0
- +9 if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- +10 DO RPTHDR(.XMLEN,.XMPAGE)
- +11 SET XMIEN=""
- +12 FOR
- SET XMIEN=$ORDER(^XMB(3.73,"C",XMDUZ,XMIEN))
- if XMIEN=""
- QUIT
- Begin DoDot:1
- +13 SET XMREC=$GET(^XMB(3.73,XMIEN,0))
- IF XMREC=""
- KILL ^XMB(3.73,"C",XMDUZ,XMIEN)
- QUIT
- +14 SET XMZ=+$PIECE(XMREC,U,3)
- +15 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- IF XMZREC=""
- DO DELDATE(XMIEN)
- QUIT
- +16 SET XMWHEN=$PIECE(XMREC,U,1)
- +17 SET XMK=$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,""))
- +18 ; * N/A *
- SET XMKN=$SELECT('XMK:$$EZBLD^DIALOG(34014),1:$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,0)),U))
- +19 IF $Y+3>IOSL
- Begin DoDot:2
- +20 IF $EXTRACT(IOST,1,2)="C-"
- DO PAGE^XMXUTIL(.XMABORT)
- if XMABORT
- QUIT
- +21 WRITE @IOF
- DO RPTHDR(.XMLEN,.XMPAGE)
- End DoDot:2
- if XMABORT
- QUIT
- +22 WRITE !,$$LJ^XLFSTR($$FMTE^XLFDT($EXTRACT(XMWHEN,1,12),"5Z"),XMLEN("DATE"))," ",$$LJ^XLFSTR($EXTRACT(XMKN,1,XMLEN("BSKT")),XMLEN("BSKT"))," ",$JUSTIFY(XMZ,XMLEN("XMZ"))," ",$EXTRACT($$SUBJ^XMXUTIL2(XMZREC),1,XMLEN("SUBJ"))
- End DoDot:1
- if XMABORT
- QUIT
- +23 ; No Later'd Messages
- if $ORDER(^XMB(3.73,"C",XMDUZ,""))=""
- WRITE !,$$EZBLD^DIALOG(34630)
- +24 IF $EXTRACT(IOST,1,2)="C-"
- IF 'XMABORT
- DO WAIT^XMXUTIL
- +25 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +26 QUIT
- RPTHDR(XMLEN,XMPAGE) ;
- +1 SET XMPAGE=XMPAGE+1
- +2 ; Later'd Messages Report for: / Page
- WRITE $$EZBLD^DIALOG(34631,XMV("NAME")),?70,$$EZBLD^DIALOG(34542,XMPAGE)
- +3 ; Date / Basket / Msg ID / Subject
- WRITE !,$$LJ^XLFSTR($$EZBLD^DIALOG(34632),XMLEN("DATE"))," ",$$LJ^XLFSTR($$EZBLD^DIALOG(34011),XMLEN("BSKT"))," ",$$RJ^XLFSTR($$EZBLD^DIALOG(34633),XMLEN("XMZ"))," ",$$EZBLD^DIALOG(34002)
- +4 WRITE !,$$REPEAT^XLFSTR("-",79)
- +5 QUIT
- DELUSER(XMDUZ) ; Delete all Later'd messages for a particular user
- +1 NEW XMIEN
- +2 SET XMIEN=""
- +3 FOR
- SET XMIEN=$ORDER(^XMB(3.73,"C",XMDUZ,XMIEN))
- if XMIEN=""
- QUIT
- DO DELDATE(XMIEN)
- +4 QUIT
- DELDATE(XMIEN) ; Delete a particular Later'd message date
- +1 NEW DIK
- +2 SET DIK="^XMB(3.73,"
- SET DA=XMIEN
- +3 DO ^DIK
- +4 QUIT
- DELMSG(XMZ) ; Delete all Later'd dates for a particular message
- +1 NEW XMDUZ,XMIEN
- +2 SET (XMDUZ,XMIEN)=""
- +3 FOR
- SET XMDUZ=$ORDER(^XMB(3.73,"AC",XMZ,XMDUZ))
- if XMDUZ=""
- QUIT
- Begin DoDot:1
- +4 FOR
- SET XMIEN=$ORDER(^XMB(3.73,"AC",XMZ,XMDUZ,XMIEN))
- if XMIEN=""
- QUIT
- DO DELDATE(XMIEN)
- End DoDot:1
- +5 QUIT
- LATER(XMDUZ,XMZ) ; For a particular message,
- +1 ; let user edit any existing latered times or add a new one.
- +2 NEW XMABORT,XMWHEN
- +3 SET XMABORT=0
- +4 IF $DATA(^XMB(3.73,"AC",XMZ,XMDUZ))
- Begin DoDot:1
- +5 WRITE @IOF
- +6 DO LATER^XMJMQ1(XMDUZ,XMZ,"","","","",.XMABORT)
- +7 SET XMABORT=0
- +8 NEW DIR,XMIEN,XMADD,XMCHG,XMDEL
- +9 SET XMIEN=$ORDER(^XMB(3.73,"AC",XMZ,XMDUZ,0))
- +10 IF $ORDER(^XMB(3.73,"AC",XMZ,XMDUZ,XMIEN))
- SET XMIEN=0
- +11 ; A:Add another date on which this message should appear new
- SET XMADD=$$EZBLD^DIALOG(34634)
- +12 ; C:Change this / a date
- SET XMCHG=$$EZBLD^DIALOG($SELECT(XMIEN:34635,1:34635.1))
- +13 ; D:Delete this / a date
- SET XMDEL=$$EZBLD^DIALOG($SELECT(XMIEN:34636,1:34636.1))
- +14 SET DIR(0)="SO^"_XMADD_";"_XMCHG_";"_XMDEL
- +15 DO ^DIR
- IF $DATA(DIRUT)
- SET XMABORT=1
- QUIT
- +16 IF Y=$PIECE(XMADD,":",1)
- Begin DoDot:2
- +17 DO LTRDATE(.XMWHEN,.XMABORT)
- if XMABORT
- QUIT
- +18 DO LTRADD(XMDUZ,XMZ,XMWHEN)
- End DoDot:2
- QUIT
- +19 IF 'XMIEN
- DO WHICH(XMDUZ,XMZ,.XMIEN,.XMABORT)
- if XMABORT
- QUIT
- +20 IF Y=$PIECE(XMCHG,":",1)
- DO CHGDATE(XMIEN)
- QUIT
- +21 ; Delete this date
- DO DELDATE(XMIEN)
- +22 ; " ... deleted."
- WRITE $$EZBLD^DIALOG(34637)
- End DoDot:1
- +23 IF '$TEST
- Begin DoDot:1
- +24 DO LTRDATE(.XMWHEN,.XMABORT)
- if XMABORT
- QUIT
- +25 DO LTRADD(XMDUZ,XMZ,XMWHEN)
- End DoDot:1
- +26 QUIT
- EDIT ; Change/delete later'd messages
- +1 ; You have no Later'd messages.
- IF '$DATA(^XMB(3.73,"C",XMDUZ))
- WRITE !!,$CHAR(7),$$EZBLD^DIALOG(34638)
- QUIT
- +2 DO LTREDIT($GET(XMDUZ,DUZ))
- +3 QUIT
- LTREDIT(XMDUZ,XMZ) ;
- +1 NEW X,Y,XMIEN,XMDEL,DIR,DIE,DR,DA,DIRUT,XMABORT
- +2 SET XMABORT=0
- +3 DO WHICH(XMDUZ,.XMZ,.XMIEN,.XMABORT)
- if XMABORT
- QUIT
- +4 ; The user has chosen a record to edit (and change the later'd date)
- +5 ; D:Delete this date
- SET XMDEL=$$EZBLD^DIALOG(34636)
- +6 ; C:Change this date
- SET DIR(0)="S^"_$$EZBLD^DIALOG(34635)_";"_XMDEL
- +7 DO ^DIR
- if $DATA(DIRUT)
- QUIT
- +8 IF Y=$PIECE(XMDEL,":",1)
- Begin DoDot:1
- +9 ; Delete this date
- DO DELDATE(XMIEN)
- +10 ; " ... deleted."
- WRITE $$EZBLD^DIALOG(34637)
- End DoDot:1
- QUIT
- +11 KILL DIR,X,Y,DIRUT
- +12 ; Change this date
- DO CHGDATE(XMIEN)
- +13 QUIT
- WHICH(XMDUZ,XMZ,XMIEN,XMABORT) ;
- +1 NEW DIC,D,X,Y
- +2 WRITE !
- +3 SET DIC="^XMB(3.73,"
- +4 SET DIC(0)="NEU"
- +5 SET D="C"
- +6 IF $DATA(XMZ)
- SET DIC("S")="I $D(^XMB(3.73,""AC"","_XMZ_","_$GET(XMDUZ,DUZ)_",Y))"
- +7 IF '$TEST
- SET DIC("S")="I $D(^XMB(3.73,""C"","_$GET(XMDUZ,DUZ)_",Y))"
- +8 SET X=$GET(XMDUZ,DUZ)
- +9 DO IX^DIC
- IF Y=-1
- SET XMABORT=1
- QUIT
- +10 SET XMIEN=+Y
- +11 QUIT
- CHGDATE(DA) ; Change a date
- +1 NEW DIE,DR,DIDEL
- +2 SET DIDEL=3.73
- +3 SET DIE=3.73
- +4 SET DR=.01
- +5 DO ^DIE
- +6 QUIT
- LTRDATE(Y,XMABORT) ;
- +1 NEW DIR
- +2 SET DIR(0)="3.73,.01"
- +3 SET DIR("B")="T+1"
- +4 DO ^DIR
- IF $DATA(DIRUT)
- SET XMABORT=1
- QUIT
- +5 QUIT
- LTRADD(XMDUZ,XMZ,XMWHEN) ;
- +1 NEW XMFDA
- +2 ; Already scheduled?
- if $DATA(^XMB(3.73,"AB",XMWHEN,XMDUZ,XMZ))
- QUIT
- +3 SET XMFDA(3.73,"+1,",.01)=XMWHEN
- +4 ;S XMFDA(3.73,"+1,",1)=XMDUZ Not needed, because done by trigger
- +5 SET XMFDA(3.73,"+1,",2)=XMZ
- +6 DO UPDATE^DIE("","XMFDA")
- +7 QUIT