XMRPCTSA.m

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

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