source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMRPCTSA.m@ 836

Last change on this file since 836 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1XMRPCTSA ;(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 ;-------------------------------------------------------------
19XM 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
34REPLY ;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 ;
38INIT ;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 ;
48TERMON ;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 ;
55DSP(XMTRAN) D TRAN^XMC1
56 Q ""
57 ;
58ERR D ^%ZTER S %=$$DSP("ERROR captured in error trap !!!")
59 G UNWIND^%ZTER
Note: See TracBrowser for help on using the repository browser.