XMA21 ;ISC-SF/GMB-Address lookup APIs ;07/17/2003 13:03
;;8.0;MailMan;**20**;Jun 28, 2002
; Was (WASH ISC)/CAP
;
; Entry points (DBIA 10067):
; CHK Check to see if a user is a member of a mail group.
; DES Interactive addressing. Set next default recipient.
; DEST Interactive addressing. Set first default recipient.
; INST Non-interactive addressing. (Same as WHO)
; WHO Non-interactive addressing.
;
; Entry points used by MailMan options (not covered by DBIA):
; DX XMDXNAME - Test name resolution (interactive)
;
CHK ; Check to see if a user is a member of a mail group.
; Sets $T if member.
; Needs:
; XMDUZ DUZ of the user
; Y IEN of the mail group
I $D(^XMB(3.8,Y,1,"B",XMDUZ)) Q
Q
DX ;
N XMINSTR,XMV,XMABORT
D INITAPI^XMVVITAE
S XMABORT=0
D INIT^XMXADDR
D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,"",XMABORT) ;Send
D CLEANUP^XMXADDR
Q
DES ; Interactive addressing. Set next default recipient.
; XMY is not killed upon entry.
; Needs:
; XMMG Next default recipient
; See entry point TO for other needs and outputs associated with
; this entry point.
D TO(.XMMG)
Q
DEST ; Interactive addressing. Set first default recipient.
; XMY is killed upon entry.
; Needs:
; XMDUN First default recipient
; See entry point TO for other needs and outputs associated with
; this entry point.
K XMY
D TO(XMDUN)
Q
TO(XMTO) ;
; Entry points DES and DEST also Need:
; XMDUZ DUZ of user
; XMDF if $D(XMDF) then do not restrict addressees
; Output:
; XMY( Array of addressees: XMY(addressee)=""
; XMOUT if $D(XMOUT) user aborted addressing
; X if X="^" user aborted addressing, else X=""
N XMV,XMINSTR,XMABORT,XMDUN
S XMABORT=0
I XMDUZ'>0 N XMDUZ S XMDUZ=DUZ
D INITAPI^XMVVITAE
I $D(XMDF) S XMINSTR("ADDR FLAGS")="R" ; No addressee restrictions
I $D(XMTO) S XMINSTR("TO PROMPT")=XMTO
D INIT^XMXADDR
D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,"",.XMABORT) ;Send
I XMABORT D Q
. S XMOUT=1,X=U
. D CLEANUP^XMXADDR
K XMOUT
S X=""
D SW
I $D(XMINSTR("SELF BSKT")) S XMY(XMDUZ,0)=XMINSTR("SELF BSKT")
I $D(XMINSTR("SHARE BSKT")) S XMY(.6,0)=XMINSTR("SHARE BSKT")
I $D(XMINSTR("SHARE DATE")) S XMY(.6,"D")=XMINSTR("SHARE DATE")
D CLEANUP^XMXADDR
Q
SW ;
N %X,%Y
S %X="^TMP(""XMY"","_$J_",",%Y="XMY(" D %XY^%RCR
Q
INST ; Non-interactive addressing (Just fall thru to WHO)
WHO ; Non-interactive addressing
; Needs:
; XMDUZ user's DUZ
; X local or remote address
; (-X will remove address)
; XMDF if $D(XMDF) then do not restrict addressees
; XMLOC if $D(XMLOC), forces output of XMMG error message if error
; Output:
; XMY address: XMY(address)=""
; Y if Y=-1, then lookup has failed
; = <DUZ^full name> if local addressee
; = <domain ien^domain name> if remote addressee
; XMMG contains error message if Y=-1
; = "" if local addressee
; = via domain message if remote addressee
N XMV,XMINSTR,XMSTRIKE
I XMDUZ'>0 N XMDUZ S XMDUZ=DUZ
D INITAPI^XMVVITAE
I $D(XMDF) S XMINSTR("ADDR FLAGS")="R" ; No addressee restrictions
D INIT^XMXADDR
I $E(X)="-" S XMSTRIKE=1,X=$E(X,2,99)
K XMERR,^TMP("XMERR",$J)
D CHKADDR^XMXADDR(XMDUZ,X,.XMINSTR,"",.Y)
I $D(XMERR) D Q
. S XMMG=^TMP("XMERR",$J,1,"TEXT",1)
. K XMERR,^TMP("XMERR",$J)
. S Y=-1
. I $D(XMLOC) W " ",XMMG
. D CLEANUP^XMXADDR
I $G(XMSTRIKE) D Q
. N XMADDR
. S X=Y
. S XMADDR=""
. F S XMADDR=$O(^TMP("XMY",$J,XMADDR)) Q:XMADDR="" K XMY(XMADDR)
. S XMMG=""
. D CLEANUP^XMXADDR
I Y["@" D Q
. N XMIEN
. S XMIEN=^TMP("XMY",$J,Y) ; IEN
. S XMY(Y)=XMIEN
. S X=$P(Y,"@",2)
. S Y=XMIEN_U_$P(^DIC(4.2,XMIEN,0),U,1)
. S XMMG=$$EZBLD^DIALOG(39101,$P(Y,U,2)) ; via |1|
. D CLEANUP^XMXADDR
D SW
I $E(X,1,2)="G." D
. S X=$E(Y,3,99)
. S Y=$O(^XMB(3.8,"B",X,0))_U_X ; ien^mail group name
E I $L(X>2),".D.H.S."[("."_$E(X,1,2)) D
. S X=$E(Y,3,99)
. S Y=XMY(Y)_U_X ; ien^full name
E D
. S X=Y ; full name
. S Y=$O(XMY(""))_U_Y ; duz^full name
S XMMG=""
D CLEANUP^XMXADDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMA21 4155 printed Apr 09, 2024@21:14:52 Page 2
XMA21 ;ISC-SF/GMB-Address lookup APIs ;07/17/2003 13:03
+1 ;;8.0;MailMan;**20**;Jun 28, 2002
+2 ; Was (WASH ISC)/CAP
+3 ;
+4 ; Entry points (DBIA 10067):
+5 ; CHK Check to see if a user is a member of a mail group.
+6 ; DES Interactive addressing. Set next default recipient.
+7 ; DEST Interactive addressing. Set first default recipient.
+8 ; INST Non-interactive addressing. (Same as WHO)
+9 ; WHO Non-interactive addressing.
+10 ;
+11 ; Entry points used by MailMan options (not covered by DBIA):
+12 ; DX XMDXNAME - Test name resolution (interactive)
+13 ;
CHK ; Check to see if a user is a member of a mail group.
+1 ; Sets $T if member.
+2 ; Needs:
+3 ; XMDUZ DUZ of the user
+4 ; Y IEN of the mail group
+5 IF $DATA(^XMB(3.8,Y,1,"B",XMDUZ))
QUIT
+6 QUIT
DX ;
+1 NEW XMINSTR,XMV,XMABORT
+2 DO INITAPI^XMVVITAE
+3 SET XMABORT=0
+4 DO INIT^XMXADDR
+5 ;Send
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,"",XMABORT)
+6 DO CLEANUP^XMXADDR
+7 QUIT
DES ; Interactive addressing. Set next default recipient.
+1 ; XMY is not killed upon entry.
+2 ; Needs:
+3 ; XMMG Next default recipient
+4 ; See entry point TO for other needs and outputs associated with
+5 ; this entry point.
+6 DO TO(.XMMG)
+7 QUIT
DEST ; Interactive addressing. Set first default recipient.
+1 ; XMY is killed upon entry.
+2 ; Needs:
+3 ; XMDUN First default recipient
+4 ; See entry point TO for other needs and outputs associated with
+5 ; this entry point.
+6 KILL XMY
+7 DO TO(XMDUN)
+8 QUIT
TO(XMTO) ;
+1 ; Entry points DES and DEST also Need:
+2 ; XMDUZ DUZ of user
+3 ; XMDF if $D(XMDF) then do not restrict addressees
+4 ; Output:
+5 ; XMY( Array of addressees: XMY(addressee)=""
+6 ; XMOUT if $D(XMOUT) user aborted addressing
+7 ; X if X="^" user aborted addressing, else X=""
+8 NEW XMV,XMINSTR,XMABORT,XMDUN
+9 SET XMABORT=0
+10 IF XMDUZ'>0
NEW XMDUZ
SET XMDUZ=DUZ
+11 DO INITAPI^XMVVITAE
+12 ; No addressee restrictions
IF $DATA(XMDF)
SET XMINSTR("ADDR FLAGS")="R"
+13 IF $DATA(XMTO)
SET XMINSTR("TO PROMPT")=XMTO
+14 DO INIT^XMXADDR
+15 ;Send
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,"",.XMABORT)
+16 IF XMABORT
Begin DoDot:1
+17 SET XMOUT=1
SET X=U
+18 DO CLEANUP^XMXADDR
End DoDot:1
QUIT
+19 KILL XMOUT
+20 SET X=""
+21 DO SW
+22 IF $DATA(XMINSTR("SELF BSKT"))
SET XMY(XMDUZ,0)=XMINSTR("SELF BSKT")
+23 IF $DATA(XMINSTR("SHARE BSKT"))
SET XMY(.6,0)=XMINSTR("SHARE BSKT")
+24 IF $DATA(XMINSTR("SHARE DATE"))
SET XMY(.6,"D")=XMINSTR("SHARE DATE")
+25 DO CLEANUP^XMXADDR
+26 QUIT
SW ;
+1 NEW %X,%Y
+2 SET %X="^TMP(""XMY"","_$JOB_","
SET %Y="XMY("
DO %XY^%RCR
+3 QUIT
INST ; Non-interactive addressing (Just fall thru to WHO)
WHO ; Non-interactive addressing
+1 ; Needs:
+2 ; XMDUZ user's DUZ
+3 ; X local or remote address
+4 ; (-X will remove address)
+5 ; XMDF if $D(XMDF) then do not restrict addressees
+6 ; XMLOC if $D(XMLOC), forces output of XMMG error message if error
+7 ; Output:
+8 ; XMY address: XMY(address)=""
+9 ; Y if Y=-1, then lookup has failed
+10 ; = <DUZ^full name> if local addressee
+11 ; = <domain ien^domain name> if remote addressee
+12 ; XMMG contains error message if Y=-1
+13 ; = "" if local addressee
+14 ; = via domain message if remote addressee
+15 NEW XMV,XMINSTR,XMSTRIKE
+16 IF XMDUZ'>0
NEW XMDUZ
SET XMDUZ=DUZ
+17 DO INITAPI^XMVVITAE
+18 ; No addressee restrictions
IF $DATA(XMDF)
SET XMINSTR("ADDR FLAGS")="R"
+19 DO INIT^XMXADDR
+20 IF $EXTRACT(X)="-"
SET XMSTRIKE=1
SET X=$EXTRACT(X,2,99)
+21 KILL XMERR,^TMP("XMERR",$JOB)
+22 DO CHKADDR^XMXADDR(XMDUZ,X,.XMINSTR,"",.Y)
+23 IF $DATA(XMERR)
Begin DoDot:1
+24 SET XMMG=^TMP("XMERR",$JOB,1,"TEXT",1)
+25 KILL XMERR,^TMP("XMERR",$JOB)
+26 SET Y=-1
+27 IF $DATA(XMLOC)
WRITE " ",XMMG
+28 DO CLEANUP^XMXADDR
End DoDot:1
QUIT
+29 IF $GET(XMSTRIKE)
Begin DoDot:1
+30 NEW XMADDR
+31 SET X=Y
+32 SET XMADDR=""
+33 FOR
SET XMADDR=$ORDER(^TMP("XMY",$JOB,XMADDR))
if XMADDR=""
QUIT
KILL XMY(XMADDR)
+34 SET XMMG=""
+35 DO CLEANUP^XMXADDR
End DoDot:1
QUIT
+36 IF Y["@"
Begin DoDot:1
+37 NEW XMIEN
+38 ; IEN
SET XMIEN=^TMP("XMY",$JOB,Y)
+39 SET XMY(Y)=XMIEN
+40 SET X=$PIECE(Y,"@",2)
+41 SET Y=XMIEN_U_$PIECE(^DIC(4.2,XMIEN,0),U,1)
+42 ; via |1|
SET XMMG=$$EZBLD^DIALOG(39101,$PIECE(Y,U,2))
+43 DO CLEANUP^XMXADDR
End DoDot:1
QUIT
+44 DO SW
+45 IF $EXTRACT(X,1,2)="G."
Begin DoDot:1
+46 SET X=$EXTRACT(Y,3,99)
+47 ; ien^mail group name
SET Y=$ORDER(^XMB(3.8,"B",X,0))_U_X
End DoDot:1
+48 IF '$TEST
IF $LENGTH(X>2)
IF ".D.H.S."[("."_$EXTRACT(X,1,2))
Begin DoDot:1
+49 SET X=$EXTRACT(Y,3,99)
+50 ; ien^full name
SET Y=XMY(Y)_U_X
End DoDot:1
+51 IF '$TEST
Begin DoDot:1
+52 ; full name
SET X=Y
+53 ; duz^full name
SET Y=$ORDER(XMY(""))_U_Y
End DoDot:1
+54 SET XMMG=""
+55 DO CLEANUP^XMXADDR
+56 QUIT
