source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTKERM4.m@ 623

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1XTKERM4 ;SF/RWF - Kermit utility parts ;11/8/93 11:46 ;
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3INIT ;Init kermit paramiters
4 S (XTKS("PN"),XTKR("PN"))=0
5 S XTKRDAT="~+ @-#N1" D RPAR S XTKSDAT="~+ @-#N1" D SPAR
6 S XTKS("TO")=15,XTKS("QA")="#",(XTKS("SOH"),XTKR("SOH"))=1
7 S (XTKR("MAXTRY"),XTKS("MAXTRY"))=10,XTKERR=0
8 S (XTKR("TRY"),XTKR("CCNT"),XTKR("PN"))=0,XTKR("PT")="B",XTKR("SA")=""
9 S (XTKS("TRY"),XTKS("CCNT"),XTKS("PN"))=0,XTKS("PT")="S",XTKS("SA")=""
10 S:'$D(XTKDIC) XTKERR=1 S:'$D(XTKMODE) XTKMODE=2 S:'$D(DWLC) DWLC=0
11 S U="^",XTKR("TRMRD")=^%ZOSF("TRMRD")
12 Q
13RPAR ;Setup receive paramiters from the S packet, Some go into send parameters
14 Q:XTKRDAT']""
15 S X=$A(XTKRDAT)-35 S:X>1 XTKS("SIZ")=X
16 S XTKR("TO")=$A(XTKRDAT,2)-32,XTKS("EOL")=$A(XTKRDAT,5)-32,XTKR("QA")=$E(XTKRDAT,6)
17 S:XTKS("EOL")<1 XTKS("EOL")=13 S:XTKR("QA")=" "!(XTKR("QA")="") XTKR("QA")="#"
18 S:XTKR("TO")<1 XTKR("TO")=5
19 Q
20SPAR ;Setup send paramiters from the Y packet.
21 Q:XTKSDAT']""
22 S X=$A(XTKSDAT)-35 S:X>1 XTKS("SIZ")=X
23 S XTKR("TO")=$A(XTKSDAT,2)-32,XTKS("NPAD")=$A(XTKSDAT,3)-32,XTKS("PADC")=$E(XTKSDAT,4)#64,XTKS("EOL")=$A(XTKSDAT,5)-32,XTKR("QA")=$E(XTKSDAT,6)
24 S:XTKS("EOL")<1 XTKS("EOL")=13 S:XTKR("QA")=" "!(XTKR("QA")="") XTKR("QA")="#" S:XTKS("NPAD")<0 XTKS("NPAD")=0
25 S:XTKR("TO")<1 XTKR("TO")=5
26 Q
27SFILE ;Get file to send.
28 K DIC S XTKERR=1,DIC="^DIZ(8980,",DIC(0)="AEMQ",DIC("A")="KERMIT FILE TO SEND:" D ^DIC Q:Y'>0
29 S XTKERR=0,XTKDA=+Y,XTKDIC="^DIZ(8980,"_XTKDA_",2,",XTKFILE=$P(Y,U,2),DIE=DIC,DA=+Y,DR="1///NOW;3" D ^DIE
30 S XTKMODE=$P(^DIZ(8980,XTKDA,0),U,4) K DIC,DIE,DR,DA
31 Q
32RFILE ;Recive file
33 W !!,"If you enter 'XXX' for the file name it will be replaced by the name sent."
34 K DIC S XTKERR=1,DLAYGO=8980,DIC="^DIZ(8980,",DIC(0)="AEMQLZ",DIC("A")="RECIEVE TO KERMIT FILE:",DIC("DR")="2//YES;3//TEXT" D ^DIC Q:Y'>0
35 S XTKDA=+Y,XTKFILE=$P(Y,U,2) I '$P(Y,U,3) S DA=+Y,DIE=DIC,DR="1///NOW;2;3" D ^DIE S Y(0)=^DIZ(8980,XTKDA,0)
36 S XTKERR=0,XTKDIC="^DIZ(8980,"_XTKDA_",2,",XTKR("RFN")=$P(Y(0),U,3),XTKMODE=$P(Y(0),U,4)
37 S @(XTKDIC_"0)")="" K DIC,DIE,DA,DR
38 Q
39READY S X=0 X ^%ZOSF("RM"),^%ZOSF("TYPE-AHEAD"),^%ZOSF("EOFF"),^%ZOSF("TRMON") Q
40RESTORE S X=$S($D(IOM):IOM,1:80) X ^%ZOSF("RM"),^%ZOSF("EON"),^%ZOSF("TRMOFF") Q:$D(XTKDEBUG)
41CLEAN ;Kill off variables
42 K A,C,F1,L,X1,X2,XTKR,XTKS,XTKRDAT,XTKSDAT,XTKRPK,XTKSPK,XTKDA,XTKFILE,XTKDIC,Y,Z,XTKET
43 Q
44BSPAR ;Build S or Y init string
45 S XTKSDAT="~"_$C(XTKS("TO")+32)_" @-#N1"
46 Q
Note: See TracBrowser for help on using the repository browser.