Released XM*8*45 SEQ #41 Extracted from mail message **KIDS**:XM*8.0*45^ **INSTALL NAME** XM*8.0*45 "BLD",9392,0) XM*8.0*45^MAILMAN^0^3130619^y "BLD",9392,1,0) ^^6^6^3130508^ "BLD",9392,1,1,0) "BLD",9392,1,2,0) This patch will address the following issues: "BLD",9392,1,3,0) 1. Mailman returns an error "may not be real person" "BLD",9392,1,4,0) 2. Partial message is being delivered due to multiple "BLD",9392,1,5,0) message parts that come through from different servers at different times. "BLD",9392,1,6,0) 3. Compile errors on the $ZC command. "BLD",9392,4,0) ^9.64PA^^ "BLD",9392,6.3) 8 "BLD",9392,"ABPKG") n "BLD",9392,"KRN",0) ^9.67PA^779.2^20 "BLD",9392,"KRN",.4,0) .4 "BLD",9392,"KRN",.401,0) .401 "BLD",9392,"KRN",.402,0) .402 "BLD",9392,"KRN",.403,0) .403 "BLD",9392,"KRN",.5,0) .5 "BLD",9392,"KRN",.84,0) .84 "BLD",9392,"KRN",3.6,0) 3.6 "BLD",9392,"KRN",3.8,0) 3.8 "BLD",9392,"KRN",9.2,0) 9.2 "BLD",9392,"KRN",9.8,0) 9.8 "BLD",9392,"KRN",9.8,"NM",0) ^9.68A^7^7 "BLD",9392,"KRN",9.8,"NM",1,0) XMXPARM^^0^B68128895 "BLD",9392,"KRN",9.8,"NM",2,0) XMTDO^^0^B5148040 "BLD",9392,"KRN",9.8,"NM",3,0) XML1CRC^^0^B12800225 "BLD",9392,"KRN",9.8,"NM",4,0) XML4CRC^^0^B19995633 "BLD",9392,"KRN",9.8,"NM",5,0) XML4CRC1^^0^B12862513 "BLD",9392,"KRN",9.8,"NM",6,0) XMLSWP^^0^B10332361 "BLD",9392,"KRN",9.8,"NM",7,0) XMLSWP0^^0^B10115149 "BLD",9392,"KRN",9.8,"NM","B","XML1CRC",3) "BLD",9392,"KRN",9.8,"NM","B","XML4CRC",4) "BLD",9392,"KRN",9.8,"NM","B","XML4CRC1",5) "BLD",9392,"KRN",9.8,"NM","B","XMLSWP",6) "BLD",9392,"KRN",9.8,"NM","B","XMLSWP0",7) "BLD",9392,"KRN",9.8,"NM","B","XMTDO",2) "BLD",9392,"KRN",9.8,"NM","B","XMXPARM",1) "BLD",9392,"KRN",19,0) 19 "BLD",9392,"KRN",19,"NM",0) ^9.68A^^ "BLD",9392,"KRN",19.1,0) 19.1 "BLD",9392,"KRN",101,0) 101 "BLD",9392,"KRN",409.61,0) 409.61 "BLD",9392,"KRN",771,0) 771 "BLD",9392,"KRN",779.2,0) 779.2 "BLD",9392,"KRN",870,0) 870 "BLD",9392,"KRN",8989.51,0) 8989.51 "BLD",9392,"KRN",8989.52,0) 8989.52 "BLD",9392,"KRN",8994,0) 8994 "BLD",9392,"KRN","B",.4,.4) "BLD",9392,"KRN","B",.401,.401) "BLD",9392,"KRN","B",.402,.402) "BLD",9392,"KRN","B",.403,.403) "BLD",9392,"KRN","B",.5,.5) "BLD",9392,"KRN","B",.84,.84) "BLD",9392,"KRN","B",3.6,3.6) "BLD",9392,"KRN","B",3.8,3.8) "BLD",9392,"KRN","B",9.2,9.2) "BLD",9392,"KRN","B",9.8,9.8) "BLD",9392,"KRN","B",19,19) "BLD",9392,"KRN","B",19.1,19.1) "BLD",9392,"KRN","B",101,101) "BLD",9392,"KRN","B",409.61,409.61) "BLD",9392,"KRN","B",771,771) "BLD",9392,"KRN","B",779.2,779.2) "BLD",9392,"KRN","B",870,870) "BLD",9392,"KRN","B",8989.51,8989.51) "BLD",9392,"KRN","B",8989.52,8989.52) "BLD",9392,"KRN","B",8994,8994) "BLD",9392,"QUES",0) ^9.62^^ "BLD",9392,"REQB",0) ^9.611^1^1 "BLD",9392,"REQB",1,0) XM*8.0*15^1 "BLD",9392,"REQB","B","XM*8.0*15",1) "MBREQ") 0 "PKG",54,-1) 1^1 "PKG",54,0) MAILMAN^XM^Electronic Mail, both local and networked "PKG",54,20,0) ^9.402P^^ "PKG",54,22,0) ^9.49I^1^1 "PKG",54,22,1,0) 8.0^3020815^3020826^66481 "PKG",54,22,1,"PAH",1,0) 45^3130619 "PKG",54,22,1,"PAH",1,1,0) ^^6^6^3130619 "PKG",54,22,1,"PAH",1,1,1,0) "PKG",54,22,1,"PAH",1,1,2,0) This patch will address the following issues: "PKG",54,22,1,"PAH",1,1,3,0) 1. Mailman returns an error "may not be real person" "PKG",54,22,1,"PAH",1,1,4,0) 2. Partial message is being delivered due to multiple "PKG",54,22,1,"PAH",1,1,5,0) message parts that come through from different servers at different times. "PKG",54,22,1,"PAH",1,1,6,0) 3. Compile errors on the $ZC command. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 7 "RTN","XML1CRC") 0^3^B12800225^B12736464 "RTN","XML1CRC",1,0) XML1CRC ;(WASH ISC)/RJ-OS Check Sum ;04/17/2002 10:58 "RTN","XML1CRC",2,0) ;;8.0;MailMan;**45**;Jun 28, 2002;Build 8 "RTN","XML1CRC",3,0) OPEN D GET,OP "RTN","XML1CRC",4,0) S:'$D(XMESC) XMESC="~" S:'$D(XMFS) XMFS=255 S:'$D(XM) XM="" S (XMSSQ,XMRSQ)=1 Q "RTN","XML1CRC",5,0) GET S X=XMCHAN,DIC="^DIC(3.4,",DIC(0)="Z" D ^DIC S XMCHAN=+Y "RTN","XML1CRC",6,0) I '$D(^DIC(3.4,XMCHAN,0)) S ER=1,Y="Invalid channel" Q "RTN","XML1CRC",7,0) G2 S XMPROT=$P(^DIC(3.4,XMCHAN,0),U) "RTN","XML1CRC",8,0) F X=1:1:4 S @($P("XMSEN^XMREC^XMOPEN^XMCLOSE",U,X))=$S($D(^(X)):^(X),1:"Q") "RTN","XML1CRC",9,0) Q "RTN","XML1CRC",10,0) OP I $D(XMOPEN) X:$L(XMOPEN) XMOPEN "RTN","XML1CRC",11,0) I '$D(XMQUIET) S X=255 X ^%ZOSF("RM") "RTN","XML1CRC",12,0) Q "RTN","XML1CRC",13,0) C X ^%ZOSF("EON") "RTN","XML1CRC",14,0) I $D(XMCLOSE) X:$L(XMCLOSE) XMCLOSE "RTN","XML1CRC",15,0) Q "RTN","XML1CRC",16,0) SEND ;returns ER(0 OR 1), XMLER=number of "soft" errors "RTN","XML1CRC",17,0) I $L(XMSG)>255 S XMLER=0,ER=1 G SRQ "RTN","XML1CRC",18,0) I XMSG'?.ANP F %=1:1:$L(XMSG) I $E(XMSG,%)?1C,$A(XMSG,%)'=9 S XMSG=$E(XMSG,1,%-1)_$E(XMSG,%+1,999) Q:XMSG?.ANP S %=%-1 "RTN","XML1CRC",19,0) D SRINIT S X=XMSG D SUM "RTN","XML1CRC",20,0) I $G(XMINST) D XMTSTAT^XMTDR(XMINST,"S",XMSG,0) ; 1SCP "RTN","XML1CRC",21,0) SL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT "RTN","XML1CRC",22,0) I ER W XMLERR,$C(13) G SRQ "RTN","XML1CRC",23,0) D BUFLUSH W XMSG,$C(13),XMLINE,U,XMSUM,$C(13) R XMLX:XMLTIME G:XMLX=(XMLINE_U_XMLACK) SRQ "RTN","XML1CRC",24,0) S XMLY=XMLX=(XMLINE_U_XMLNAK),XMLZ=0 D:'XMLY ENQ G SL:XMLY,SRQ "RTN","XML1CRC",25,0) ENQ ;ACK/NAK garbled / re-establish contact "RTN","XML1CRC",26,0) S XMLZ=XMLZ+1 I XMLZ>XMLMAXER S (ER,XMLY)=1 Q "RTN","XML1CRC",27,0) D BUFLUSH W XMLENQ,$C(13) R XMLX:XMLTIME Q:XMLX=(XMLINE_U_XMLACK) "RTN","XML1CRC",28,0) I XMLX[XMLACK!(XMLX[XMLNAK),+XMLX=XMLINE!(+XMLX=XMLINE-1) S XMLY=1 Q "RTN","XML1CRC",29,0) H 1 G ENQ "RTN","XML1CRC",30,0) REC ;SEE SEND "RTN","XML1CRC",31,0) D SRINIT S:'$D(XMLAN) XMLAN=XMLINE_U_XMLNAK "RTN","XML1CRC",32,0) I $D(XMRG),$G(XMINST) D XMTSTAT^XMTDR(XMINST,"R",XMRG,0) ; 1SCP "RTN","XML1CRC",33,0) RL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT I ER=1 G SRQ "RTN","XML1CRC",34,0) R XMRG#255:$S($D(XMSTIME):XMSTIME,1:XMLTIME) "RTN","XML1CRC",35,0) S XMLZ=$S('$T:-1,XMRG=XMLENQ:0,XMRG=XMLERR:2,1:1) "RTN","XML1CRC",36,0) S ER=XMLZ=2 G:XMLZ>1 SRQ I 'XMLZ D BUFLUSH W XMLAN,$C(13) G RL "RTN","XML1CRC",37,0) R XMLY:XMLTIME I +XMLY=XMLINE S X=XMRG D SUM S XMLZ=XMSUM=$P(XMLY,U,2) G RL2 "RTN","XML1CRC",38,0) S XMLZ=0 I +XMLY=(XMLINE-1),XMLINE'=1 D BUFLUSH W +XMLY,U,XMLACK,$C(13) G RL "RTN","XML1CRC",39,0) RL2 S XMLAN=XMLINE_U_$S(XMLZ:XMLACK,1:XMLNAK) D BUFLUSH W XMLAN,$C(13) "RTN","XML1CRC",40,0) G SRQ:XMLZ,RL "RTN","XML1CRC",41,0) SRINIT ; "RTN","XML1CRC",42,0) S XMLINE=$S('$D(XMLINE):1,1:XMLINE+1),XMLACK="ACK",XMLNAK="NAK" "RTN","XML1CRC",43,0) S XMLENQ=$C(9)_"ENQ"_$C(9),XMLERR=$C(9)_"ERROR"_$C(9) "RTN","XML1CRC",44,0) S XMLER=-1 ;soft error count "RTN","XML1CRC",45,0) S XMLMAXER=5 ;maximum allowable soft errors "RTN","XML1CRC",46,0) S XMLTIME=30 ;length of READ time "RTN","XML1CRC",47,0) S ER=0 ;non-recoverable error flag "RTN","XML1CRC",48,0) Q "RTN","XML1CRC",49,0) NEWSTRAT ;machines have various loads "RTN","XML1CRC",50,0) I XMLMAXER=5 S ER=1 Q ;already tried new strategy, give up. "RTN","XML1CRC",51,0) S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER),XMLER=0 ;add to total "RTN","XML1CRC",52,0) S XMLMAXER=5 ;reduce allowable soft errors "RTN","XML1CRC",53,0) S XMLTIME=30 ;increase the READ time "RTN","XML1CRC",54,0) Q "RTN","XML1CRC",55,0) SRQ ;Exit from Send/Receive "RTN","XML1CRC",56,0) S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER) ;Total errors "RTN","XML1CRC",57,0) K XMLACK,XMLNAK,XMLENQ,XMLERR,XMLMAXER,XMLTIME,XMLX,XMLY,XMLZ "RTN","XML1CRC",58,0) Q "RTN","XML1CRC",59,0) BUFLUSH ;Flush any characters out of the buffer "RTN","XML1CRC",60,0) Q:'$D(XMBFLUSH) "RTN","XML1CRC",61,0) X ^%ZOSF("TRMON") S X=$P($H,",",2) F %=1:1 R %:0 Q:'$T S %=$P($H,",",2) S:%15 "RTN","XML1CRC",62,0) X ^%ZOSF("TRMOFF") Q "RTN","XML1CRC",63,0) SUM ;Calculate checksum "RTN","XML1CRC",64,0) I '$D(XMOS) D LPC^XMLSWP0 "RTN","XML1CRC",65,0) I $D(XMOS(0)) X XMOS(0) S XMSUM=Y Q "RTN","XML1CRC",66,0) I XMOS["VAX DSM" X "S XMSUM=$ZC(%LPC,X)" Q "RTN","XML1CRC",67,0) I XMOS["DSM" X "S XMSUM=$ZC(LPC,X)" Q "RTN","XML1CRC",68,0) I XMOS["M/11"!(XMOS["M/VX") X "S XMSUM=$ZC(X)" Q "RTN","XML1CRC",69,0) S XMSUM=$A(X) Q:$L(X)=1 S I=1 "RTN","XML1CRC",70,0) A S I=I+1 I $L(X)2 XML4S=XML4S\2 Q "RTN","XML4CRC",24,0) ER D ER1 Q "RTN","XML4CRC",25,0) ER1 N % S %=0 "RTN","XML4CRC",26,0) ER2 S XMTRAN="Rec'd "_$G(X) D T R X:9 I $T S %=$G(%)+1 I %<99 G ER2:$T "RTN","XML4CRC",27,0) S ER=1 K XMBLOCK Q "RTN","XML4CRC",28,0) SBERROR ; "RTN","XML4CRC",29,0) N X D ERROR Q "RTN","XML4CRC",30,0) REC ;Receiver "RTN","XML4CRC",31,0) I '$D(XMLBMER) D RINIT S XMLIN=0 Q "RTN","XML4CRC",32,0) I XMLBCHR2_"^"=$E(XMRG,1,4) S %=2 D STAT,RCHECK S XMLBTSUM=0 Q "RTN","XML4CRC",33,0) S X=XMRG D SUM S XMLBTSUM=XMLBTSUM+XMSUM,XMRG=$E(XMRG,1,($L(XMRG)-1)),XMLBMSG=XMRG Q "RTN","XML4CRC",34,0) RINIT ; "RTN","XML4CRC",35,0) S XMLBPAUS=0,XMLBER=0,XMLBMER=4,XMLBTIME=15,XMLBNAK="NAK",XMLBACK="ACK",XMLBCHR=$C(42),XMLBCHR1=$C(42)_$C(126),XMLBCHR2=$C(126)_$C(42)_$C(126),XMLBLINE=XMLIN,XMLBTSUM=0,XMLBMSG="",XMLBSTRT=XMLIN-1,XML4S(0)=0,XML4S=0 "RTN","XML4CRC",36,0) S X=$P(XMRG,XMLBCHR1,1) D SUM I XMSUM=$P(XMRG,XMLBCHR1,2) S XMLBMER=$P(X,U,2),XMLBER=0 W XMLBACK,$C(13) Q "RTN","XML4CRC",37,0) W XMLBNAK,$C(13) D ERROR K XMLBMER Q "RTN","XML4CRC",38,0) RCHECK ;Check block sum "RTN","XML4CRC",39,0) I XMLBTSUM=0,XML4S(0)=0 G REC^XML4CRC1 "RTN","XML4CRC",40,0) S XMLINE=$P(XMRG,U,4),XMLIN=XMLIN-1,XMRG=$P(XMRG,U,2,3),X=XMLIN_U_XMLBTSUM I XMRG=X W XMLBACK,$C(13) S XMLBER=0,XMRG=XMLBMSG,XMLBSTRT=XMLIN Q "RTN","XML4CRC",41,0) W XMLBNAK,$C(13) S XMLIN=XMLBSTRT,XMRG=$S($D(^XMB(3.9,XMZ,2,XMLIN,0)):^(0),1:""),XMTRAN="NAK'd block" D ERROR,T Q "RTN","XML4CRC",42,0) ERROR ;Log error, new delay factor "RTN","XML4CRC",43,0) D BUFLUSH S XMLBER=XMLBER+1,XMTLER=XMTLER+1 S:XMTLER#XMLBMER=0 XMLBPAUS=XMLBPAUS*2 D:XMLBPAUS>1000 END Q "RTN","XML4CRC",44,0) BUFLUSH ;Flush any characters out of the buffer "RTN","XML4CRC",45,0) Q:'$D(XMBFLUSH) "RTN","XML4CRC",46,0) X ^%ZOSF("TRMON") S X=$P($H,",",2) F %=1:1 R %:0 Q:'$T S %=$P($H,",",2) S:%15 "RTN","XML4CRC",47,0) X ^%ZOSF("TRMOFF") Q "RTN","XML4CRC",48,0) PAUSE ;Delay "RTN","XML4CRC",49,0) F %=1:1:XMLBPAUS "RTN","XML4CRC",50,0) Q "RTN","XML4CRC",51,0) PROG ;Statistics "RTN","XML4CRC",52,0) S %1=$S(%=1:$S('$D(XMSG):0,1:$L(XMSG)),1:$S($D(XMRG):$L(XMRG),1:0)),XMLCT=$S($D(XMLCT):XMLCT+%1,1:%1) "RTN","XML4CRC",53,0) Q "RTN","XML4CRC",54,0) STAT Q:$S('$D(XMINST):1,'$L(XMINST):1,1:0) "RTN","XML4CRC",55,0) S %1=$H_U_$S($D(XMZ):XMZ,1:"")_U_XMLINE_U_$S($D(XMTLER):XMTLER+XMLER-1,1:XMLER-1)_U_$J(XMLCC/($H-XMLBTST*86400+($P($H,",",2)-$P(XMLBTST,",",2))),0,2)_U_IO_" "_XMPROT "RTN","XML4CRC",56,0) S %0=$S($D(^XMBS(4.2999,XMINST,3))#10:^(3),1:""),$P(%0,U,1,6)=%1,^(3)=%0,XMLCT=0,XMLL=XMLINE,XMLT=$P($H,",",2) "RTN","XML4CRC",57,0) K %,%1,%0 Q "RTN","XML4CRC",58,0) BLSIZE ;block size "RTN","XML4CRC",59,0) S XML4S=$S($D(XML4S)#10=0:100,XML4S*2<100:XML4S*2,1:100),XML4S(0)=0 Q "RTN","XML4CRC",60,0) LAST ;FIND LAST LINE "RTN","XML4CRC",61,0) K XML4END S %=$P(^XMB(3.9,XMZ,2,0),U,3) I '% S %=^(0,0,99999999),%=$P(%,U,$L(%,U)-1) "RTN","XML4CRC",62,0) Q:'$D(^XMB(3.9,XMZ,2,%)) F %=%-1:0 S Y=$O(^(%)) Q:Y="" S %=Y "RTN","XML4CRC",63,0) S XML4END=% Q "RTN","XML4CRC",64,0) SUM ;Calculate Checksum "RTN","XML4CRC",65,0) I '$D(XMOS) D LPC^XMLSWP0 "RTN","XML4CRC",66,0) I $D(XMOS(0)) X XMOS(0) Q "RTN","XML4CRC",67,0) I XMOS["VAX DSM" X "S XMSUM=$ZC(%LPC,X)+$L(X)*$L(X)" Q "RTN","XML4CRC",68,0) I XMOS["DSM" X "S XMSUM=$ZC(LPC,X)+$L(X)*$L(X)" Q "RTN","XML4CRC",69,0) I XMOS["M/11"!(XMOS["M/VX") X "S XMSUM=$ZC(X)+$L(X)*$L(X)" Q "RTN","XML4CRC",70,0) S XMSUM=0 Q "RTN","XML4CRC",71,0) KILL ;Kill variables "RTN","XML4CRC",72,0) K XMBLOCK,XMLBTSUM,XML4S,XMLBER,XMLBCHR,XMLBCHR1,XMLBCHR2,XMLBVAR,XMLBPAUS,XMLBNAK,XMLBACK,XMLBMER,XMLBTIME,XMLBSTRT,XMLBLINE,XMLBMSG Q "RTN","XML4CRC",73,0) END ;Errors/Quit. "RTN","XML4CRC",74,0) G ER "RTN","XML4CRC",75,0) T D TRAN^XMC1 Q "RTN","XML4CRC1") 0^5^B12862513^B12792269 "RTN","XML4CRC1",1,0) XML4CRC1 ;(WASH ISC)/RFJ-Block Mode Protocol ;04/17/2002 10:57 "RTN","XML4CRC1",2,0) ;;8.0;MailMan;**45**;Jun 28, 2002;Build 8 "RTN","XML4CRC1",3,0) OPEN D GET,OP "RTN","XML4CRC1",4,0) S:'$D(XMESC) XMESC=$C(126) S:'$D(XMFS) XMFS=255 S:'$D(XM) XM="" S (XMSSQ,XMRSQ)=1 Q "RTN","XML4CRC1",5,0) GET S X=XMCHAN,DIC="^DIC(3.4,",DIC(0)="Z" D ^DIC S XMCHAN=+Y "RTN","XML4CRC1",6,0) I '$D(^DIC(3.4,XMCHAN,0)) S ER=1,Y="Invalid channel" Q "RTN","XML4CRC1",7,0) G2 S XMPROT=$P(^DIC(3.4,XMCHAN,0),U,1) "RTN","XML4CRC1",8,0) F X=1:1:4 S @($P("XMSEN^XMREC^XMOPEN^XMCLOSE",U,X))=$S($D(^(X)):^(X),1:"Q") "RTN","XML4CRC1",9,0) Q "RTN","XML4CRC1",10,0) OP I $D(XMOPEN) X:$L(XMOPEN) XMOPEN "RTN","XML4CRC1",11,0) I '$D(XMQUIET) S X=255 X ^%ZOSF("RM") "RTN","XML4CRC1",12,0) Q "RTN","XML4CRC1",13,0) C X ^%ZOSF("EON") "RTN","XML4CRC1",14,0) I $D(XMCLOSE) X:$L(XMCLOSE) XMCLOSE "RTN","XML4CRC1",15,0) Q "RTN","XML4CRC1",16,0) SEND ;Sends XMSG, returns ER=0 or 1, and XMLER=number of "soft" errors "RTN","XML4CRC1",17,0) I $L(XMSG)>255 S XMLER=0,ER=1 G SRQ "RTN","XML4CRC1",18,0) I XMSG'?.ANP S X=XMSG,XMSG="" F %=1:1:$L(X) S:$E(X,%)'?1C!($A(X,%)=9) XMSG=XMSG_$E(X,%) "RTN","XML4CRC1",19,0) D SRINIT S X=XMSG,XMLCC=XMLCC+$L(XMSG) D SUM "RTN","XML4CRC1",20,0) SL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT "RTN","XML4CRC1",21,0) I ER W XMLERR,$C(13) G SRQ "RTN","XML4CRC1",22,0) D BUFLUSH W XMSG,$C(13) W XMLINE,U,XMSUM,$C(13) R XMLX:XMLTIME G:XMLX=(XMLINE_U_XMLACK) SRQ "RTN","XML4CRC1",23,0) S XMLY=XMLX=(XMLINE_U_XMLNAK),XMLZ=0 D:'XMLY ENQ G SL:XMLY,SRQ "RTN","XML4CRC1",24,0) ENQ ;Assume the ACK/NAK was garbled by noise and try to re-establish contact "RTN","XML4CRC1",25,0) S XMLZ=XMLZ+1 I XMLZ>XMLMAXER S (ER,XMLY)=1 Q "RTN","XML4CRC1",26,0) D BUFLUSH W XMLENQ,$C(13) R XMLX:XMLTIME Q:XMLX=(XMLINE_U_XMLACK) "RTN","XML4CRC1",27,0) I XMLX[XMLACK!(XMLX[XMLNAK),+XMLX=XMLINE!(+XMLX=XMLINE-1) S XMLY=1 Q "RTN","XML4CRC1",28,0) H 1 G ENQ "RTN","XML4CRC1",29,0) REC ;Receives XMRG, returns ER=0 or 1, and XMLER=number of "soft" errors "RTN","XML4CRC1",30,0) D SRINIT S:'$D(XMLAN) XMLAN=XMLINE_U_XMLNAK "RTN","XML4CRC1",31,0) RL S XMLER=XMLER+1 I (XMLER+1)>XMLMAXER D NEWSTRAT I ER=1 G SRQ "RTN","XML4CRC1",32,0) R XMRG#255:$S($D(XMSTIME):XMSTIME,1:XMLTIME) S XMLCC=$S('$D(XMLCC):$L(XMRG),1:XMLCC+$L(XMRG)),XMLZ=$S('$T:-1,XMRG=XMLENQ:0,XMRG=XMLERR:2,1:1),%=2 "RTN","XML4CRC1",33,0) S %=2 D PROG^XML4CRC I $D(XMLIN),XMLIN'<1 G REC^XML4CRC:XMRG["*" "RTN","XML4CRC1",34,0) S ER=XMLZ=2 G:XMLZ>1 SRQ I XMLZ<1 D BUFLUSH W XMLAN,$C(13) G RL "RTN","XML4CRC1",35,0) R XMLY:XMLTIME I +XMLY=XMLINE S X=XMRG D SUM S XMLZ=XMSUM=$P(XMLY,U,2) G RL2 "RTN","XML4CRC1",36,0) S XMLZ=0 I +XMLY=(XMLINE-1),XMLINE'=1 D BUFLUSH W +XMLY,U,XMLACK,$C(13) G RL "RTN","XML4CRC1",37,0) RL2 D:$D(XMLBMER) KILL^XML4CRC S XMLAN=XMLINE_U_$S(XMLZ:XMLACK,1:XMLNAK) D BUFLUSH W XMLAN,$C(13) "RTN","XML4CRC1",38,0) G SRQ:XMLZ,RL "RTN","XML4CRC1",39,0) SRINIT ;Initialize variables for Send/Receive "RTN","XML4CRC1",40,0) I '$D(XMLBTST) S XMLBTST=+$H_","_($P($H,",",2)-.001),XMLCC=0 ;Time stamp when message started "RTN","XML4CRC1",41,0) S XMLINE=$S('$D(XMLINE):1,1:XMLINE+1),XMLACK="ACK",XMLNAK="NAK" "RTN","XML4CRC1",42,0) S XMLENQ=$C(9)_"ENQ"_$C(9),XMLERR=$C(9)_"ERROR"_$C(9) "RTN","XML4CRC1",43,0) S XMLER=-1 ;soft error count "RTN","XML4CRC1",44,0) S XMLMAXER=5 ;maximum allowable soft errors "RTN","XML4CRC1",45,0) S XMLTIME=10 ;length of READ time "RTN","XML4CRC1",46,0) S ER=0 ;non-recoverable error flag "RTN","XML4CRC1",47,0) Q "RTN","XML4CRC1",48,0) NEWSTRAT ;Select new strategy, one or both machines may be slow "RTN","XML4CRC1",49,0) I XMLMAXER=5 S ER=1 Q ;already tried new strategy, give up. "RTN","XML4CRC1",50,0) S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER),XMLER=0 ;add to total "RTN","XML4CRC1",51,0) S XMLMAXER=5 ;reduce allowable soft errors "RTN","XML4CRC1",52,0) S XMLTIME=30 ;increase the READ time "RTN","XML4CRC1",53,0) Q "RTN","XML4CRC1",54,0) SRQ ;Exit from Send/Receive "RTN","XML4CRC1",55,0) S XMTLER=$S('$D(XMTLER):XMLER,1:XMTLER+XMLER) ;Total errors "RTN","XML4CRC1",56,0) K XMLACK,XMLNAK,XMLENQ,XMLERR,XMLMAXER,XMLTIME,XMLX,XMLY,XMLZ "RTN","XML4CRC1",57,0) Q "RTN","XML4CRC1",58,0) BUFLUSH ;Flush any characters out of the buffer "RTN","XML4CRC1",59,0) Q:'$D(XMBFLUSH) "RTN","XML4CRC1",60,0) X ^%ZOSF("TRMON") S X=$P($H,",",2) F %=1:1 R %:0 Q:'$T S %=$P($H,",",2) S:%15 "RTN","XML4CRC1",61,0) X ^%ZOSF("TRMOFF") Q "RTN","XML4CRC1",62,0) SUM ;Calculate checksum, accounting also for the character's position "RTN","XML4CRC1",63,0) I '$D(XMOS) D LPC^XMLSWP0 "RTN","XML4CRC1",64,0) I $D(XMOS(0)) X XMOS(0) Q "RTN","XML4CRC1",65,0) I XMOS["VAX DSM" X "S XMSUM=$ZC(%LPC,X)+$L(X)*$L(X)" Q "RTN","XML4CRC1",66,0) I XMOS["DSM" X "S XMSUM=$ZC(LPC,X)+$L(X)*$L(X)" Q "RTN","XML4CRC1",67,0) I XMOS["M/11"!(XMOS["M/VX") X "S XMSUM=$ZC(X)+$L(X)*$L(X)" Q "RTN","XML4CRC1",68,0) S XMSUM=0 F %=1:1:$L(X) S XMSUM=XMSUM+($A(X,%)*%) "RTN","XML4CRC1",69,0) Q "RTN","XMLSWP") 0^6^B10332361^B10276184 "RTN","XMLSWP",1,0) XMLSWP ;(WASH ISC)/CAP-Sliding Window Protocol ;04/17/2002 10:58 "RTN","XMLSWP",2,0) ;;8.0;MailMan;**45**;Jun 28, 2002;Build 8 "RTN","XMLSWP",3,0) SEND ; "RTN","XMLSWP",4,0) S X=1 G I^XMLSWP0 "RTN","XMLSWP",5,0) 1 ;I $L(XMSG)>245 G E "RTN","XMLSWP",6,0) I XMSG'?.ANP F %=1:1:$L(XMSG) I $E(XMSG,%)?1C,$A(XMSG,%)'=9 S XMSG=$E(XMSG,1,%-1)_$E(XMSG,%+1,999) Q:XMSG?.ANP S %=%-1 "RTN","XMLSWP",7,0) S C=C+$L(XMSG),F=0 I G S A=A+1,XMLIN=$S(J<1:"",1:XMLIN\1+1),(M,B(1))=0,XMLCT=$S($D(XMLCT):XMLCT+$L(XMSG),1:$L(XMSG)) "RTN","XMLSWP",8,0) D S I=$S('G:"",1:XMLIN),X=XMSG D SUM S Q=I_U_S_"^~^^"_$S(XMSG=".":"<>",1:"") D CHK S $P(Q,U,4)=S "RTN","XMLSWP",9,0) W X_$C(13),Q_$C(13) S D=X X P("S") "RTN","XMLSWP",10,0) I G,I'="" S W(I,0)=J,W(I,1)=$P(Q,U,2),W(I,2)=Q "RTN","XMLSWP",11,0) I $D(XMINST),$L(XMINST),$S(I<100&(I#20=0):1,I#100=0:1,I<1:1,B(1):1,'J:1,1:0) D PROGS^XMLSWP2 "RTN","XMLSWP",12,0) ; "RTN","XMLSWP",13,0) C G Q:$S(ER:1,1:0) I G,$D(XMLIN),XMLIN G W "RTN","XMLSWP",14,0) 2 I G,XMLIN,'$O(W(0)) G Q:J<1!'J,W "RTN","XMLSWP",15,0) R X:$S('$D(XMLIN):30,XMLIN="":30,'G:30,W<8:9,1:5) E S:M M=2 G U:'$L(X) "RTN","XMLSWP",16,0) I X'?.".".N1"^"1N.N1"^~".E G:'G 1:X="!@~^NAK^~@!",C S G=G+1 G C:G<3,W "RTN","XMLSWP",17,0) S D=X,$P(X,U,4)="" D SUM S X=D I S'=$P(X,U,4) G G:G S F=F+1 G 2:F<9,QQQ "RTN","XMLSWP",18,0) S B=0 I X?1"!@~^"1N.N1"^~@!^"1N.N1"^Resynch" S D=X,B=0 X P("R") S Y=X G G2 "RTN","XMLSWP",19,0) I $S('$D(XMLIN):1,XMLIN="":1,'G:1,1:0) G Q:X=Q S F=F+1 G 2:F<9,QQQ "RTN","XMLSWP",20,0) 3 I '$D(W(+X)) G G9:M="END",W "RTN","XMLSWP",21,0) I W(+X,1)-$P(X,U,2)'=0 S D="BAD Acknowledgement" X P("I") G R "RTN","XMLSWP",22,0) I $O(W(0))=+X D K S G=1 G G9:M="END",W:'M,C "RTN","XMLSWP",23,0) I $D(W(+X)) D K S G=G+1 S:W6:W-4,W>6:6,1:W),V=0 G G:WV):1,W>4&(W*3>V):1,1:0) "RTN","XMLSWP",37,0) S V=0 I $D(IOST),$E(IOST,1,6)="C-MINI" S W=$S(W<8:8,W<9:10,W<12:12,1:W) "RTN","XMLSWP",38,0) E S W=$S(W<4:4,1:5) "RTN","XMLSWP",39,0) Q "RTN","XMLSWP",40,0) ;Timeout "RTN","XMLSWP",41,0) U S B(1)=B(1)+1,D="Time-out ["_B(1)_"]" X P("I") I B(1)<$S(G:4,1:2) G:'$O(W(0)) W:G,D S I=XMLIN G R:A>W,W:G,D "RTN","XMLSWP",42,0) G E "RTN","XMLSWP",43,0) CHK N X S X=Q "RTN","XMLSWP",44,0) SUM ;Calculate S=checksum "RTN","XMLSWP",45,0) I $D(XMOS(0)) X XMOS(0) S S=XMSUM Q "RTN","XMLSWP",46,0) I XMOS["VAX DSM" X "S S=$ZC(%LPC,X)+$L(X)*$L(X)" Q "RTN","XMLSWP",47,0) I XMOS["DSM" X "S S=$ZC(LPC,X)+$L(X)*$L(X)" Q "RTN","XMLSWP",48,0) I XMOS["M/11"!(XMOS["M/VX") X "S S=$ZC(X)+$L(X)*$L(X)" Q "RTN","XMLSWP",49,0) G ZSUM^XMLSWP0 "RTN","XMLSWP",50,0) ;RE-SYNCH Sender "RTN","XMLSWP",51,0) G S (B,XMLSWPQ,M)=0 I M,'$O(W(0)) G W "RTN","XMLSWP",52,0) I M'=1 G W:'$O(W(0)) S M=1 G 2 "RTN","XMLSWP",53,0) G0 S XMLSWPQ=$G(XMLSWPQ)+1 R Y:(9+B) G:'$T G9:XMLSWPQ>20,G0 K XMLSWPQ I B>$S(M:3,1:33) G Q:'M,E "RTN","XMLSWP",54,0) G G9:'$L(Y) S D=Y X P("R") I Y="A-OK" R Y:(9+B) G G9:Y="",G9:Y'="^432^~" F D=0:0 R Y:4 E G R:$O(W(0)),QQ "RTN","XMLSWP",55,0) G G1:Y?1"!@~^"1N.N1"^~@!^"1N.N1"^Resynch" I 'M S M=0 G G9:'$O(W(0)) S X=Y,M="END" G 3 "RTN","XMLSWP",56,0) G W:Y=O,G9 "RTN","XMLSWP",57,0) G1 S (D,X)=Y,$P(X,U,4)="" D SUM G G9:S'=$P(D,U,4) "RTN","XMLSWP",58,0) G2 S D="Rec'r reqests "_$P(Y,U,2) X P("I") S B=0 G R:$O(W(0)),QQQ "RTN","XMLSWP",59,0) G9 S (D,X)=O,B=B+1 D SUM S X=U_S_"^~^^@@<>" D SUM S $P(X,U,4)=S W O_$C(13)_X_$C(13) X P("S") "RTN","XMLSWP",60,0) G G0 "RTN","XMLSWP0") 0^7^B10115149^B10066868 "RTN","XMLSWP0",1,0) XMLSWP0 ;(WASH ISC)/CAP-Sliding Window Protocol ;04/17/2002 10:59 "RTN","XMLSWP0",2,0) ;;8.0;MailMan;**45**;Jun 28, 2002;Build 8 "RTN","XMLSWP0",3,0) REC ;SEE SEND "RTN","XMLSWP0",4,0) S X=0 G I "RTN","XMLSWP0",5,0) RL ; "RTN","XMLSWP0",6,0) R X:$S($D(XMSTIME):XMSTIME,1:15) S Z=$T,(XMRG,D)=X X P("R") "RTN","XMLSWP0",7,0) I 'Z S B=B+1 G RL:B<3 S B=0,B(0)=$S($D(B(0)):B(0)+1,1:1) G:B(0)<4&G F:'M,RL D E G ER "RTN","XMLSWP0",8,0) S (B,B(0))=0 "RTN","XMLSWP0",9,0) Y S L=X D SUM I $D(XMLIN),XMLIN>1,X?1"..".E S (XMRG,X)=$E(X,2,999) "RTN","XMLSWP0",10,0) R W:15 E S B=B+1 G RL "RTN","XMLSWP0",11,0) G Z:L'=".",Z:$P(W,U,2)'=47,Z:$P(W,U,5)'="<>" "RTN","XMLSWP0",12,0) S (D,V)=1,F=0 I $O(W(0)) G F "RTN","XMLSWP0",13,0) V S XMRG="." K XMBLOCK F XMLIN=XMLIN+1:1 Q:'$D(^XMB(3.9,XMZ,2,XMLIN)) "RTN","XMLSWP0",14,0) D SEND Q:D S F=F+1 G ER "RTN","XMLSWP0",15,0) Z S D=0 I W'?.".".N1"^"1N.N1"^~".E S (XMRG,X)=W G Y "RTN","XMLSWP0",16,0) I S-$P(W,U,2)=0 S D=1 D SEND "RTN","XMLSWP0",17,0) I D,L=O G F:$P(W,"@@",2)="<>" "RTN","XMLSWP0",18,0) I 'D G F:G S F=F+1,ER=1 Q:F>3 W "!@~^NAK^~@!",$C(13) S ER=0 G RL "RTN","XMLSWP0",19,0) Q:'$D(XMLIN)!'+W Q:XMLIN=0 S M=$S(L="QUIT":99,1:0),F=0 "RTN","XMLSWP0",20,0) I XMLIN>1,XMLIN+1-W'=0,W-XMLIN>0 F D=W-1:-1 Q:D<1!$D(^XMB(3.9,XMZ,2,D,0)) S W(D)="" "RTN","XMLSWP0",21,0) S D=$S(1-W>0:XMLIN+.001,1:+W) S:D-XMLIN>0 XMLIN=+W K W(+W) I '$D(^XMB(3.9,XMZ,2,D,0)) S ^(0)=XMRG,C=C+$L(XMRG) "RTN","XMLSWP0",22,0) I $D(XMINST),$L(XMINST) S I=XMLIN D P "RTN","XMLSWP0",23,0) G W:XMLIN#10'=0,W:'$O(W(0)) D E S D="Didn't receive "_$O(W(0)) X P("I") "RTN","XMLSWP0",24,0) G F "RTN","XMLSWP0",25,0) W G RL:'V,F:$O(W(0)),V "RTN","XMLSWP0",26,0) ; "RTN","XMLSWP0",27,0) ;QUIT control "RTN","XMLSWP0",28,0) E S F=F+1 S D="Errors ("_F_")" X P("I") Q "RTN","XMLSWP0",29,0) Q "RTN","XMLSWP0",30,0) SUM ;Calculate S=checksum "RTN","XMLSWP0",31,0) I $D(XMOS(0)) X XMOS(0) S S=XMSUM Q "RTN","XMLSWP0",32,0) I XMOS["VAX DSM" X "S S=$ZC(%LPC,X)+$L(X)*$L(X)" Q "RTN","XMLSWP0",33,0) I XMOS["DSM" X "S S=$ZC(LPC,X)+$L(X)*$L(X)" Q "RTN","XMLSWP0",34,0) I XMOS["M/11"!(XMOS["M/VX") X "S S=$ZC(X)+$L(X)*$L(X)" Q "RTN","XMLSWP0",35,0) ZSUM S S=$A(X) Q:$L(X)=1 N J S J=1 "RTN","XMLSWP0",36,0) A S J=J+1 I $L(X)300 D Q ;patch mod for timing lag with mail msg "RTN","XMTDO",15,0) . N XMPARM,XMINSTR "RTN","XMTDO",16,0) . S XMINSTR("FROM")=.5 "RTN","XMTDO",17,0) . S XMPARM(1)=XMSERVER "RTN","XMTDO",18,0) . S XMPARM(2)=ZTSK "RTN","XMTDO",19,0) . D TASKBULL^XMXBULL(.5,"XM SEND ERR SERVER MSG",.XMPARM,"",.5,.XMINSTR) "RTN","XMTDO",20,0) Q:XMZREC="" ;patch mode to quit if mail msg lag check occurs in for loop waiting for next line "RTN","XMTDO",21,0) S XMSUBJ=$P(XMZREC,U,1) "RTN","XMTDO",22,0) S:XMSUBJ["~U~" XMSUB=$$DECODEUP^XMXUTIL1(XMSUBJ) "RTN","XMTDO",23,0) S XMFROM=$P(XMZREC,U,2) "RTN","XMTDO",24,0) S:XMFROM["@" XMFROM=$$REPLYTO1^XMXREPLY(XMZ) "RTN","XMTDO",25,0) D SETSTAT(XMSVIENS,$$EZBLD^DIALOG(39300)) ; Server hand off ready "RTN","XMTDO",26,0) D DOSERV($E(XMSERVER,3,99),XMZ,XMFROM,XMSUBJ,.XMSERR) "RTN","XMTDO",27,0) D SETSTAT(XMSVIENS,$S($D(XMSERR):XMSERR,1:$$EZBLD^DIALOG(39301))) ; Served (hand off done) "RTN","XMTDO",28,0) S ZTREQ="@" "RTN","XMTDO",29,0) Q "RTN","XMTDO",30,0) DOSERV(XMXX,XMZ,XMFROM,XMSUBJ,XQSRVOK) ; "RTN","XMTDO",31,0) N XMCHAN,XMPROT,X,Y,XMSEN,XMREC,XMOPEN,XMCLOSE,XMSVIENS "RTN","XMTDO",32,0) S XMCHAN="SERVER" "RTN","XMTDO",33,0) D GET^XML "RTN","XMTDO",34,0) S X=XMXX_U_XMZ_U_XMFROM_U_XMSUBJ "RTN","XMTDO",35,0) D ^XQSRV "RTN","XMTDO",36,0) ; ^XQSRV1 calls SETSB^XMA1C to put the msg in the postmaster's bskt. "RTN","XMTDO",37,0) ; Instead, that line could read: "RTN","XMTDO",38,0) ; D:XQSRV PUTSERV^XMXMSGS1(XQSOP,XQMSG) "RTN","XMTDO",39,0) Q "RTN","XMTDO",40,0) DEVICE ; D.device or H.device TASKMAN ENTRY "RTN","XMTDO",41,0) ; Variables supplied by TaskMan: XMDUZ,XMZ,XMDVIENS,XMPRTHDR "RTN","XMTDO",42,0) ; TaskMan opens and closes the device. "RTN","XMTDO",43,0) N XMV "RTN","XMTDO",44,0) I '$G(DUZ) D DUZ^XUP(XMDUZ) "RTN","XMTDO",45,0) D INITAPI^XMVVITAE "RTN","XMTDO",46,0) D PRTMSG^XMJMP(XMDUZ,"?",XMZ,"0-",0,$G(XMPRTHDR,1)) "RTN","XMTDO",47,0) D SETSTAT(XMDVIENS,$$EZBLD^DIALOG(39302)) ; Printed "RTN","XMTDO",48,0) S ZTREQ="@" "RTN","XMTDO",49,0) Q "RTN","XMTDO",50,0) SETSTAT(XMIENS,XMSTATUS) ; Record Time/Status in msg file "RTN","XMTDO",51,0) N XMFDA "RTN","XMTDO",52,0) S XMFDA(3.91,XMIENS,2)=$$NOW^XLFDT "RTN","XMTDO",53,0) S XMFDA(3.91,XMIENS,5)=XMSTATUS "RTN","XMTDO",54,0) D FILE^DIE("","XMFDA") "RTN","XMTDO",55,0) Q "RTN","XMXPARM") 0^1^B68128895^B73633568 "RTN","XMXPARM",1,0) XMXPARM ;ISC-SF/GMB-Parameter check ;03/26/2003 08:00 "RTN","XMXPARM",2,0) ;;8.0;MailMan;**15,45**;Jun 28, 2002;Build 8 "RTN","XMXPARM",3,0) ACTMSGS(XMDUZ,XMK,XMKZA) ; "RTN","XMXPARM",4,0) K XMERR,^TMP("XMERR",$J) "RTN","XMXPARM",5,0) D XMDUZ(.XMDUZ,.XMV) "RTN","XMXPARM",6,0) I $G(XMK)'="" S XMK=$$XMK(XMDUZ,"XMK",XMK) "RTN","XMXPARM",7,0) D XMKZA^XMXPARM1(.XMKZA) "RTN","XMXPARM",8,0) Q "RTN","XMXPARM",9,0) ACTMSG(XMDUZ,XMK,XMKZ) ; "RTN","XMXPARM",10,0) K XMERR,^TMP("XMERR",$J) "RTN","XMXPARM",11,0) D XMDUZ(.XMDUZ,.XMV) "RTN","XMXPARM",12,0) I $G(XMK)'="" D "RTN","XMXPARM",13,0) . S XMK=$$XMK(XMDUZ,"XMK",XMK) "RTN","XMXPARM",14,0) . D XMKZ^XMXPARM1(XMK,.XMKZ) "RTN","XMXPARM",15,0) E D XMZ(.XMKZ) "RTN","XMXPARM",16,0) Q "RTN","XMXPARM",17,0) ANSRMSG(XMDUZ,XMK,XMKZ,XMSUBJ,XMBODY,XMTO,XMINSTR) ; "RTN","XMXPARM",18,0) D ACTMSG(.XMDUZ,.XMK,.XMKZ) "RTN","XMXPARM",19,0) I $G(XMSUBJ)'="" S XMSUBJ=$$XMSUBJ("XMSUBJ",$G(XMSUBJ)) "RTN","XMXPARM",20,0) D XMBODY^XMXPARM1(.XMBODY) "RTN","XMXPARM",21,0) D:$D(XMTO) XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; truly optional "RTN","XMXPARM",22,0) D:$D(XMINSTR) XMINSTR(.XMINSTR) "RTN","XMXPARM",23,0) Q "RTN","XMXPARM",24,0) BULLETIN(XMDUZ,XMBN,XMPARM,XMBODY,XMTO,XMINSTR,XMATTACH) ; "RTN","XMXPARM",25,0) K XMERR,^TMP("XMERR",$J) "RTN","XMXPARM",26,0) D XMDUZ(.XMDUZ,.XMV) "RTN","XMXPARM",27,0) D XMBN^XMXPARM1(.XMBN) "RTN","XMXPARM",28,0) D:$D(XMBODY) XMBODY^XMXPARM1(.XMBODY,1) "RTN","XMXPARM",29,0) D:$D(XMTO) XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; truly optional "RTN","XMXPARM",30,0) D:$D(XMINSTR) XMINSTR(.XMINSTR) "RTN","XMXPARM",31,0) Q "RTN","XMXPARM",32,0) FWDMSG(XMDUZ,XMK,XMKZA,XMTO,XMINSTR) ; "RTN","XMXPARM",33,0) D ACTMSGS(.XMDUZ,.XMK,.XMKZA) "RTN","XMXPARM",34,0) D XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; need at least one "RTN","XMXPARM",35,0) D:$D(XMINSTR) XMINSTR(.XMINSTR) "RTN","XMXPARM",36,0) Q "RTN","XMXPARM",37,0) LATERMSG(XMDUZ,XMK,XMKZA,XMINSTR) ; "RTN","XMXPARM",38,0) D ACTMSGS(.XMDUZ,.XMK,.XMKZA) "RTN","XMXPARM",39,0) I $D(XMINSTR("LATER")) D Q "RTN","XMXPARM",40,0) . ;I XMINSTR("LATER")="@" Q "RTN","XMXPARM",41,0) . S XMINSTR("LATER")=$$XMDATE("XMINSTR(""LATER"")",XMINSTR("LATER")) "RTN","XMXPARM",42,0) I $G(XMINSTR)'="" D Q "RTN","XMXPARM",43,0) . ;I XMINSTR="@" Q "RTN","XMXPARM",44,0) . S XMINSTR=$$XMDATE("LATER",XMINSTR) "RTN","XMXPARM",45,0) D ERRSET^XMXUTIL(39419) ;Later date must be supplied. "RTN","XMXPARM",46,0) Q "RTN","XMXPARM",47,0) MOVEMSG(XMDUZ,XMK,XMKZA,XMKTO) ; "RTN","XMXPARM",48,0) D ACTMSGS(.XMDUZ,.XMK,.XMKZA) "RTN","XMXPARM",49,0) D XMKTO(XMDUZ,.XMKTO) "RTN","XMXPARM",50,0) Q "RTN","XMXPARM",51,0) PRTMSG(XMDUZ,XMK,XMKZA,XMPRTTO,XMINSTR,XMSUBJ,XMTO) ; "RTN","XMXPARM",52,0) D ACTMSGS(.XMDUZ,.XMK,.XMKZA) "RTN","XMXPARM",53,0) Q:'$D(XMINSTR) "RTN","XMXPARM",54,0) I $D(XMINSTR("WHEN")) S XMINSTR("WHEN")=$$XMDATE("XMINSTR(""WHEN"")",XMINSTR("WHEN")) "RTN","XMXPARM",55,0) I $D(XMINSTR("HDR")) D XMCODE^XMXPARM1("XMINSTR(""HDR"")",XMINSTR("HDR"),"^0^1^") "RTN","XMXPARM",56,0) I $D(XMINSTR("RECIPS")) D XMCODE^XMXPARM1("XMINSTR(""RECIPS"")",XMINSTR("RECIPS"),"^0^1^2^") "RTN","XMXPARM",57,0) I $G(XMSUBJ)'="" S XMSUBJ=$$XMSUBJ("XMSUBJ",$G(XMSUBJ)) "RTN","XMXPARM",58,0) I $D(XMTO) D XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; ok "RTN","XMXPARM",59,0) Q "RTN","XMXPARM",60,0) REPLYMSG(XMDUZ,XMK,XMKZ,XMBODY,XMINSTR) ; "RTN","XMXPARM",61,0) D ACTMSG(.XMDUZ,.XMK,.XMKZ) "RTN","XMXPARM",62,0) D XMBODY^XMXPARM1(.XMBODY) "RTN","XMXPARM",63,0) D:$D(XMINSTR) XMINSTR(.XMINSTR) "RTN","XMXPARM",64,0) I $G(XMINSTR("NET REPLY")),$G(XMINSTR("NET SUBJ"))'="" S XMINSTR("NET SUBJ")=$$XMSUBJ("XMINSTR(""NET SUBJ"")",XMINSTR("NET SUBJ")) "RTN","XMXPARM",65,0) Q "RTN","XMXPARM",66,0) SENDMSG(XMDUZ,XMSUBJ,XMBODY,XMTO,XMINSTR,XMATTACH) ; "RTN","XMXPARM",67,0) K XMERR,^TMP("XMERR",$J) "RTN","XMXPARM",68,0) D XMDUZ(.XMDUZ,.XMV) "RTN","XMXPARM",69,0) S XMSUBJ=$$XMSUBJ("XMSUBJ",$G(XMSUBJ)) "RTN","XMXPARM",70,0) D XMBODY^XMXPARM1(.XMBODY) "RTN","XMXPARM",71,0) D XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; need at least one "RTN","XMXPARM",72,0) D:$D(XMINSTR) XMINSTR(.XMINSTR) "RTN","XMXPARM",73,0) D:$D(XMATTACH) XMATTACH^XMXPARM1(.XMATTACH) "RTN","XMXPARM",74,0) Q "RTN","XMXPARM",75,0) VAPORMSG(XMDUZ,XMK,XMKZA,XMINSTR) ; "RTN","XMXPARM",76,0) D ACTMSGS(.XMDUZ,.XMK,.XMKZA) "RTN","XMXPARM",77,0) I $D(XMINSTR("VAPOR")) D Q "RTN","XMXPARM",78,0) . I XMINSTR("VAPOR")="@" Q "RTN","XMXPARM",79,0) . S XMINSTR("VAPOR")=$$XMDATE("XMINSTR(""VAPOR"")",XMINSTR("VAPOR")) "RTN","XMXPARM",80,0) I $G(XMINSTR)'="" D Q "RTN","XMXPARM",81,0) . I XMINSTR="@" Q "RTN","XMXPARM",82,0) . S XMINSTR=$$XMDATE("VAPOR",XMINSTR) "RTN","XMXPARM",83,0) D ERRSET^XMXUTIL(39417) ;Vaporize date must be supplied. "RTN","XMXPARM",84,0) Q "RTN","XMXPARM",85,0) ADDRNSND(XMDUZ,XMZ,XMTO,XMINSTR) ; "RTN","XMXPARM",86,0) K XMERR,^TMP("XMERR",$J) "RTN","XMXPARM",87,0) D XMDUZ(.XMDUZ,.XMV) "RTN","XMXPARM",88,0) D XMZ(.XMZ) "RTN","XMXPARM",89,0) D XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; need at least one "RTN","XMXPARM",90,0) D:$D(XMINSTR) XMINSTR(.XMINSTR) "RTN","XMXPARM",91,0) Q "RTN","XMXPARM",92,0) MOVEBODY(XMZ,XMBODY) ; "RTN","XMXPARM",93,0) K XMERR,^TMP("XMERR",$J) "RTN","XMXPARM",94,0) D XMZ(.XMZ) "RTN","XMXPARM",95,0) D XMBODY^XMXPARM1(.XMBODY) "RTN","XMXPARM",96,0) Q "RTN","XMXPARM",97,0) VSUBJ(XMSUBJ) ; "RTN","XMXPARM",98,0) K XMERR,^TMP("XMERR",$J) "RTN","XMXPARM",99,0) S XMSUBJ=$$XMSUBJ("XMSUBJ",$G(XMSUBJ)) "RTN","XMXPARM",100,0) Q "RTN","XMXPARM",101,0) ITOWHOM(XMDUZ,XMZ,XMTYPE,XMINSTR) ; "RTN","XMXPARM",102,0) K XMERR,^TMP("XMERR",$J) "RTN","XMXPARM",103,0) D XMDUZ(.XMDUZ,.XMV) "RTN","XMXPARM",104,0) D XMFLAG("XMTYPE",XMTYPE,"SF") "RTN","XMXPARM",105,0) I XMTYPE'="S",XMINSTR("ADDR FLAGS")'["R" D XMZ(.XMZ) "RTN","XMXPARM",106,0) D:$D(XMINSTR) XMINSTR(.XMINSTR) "RTN","XMXPARM",107,0) Q "RTN","XMXPARM",108,0) TOWHOM(XMDUZ,XMZ,XMTYPE,XMTO,XMINSTR) ; "RTN","XMXPARM",109,0) D ITOWHOM(.XMDUZ,.XMZ,.XMTYPE,.XMINSTR) "RTN","XMXPARM",110,0) D XMTO^XMXPARM1(XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; need at least one "RTN","XMXPARM",111,0) Q "RTN","XMXPARM",112,0) XMDUZ(XMDUZ,XMV) ; "RTN","XMXPARM",113,0) S:$G(XMDUZ)="" XMDUZ=DUZ "RTN","XMXPARM",114,0) D CHKUSER^XMXPARM1(.XMDUZ) "RTN","XMXPARM",115,0) ; Need XMV "NAME","DUZ NAME", "NETNAME", "VERSION" "RTN","XMXPARM",116,0) ; ^XMB("NETNAME"),^XMB("NUM"),^XMB("VIA") "RTN","XMXPARM",117,0) I XMDUZ'=DUZ D "RTN","XMXPARM",118,0) . I $D(^XUSEC("XMNOPRIV",DUZ)) D Q ;You have been given the XMNOPRIV "RTN","XMXPARM",119,0) . . D ERRSET^XMXUTIL(38053) ;key and may not become anyone's surrogate. "RTN","XMXPARM",120,0) . I XMDUZ'=.6,'$D(^XMB(3.7,"AB",DUZ,XMDUZ)) D Q "RTN","XMXPARM",121,0) . . ;You are not authorized to be a surrogate of DUZ |1|. "RTN","XMXPARM",122,0) . . D ERRSET^XMXUTIL(39401,XMDUZ) "RTN","XMXPARM",123,0) I $D(XMV("VERSION")),$G(XMV("DUZ NAME"))=$$NAME^XMXUTIL(DUZ),$G(XMV("NAME"))=$$NAME^XMXUTIL(XMDUZ) Q "RTN","XMXPARM",124,0) D INITAPI^XMVVITAE "RTN","XMXPARM",125,0) Q "RTN","XMXPARM",126,0) XMSUBJ(XMPARM,XMSUBJ) ; Validate a prospective message subject "RTN","XMXPARM",127,0) ;I $G(XMSUBJ)="" D ERRSET^XMXUTIL(39402) Q "" ;No subject. "RTN","XMXPARM",128,0) I XMSUBJ?.E1C.E S XMSUBJ=$$CTRL^XMXUTIL1(XMSUBJ) "RTN","XMXPARM",129,0) I $E(XMSUBJ,1)=" "!($E(XMSUBJ,$L(XMSUBJ))=" ") S XMSUBJ=$$STRIP^XMXUTIL1(XMSUBJ) "RTN","XMXPARM",130,0) I XMSUBJ[" " S XMSUBJ=$$MAXBLANK^XMXUTIL1(XMSUBJ) "RTN","XMXPARM",131,0) I $G(XMSUBJ)="" Q $$EZBLD^DIALOG(34012) ;* No Subject * "RTN","XMXPARM",132,0) I $L(XMSUBJ)+(2*($L(XMSUBJ,U)-1))>65!($L(XMSUBJ)<3) D Q XMSUBJ "RTN","XMXPARM",133,0) . D ERRSET^XMXUTIL(39403) ;Subject must be from 3 to 65 characters long. "RTN","XMXPARM",134,0) I XMSUBJ?1"R".N D Q XMSUBJ "RTN","XMXPARM",135,0) . D ERRSET^XMXUTIL(39404) ;Subject 'Rnnn' reserved. "RTN","XMXPARM",136,0) ;D CHK^DIE(3.9,.01,"H",XMSUBJ) "RTN","XMXPARM",137,0) Q XMSUBJ "RTN","XMXPARM",138,0) XMINSTR(XMINSTR) ; Validate special instructions "RTN","XMXPARM",139,0) S:$D(XMINSTR("RCPT BSKT")) XMINSTR("RCPT BSKT")=$$XMKN^XMXPARMB(XMDUZ,"XMINSTR(""RCPT BSKT"")",XMINSTR("RCPT BSKT"),1) "RTN","XMXPARM",140,0) S:$D(XMINSTR("SELF BSKT")) XMINSTR("SELF BSKT")=$$XMK(XMDUZ,"XMINSTR(""SELF BSKT"")",XMINSTR("SELF BSKT"),1) "RTN","XMXPARM",141,0) I $D(XMINSTR("SHARE DATE")) S XMINSTR("SHARE DATE")=$$XMDATE("XMINSTR(""SHARE DATE"")",XMINSTR("SHARE DATE")) "RTN","XMXPARM",142,0) S:$D(XMINSTR("SHARE BSKT")) XMINSTR("SHARE BSKT")=$$XMK(.6,"XMINSTR(""SHARE BSKT"")",XMINSTR("SHARE BSKT"),1) "RTN","XMXPARM",143,0) I $D(XMINSTR("VAPOR")) S XMINSTR("VAPOR")=$$XMDATE("XMINSTR(""VAPOR"")",XMINSTR("VAPOR")) "RTN","XMXPARM",144,0) I $D(XMINSTR("LATER")) S XMINSTR("LATER")=$$XMDATE("XMINSTR(""LATER"")",XMINSTR("LATER")) "RTN","XMXPARM",145,0) I $D(XMINSTR("FROM")) S XMINSTR("FROM")=$$XMFROM("XMINSTR(""FROM"")",XMINSTR("FROM")) "RTN","XMXPARM",146,0) I $D(XMINSTR("FWD BY")) S XMINSTR("FWD BY")=$$XMFROM("XMINSTR(""FWD BY"")",XMINSTR("FWD BY")) "RTN","XMXPARM",147,0) D:$D(XMINSTR("FLAGS")) XMFLAG("XMINSTR(""FLAGS"")",XMINSTR("FLAGS"),"CIPRSX") "RTN","XMXPARM",148,0) I $D(XMINSTR("SCR KEY"))!$D(XMINSTR("SCR HINT")) D "RTN","XMXPARM",149,0) . D XMKEY^XMXPARM1($G(XMINSTR("SCR KEY"))) "RTN","XMXPARM",150,0) . D XMHINT^XMXPARM1($G(XMINSTR("SCR HINT"))) "RTN","XMXPARM",151,0) D:$D(XMINSTR("TYPE")) XMTYPE(XMINSTR("TYPE")) "RTN","XMXPARM",152,0) D:$D(XMINSTR("STRIP")) XMSTRIP^XMXPARM1(XMINSTR("STRIP")) "RTN","XMXPARM",153,0) Q "RTN","XMXPARM",154,0) XMDATE(XMPARM,XMDATE) ; "RTN","XMXPARM",155,0) N %DT,Y,X "RTN","XMXPARM",156,0) S X=XMDATE "RTN","XMXPARM",157,0) S %DT="FT",%DT(0)="NOW" "RTN","XMXPARM",158,0) D ^%DT "RTN","XMXPARM",159,0) Q:Y>0 Y "RTN","XMXPARM",160,0) N XMP "RTN","XMXPARM",161,0) S XMP("PARAM","ID")=XMPARM "RTN","XMXPARM",162,0) S XMP("PARAM","VALUE")=XMDATE "RTN","XMXPARM",163,0) D ERRSET^XMXUTIL(39409,.XMP) ;Must be a date in the future. "RTN","XMXPARM",164,0) Q XMDATE "RTN","XMXPARM",165,0) XMFROM(XMPARM,XMFROM) ; "RTN","XMXPARM",166,0) ;Code below is preventing valid new person file entries from Processing "RTN","XMXPARM",167,0) ;N XMHOLD "RTN","XMXPARM",168,0) Q:XMFROM=.5 XMFROM "RTN","XMXPARM",169,0) I +XMFROM=XMFROM!(XMFROM[U)!($L(XMFROM)>65)!(XMFROM="") D Q XMFROM "RTN","XMXPARM",170,0) . N XMP S XMP("PARAM","ID")=XMPARM,XMP("PARAM","VALUE")=XMFROM "RTN","XMXPARM",171,0) . ;S XMP("PARAM","FILE")=X,XMP("PARAM","FIELD")=Y "RTN","XMXPARM",172,0) . ;Must be from 1 to 65 characters, no # or ^. "RTN","XMXPARM",173,0) . D ERRSET^XMXUTIL(39410,.XMP) "RTN","XMXPARM",174,0) ;S XMHOLD=XMFROM "RTN","XMXPARM",175,0) ;S XMFROM=$$CTRL^XMXUTIL1(XMFROM) "RTN","XMXPARM",176,0) ;S XMFROM=$$STRIP^XMXUTIL1(XMFROM) "RTN","XMXPARM",177,0) ;S XMFROM=$$MAXBLANK^XMXUTIL1(XMFROM) "RTN","XMXPARM",178,0) ;Q:XMFROM["POSTMASTER" XMFROM "RTN","XMXPARM",179,0) ; "B^BB^C^D" = name^alias^initial^nickname "RTN","XMXPARM",180,0) ;I '$$FIND1^DIC(200,"","O",$$UP^XLFSTR(XMFROM),"B^BB^C^D")!$D(DIERR) D Q XMHOLD "RTN","XMXPARM",181,0) ;. N XMP S XMP("PARAM","ID")=XMPARM,XMP("PARAM","VALUE")=XMHOLD "RTN","XMXPARM",182,0) ;. ;S XMP("PARAM","FILE")=X,XMP("PARAM","FIELD")=Y "RTN","XMXPARM",183,0) ;. D ERRSET^XMXUTIL(39411,.XMP) ;May not be a real person. "RTN","XMXPARM",184,0) Q XMFROM "RTN","XMXPARM",185,0) XMTYPE(XMTYPE) ; Validate a message type "RTN","XMXPARM",186,0) I $L(XMTYPE)'=1 D Q "RTN","XMXPARM",187,0) . N XMP S XMP("PARAM","ID")="XMINSTR(""TYPE"")",XMP("PARAM","VALUE")=XMTYPE "RTN","XMXPARM",188,0) . ;S XMPARM("PARAM","FILE")=3.9,XMPARM("PARAM","FIELD")=1.7 "RTN","XMXPARM",189,0) . D ERRSET^XMXUTIL(39412,.XMP) ;Must be 1 character. "RTN","XMXPARM",190,0) D XMFLAG("XMINSTR(""TYPE"")",XMTYPE,"BDKOSX") "RTN","XMXPARM",191,0) Q "RTN","XMXPARM",192,0) XMFLAG(XMPARM,XMFLAG,FLAGSET) ; "RTN","XMXPARM",193,0) N XMLEFT "RTN","XMXPARM",194,0) S XMLEFT=$TR(XMFLAG,FLAGSET,"") "RTN","XMXPARM",195,0) Q:XMLEFT="" "RTN","XMXPARM",196,0) N XMP S XMP("PARAM","ID")=XMPARM,XMP("PARAM","VALUE")=XMFLAG,XMP(1)=XMLEFT "RTN","XMXPARM",197,0) D ERRSET^XMXUTIL(39413,.XMP) ;|1| is not valid. "RTN","XMXPARM",198,0) Q "RTN","XMXPARM",199,0) XMKTO(XMDUZ,XMKTO) ; "RTN","XMXPARM",200,0) I $G(XMKTO)="" D Q "RTN","XMXPARM",201,0) . N XMP S XMP("PARAM","ID")="XMKTO",XMP("PARAM","VALUE")="" "RTN","XMXPARM",202,0) . D ERRSET^XMXUTIL(39416,.XMP) ;Destination basket must be supplied. "RTN","XMXPARM",203,0) S XMKTO=$$XMK(XMDUZ,"XMKTO",XMKTO) "RTN","XMXPARM",204,0) Q "RTN","XMXPARM",205,0) XMK(XMDUZ,XMPARM,XMK,XMOPTNL) ; "RTN","XMXPARM",206,0) I +XMK=XMK,$D(^XMB(3.7,XMDUZ,2,XMK)) Q XMK "RTN","XMXPARM",207,0) ; Just in case a name was passed... "RTN","XMXPARM",208,0) N XMKN "RTN","XMXPARM",209,0) S XMKN=XMK "RTN","XMXPARM",210,0) S XMK=$$FIND1^DIC(3.701,","_XMDUZ_",","OQ",XMKN) "RTN","XMXPARM",211,0) Q:XMK XMK "RTN","XMXPARM",212,0) I '$D(DIERR),$G(XMOPTNL) Q XMKN ; Basket not found. Will create on delivery. "RTN","XMXPARM",213,0) N XMP S XMP("PARAM","ID")=XMPARM,XMP("PARAM","VALUE")=XMKN,XMP(1)=XMKN "RTN","XMXPARM",214,0) ;Basket name '|1|' ambiguous / not found. "RTN","XMXPARM",215,0) D ERRSET^XMXUTIL($S($D(DIERR):39414,1:39415),.XMP) "RTN","XMXPARM",216,0) Q XMKN "RTN","XMXPARM",217,0) XMZ(XMZ) ; "RTN","XMXPARM",218,0) I $G(XMZ),$D(^XMB(3.9,XMZ,0)) Q "RTN","XMXPARM",219,0) D ERRSET^XMXUTIL(34353,XMZ) ;Message '|1|' does not exist. "RTN","XMXPARM",220,0) Q "VER") 8.0^22.0 "BLD",9392,6) ^41 **END** **END**