source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMRPCTS.m@ 1076

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1XMRPCTS ;(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
5PCTS ;
6 S %=$$DSP("==>STARTING PCTS DIALOGUE<=="),XMRPCTS("R")=0
7 S XMCOUNT=0
8ST 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 ;
19MAK1 W "MAK1",XMCR,XMLF,XMMN,XMCR,XMLF,XMET,XMCR S %=$$DSP("<==MAK1/"_XMMN),%=0
20 ;
21 S XMCOUNT=0
22MDTA 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 ;
28SH 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)
29TT 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
35CHKSUM(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
44DSP(XMTRAN) D TRAN^XMC1
45 Q "" ;Show us what is going on
46 ;
47EXIT 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 ;
53STRLF(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)
56CSUM(X) ;Calculate Checksum
57 N Y X ^%ZOSF("LPC") Q Y
Note: See TracBrowser for help on using the repository browser.