- 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 Jan 18, 2025@03:15 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)