- XMAH1 ;(WASH ISC)/CAP- Network Responses ;3/25/91 20:13 ; [ 02/22/96 9:27 AM ]
- ;;7.1;Mailman;**1003**;OCT 27, 1998
- ;;7.1;MailMan;**4**;Jun 02, 1994
- ENTA G AQ:XMK>.999,AQ:"Yy"[$E($P(XMR,U,12)_" ")
- S Y=$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
- I Y,$D(^XMB(3.9,XMZ,1,Y,"T")) G AZ:^("T")="I"
- W *7,!!," << Message SAVED in IN Basket ! >>",!
- S (XMK,XMKM)=1,XMKN="IN",XMKD=.5 D NEW^XMA,KL^XMA1B,S2^XMA1B K XMKD,XMKM S XMKS=""
- AQ ;Is it a network response ? (current code just checks sender)
- ;IHS/MFD added ,IHSREC and ,IHSREC=1 below
- ;IHSREC -the sender is from another domain, also used for other domain
- ; recipients under IHS1 subroutine
- ;IHS -one or more recipients are of another domain
- ;IHSNET -the send across network question has already been asked
- ;FORUM is screened when sender is from there
- ;R mfd ;for testing
- K XMNETREC,IHSREC I XMDUZ'=.6,$S($P(XMR,U,2)["@":1,1:0),$S($P(XMR,U,2)["DOMAIN.NAME":0,1:1) S XMNETREC=1,IHSREC=1
- K IHS,IHSNET D IHS ;IHS/MFD added line
- D REPLY^XMA11 K XMSUB I X[U K XMNETREC G AZ
- W !!," << LOCAL Reply Sent >>",!
- AQ1 ;I $S('$D(XMNETREC):0,XMNETREC:1,1:0) K XMCHAN D AR ;IHS/MFD comm out
- I $S('$D(IHSREC):0,IHSREC:1,1:0) K XMCHAN K IHSREC D AR ;IHS/MFD added line
- I $D(IHS) D IHS1 K IHSX,IHS,IHSNET,IHSREC ;IHS/MFD added line
- AZ G C1^XMA1
- AR K XMY,XMY0,^TMP("XMY",$J),^TMP("XMY0",$J)
- ;
- G ARN:$D(IHSNET)
- G ARN:$D(XMCHAN) D ZIS
- ARA W *7,$S($D(IORVON):IORVON,1:""),!,"Do you wish to send this reply across the network ? YES//",$S($D(IORVOFF):IORVOFF,1:"") R X:DTIME ;IHS/MFD changed NO to YES for default
- S IHSNET=""
- G ARS:X["^" S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- ;G ARS:$E("NO",1,$L(X))=X,ARN:$E("YES",1,$L(X))=X
- G ARN:$E("YES",1,$L(X))=X,ARS:$E("NO",1,$L(X))=X ;IHS/MFD added line
- W !!,$C(7)_"Enter 'Yes' if you wish to send this message across the network."
- W !,"Enter 'No' if you wish your response to remain local."
- W !,"The sender of this message will not see your response if you answer 'No'."
- W !!,"CAUTION !!!",!!
- W "A network response will go to all message recipients on the mail system"
- W !,"of the sender. FOR EXAMPLE, If the sender's address ends '@DOMAIN.NAME'"
- W !,"and the message had 500 recipients on FORUM, then a response sent across"
- W !,"the network will be delivered to 500 recipients. If you prefer to send a"
- W !,"response only to the sender, you should create a new message.",!!
- G ARA
- ARN S XMNETREC(0)=XMZ,XMSUB="Reply to: "_$E($P(XMR,U),1,50)
- S XMNETREC("XMR")=XMR,XMR=^XMB(3.9,XMNETREC,0),$P(XMR,U,8)=XMZ,XMZ=XMNETREC I $D(XMCHAN)!($D(IHS)) S $P(XMR,U)=XMSUB,^(0)=XMR
- I '$D(XMCHAN),'$D(IHSNET) S X=0 D ENTS^XMA20 W ! ;IHS/MFD comm out ask of subject
- I $S(X=U:1,'$D(^XMB(3.9,XMZ,0)):1,1:0) G ARS
- S X=XMSUB ;IHS/MFD added line
- S Y=$P(^XMB(3.9,XMZ,0),U) I $L(Y) K ^XMB(3.9,"B",$E(Y,1,30),XMZ)
- S ^XMB(3.9,"B",$E(X,1,30),XMZ)="",$P(XMR,U,1,2)=X_U_$S($D(XMDUZ):XMDUZ,1:DUZ),^XMB(3.9,XMZ,0)=XMR,XMN=0
- ;
- ;Send Network Response to Sender's home system
- S (Y1,X)=$P($$NET^XMRENT(XMNETREC(0)),U,3) I $G(X)="" S (Y1,X)=$P(^XMB(3.9,XMNETREC(0),0),U,2)
- I $D(IHSREC) S (Y1,X)=IHSREC K IHSREC
- I X["@" D ACHK I Y<0,'$D(XMCHAN) W !,"Reply NOT sent to sender.",*7 S Y=$S($P(X,"@")["POSTMASTER":"No responses allowed to remote Postmaster",1:"no known path") W !,*7,"(",$S('$D(XMMG):Y,XMMG="":Y,1:XMMG),")"
- S Y=$S($D(^XMB(3.9,XMNETREC(0),5)):^(5),1:XMNETREC(0)_"@"_^XMB("NETNAME")),%=$S($D(^XMB(3.9,XMNETREC(0),"K")):^("K"),1:""),^XMB(3.9,XMZ,"IN")=Y I $L(%) S ^("K")=%
- D ENT1^XMAD1 D POP ;I '$D(XMCHAN) W !,"Network Reply complete !" ;IHS/MFD commented out
- Q:$D(IHS) ;IHS/MFD
- ARQ K XMNETREC,XMSUB Q
- ARS W !!,"Response will only be local !",!! D POP G ARQ
- ACHK I X["@",$P(X,"@")["POSTMASTER" S Y=-1,XMMG="Replies to message from remote POSTMASTERS not allowed !"_$C(7) Q
- N % D INSTXM^XMA21 Q
- ZIS Q:$D(IORVON) S X="IORVON;IORVOFF;IOBON;IOBOFF" D ENDR^%ZISS Q
- POP Q:'$D(XMNETREC(0)) S XMZ=XMNETREC(0),XMR=XMNETREC("XMR") Q
- IHS ;IHS/MFD added subroutine looking for network recipients
- N X S X=""
- F S X=$O(^XMB(3.9,XMZ,1,"C",X)) Q:X="" I X["@" S (XMNETREC,IHS)=1 Q
- Q
- IHS1 S IHSX=""
- F S IHSX=$O(^XMB(3.9,XMZ,1,"C",IHSX)) Q:IHSX="" I IHSX["@" S IHSREC="<"_IHSX_">" I $D(XMNETREC) D AR
- Q
- XMAH1 ;(WASH ISC)/CAP- Network Responses ;3/25/91 20:13 ; [ 02/22/96 9:27 AM ]
- +1 ;;7.1;Mailman;**1003**;OCT 27, 1998
- +2 ;;7.1;MailMan;**4**;Jun 02, 1994
- ENTA IF XMK>.999
- GOTO AQ
- IF "Yy"[$EXTRACT($PIECE(XMR,U,12)_" ")
- GOTO AQ
- +1 SET Y=$ORDER(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
- +2 IF Y
- IF $DATA(^XMB(3.9,XMZ,1,Y,"T"))
- IF ^("T")="I"
- GOTO AZ
- +3 WRITE *7,!!," << Message SAVED in IN Basket ! >>",!
- +4 SET (XMK,XMKM)=1
- SET XMKN="IN"
- SET XMKD=.5
- DO NEW^XMA
- DO KL^XMA1B
- DO S2^XMA1B
- KILL XMKD,XMKM
- SET XMKS=""
- AQ ;Is it a network response ? (current code just checks sender)
- +1 ;IHS/MFD added ,IHSREC and ,IHSREC=1 below
- +2 ;IHSREC -the sender is from another domain, also used for other domain
- +3 ; recipients under IHS1 subroutine
- +4 ;IHS -one or more recipients are of another domain
- +5 ;IHSNET -the send across network question has already been asked
- +6 ;FORUM is screened when sender is from there
- +7 ;R mfd ;for testing
- +8 KILL XMNETREC,IHSREC
- IF XMDUZ'=.6
- IF $SELECT($PIECE(XMR,U,2)["@":1,1:0)
- IF $SELECT($PIECE(XMR,U,2)["DOMAIN.NAME":0,1:1)
- SET XMNETREC=1
- SET IHSREC=1
- +9 ;IHS/MFD added line
- KILL IHS,IHSNET
- DO IHS
- +10 DO REPLY^XMA11
- KILL XMSUB
- IF X[U
- KILL XMNETREC
- GOTO AZ
- +11 WRITE !!," << LOCAL Reply Sent >>",!
- AQ1 ;I $S('$D(XMNETREC):0,XMNETREC:1,1:0) K XMCHAN D AR ;IHS/MFD comm out
- +1 ;IHS/MFD added line
- IF $SELECT('$DATA(IHSREC):0,IHSREC:1,1:0)
- KILL XMCHAN
- KILL IHSREC
- DO AR
- +2 ;IHS/MFD added line
- IF $DATA(IHS)
- DO IHS1
- KILL IHSX,IHS,IHSNET,IHSREC
- AZ GOTO C1^XMA1
- AR KILL XMY,XMY0,^TMP("XMY",$JOB),^TMP("XMY0",$JOB)
- +1 ;
- +2 IF $DATA(IHSNET)
- GOTO ARN
- +3 IF $DATA(XMCHAN)
- GOTO ARN
- DO ZIS
- ARA ;IHS/MFD changed NO to YES for default
- WRITE *7,$SELECT($DATA(IORVON):IORVON,1:""),!,"Do you wish to send this reply across the network ? YES//",$SELECT($DATA(IORVOFF):IORVOFF,1:"")
- READ X:DTIME
- +1 SET IHSNET=""
- +2 IF X["^"
- GOTO ARS
- SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +3 ;G ARS:$E("NO",1,$L(X))=X,ARN:$E("YES",1,$L(X))=X
- +4 ;IHS/MFD added line
- IF $EXTRACT("YES",1,$LENGTH(X))=X
- GOTO ARN
- IF $EXTRACT("NO",1,$LENGTH(X))=X
- GOTO ARS
- +5 WRITE !!,$CHAR(7)_"Enter 'Yes' if you wish to send this message across the network."
- +6 WRITE !,"Enter 'No' if you wish your response to remain local."
- +7 WRITE !,"The sender of this message will not see your response if you answer 'No'."
- +8 WRITE !!,"CAUTION !!!",!!
- +9 WRITE "A network response will go to all message recipients on the mail system"
- +10 WRITE !,"of the sender. FOR EXAMPLE, If the sender's address ends '@DOMAIN.NAME'"
- +11 WRITE !,"and the message had 500 recipients on FORUM, then a response sent across"
- +12 WRITE !,"the network will be delivered to 500 recipients. If you prefer to send a"
- +13 WRITE !,"response only to the sender, you should create a new message.",!!
- +14 GOTO ARA
- ARN SET XMNETREC(0)=XMZ
- SET XMSUB="Reply to: "_$EXTRACT($PIECE(XMR,U),1,50)
- +1 SET XMNETREC("XMR")=XMR
- SET XMR=^XMB(3.9,XMNETREC,0)
- SET $PIECE(XMR,U,8)=XMZ
- SET XMZ=XMNETREC
- IF $DATA(XMCHAN)!($DATA(IHS))
- SET $PIECE(XMR,U)=XMSUB
- SET ^(0)=XMR
- +2 ;IHS/MFD comm out ask of subject
- IF '$DATA(XMCHAN)
- IF '$DATA(IHSNET)
- SET X=0
- DO ENTS^XMA20
- WRITE !
- +3 IF $SELECT(X=U:1,'$DATA(^XMB(3.9,XMZ,0)):1,1:0)
- GOTO ARS
- +4 ;IHS/MFD added line
- SET X=XMSUB
- +5 SET Y=$PIECE(^XMB(3.9,XMZ,0),U)
- IF $LENGTH(Y)
- KILL ^XMB(3.9,"B",$EXTRACT(Y,1,30),XMZ)
- +6 SET ^XMB(3.9,"B",$EXTRACT(X,1,30),XMZ)=""
- SET $PIECE(XMR,U,1,2)=X_U_$SELECT($DATA(XMDUZ):XMDUZ,1:DUZ)
- SET ^XMB(3.9,XMZ,0)=XMR
- SET XMN=0
- +7 ;
- +8 ;Send Network Response to Sender's home system
- +9 SET (Y1,X)=$PIECE($$NET^XMRENT(XMNETREC(0)),U,3)
- IF $GET(X)=""
- SET (Y1,X)=$PIECE(^XMB(3.9,XMNETREC(0),0),U,2)
- +10 IF $DATA(IHSREC)
- SET (Y1,X)=IHSREC
- KILL IHSREC
- +11 IF X["@"
- DO ACHK
- IF Y<0
- IF '$DATA(XMCHAN)
- WRITE !,"Reply NOT sent to sender.",*7
- SET Y=$SELECT($PIECE(X,"@")["POSTMASTER":"No responses allowed to remote Postmaster",1:"no known path")
- WRITE !,*7,"(",$SELECT('$DATA(XMMG):Y,XMMG="":Y,1:XMMG),")"
- +12 SET Y=$SELECT($DATA(^XMB(3.9,XMNETREC(0),5)):^(5),1:XMNETREC(0)_"@"_^XMB("NETNAME"))
- SET %=$SELECT($DATA(^XMB(3.9,XMNETREC(0),"K")):^("K"),1:"")
- SET ^XMB(3.9,XMZ,"IN")=Y
- IF $LENGTH(%)
- SET ^("K")=%
- +13 ;I '$D(XMCHAN) W !,"Network Reply complete !" ;IHS/MFD commented out
- DO ENT1^XMAD1
- DO POP
- +14 ;IHS/MFD
- IF $DATA(IHS)
- QUIT
- ARQ KILL XMNETREC,XMSUB
- QUIT
- ARS WRITE !!,"Response will only be local !",!!
- DO POP
- GOTO ARQ
- ACHK IF X["@"
- IF $PIECE(X,"@")["POSTMASTER"
- SET Y=-1
- SET XMMG="Replies to message from remote POSTMASTERS not allowed !"_$CHAR(7)
- QUIT
- +1 NEW %
- DO INSTXM^XMA21
- QUIT
- ZIS IF $DATA(IORVON)
- QUIT
- SET X="IORVON;IORVOFF;IOBON;IOBOFF"
- DO ENDR^%ZISS
- QUIT
- POP IF '$DATA(XMNETREC(0))
- QUIT
- SET XMZ=XMNETREC(0)
- SET XMR=XMNETREC("XMR")
- QUIT
- IHS ;IHS/MFD added subroutine looking for network recipients
- +1 NEW X
- SET X=""
- +2 FOR
- SET X=$ORDER(^XMB(3.9,XMZ,1,"C",X))
- IF X=""
- QUIT
- IF X["@"
- SET (XMNETREC,IHS)=1
- QUIT
- +3 QUIT
- IHS1 SET IHSX=""
- +1 FOR
- SET IHSX=$ORDER(^XMB(3.9,XMZ,1,"C",IHSX))
- IF IHSX=""
- QUIT
- IF IHSX["@"
- SET IHSREC="<"_IHSX_">"
- IF $DATA(XMNETREC)
- DO AR
- +2 QUIT
