| [613] | 1 | XMRPCTS ;(KC-VAMC)/XXX-Steal TWIX's from PCTS Host [RCVR] ;03/18/2002 09:10
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; Entry points used by MailMan options (not covered by DBIA):
|
|---|
| 4 | ; PCTS XMNET-TWIX-SEND
|
|---|
| 5 | PCTS ;
|
|---|
| 6 | S %=$$DSP("==>STARTING PCTS DIALOGUE<=="),XMRPCTS("R")=0
|
|---|
| 7 | S XMCOUNT=0
|
|---|
| 8 | ST I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^XMRPCTSA"
|
|---|
| 9 | E S X="ERR^XMRPCTSA",@^%ZOSF("TRAP")
|
|---|
| 10 | D INIT^XMRPCTSA
|
|---|
| 11 | S %=$$DSP("==>Handshaking with PCTS - This make take a while<==")
|
|---|
| 12 | F I=1:1:3 R X:5 Q:$T
|
|---|
| 13 | I X["MREQ" R X:3 S XMMN=$P(X,XMLF,2) G:X[XMET!(XMMN'?1N.N) EXIT S %=$$DSP("==>MREQ") G MAK1
|
|---|
| 14 | I X["MAOK" S %=$$DSP("==>MAOK") D ^XMRPCTS0 G EXIT ; We can send stuff here
|
|---|
| 15 | I X["MEND"!(X[XMET) S %=$$DSP("==>MENDing<==") G EXIT
|
|---|
| 16 | ;S %=$$DSP("===>'"_X_"' Received / Not Understood !!!")
|
|---|
| 17 | S XMCOUNT=XMCOUNT+1 G ST:XMCOUNT<3,EXIT
|
|---|
| 18 | ;
|
|---|
| 19 | MAK1 W "MAK1",XMCR,XMLF,XMMN,XMCR,XMLF,XMET,XMCR S %=$$DSP("<==MAK1/"_XMMN),%=0
|
|---|
| 20 | ;
|
|---|
| 21 | S XMCOUNT=0
|
|---|
| 22 | MDTA F I=1:1:3 R X:5 Q:$T
|
|---|
| 23 | I X["MDTA" R X:3 S XMMN=$P(X,XMLF,2) G:X[XMET EXIT S %=$$DSP("==>MDTA, AMS Message #"_XMMN),XMSUB="PCTS==> AMS Message Number: "_XMMN G SH
|
|---|
| 24 | I X["MEND"!(X[XMET) S %=$$DSP("==>MENDing<==") G EXIT
|
|---|
| 25 | ;S %=$$DSP("===>'"_X_"' Received & Not Understood !!!")
|
|---|
| 26 | S XMCOUNT=XMCOUNT+1 G MDTA:XMCOUNT<3,EXIT
|
|---|
| 27 | ;
|
|---|
| 28 | SH R X:5 G:'$T EXIT S XMHDR=$P(X,XMSH,2) S %=$$DSP("==>"_XMHDR),^TMP($J,1,0)=XMHDR,XMLPC=$$CSUM($C(XMLPC)_XMHDR_XMCR)
|
|---|
| 29 | TT S X1="" F I=2:1 R X:5 Q:'$T D
|
|---|
| 30 | .I X1["NNNN"&(($A($E(X,1)=10))&($A($E(X,2)=25))) R X2:5 Q
|
|---|
| 31 | .S XMLPC=$$CSUM($C(XMLPC)_X_XMCR),X=$$STRLF(X),X1=X
|
|---|
| 32 | .S ^TMP($J,I,0)=X,%=$$DSP("==>"_X)
|
|---|
| 33 | I X1["NNNN" S ^TMP($J,I,0)="------ End of PCTS Message ------",%=$$DSP("==>NNNN Received") D CHKSUM(X) D XM^XMRPCTSA,REPLY^XMRPCTSA K X1 G ST
|
|---|
| 34 | I X1'["NNNN" S %=$$DSP("==>No 'NNNN', End of Message Found") K X1 G EXIT
|
|---|
| 35 | CHKSUM(X) ;Verify the Checksum, We MUST agree.
|
|---|
| 36 | S XMLPC=$$CSUM($C(XMLPC)_XMLF) ;Add in that last LineFeed
|
|---|
| 37 | S XMLPC=$E(XMDH,XMLPC\16+1)_$E(XMDH,XMLPC#16+1) ;The Magic Code
|
|---|
| 38 | ;U IO R X:5 S X=$P(X,$C(25),2) ;Em is 25
|
|---|
| 39 | ;S XMLPC=$S(X=XMLPC:1,1:0) ;Do the checksums match ?
|
|---|
| 40 | ;Hardwire checksum evaluation to be true
|
|---|
| 41 | S XMLPC=1
|
|---|
| 42 | S %=$$DSP("==>CHECKSUM "_$S(XMLPC:"OK",1:"FAILED")_"<==")
|
|---|
| 43 | Q
|
|---|
| 44 | DSP(XMTRAN) D TRAN^XMC1
|
|---|
| 45 | Q "" ;Show us what is going on
|
|---|
| 46 | ;
|
|---|
| 47 | EXIT X ^%ZOSF("TRMOFF")
|
|---|
| 48 | K XMCR,XMLF,XMET,XMSH,XMLPC,XMLMN,XMMN,XMDH
|
|---|
| 49 | S %=$$DSP("==>ENDING PCTS DIALOGUE & RETURNING TO MAILMAN SCRIPT<==")
|
|---|
| 50 | F %="R","S" S XMCNT(%)=$S($G(XMRPCTS(%)):XMRPCTS(%),1:0)
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | STRLF(X) ;Remove leading LineFeed(s) from String
|
|---|
| 54 | N I F I=1:1:$L(X) Q:X'[$C(10) I $A(X)=10 S X=$E(X,2,$L(X))
|
|---|
| 55 | Q (X)
|
|---|
| 56 | CSUM(X) ;Calculate Checksum
|
|---|
| 57 | N Y X ^%ZOSF("LPC") Q Y
|
|---|
