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