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

XMXADDR2.m

Go to the documentation of this file.
  1. XMXADDR2 ;ISC-SF/GMB-XMXADDR (cont.) ;04/17/2002 13:42
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. BRODCAST(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMFULL) ;
  1. I $D(XMRESTR("NET RECEIVE")) D SETERR^XMXADDR4(0,"",39035) Q ;Broadcast messages are not accepted from remote sites.
  1. I DUZ'=.5,'$D(^XUSEC("XMSTAR",DUZ)),'$D(^XUSEC("XMSTAR LIMITED",DUZ)) D Q
  1. . ;Only the Postmaster or XMSTAR key holders may broadcast messages.
  1. . D SETERR^XMXADDR4($G(XMIA),"!",39036)
  1. I $D(XMRESTR("NOBCAST")) D SETERR^XMXADDR4($G(XMIA),"P",39036.5) Q ; Messages with replies may not be broadcast.
  1. N XMCAST
  1. I DUZ=.5!$D(^XUSEC("XMSTAR",DUZ)) D Q:$D(XMERROR)
  1. . I '$G(XMIA) S XMCAST=$S(XMADDR="*":"F",1:"L") Q
  1. . I XMADDR'="*" S XMCAST="L" Q
  1. . D TYPECAST(.XMCAST)
  1. E S XMCAST="L"
  1. I XMCAST="F" D FULLCAST(XMSTRIKE,XMPREFIX,XMLATER,.XMFULL) Q
  1. ; Doing a limited broadcast...
  1. N XMLTD
  1. I XMADDR'="*" D
  1. . D CHECKIT(XMADDR,.XMLTD)
  1. E D
  1. . D TYPELTD(.XMLTD) Q:$D(XMERROR)
  1. . D PARMLTD(.XMLTD) Q:$D(XMERROR)
  1. Q:$D(XMERROR)
  1. ;S XMFULL="* (Limited Broadcast)"
  1. S XMFULL="*;"_XMLTD("TYPE")_";"_XMLTD("PARM")
  1. I $G(XMINSTR("ADDR FLAGS"))["X" Q
  1. I XMSTRIKE Q:$D(^TMP("XMY0",$J,XMFULL,"L")) W:$G(XMIA) $$EZBLD^DIALOG(39037) ;Deleting limited broadcast recipients
  1. I $G(XMIA),'XMSTRIKE,XMLATER="?" D QLATER^XMXADDR(XMFULL,.XMLATER) Q:$D(XMERROR)
  1. I XMLATER,'$G(XMIA) Q
  1. I 'XMSTRIKE,$G(XMIA) W !,$$EZBLD^DIALOG(39038),! ;Limited broadcast recipients:
  1. N XMSCREEN
  1. ; User must have access code, verify code, primary menu, and mailbox
  1. S XMSCREEN="I $L($P(^(0),U,3)),$L($P($G(^(.1)),U,2)),$L($P($G(^(201)),U,1)),$D(^XMB(3.7,+Y,2))"
  1. D FIND^DIC(200,"","@","QX",XMLTD("PARM IEN"),"",XMLTD("XREF"),XMSCREEN)
  1. I '$D(^TMP("DILIST",$J)) D Q
  1. . D SETERR^XMXADDR4($G(XMIA),"",39039) ;No matches. No recipients.
  1. D SHOWLTD(XMDUZ,XMSTRIKE,XMPREFIX,XMLATER,$G(XMIA))
  1. Q
  1. TYPECAST(XMCAST) ;
  1. N DIR,XMALL
  1. S XMALL=$$EZBLD^DIALOG(39040) ;Broadcast to all local users
  1. S DIR(0)="S^"_XMALL_";"_$$EZBLD^DIALOG(39041) ;Limited broadcast to local users
  1. D BLD^DIALOG(39042,"","","DIR(""A"")") ;Broadcast type
  1. S DIR("B")=$P(XMALL,":",2,9)
  1. ;Enter B to broadcast to all local users.
  1. ;Enter L to broadcast to a subset of local users. Limited broadcasts
  1. ;are to local users who have something in common, such as belonging
  1. ;to the same DIVISION, or holding the same PRIMARY MENU.
  1. ;The LIMITED BROADCASTs from which you may choose are defined by
  1. ;your IRM in the MAILMAN SITE PARAMETERS file.
  1. D BLD^DIALOG(39043,"","","DIR(""?"")")
  1. D ^DIR I $D(DIRUT) D SETERR^XMXADDR4(0,"",37002) Q ;up-arrow or time out.
  1. S XMCAST=$S(Y=$P(XMALL,":",1):"F",1:"L")
  1. Q
  1. FULLCAST(XMSTRIKE,XMPREFIX,XMLATER,XMFULL) ;
  1. S XMFULL=$$EZBLD^DIALOG(39006) ;* (Broadcast to all local users)
  1. W:$G(XMIA) $E(XMFULL,2,99)
  1. D SETEXP^XMXADDR(XMFULL,"",XMSTRIKE,XMPREFIX,XMLATER)
  1. Q
  1. TYPELTD(XMLTD) ;
  1. N DIC,DA,X,Y,DIR,XMDEF
  1. S DA(1)=1
  1. S DIC="^XMB(1,1,5,"
  1. S XMDEF=$P(^XMB(1,1,0),U,20) I XMDEF S XMDEF=$P($G(^XMB(1,1,5,XMDEF,0)),U,1) I XMDEF'="" S DIC("B")=XMDEF
  1. S DIC(0)="AEQZ"
  1. D ^DIC I Y=-1!$D(DTOUT)!$D(DUOUT) D SETERR^XMXADDR4(0,"",37002) Q ;up-arrow or time out.
  1. S XMLTD("TYPE IEN")=+Y
  1. S XMLTD("TYPE")=$P(Y(0),U,1)
  1. S XMLTD("FILE")=$P(Y(0),U,2)
  1. S XMLTD("XREF")=$P(Y(0),U,3)
  1. D CHKFILE(.XMLTD) Q:$D(XMERROR)
  1. D CHKXREF(.XMLTD) Q:$D(XMERROR)
  1. Q
  1. CHKFILE(XMLTD) ;
  1. I XMLTD("FILE")="" D Q
  1. . ;Limited Broadcast entry |1|, field |2| is null.
  1. . D SETERR^XMXADDR4($G(XMIA),"!",39044,XMLTD("TYPE IEN"),1)
  1. I '$$VFILE^DILFD(XMLTD("FILE")) D Q
  1. . ;Limited Broadcast entry |1|, field |2|: '|3|' does not exist.
  1. . D SETERR^XMXADDR4($G(XMIA),"!",39045,XMLTD("TYPE IEN"),1,XMLTD("FILE"))
  1. Q
  1. CHKXREF(XMLTD) ;
  1. I XMLTD("XREF")="" D Q
  1. . ;Limited Broadcast entry |1|, field |2| is null.
  1. . D SETERR^XMXADDR4($G(XMIA),"!",39044,XMLTD("TYPE IEN"),2)
  1. I '$D(^VA(200,XMLTD("XREF"))) D Q
  1. . ;Limited Broadcast entry |1|, field |2|: '|3|' does not exist.
  1. . D SETERR^XMXADDR4($G(XMIA),"!",39045,XMLTD("TYPE IEN"),2,XMLTD("XREF"))
  1. Q
  1. PARMLTD(XMLTD) ;
  1. N DIC,DIR,X,Y
  1. S DIC=$$ROOT^DILFD(XMLTD("FILE"))
  1. S DIC(0)="AEQZ"
  1. S DIC("S")="I $D(^VA(200,"""_XMLTD("XREF")_""",+Y))"
  1. S DIC("A")=$$EZBLD^DIALOG(39046,XMLTD("TYPE")) ;Select Limited Broadcast |1|:
  1. D ^DIC I Y=-1!$D(DTOUT)!$D(DUOUT) D SETERR^XMXADDR4(0,"",37002) Q ;up-arrow or time out.
  1. S XMLTD("PARM IEN")=+Y
  1. S XMLTD("PARM")=Y(0,0)
  1. Q
  1. CHECKIT(XMADDR,XMLTD) ;
  1. S XMLTD("TYPE")=$P(XMADDR,";",2) I XMLTD("TYPE")="" D SETERR^XMXADDR4($G(XMIA),"!",39047) Q ;Limited Broadcast selection is null.
  1. S XMLTD("PARM")=$P(XMADDR,";",3) I XMLTD("PARM")="" D SETERR^XMXADDR4($G(XMIA),"!",39047.5) Q ;Limited Broadcast selection value is null.
  1. S XMLTD("TYPE IEN")=$$FIND1^DIC(4.32,",1,","OQ",XMLTD("TYPE"))
  1. I 'XMLTD("TYPE IEN") D SETERR^XMXADDR4($G(XMIA),"!",$S(XMLTD("TYPE IEN")=0:39048,1:39049),XMLTD("TYPE")) Q ;Limited Broadcast selection not found: |1| / Limited Broadcast selection ambiguous: |1|
  1. N XMREC
  1. S XMREC=$G(^XMB(1,1,5,XMLTD("TYPE IEN"),0))
  1. S XMLTD("TYPE")=$P(XMREC,U,1)
  1. S XMLTD("FILE")=$P(XMREC,U,2)
  1. S XMLTD("XREF")=$P(XMREC,U,3)
  1. D CHKFILE(.XMLTD) Q:$D(XMERROR)
  1. D CHKXREF(.XMLTD) Q:$D(XMERROR)
  1. S XMLTD("PARM IEN")=$$FIND1^DIC(XMLTD("FILE"),"","OQ",XMLTD("PARM"))
  1. I XMLTD("PARM IEN") S XMLTD("PARM")=$$GET1^DIQ(XMLTD("FILE"),XMLTD("PARM IEN")_",",.01) Q
  1. N XMPARM S XMPARM(1)=XMLTD("PARM"),XMPARM(2)=XMLTD("FILE")
  1. D SETERR^XMXADDR4($G(XMIA),"!",$S(XMLTD("PARM IEN")=0:39050,1:39051),.XMPARM) ;Limited Broadcast value '|1|' not found / Limited Broadcast value '|1|' ambiguous
  1. Q
  1. SHOWLTD(XMDUZ,XMSTRIKE,XMPREFIX,XMLATER,XMIA) ;
  1. N XMI,XMGM,XMCNT
  1. S (XMI,XMCNT)=0
  1. F S XMI=$O(^TMP("DILIST",$J,2,XMI)) Q:'XMI S XMGM=^(XMI) D
  1. . N XMERROR,XMFWDADD
  1. . I 'XMLATER D INDIV^XMXADDR(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER)
  1. . Q:'XMIA
  1. . I XMCNT,XMCNT#16=0 D Q:'XMIA
  1. . . N DIR,Y ;Do you want to see more Limited Broadcast recipients
  1. . . S DIR("A")=$$EZBLD^DIALOG(39052)
  1. . . S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ;No
  1. . . D ^DIR
  1. . . S XMIA=+Y ; The '+' takes care of $D(DIRUT)
  1. . S XMCNT=XMCNT+1
  1. . W:XMCNT#4-1=0 !
  1. . W ?XMCNT-1#4*20,$E($S(XMPREFIX="":"",1:XMPREFIX_":")_$$NAME^XMXUTIL(XMGM),1,19)
  1. K ^TMP("DILIST",$J)
  1. Q
  1. INXFORM(X) ; Input transform for file 4.3, field 51 LIMITED BROADCAST DEFAULT
  1. N DIC,DA,Y,DIR,XMERROR,XMLTD,XMIA
  1. I '$D(ZTQUEUED) S XMIA=1
  1. S DA(1)=1
  1. S DIC="^XMB(1,1,5,"
  1. S DIC(0)="EQZ"
  1. D ^DIC I Y=-1!$D(DTOUT)!$D(DUOUT) K X Q
  1. S XMLTD("TYPE IEN")=+Y
  1. S XMLTD("TYPE")=$P(Y(0),U,1)
  1. S XMLTD("FILE")=$P(Y(0),U,2)
  1. S XMLTD("XREF")=$P(Y(0),U,3)
  1. D CHKFILE(.XMLTD) I $D(XMERROR) K X Q
  1. D CHKXREF(.XMLTD) I $D(XMERROR) K X Q
  1. S X=XMLTD("TYPE IEN")
  1. Q
  1. EXHELP ; Executable help for file 4.3, field 51 LIMITED BROADCAST DEFAULT
  1. N I
  1. D EN^DDIOL($$EZBLD^DIALOG(38056)) ; Choose from:
  1. S I=0
  1. F S I=$O(^XMB(1,1,5,I)) Q:'I D EN^DDIOL($P(^(I,0),U,1))
  1. Q