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