XMXADDR4 ;ISC-SF/GMB-XMXADDRG (cont.) ;04/17/2002 13:50
;;8.0;MailMan;;Jun 28, 2002
DISTR(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
; XMGN Distribution group name
N XMGM,XMGN
S XMGM=""
F S XMGM=$O(^XMB(3.8,XMG,7,"B",XMGM)) Q:'XMGM D I XMLATER,'$G(XMIA) Q
. I '$D(^XMB(3.816,XMGM)) D DELETE1(XMG,7,XMGM) Q
. S XMGN=$P(^XMB(3.816,XMGM,0),U,1) Q:XMGN=""
. I ".S.s.D.d.H.h.G.g."'[("."_$E(XMGN,1,2)) S XMGN="G."_XMGN
. W:$G(XMIA) !,$$EZBLD^DIALOG(39080),XMGN ;Distribution List:
. D:'XMLATER EXPDISTR(XMDUZ,XMG,XMGM,XMGN,XMSTRIKE,XMPREFIX,XMLATER)
Q
EXPDISTR(XMDUZ,XMG,XMGM,XMGN,XMSTRIKE,XMPREFIX,XMLATER) ;
N XMI,XMDOMAIN
;S:".G.g."'[("."_$E(XMGM,1,2)) XMLATER="" ; XMLATER not appropriate for Servers or Devices.
S XMI=0
F S XMI=$O(^XMB(3.816,XMGM,1,"B",XMI)) Q:'XMI D
. Q:XMI=^XMB("NUM")
. S XMDOMAIN=$P($G(^DIC(4.2,XMI,0)),U,1) Q:XMDOMAIN=""
. N XMERROR,XMIA,XMVIA
. D DNS^XMXADDRD(XMDUZ,XMDOMAIN,.XMVIA)
. I $D(XMERROR) S ^TMP("XM",$J,"GRPERR",XMG,"D",XMGN_"@"_XMDOMAIN)=$$GETERR Q
. S XMGMBRS=1
. D SETEXP^XMXADDR(XMGN_"@"_XMDOMAIN,XMVIA,XMSTRIKE,XMPREFIX,XMLATER)
Q
FAXGROUP(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
N XMGM,XMI
S XMGM=""
F S XMGM=$O(^XMB(3.8,XMG,9,"B",XMGM)) Q:XMGM="" D I XMLATER,'$G(XMIA) Q
. S XMGN=$P($G(^AKF("FAXG",XMGM,0)),U)
. I XMGN="" D DELETE1(XMG,9,XMGM) Q
. W:$G(XMIA) !,$$EZBLD^DIALOG(39081),XMGN ;Fax Group:
. S XMI=""
. F S XMI=$O(^AKF("FAXG",XMGM,2,"B",XMI)) Q:XMI="" D FAX(XMDUZ,XMI,XMSTRIKE,XMPREFIX,XMLATER)
Q
FAX(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
N XMGN
S XMGN=$P($G(^AKF("FAXR",XMG,0)),U)
Q:XMGN=""
W:$G(XMIA) !,$$EZBLD^DIALOG(39082),XMGN ;Fax Recipient:
;D SETEXP^XMXADDR("F."_XMGN,XMG,XMSTRIKE,XMPREFIX,"") ; XMLATER not appropriate
D:'XMLATER SETEXP^XMXADDR("F."_XMGN,XMG,XMSTRIKE,XMPREFIX,XMLATER)
S XMGMBRS=1
Q
FAXINDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
; XMGM Group member
N XMGM,XMCNT
S XMGM="",XMCNT=0
F S XMGM=$O(^XMB(3.8,XMG,8,"B",XMGM)) Q:XMGM="" D I XMLATER,'$G(XMIA) Q
. I '$D(^AKF("FAXR",XMGM)) D DELETE1(XMG,8,XMGM) Q
. D FAX(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER)
Q
DELETE1(XMGIEN,XMNODE,XMGM) ;
N DIK,DA
L +^XMB(3.8,XMGIEN,XMNODE):0 E Q
S DA=$O(^XMB(3.8,XMG,XMNODE,"B",XMGM,0))
S DA(1)=XMGIEN
S DIK="^XMB(3.8,"_DA(1)_","_XMNODE_","
D ^DIK
L -^XMB(3.8,XMGIEN,XMNODE)
Q
DELETE2(XMGIEN,XMNODE,DA) ;
N DIK
L +^XMB(3.8,XMGIEN,XMNODE):0 E Q
S DA(1)=XMGIEN
S DIK="^XMB(3.8,"_DA(1)_","_XMNODE_","
D ^DIK
L -^XMB(3.8,XMGIEN,XMNODE)
Q
GRPERR(XMDUZ,XMG,XMGN) ; Send a bulletin about errors in groups.
N XMGIEN,XMPARM,XMINSTR
S XMINSTR("FROM")=.5
S XMPARM(1)=XMGN
S XMGIEN=0
F S XMGIEN=$O(^TMP("XM",$J,"GRPERR",XMGIEN)) Q:'XMGIEN D
. N XMTXT,XMI,XMTO
. S XMI=0
. I XMGIEN'=XMG D
. . N XMPARM S XMPARM(1)=$P($G(^XMB(3.8,XMGIEN,0)),U,1),XMPARM(2)=XMGIEN
. . S XMI=XMI+1,XMTXT(XMI)=""
. . S XMI=XMI+1,XMTXT(XMI)=$$EZBLD^DIALOG(39083,.XMPARM) ;Problems in member group: |1| (IEN=|2|)
. I $D(^TMP("XM",$J,"GRPERR",XMGIEN,"L")) D GRPTXT(XMGIEN,"L",39084,.XMTXT,.XMI) ;Local Member:
. I $D(^TMP("XM",$J,"GRPERR",XMGIEN,"R")) D GRPTXT(XMGIEN,"R",39085,.XMTXT,.XMI) ;Remote Member:
. I $D(^TMP("XM",$J,"GRPERR",XMGIEN,"D")) D GRPTXT(XMGIEN,"D",39086,.XMTXT,.XMI) ;Distribution List Domain:
. I $D(^TMP("XM",$J,"GRPERR",XMGIEN,"C")) D GRPTXT(XMGIEN,"C",39087,.XMTXT,.XMI) ;Circular Group Reference:
. S XMTO(XMDUZ)="" ; Person sending the message
. D GRPADDR(XMG,.XMTO)
. I XMG'=XMGIEN D GRPADDR(XMGIEN,.XMTO)
. D TASKBULL^XMXBULL(XMDUZ,"XM GROUP ERROR",.XMPARM,"XMTXT",.XMTO,.XMINSTR)
Q
GRPTXT(XMGIEN,XMTYPE,XMPROB,XMTXT,XMI) ;
N XMNAME
S XMNAME=""
F S XMNAME=$O(^TMP("XM",$J,"GRPERR",XMGIEN,XMTYPE,XMNAME)) Q:XMNAME="" D
. S XMI=XMI+1,XMTXT(XMI)=""
. S XMI=XMI+1,XMTXT(XMI)=$$EZBLD^DIALOG(XMPROB)_XMNAME
. S XMI=XMI+1,XMTXT(XMI)=$$EZBLD^DIALOG(39088)_^TMP("XM",$J,"GRPERR",XMGIEN,XMTYPE,XMNAME) ;Error:
Q
GRPADDR(XMGIEN,XMTO) ;
N I
S I=$P($G(^XMB(3.8,XMGIEN,3)),U,1) S:I XMTO(I)="" ; Organizer
S I=$P($G(^XMB(3.8,XMGIEN,0)),U,7) S:I XMTO(I)="" ; Coordinator
Q:'$D(^XMB(3.8,XMGIEN,4,"B"))
S I=0
F S I=$O(^XMB(3.8,XMGIEN,4,"B",I)) Q:'I D
. S XMTO(I)="" ; Authorized sender
Q
SETERR(XMIA,XMFORMAT,XMDIALOG,XMP1,XMP2,XMP3) ;
S XMERROR=XMDIALOG
I $D(XMP1) S XMERROR(1)=XMP1
I $D(XMP2) S XMERROR(2)=XMP2
I $D(XMP3) S XMERROR(3)=XMP3
I XMIA D WRIERR(XMFORMAT)
Q
WRIERR(XMFORMAT) ;
I XMFORMAT="" W $$GETERR Q
I XMFORMAT'="P" D EN^DDIOL($$GETERR,"",XMFORMAT) Q
N XMTEXT
D BLD^DIALOG(XMERROR,.XMERROR,"","XMTEXT","F")
D MSG^DIALOG("WE","","","","XMTEXT")
Q
GETERR() ;
Q $$EZBLD^DIALOG(XMERROR,.XMERROR)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXADDR4 4700 printed Apr 09, 2024@21:13:01 Page 2
XMXADDR4 ;ISC-SF/GMB-XMXADDRG (cont.) ;04/17/2002 13:50
+1 ;;8.0;MailMan;;Jun 28, 2002
DISTR(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
+1 ; XMGN Distribution group name
+2 NEW XMGM,XMGN
+3 SET XMGM=""
+4 FOR
SET XMGM=$ORDER(^XMB(3.8,XMG,7,"B",XMGM))
if 'XMGM
QUIT
Begin DoDot:1
+5 IF '$DATA(^XMB(3.816,XMGM))
DO DELETE1(XMG,7,XMGM)
QUIT
+6 SET XMGN=$PIECE(^XMB(3.816,XMGM,0),U,1)
if XMGN=""
QUIT
+7 IF ".S.s.D.d.H.h.G.g."'[("."_$EXTRACT(XMGN,1,2))
SET XMGN="G."_XMGN
+8 ;Distribution List:
if $GET(XMIA)
WRITE !,$$EZBLD^DIALOG(39080),XMGN
+9 if 'XMLATER
DO EXPDISTR(XMDUZ,XMG,XMGM,XMGN,XMSTRIKE,XMPREFIX,XMLATER)
End DoDot:1
IF XMLATER
IF '$GET(XMIA)
QUIT
+10 QUIT
EXPDISTR(XMDUZ,XMG,XMGM,XMGN,XMSTRIKE,XMPREFIX,XMLATER) ;
+1 NEW XMI,XMDOMAIN
+2 ;S:".G.g."'[("."_$E(XMGM,1,2)) XMLATER="" ; XMLATER not appropriate for Servers or Devices.
+3 SET XMI=0
+4 FOR
SET XMI=$ORDER(^XMB(3.816,XMGM,1,"B",XMI))
if 'XMI
QUIT
Begin DoDot:1
+5 if XMI=^XMB("NUM")
QUIT
+6 SET XMDOMAIN=$PIECE($GET(^DIC(4.2,XMI,0)),U,1)
if XMDOMAIN=""
QUIT
+7 NEW XMERROR,XMIA,XMVIA
+8 DO DNS^XMXADDRD(XMDUZ,XMDOMAIN,.XMVIA)
+9 IF $DATA(XMERROR)
SET ^TMP("XM",$JOB,"GRPERR",XMG,"D",XMGN_"@"_XMDOMAIN)=$$GETERR
QUIT
+10 SET XMGMBRS=1
+11 DO SETEXP^XMXADDR(XMGN_"@"_XMDOMAIN,XMVIA,XMSTRIKE,XMPREFIX,XMLATER)
End DoDot:1
+12 QUIT
FAXGROUP(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
+1 NEW XMGM,XMI
+2 SET XMGM=""
+3 FOR
SET XMGM=$ORDER(^XMB(3.8,XMG,9,"B",XMGM))
if XMGM=""
QUIT
Begin DoDot:1
+4 SET XMGN=$PIECE($GET(^AKF("FAXG",XMGM,0)),U)
+5 IF XMGN=""
DO DELETE1(XMG,9,XMGM)
QUIT
+6 ;Fax Group:
if $GET(XMIA)
WRITE !,$$EZBLD^DIALOG(39081),XMGN
+7 SET XMI=""
+8 FOR
SET XMI=$ORDER(^AKF("FAXG",XMGM,2,"B",XMI))
if XMI=""
QUIT
DO FAX(XMDUZ,XMI,XMSTRIKE,XMPREFIX,XMLATER)
End DoDot:1
IF XMLATER
IF '$GET(XMIA)
QUIT
+9 QUIT
FAX(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
+1 NEW XMGN
+2 SET XMGN=$PIECE($GET(^AKF("FAXR",XMG,0)),U)
+3 if XMGN=""
QUIT
+4 ;Fax Recipient:
if $GET(XMIA)
WRITE !,$$EZBLD^DIALOG(39082),XMGN
+5 ;D SETEXP^XMXADDR("F."_XMGN,XMG,XMSTRIKE,XMPREFIX,"") ; XMLATER not appropriate
+6 if 'XMLATER
DO SETEXP^XMXADDR("F."_XMGN,XMG,XMSTRIKE,XMPREFIX,XMLATER)
+7 SET XMGMBRS=1
+8 QUIT
FAXINDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
+1 ; XMGM Group member
+2 NEW XMGM,XMCNT
+3 SET XMGM=""
SET XMCNT=0
+4 FOR
SET XMGM=$ORDER(^XMB(3.8,XMG,8,"B",XMGM))
if XMGM=""
QUIT
Begin DoDot:1
+5 IF '$DATA(^AKF("FAXR",XMGM))
DO DELETE1(XMG,8,XMGM)
QUIT
+6 DO FAX(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER)
End DoDot:1
IF XMLATER
IF '$GET(XMIA)
QUIT
+7 QUIT
DELETE1(XMGIEN,XMNODE,XMGM) ;
+1 NEW DIK,DA
+2 LOCK +^XMB(3.8,XMGIEN,XMNODE):0
IF '$TEST
QUIT
+3 SET DA=$ORDER(^XMB(3.8,XMG,XMNODE,"B",XMGM,0))
+4 SET DA(1)=XMGIEN
+5 SET DIK="^XMB(3.8,"_DA(1)_","_XMNODE_","
+6 DO ^DIK
+7 LOCK -^XMB(3.8,XMGIEN,XMNODE)
+8 QUIT
DELETE2(XMGIEN,XMNODE,DA) ;
+1 NEW DIK
+2 LOCK +^XMB(3.8,XMGIEN,XMNODE):0
IF '$TEST
QUIT
+3 SET DA(1)=XMGIEN
+4 SET DIK="^XMB(3.8,"_DA(1)_","_XMNODE_","
+5 DO ^DIK
+6 LOCK -^XMB(3.8,XMGIEN,XMNODE)
+7 QUIT
GRPERR(XMDUZ,XMG,XMGN) ; Send a bulletin about errors in groups.
+1 NEW XMGIEN,XMPARM,XMINSTR
+2 SET XMINSTR("FROM")=.5
+3 SET XMPARM(1)=XMGN
+4 SET XMGIEN=0
+5 FOR
SET XMGIEN=$ORDER(^TMP("XM",$JOB,"GRPERR",XMGIEN))
if 'XMGIEN
QUIT
Begin DoDot:1
+6 NEW XMTXT,XMI,XMTO
+7 SET XMI=0
+8 IF XMGIEN'=XMG
Begin DoDot:2
+9 NEW XMPARM
SET XMPARM(1)=$PIECE($GET(^XMB(3.8,XMGIEN,0)),U,1)
SET XMPARM(2)=XMGIEN
+10 SET XMI=XMI+1
SET XMTXT(XMI)=""
+11 ;Problems in member group: |1| (IEN=|2|)
SET XMI=XMI+1
SET XMTXT(XMI)=$$EZBLD^DIALOG(39083,.XMPARM)
End DoDot:2
+12 ;Local Member:
IF $DATA(^TMP("XM",$JOB,"GRPERR",XMGIEN,"L"))
DO GRPTXT(XMGIEN,"L",39084,.XMTXT,.XMI)
+13 ;Remote Member:
IF $DATA(^TMP("XM",$JOB,"GRPERR",XMGIEN,"R"))
DO GRPTXT(XMGIEN,"R",39085,.XMTXT,.XMI)
+14 ;Distribution List Domain:
IF $DATA(^TMP("XM",$JOB,"GRPERR",XMGIEN,"D"))
DO GRPTXT(XMGIEN,"D",39086,.XMTXT,.XMI)
+15 ;Circular Group Reference:
IF $DATA(^TMP("XM",$JOB,"GRPERR",XMGIEN,"C"))
DO GRPTXT(XMGIEN,"C",39087,.XMTXT,.XMI)
+16 ; Person sending the message
SET XMTO(XMDUZ)=""
+17 DO GRPADDR(XMG,.XMTO)
+18 IF XMG'=XMGIEN
DO GRPADDR(XMGIEN,.XMTO)
+19 DO TASKBULL^XMXBULL(XMDUZ,"XM GROUP ERROR",.XMPARM,"XMTXT",.XMTO,.XMINSTR)
End DoDot:1
+20 QUIT
GRPTXT(XMGIEN,XMTYPE,XMPROB,XMTXT,XMI) ;
+1 NEW XMNAME
+2 SET XMNAME=""
+3 FOR
SET XMNAME=$ORDER(^TMP("XM",$JOB,"GRPERR",XMGIEN,XMTYPE,XMNAME))
if XMNAME=""
QUIT
Begin DoDot:1
+4 SET XMI=XMI+1
SET XMTXT(XMI)=""
+5 SET XMI=XMI+1
SET XMTXT(XMI)=$$EZBLD^DIALOG(XMPROB)_XMNAME
+6 ;Error:
SET XMI=XMI+1
SET XMTXT(XMI)=$$EZBLD^DIALOG(39088)_^TMP("XM",$JOB,"GRPERR",XMGIEN,XMTYPE,XMNAME)
End DoDot:1
+7 QUIT
GRPADDR(XMGIEN,XMTO) ;
+1 NEW I
+2 ; Organizer
SET I=$PIECE($GET(^XMB(3.8,XMGIEN,3)),U,1)
if I
SET XMTO(I)=""
+3 ; Coordinator
SET I=$PIECE($GET(^XMB(3.8,XMGIEN,0)),U,7)
if I
SET XMTO(I)=""
+4 if '$DATA(^XMB(3.8,XMGIEN,4,"B"))
QUIT
+5 SET I=0
+6 FOR
SET I=$ORDER(^XMB(3.8,XMGIEN,4,"B",I))
if 'I
QUIT
Begin DoDot:1
+7 ; Authorized sender
SET XMTO(I)=""
End DoDot:1
+8 QUIT
SETERR(XMIA,XMFORMAT,XMDIALOG,XMP1,XMP2,XMP3) ;
+1 SET XMERROR=XMDIALOG
+2 IF $DATA(XMP1)
SET XMERROR(1)=XMP1
+3 IF $DATA(XMP2)
SET XMERROR(2)=XMP2
+4 IF $DATA(XMP3)
SET XMERROR(3)=XMP3
+5 IF XMIA
DO WRIERR(XMFORMAT)
+6 QUIT
WRIERR(XMFORMAT) ;
+1 IF XMFORMAT=""
WRITE $$GETERR
QUIT
+2 IF XMFORMAT'="P"
DO EN^DDIOL($$GETERR,"",XMFORMAT)
QUIT
+3 NEW XMTEXT
+4 DO BLD^DIALOG(XMERROR,.XMERROR,"","XMTEXT","F")
+5 DO MSG^DIALOG("WE","","","","XMTEXT")
+6 QUIT
GETERR() ;
+1 QUIT $$EZBLD^DIALOG(XMERROR,.XMERROR)
