- 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 Jan 18, 2025@03:11:50 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