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