- 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 Feb 18, 2025@23:39:16 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
