XMXGRP1 ;ISC-SF/GMB-Group creation/enrollment (cont.) ;04/17/2002 14:10
;;8.0;MailMan;;Jun 28, 2002
FAFMSGS(XMDUZ,XMGRP,XMTO,XMINSTR,ZTSK) ; Create task to find and forward messages
; The following line can be deleted once we enable "A":
S XMINSTR("FLAGS")=$TR($G(XMINSTR("FLAGS")),"A") Q:$G(XMINSTR("FLAGS"))'["F"
N ZTSAVE,ZTDESC,ZTRTN,ZTDTH,ZTIO,I
S ZTDESC=$$EZBLD^DIALOG(38023.8) ; MailMan: Find & Forward mail group messages
S ZTIO="",ZTDTH=$H,ZTRTN="FAFTSK^XMXGRP1"
F I="DUZ","XMDUZ","XMGRP*","XMTO*","XMINSTR(" S ZTSAVE(I)=""
D ^%ZTLOAD
Q
FAFTSK ; Find and add/forward messages
N XMFDATE,XMTDATE,XMGROUP,XMX,XMFIRST,XMABORT
S XMABORT=0
D INIT Q:XMABORT
D PROCESS
D CLEANUP^XMXADDR
K ^TMP("XM",$J,"SAVE")
Q
PROCESS ;
I XMINSTR("FLAGS")["A",XMINSTR("FLAGS")["F" D Q ; Forward some of the messages to the users, and add the users to the rest of the messages.
. D SAVFWD(.XMX)
. I XMFIRST<XMFDATE D
. . D CHKADD(.XMX) Q:'$D(^TMP("XMY",$J))
. . D ADDFWD(XMDUZ,.XMGROUP,"A",XMFIRST,XMFDATE-1,.XMX) ; add
. . M ^TMP("XMY",$J)=^TMP("XM",$J,"SAVE")
. D ADDFWD(XMDUZ,.XMGROUP,"F",XMFDATE,XMTDATE,.XMX) ; forward
. I XMTDATE<DT D
. . I XMX("RESTORE") M ^TMP("XMY",$J)=^TMP("XM",$J,"SAVE") S XMX("RESTORE")=0
. . D CHKADD(.XMX) Q:'$D(^TMP("XMY",$J))
. . D ADDFWD(XMDUZ,.XMGROUP,"A",XMTDATE+.1,DT,.XMX) ; add
I XMINSTR("FLAGS")["F" D Q ; Just forward messages to users
. D SAVFWD(.XMX)
. D ADDFWD(XMDUZ,.XMGROUP,"F",XMFDATE,XMTDATE,.XMX) ; forward
I XMINSTR("FLAGS")["A" D Q ; Just add users to messages
. D CHKADD(.XMX) Q:'$D(^TMP("XMY",$J))
. D ADDFWD(XMDUZ,.XMGROUP,"A",XMFDATE,XMTDATE,.XMX) ; add
Q
INIT ;
N XMPRIVAT,XMGN,XMI
S ZTREQ="@"
S XMPRIVAT=$$EZBLD^DIALOG(39135) ; " [Private Mail Group]"
S XMFIRST=$O(^XMB(3.9,"C",2500000)) ; earliest message date (after 1950!)
S XMFDATE=$G(XMINSTR("FDATE"),XMFIRST)
S XMTDATE=$G(XMINSTR("TDATE"),DT)
D INITAPI^XMVVITAE
D INIT^XMXADDR
D CHKADDR^XMXADDR(XMDUZ,.XMTO)
I '$$GOTADDR^XMXADDR S XMABORT=1 Q
I $G(XMGRP)]"" S XMGRP(XMGRP)=$O(^XMB(3.8,"B",XMGRP,0))
S XMGN=""
F S XMGN=$O(XMGRP(XMGN)) Q:XMGN="" D
. S XMI=XMGRP(XMGN)
. S XMGROUP("G."_XMGN_$S($P($G(^XMB(3.8,XMI,0)),U,2)="PR":XMPRIVAT,1:""))=XMI
K XMGRP
I $D(XMINSTR("SELF BSKT")) S XMX("SELF BSKT")=XMINSTR("SELF BSKT")
Q
SAVFWD(XMX) ;
S XMX("RESTORE")=0
M ^TMP("XM",$J,"SAVE")=^TMP("XMY",$J)
S XMX("ONE")=$O(^TMP("XMY",$J,"")) ; First recipient. Is it the only one?
I $O(^TMP("XMY",$J,XMX("ONE")))'="" S XMX("ONE")=0 ; There's more than one recipient
Q
CHKADD(XMX) ;
S XMX("FWDBY")=XMV("NAME")_$S(XMDUZ=DUZ:"",1:$$EZBLD^DIALOG(38008,XMV("DUZ NAME")))_" "_$$MMDT^XMXUTIL1($$NOW^XLFDT) ; " (Surrogate: _x_)"
S XMI=0 ; Delete any remote addresses - responses won't be forwarded.
F S XMI=$O(^TMP("XMY",$J,XMI)) Q:XMI="" K:+XMI'=XMI ^(XMI)
Q
ADDFWD(XMDUZ,XMGROUP,XMWHAT,XMFDATE,XMTDATE,XMX) ;
N XMZ,XMCRE8,XMGN
S XMZ=0
S XMCRE8=XMFDATE-.1
F S XMCRE8=$O(^XMB(3.9,"C",XMCRE8)) Q:'XMCRE8 Q:XMCRE8>XMTDATE D Q:$G(ZTSTOP)
. I $$S^%ZTLOAD S ZTSTOP=1 Q
. F S XMZ=$O(^XMB(3.9,"C",XMCRE8,XMZ)) Q:'XMZ D
. . Q:$$ZCLOSED^XMXSEC(XMZ) ; Message is closed
. . S XMGN=""
. . F S XMGN=$O(XMGROUP(XMGN)) Q:XMGN="" Q:$S($L(XMGN)<31:$D(^XMB(3.9,XMZ,6,"B",XMGN)),$D(^XMB(3.9,XMZ,6,"B",$E(XMGN,1,30))):(XMGN=$P($G(^XMB(3.9,XMZ,6,+$O(^XMB(3.9,XMZ,6,"B",$E(XMGN,1,30),0)),0)),U,1)),1:0)
. . Q:XMGN="" ; Message is not addressed to any of the groups
. . I XMWHAT="F" D FWD(XMDUZ,XMZ,.XMX) Q
. . D ADD(XMDUZ,XMZ,.XMX)
Q
FWD(XMDUZ,XMZ,XMX) ; Forward the message to the user
N XMINSTR
I $D(XMX("SELF BSKT")) S XMINSTR("SELF BSKT")=XMX("SELF BSKT")
I XMX("ONE")'=0 Q:$D(^XMB(3.9,XMZ,1,"C",XMX("ONE"))) ; User already on msg.
I XMX("ONE")=0 D Q:'$D(^TMP("XMY",$J))
. I XMX("RESTORE") M ^TMP("XMY",$J)=^TMP("XM",$J,"SAVE") S XMX("RESTORE")=0
. N XMI
. S XMI=""
. F S XMI=$O(^TMP("XMY",$J,XMI)) Q:XMI="" D
. . Q:'$D(^XMB(3.9,XMZ,1,"C",XMI)) ; User not yet on msg.
. . K ^TMP("XMY",$J,XMI) ; User on msg - don't forward to user.
. . S XMX("RESTORE")=1
D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
Q
ADD(XMDUZ,XMZ,XMX) ; Add user(s) to message.
; XMX("FWDBY")
N XMI,XMFDA,XMIENS,XMPRI
S XMPRI=$$ZPRI^XMXUTIL2(XMZ) ; Is msg priority?
; Put users into RECIPIENT multiple
S XMI=0
F S XMI=$O(^TMP("XMY",$J,XMI)) Q:'XMI D
. Q:$D(^XMB(3.9,XMZ,1,"C",XMI)) ; User already on msg - don't add.
. D NEW^XMKP(XMZ,XMPRI,XMI,$G(^TMP("XMY",$J,XMI,1)),.XMFDA,.XMIENS) ; New recipient
. S XMFDA(3.91,XMIENS,8)=XMX("FWDBY") ; fwd by name date time
. S XMFDA(3.91,XMIENS,8.01)=XMDUZ ; fwd by duz
. ; Need new field that says 'parked until next reply'.
. D UPDATE^DIE("","XMFDA")
Q
NOTIFY(XMG,XMNEWMBR) ; If the group is restricted in any way,
; notify the organizer & coordinator of the new members.
N XMREC,XMTO,I
S XMREC=^XMB(3.8,XMG,0)
I $P(XMREC,U,2)="PU",$P(XMREC,U,3)="y" Q
S I=$P($G(^XMB(3.8,XMG,3)),U) S:I XMTO(I)="" ; organizer
S I=$P(XMREC,U,7) S:I XMTO(I)="" ; coordinator
Q:$D(XMTO(DUZ))
N XMPARM,XMTEXT,XMINSTR,XMNAME,J
S I=0 F S I=$O(XMNEWMBR(I)) Q:'I S XMNAME($$NAME^XMXUTIL(I,1))=""
S J="" F I=1:1 S J=$O(XMNAME(J)) Q:J="" S XMTEXT(I)=J
S XMINSTR("FROM")=.5
S XMPARM(1)=$$NAME^XMXUTIL(DUZ),XMPARM(2)=$P(^XMB(3.8,XMG,0),U,1)
D TASKBULL^XMXBULL(DUZ,"XM GROUP EDIT NOTIFY",.XMPARM,"XMTEXT",.XMTO,.XMINSTR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXGRP1 5422 printed Apr 09, 2024@21:13:41 Page 2
XMXGRP1 ;ISC-SF/GMB-Group creation/enrollment (cont.) ;04/17/2002 14:10
+1 ;;8.0;MailMan;;Jun 28, 2002
FAFMSGS(XMDUZ,XMGRP,XMTO,XMINSTR,ZTSK) ; Create task to find and forward messages
+1 ; The following line can be deleted once we enable "A":
+2 SET XMINSTR("FLAGS")=$TRANSLATE($GET(XMINSTR("FLAGS")),"A")
if $GET(XMINSTR("FLAGS"))'["F"
QUIT
+3 NEW ZTSAVE,ZTDESC,ZTRTN,ZTDTH,ZTIO,I
+4 ; MailMan: Find & Forward mail group messages
SET ZTDESC=$$EZBLD^DIALOG(38023.8)
+5 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTRTN="FAFTSK^XMXGRP1"
+6 FOR I="DUZ","XMDUZ","XMGRP*","XMTO*","XMINSTR("
SET ZTSAVE(I)=""
+7 DO ^%ZTLOAD
+8 QUIT
FAFTSK ; Find and add/forward messages
+1 NEW XMFDATE,XMTDATE,XMGROUP,XMX,XMFIRST,XMABORT
+2 SET XMABORT=0
+3 DO INIT
if XMABORT
QUIT
+4 DO PROCESS
+5 DO CLEANUP^XMXADDR
+6 KILL ^TMP("XM",$JOB,"SAVE")
+7 QUIT
PROCESS ;
+1 ; Forward some of the messages to the users, and add the users to the rest of the messages.
IF XMINSTR("FLAGS")["A"
IF XMINSTR("FLAGS")["F"
Begin DoDot:1
+2 DO SAVFWD(.XMX)
+3 IF XMFIRST<XMFDATE
Begin DoDot:2
+4 DO CHKADD(.XMX)
if '$DATA(^TMP("XMY",$JOB))
QUIT
+5 ; add
DO ADDFWD(XMDUZ,.XMGROUP,"A",XMFIRST,XMFDATE-1,.XMX)
+6 MERGE ^TMP("XMY",$JOB)=^TMP("XM",$JOB,"SAVE")
End DoDot:2
+7 ; forward
DO ADDFWD(XMDUZ,.XMGROUP,"F",XMFDATE,XMTDATE,.XMX)
+8 IF XMTDATE<DT
Begin DoDot:2
+9 IF XMX("RESTORE")
MERGE ^TMP("XMY",$JOB)=^TMP("XM",$JOB,"SAVE")
SET XMX("RESTORE")=0
+10 DO CHKADD(.XMX)
if '$DATA(^TMP("XMY",$JOB))
QUIT
+11 ; add
DO ADDFWD(XMDUZ,.XMGROUP,"A",XMTDATE+.1,DT,.XMX)
End DoDot:2
End DoDot:1
QUIT
+12 ; Just forward messages to users
IF XMINSTR("FLAGS")["F"
Begin DoDot:1
+13 DO SAVFWD(.XMX)
+14 ; forward
DO ADDFWD(XMDUZ,.XMGROUP,"F",XMFDATE,XMTDATE,.XMX)
End DoDot:1
QUIT
+15 ; Just add users to messages
IF XMINSTR("FLAGS")["A"
Begin DoDot:1
+16 DO CHKADD(.XMX)
if '$DATA(^TMP("XMY",$JOB))
QUIT
+17 ; add
DO ADDFWD(XMDUZ,.XMGROUP,"A",XMFDATE,XMTDATE,.XMX)
End DoDot:1
QUIT
+18 QUIT
INIT ;
+1 NEW XMPRIVAT,XMGN,XMI
+2 SET ZTREQ="@"
+3 ; " [Private Mail Group]"
SET XMPRIVAT=$$EZBLD^DIALOG(39135)
+4 ; earliest message date (after 1950!)
SET XMFIRST=$ORDER(^XMB(3.9,"C",2500000))
+5 SET XMFDATE=$GET(XMINSTR("FDATE"),XMFIRST)
+6 SET XMTDATE=$GET(XMINSTR("TDATE"),DT)
+7 DO INITAPI^XMVVITAE
+8 DO INIT^XMXADDR
+9 DO CHKADDR^XMXADDR(XMDUZ,.XMTO)
+10 IF '$$GOTADDR^XMXADDR
SET XMABORT=1
QUIT
+11 IF $GET(XMGRP)]""
SET XMGRP(XMGRP)=$ORDER(^XMB(3.8,"B",XMGRP,0))
+12 SET XMGN=""
+13 FOR
SET XMGN=$ORDER(XMGRP(XMGN))
if XMGN=""
QUIT
Begin DoDot:1
+14 SET XMI=XMGRP(XMGN)
+15 SET XMGROUP("G."_XMGN_$SELECT($PIECE($GET(^XMB(3.8,XMI,0)),U,2)="PR":XMPRIVAT,1:""))=XMI
End DoDot:1
+16 KILL XMGRP
+17 IF $DATA(XMINSTR("SELF BSKT"))
SET XMX("SELF BSKT")=XMINSTR("SELF BSKT")
+18 QUIT
SAVFWD(XMX) ;
+1 SET XMX("RESTORE")=0
+2 MERGE ^TMP("XM",$JOB,"SAVE")=^TMP("XMY",$JOB)
+3 ; First recipient. Is it the only one?
SET XMX("ONE")=$ORDER(^TMP("XMY",$JOB,""))
+4 ; There's more than one recipient
IF $ORDER(^TMP("XMY",$JOB,XMX("ONE")))'=""
SET XMX("ONE")=0
+5 QUIT
CHKADD(XMX) ;
+1 ; " (Surrogate: _x_)"
SET XMX("FWDBY")=XMV("NAME")_$SELECT(XMDUZ=DUZ:"",1:$$EZBLD^DIALOG(38008,XMV("DUZ NAME")))_" "_$$MMDT^XMXUTIL1($$NOW^XLFDT)
+2 ; Delete any remote addresses - responses won't be forwarded.
SET XMI=0
+3 FOR
SET XMI=$ORDER(^TMP("XMY",$JOB,XMI))
if XMI=""
QUIT
if +XMI'=XMI
KILL ^(XMI)
+4 QUIT
ADDFWD(XMDUZ,XMGROUP,XMWHAT,XMFDATE,XMTDATE,XMX) ;
+1 NEW XMZ,XMCRE8,XMGN
+2 SET XMZ=0
+3 SET XMCRE8=XMFDATE-.1
+4 FOR
SET XMCRE8=$ORDER(^XMB(3.9,"C",XMCRE8))
if 'XMCRE8
QUIT
if XMCRE8>XMTDATE
QUIT
Begin DoDot:1
+5 IF $$S^%ZTLOAD
SET ZTSTOP=1
QUIT
+6 FOR
SET XMZ=$ORDER(^XMB(3.9,"C",XMCRE8,XMZ))
if 'XMZ
QUIT
Begin DoDot:2
+7 ; Message is closed
if $$ZCLOSED^XMXSEC(XMZ)
QUIT
+8 SET XMGN=""
+9 FOR
SET XMGN=$ORDER(XMGROUP(XMGN))
if XMGN=""
QUIT
if $SELECT($LENGTH(XMGN)<31
QUIT
+10 ; Message is not addressed to any of the groups
if XMGN=""
QUIT
+11 IF XMWHAT="F"
DO FWD(XMDUZ,XMZ,.XMX)
QUIT
+12 DO ADD(XMDUZ,XMZ,.XMX)
End DoDot:2
End DoDot:1
if $GET(ZTSTOP)
QUIT
+13 QUIT
FWD(XMDUZ,XMZ,XMX) ; Forward the message to the user
+1 NEW XMINSTR
+2 IF $DATA(XMX("SELF BSKT"))
SET XMINSTR("SELF BSKT")=XMX("SELF BSKT")
+3 ; User already on msg.
IF XMX("ONE")'=0
if $DATA(^XMB(3.9,XMZ,1,"C",XMX("ONE")))
QUIT
+4 IF XMX("ONE")=0
Begin DoDot:1
+5 IF XMX("RESTORE")
MERGE ^TMP("XMY",$JOB)=^TMP("XM",$JOB,"SAVE")
SET XMX("RESTORE")=0
+6 NEW XMI
+7 SET XMI=""
+8 FOR
SET XMI=$ORDER(^TMP("XMY",$JOB,XMI))
if XMI=""
QUIT
Begin DoDot:2
+9 ; User not yet on msg.
if '$DATA(^XMB(3.9,XMZ,1,"C",XMI))
QUIT
+10 ; User on msg - don't forward to user.
KILL ^TMP("XMY",$JOB,XMI)
+11 SET XMX("RESTORE")=1
End DoDot:2
End DoDot:1
if '$DATA(^TMP("XMY",$JOB))
QUIT
+12 DO FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
+13 QUIT
ADD(XMDUZ,XMZ,XMX) ; Add user(s) to message.
+1 ; XMX("FWDBY")
+2 NEW XMI,XMFDA,XMIENS,XMPRI
+3 ; Is msg priority?
SET XMPRI=$$ZPRI^XMXUTIL2(XMZ)
+4 ; Put users into RECIPIENT multiple
+5 SET XMI=0
+6 FOR
SET XMI=$ORDER(^TMP("XMY",$JOB,XMI))
if 'XMI
QUIT
Begin DoDot:1
+7 ; User already on msg - don't add.
if $DATA(^XMB(3.9,XMZ,1,"C",XMI))
QUIT
+8 ; New recipient
DO NEW^XMKP(XMZ,XMPRI,XMI,$GET(^TMP("XMY",$JOB,XMI,1)),.XMFDA,.XMIENS)
+9 ; fwd by name date time
SET XMFDA(3.91,XMIENS,8)=XMX("FWDBY")
+10 ; fwd by duz
SET XMFDA(3.91,XMIENS,8.01)=XMDUZ
+11 ; Need new field that says 'parked until next reply'.
+12 DO UPDATE^DIE("","XMFDA")
End DoDot:1
+13 QUIT
NOTIFY(XMG,XMNEWMBR) ; If the group is restricted in any way,
+1 ; notify the organizer & coordinator of the new members.
+2 NEW XMREC,XMTO,I
+3 SET XMREC=^XMB(3.8,XMG,0)
+4 IF $PIECE(XMREC,U,2)="PU"
IF $PIECE(XMREC,U,3)="y"
QUIT
+5 ; organizer
SET I=$PIECE($GET(^XMB(3.8,XMG,3)),U)
if I
SET XMTO(I)=""
+6 ; coordinator
SET I=$PIECE(XMREC,U,7)
if I
SET XMTO(I)=""
+7 if $DATA(XMTO(DUZ))
QUIT
+8 NEW XMPARM,XMTEXT,XMINSTR,XMNAME,J
+9 SET I=0
FOR
SET I=$ORDER(XMNEWMBR(I))
if 'I
QUIT
SET XMNAME($$NAME^XMXUTIL(I,1))=""
+10 SET J=""
FOR I=1:1
SET J=$ORDER(XMNAME(J))
if J=""
QUIT
SET XMTEXT(I)=J
+11 SET XMINSTR("FROM")=.5
+12 SET XMPARM(1)=$$NAME^XMXUTIL(DUZ)
SET XMPARM(2)=$PIECE(^XMB(3.8,XMG,0),U,1)
+13 DO TASKBULL^XMXBULL(DUZ,"XM GROUP EDIT NOTIFY",.XMPARM,"XMTEXT",.XMTO,.XMINSTR)
+14 QUIT
