| 1 | XMRPCTSA ;(KC-VAMC)/XXX-Steal TWIX's from PCTS Host [RCVR] ;04/08/98 10:39
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; Create a Mailgroup called PCTS, all messages will be sent to its
|
|---|
| 4 | ; membership. This can be called from a mailman script, it should
|
|---|
| 5 | ; look something like this:
|
|---|
| 6 | ;
|
|---|
| 7 | ; O H=VHA.DMIA,P=SCP <---- Domain name and protocol are meaningless
|
|---|
| 8 | ; C MINI
|
|---|
| 9 | ; L ogin:
|
|---|
| 10 | ; S pcts
|
|---|
| 11 | ; L CODE:
|
|---|
| 12 | ; X W "PCTS RUCHxxx",! <---- This is your local routing indicator
|
|---|
| 13 | ; X S XMRPCTS0=XMCI+1
|
|---|
| 14 | ; X D ^XMRPCTS <---- Call this routine
|
|---|
| 15 | ; X K XMRPCTS0
|
|---|
| 16 | ;-----------------
|
|---|
| 17 | ; Mailman Host: VHA.DMIA, Physical Link: MINIOUT
|
|---|
| 18 | ;-------------------------------------------------------------
|
|---|
| 19 | XM N %,DIC,X,XMDF,XMTEXT,XXX,XMY,XMZ,Y
|
|---|
| 20 | S %=$$DSP("<==Locally Mailing AMS Message"),XMRPCTS("R")=XMRPCTS("R")+1
|
|---|
| 21 | N XM,XMCHAN,ZTSK,ZTQUEUED S ZTSK=1,ZTQUEUED=1,XMCHAN=1
|
|---|
| 22 | S XMDF=1,U="^",XMTEXT="^TMP($J,",XMDUZ=.5
|
|---|
| 23 | S XMY("G.PCTS")="",XMY(XMDUZ)="",XXX=XMSUB D ^XMD S XMLMN=XMZ
|
|---|
| 24 | ;--Make it look like a network message so we can track some info
|
|---|
| 25 | S ^XMB(3.9,XMZ,2,.001,0)="Received: from PCTS/AMS by "_^XMB("NETNAME")_" via DMI/MM translation with SSP."
|
|---|
| 26 | S ^XMB(3.9,XMZ,2,.002,0)="Subject: "_XXX
|
|---|
| 27 | S ^XMB(3.9,XMZ,2,.003,0)="Date: "_$$INDT^XMXUTIL1($$NOW^XLFDT())
|
|---|
| 28 | S ^XMB(3.9,XMZ,2,.004,0)="Message-ID:<"_$P(XMMN," ")_"@AMS>"
|
|---|
| 29 | S ^XMB(3.9,XMZ,2,.005,0)="From: The Austin AMS System"
|
|---|
| 30 | S ^XMB(3.9,XMZ,2,.006,0)="To: G.PCTS"
|
|---|
| 31 | S ^XMB(3.9,XMZ,2,.007,0)="X-Another service provided by DHCP"
|
|---|
| 32 | S ^XMB(3.9,XMZ,2,.008,0)=""
|
|---|
| 33 | Q
|
|---|
| 34 | REPLY ;Let AMS know we have the message OK and what our local msg number is
|
|---|
| 35 | S %=$$DSP("<==MAK2, Message #"_XMLMN_" Removed from AMS Queue")
|
|---|
| 36 | U IO W "MAK2",!,XMMN,!,"#"_XMLMN,!,XMET,XMCR Q
|
|---|
| 37 | ;
|
|---|
| 38 | INIT ;called from XMRPCTS & XMRPCTS0
|
|---|
| 39 | S %=$$DSP("==>Initializing<==")
|
|---|
| 40 | I '$G(XMCI) S XMCI=$S($G(XMRPCTS0):XMRPCTS0,1:999999) I XMCI>999 S ER=1,Y="Lost the counter to the script processor (XMCI)."
|
|---|
| 41 | S %=0,XMCR=$C(13),XMLF=$C(10),XMET=$C(4),XMSH=$C(1)
|
|---|
| 42 | D TERMON
|
|---|
| 43 | K ^TMP($J) ;Scratch Space
|
|---|
| 44 | S XMLPC=0 ;Longitudinal Parity Check for SSP
|
|---|
| 45 | S XMDH="0123456789ABCDEF" ; for LPC calculations
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | TERMON ;Need to change read terminators
|
|---|
| 49 | I ^%ZOSF("OS")["DSM" U IO:TERM=$C(3,4,13,27) Q
|
|---|
| 50 | I ^%ZOSF("OS")["MSM" U IO:(::::::::$C(3,4,13,27)) Q
|
|---|
| 51 | I ^%ZOSF("OS")["OpenM-NT" U $I:("":"+I-T":$C(3,4,13,27)) Q
|
|---|
| 52 | W XMRPCTS("ERROR"),"Terminators not defined for this operating system",!
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | DSP(XMTRAN) D TRAN^XMC1
|
|---|
| 56 | Q ""
|
|---|
| 57 | ;
|
|---|
| 58 | ERR D ^%ZTER S %=$$DSP("ERROR captured in error trap !!!")
|
|---|
| 59 | G UNWIND^%ZTER
|
|---|
