VistA-FOIAVistA/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQ.../XTKERM4.m

47 lines
2.4 KiB
Mathematica

XTKERM4 ;SF/RWF - Kermit utility parts ;11/8/93 11:46 ;
;;7.3;TOOLKIT;;Apr 25, 1995
INIT ;Init kermit paramiters
S (XTKS("PN"),XTKR("PN"))=0
S XTKRDAT="~+ @-#N1" D RPAR S XTKSDAT="~+ @-#N1" D SPAR
S XTKS("TO")=15,XTKS("QA")="#",(XTKS("SOH"),XTKR("SOH"))=1
S (XTKR("MAXTRY"),XTKS("MAXTRY"))=10,XTKERR=0
S (XTKR("TRY"),XTKR("CCNT"),XTKR("PN"))=0,XTKR("PT")="B",XTKR("SA")=""
S (XTKS("TRY"),XTKS("CCNT"),XTKS("PN"))=0,XTKS("PT")="S",XTKS("SA")=""
S:'$D(XTKDIC) XTKERR=1 S:'$D(XTKMODE) XTKMODE=2 S:'$D(DWLC) DWLC=0
S U="^",XTKR("TRMRD")=^%ZOSF("TRMRD")
Q
RPAR ;Setup receive paramiters from the S packet, Some go into send parameters
Q:XTKRDAT']""
S X=$A(XTKRDAT)-35 S:X>1 XTKS("SIZ")=X
S XTKR("TO")=$A(XTKRDAT,2)-32,XTKS("EOL")=$A(XTKRDAT,5)-32,XTKR("QA")=$E(XTKRDAT,6)
S:XTKS("EOL")<1 XTKS("EOL")=13 S:XTKR("QA")=" "!(XTKR("QA")="") XTKR("QA")="#"
S:XTKR("TO")<1 XTKR("TO")=5
Q
SPAR ;Setup send paramiters from the Y packet.
Q:XTKSDAT']""
S X=$A(XTKSDAT)-35 S:X>1 XTKS("SIZ")=X
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)
S:XTKS("EOL")<1 XTKS("EOL")=13 S:XTKR("QA")=" "!(XTKR("QA")="") XTKR("QA")="#" S:XTKS("NPAD")<0 XTKS("NPAD")=0
S:XTKR("TO")<1 XTKR("TO")=5
Q
SFILE ;Get file to send.
K DIC S XTKERR=1,DIC="^DIZ(8980,",DIC(0)="AEMQ",DIC("A")="KERMIT FILE TO SEND:" D ^DIC Q:Y'>0
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
S XTKMODE=$P(^DIZ(8980,XTKDA,0),U,4) K DIC,DIE,DR,DA
Q
RFILE ;Recive file
W !!,"If you enter 'XXX' for the file name it will be replaced by the name sent."
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
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)
S XTKERR=0,XTKDIC="^DIZ(8980,"_XTKDA_",2,",XTKR("RFN")=$P(Y(0),U,3),XTKMODE=$P(Y(0),U,4)
S @(XTKDIC_"0)")="" K DIC,DIE,DA,DR
Q
READY S X=0 X ^%ZOSF("RM"),^%ZOSF("TYPE-AHEAD"),^%ZOSF("EOFF"),^%ZOSF("TRMON") Q
RESTORE S X=$S($D(IOM):IOM,1:80) X ^%ZOSF("RM"),^%ZOSF("EON"),^%ZOSF("TRMOFF") Q:$D(XTKDEBUG)
CLEAN ;Kill off variables
K A,C,F1,L,X1,X2,XTKR,XTKS,XTKRDAT,XTKSDAT,XTKRPK,XTKSPK,XTKDA,XTKFILE,XTKDIC,Y,Z,XTKET
Q
BSPAR ;Build S or Y init string
S XTKSDAT="~"_$C(XTKS("TO")+32)_" @-#N1"
Q