source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTKERM2.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1XTKERM2 ;SF/RWF - Kermit Receive a file. ;11/8/93 11:50 ;
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3R I '$D(ZTQUEUED) U IO(0) D
4 . I IO=IO(0) W !,"Now start a KERMIT send from your system.",!,"Starting [REMOTE] KERMIT receive.",!
5 . E W !,"Starting a [LOCAL] KERMIT receive.",!
6 . Q
7 U IO S XTKET=$H
8 F XTKERR=0:0 D GET,@("R"_XTKR("PT")):'XTKERR Q:XTKERR!(XTKR("PT")="B")
9 D:XTKERR RB
10 S %=$H,XTKET=$H-XTKET*86400+$P(%,",",2)-$P(XTKET,",",2)
11 I '$D(ZTQUEUED) U IO(0) D
12 . W !,"Done with ",$S(IO=IO(0):"[REMOTE]",1:"[LOCAL]")," receive, File transfer ",$S('XTKERR:"was successful. ("_XTKR("CCNT")_" bytes)",1:"failed. ("_XTKERR_")")
13 W:'XTKERR !,?10,"Bytes: ",XTKR("CCNT")," Sec: ",XTKET," cps: ",$J(XTKR("CCNT")/XTKET,3,1)
14 Q
15RS S XTKS("PN")=XTKR("PN") D RPAR^XTKERM4,BSPAR^XTKERM4 S XTKS("PT")="Y" D SPACK,BUMP Q
16RF D SEQ Q:X S X=XTKRDAT D FILE,ACK,BUMP Q
17RD D SEQ Q:X D STORE,ACK,BUMP Q
18RZ D SEQ G:X ABORT S XTKRDAT="" D STORE:XTKR("SA")]"",ACK,BUMP,CLOSE Q
19RB D SEQ Q:X D ACK Q
20RY ;
21RN ;
22RE G ABORT
23SEQ S X=(XTKR("PN")'=XTKS("PN")) Q:'X D NAK S X=1 Q
24 Q
25GET S XTKR("TRY")=XTKR("TRY")+1 I XTKR("TRY")>XTKR("MAXTRY") G ABORT
26 D RPACK^XTKERM3
27 I XTKERR D NAK G GET
28 I "SFEDNZYB"'[XTKR("PT") S XTKERR="6 Unknown packet type" Q
29 Q
30ABORT S:'XTKERR XTKERR="5 Aborting receive operation" Q
31BUMP S XTKR("TRY")=0,XTKS("PN")=XTKS("PN")+1#64 Q
32PREV S XTKS("PN")=$S(XTKS("PN"):XTKS("PN")-1,1:63) Q
33NAK S XTKS("PT")="N",XTKSDAT="" D SPACK Q
34ACK S XTKS("PT")="Y",XTKSDAT="" D SPACK S XTKR("TRY")=0 Q
35SPACK G SPACK^XTKERM3
36RPACK G RPACK^XTKERM3
37FILE ;See if need to change file name.
38 I XTKDIC["DIZ(8980,",XTKR("RFN")="y" S XTKFILE(0)=XTKFILE,XTKFILE=X
39 ;Other wise toss file name we don't need it.
40 ;I XTKDIC'["^DIZ(8980," S X="KERMIT File Name: "_X D PDATA ;Old, just store the file name.
41 Q
42STORE ;Store the data (XTKRDAT) in file.
43 I 'XTKMODE S X=XTKRDAT D PDATA Q
44 F I=0:0 S I=$F(XTKRDAT,XTKR("QA"),I) Q:I<1 S X=$E(XTKRDAT,1,I-2),Y=$E(XTKRDAT,I) D TEXT:XTKMODE=2,REPLACE:XTKMODE=1
45 S X="" S:$L(XTKRDAT)+$L(XTKR("SA"))'>245 XTKR("SA")=XTKR("SA")_XTKRDAT,XTKRDAT="" S:$L(XTKRDAT)+$L(XTKR("SA"))>245 X=XTKR("SA"),XTKR("SA")=XTKRDAT,XTKRDAT="" S:XTKR("PT")="Z" X=XTKR("SA")
46 D:X]"" PDATA Q
47 ;Y=M end of line, L form feed, J line feed, other make into control
48TEXT I "L"[Y D TX2 S X="|TOP|" D PDATA Q
49 I "M"'[Y S XTKRDAT=X_$S(Y=XTKR("QA"):Y,"J"[Y:"",1:$C($A(Y)-64))_$E(XTKRDAT,I+1,999),I=I-(Y'=XTKR("QA")) Q
50TX2 I $L(XTKR("SA")) S X1=XTKR("SA"),X2=X,Z=245-$L(X1),X=X1_$E(X2,1,Z),XTKR("SA")=$E(X2,Z+1,999)
51 D PDATA S X="" G TX2:$L(XTKR("SA")) S XTKRDAT=$E(XTKRDAT,I+1,999),I=0 Q
52PDATA ;Put data in global
53 S DWLC=DWLC+1,@(XTKDIC_"DWLC,0)")=X,XTKR("CCNT")=XTKR("CCNT")+$L(X) Q
54 Q
55REPLACE S XTKRDAT=X_$S(Y=XTKR("QA"):Y,1:$C($A(Y)-64))_$E(XTKRDAT,I+1,999),I=$L(X)+(Y=XTKR("QA")) Q
56 Q
57CLOSE ;Close and update the filename if file 8980
58 I XTKDIC["DIZ(8980,",XTKR("RFN")="y" S $P(^DIZ(8980,XTKDA,0),"^",1)=XTKFILE,^DIZ(8980,"B",$E(XTKFILE,1,30),XTKDA)="" K ^DIZ(8980,"B",XTKFILE(0),XTKDA)
59 S @("X=$S($D("_XTKDIC_"0)):^(0),1:"""")"),^(0)=$P(X_"^^",U,1,2)_U_DWLC_U_DWLC
60 Q
Note: See TracBrowser for help on using the repository browser.