| 1 | LADKERMI ;SLC/RWF/DLG - KERMIT PROTOCALL CONTROLLER - DIRECT CONNECT ;7/19/90 15:06 ;
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
|
|---|
| 3 | ;;
|
|---|
| 4 | ;Call with T set to Instrument data is to/from
|
|---|
| 5 | A I $D(^LA("KR",0)) L ^LA("KR") S (%,^(0))=^LA("KR",0)+1,^(%)=T_"^"_IN_"%^%"_$H L
|
|---|
| 6 | Q:IN="~A" L ^LA(T,"P") S:'$D(^LA(T,"P")) ^("P")="KERMIT^"_$S($E(IN,3)="N":"OUT",1:"IN") S MODE=$P(^("P"),"^",2)
|
|---|
| 7 | ;P1=Seq #, P2=Last type, P3=Reset point if don't get file
|
|---|
| 8 | S:'$D(^LA(T,"P1")) ^LA(T,"P1")=0,^("P2")="" S LAKSPK=""
|
|---|
| 9 | D RCHK,@MODE Q
|
|---|
| 10 | RCHK ;Check received packet and set parts, check for mode changes.
|
|---|
| 11 | S LAKERR=0,LARLEN=$A(IN)-32,LAKERR=$L(IN)-1-LARLEN,LAKRSEQ=$A(IN,2)-32,LAKTYPE=$E(IN,3) Q:LAKERR
|
|---|
| 12 | I LAKTYPE="E" S MODE="RESTART" Q
|
|---|
| 13 | S LAKERR=(LAKTYPE'="S")&(^LA(T,"P1")'=LAKRSEQ),C=0 Q:LAKERR F I=1:1:LARLEN S C=C+$A(IN,I)
|
|---|
| 14 | S CHKSUM=C\64#4+C#64,LAKERR=$A(IN,LARLEN+1)-32-CHKSUM
|
|---|
| 15 | I MODE="IN","Y"[LAKTYPE S MODE="OUT"
|
|---|
| 16 | I MODE="OUT","FS"[LAKTYPE S MODE="IN"
|
|---|
| 17 | I MODE="QUIT","S"[LAKTYPE S MODE="IN" I '$D(^LA("LOCK",T)),$D(^LAB(62.4,T,1)) X ^(1)
|
|---|
| 18 | I MODE="QUIT","Y"[LAKTYPE S MODE="OUT",^LA(T,"P3")=^LA(T,"O",0),^LA(T,"P2")=""
|
|---|
| 19 | S $P(^LA(T,"P"),"^",2)=MODE L Q
|
|---|
| 20 | IN D NAK:LAKERR,RACK:'LAKERR,KICK:LAKTYPE="B" S OUT=LAKSPK,%=OUT D:$D(^LA("KR",0)) DEBUG Q ;Upload
|
|---|
| 21 | NAK I LAKRSEQ+1=^LA(T,"P1") S LAKSPK=$C(LAKRSEQ+32)_"Y" D SPACK Q ;Packet not right
|
|---|
| 22 | S LAKSPK=$C(^LA(T,"P1")+32)_"N" D SPACK Q
|
|---|
| 23 | ;S LAKSPK=$C(LAKRSEQ+32)_"N" D SPACK Q
|
|---|
| 24 | SPACK S LAKSPK=$C($L(LAKSPK)+33)_LAKSPK,C=0 F I=1:1:$L(LAKSPK) S C=C+$A(LAKSPK,I) ;Send a responce packet
|
|---|
| 25 | S CHKSUM=C\64#4+C#64,LAKSPK=$C(1)_LAKSPK_$C(CHKSUM+32) Q
|
|---|
| 26 | Q
|
|---|
| 27 | RACK S ^LA(T,"P1")=LAKRSEQ+1#64,^("P2")=LAKTYPE
|
|---|
| 28 | I LAKTYPE="B" S ^LA(T,"P")="KERMIT^QUIT" ;Good packet
|
|---|
| 29 | I LAKTYPE="S" S LAKSPK=" Y~} @-#N1" D SPACK Q ;Send initiate, Return config.
|
|---|
| 30 | S LAKSPK=$C(LAKRSEQ+32)_"Y" D SPACK Q
|
|---|
| 31 | QUIT K ^LA(T,"P"),^("P1"),^("P2"),^("P3") I '$D(^LA("LOCK",T)),$D(^LAB(62.4,T,1)) X ^(1)
|
|---|
| 32 | Q
|
|---|
| 33 | RESTART S:$D(^LA(T,"P3")) ^LA(T,"O",0)=^LA(T,"P3")
|
|---|
| 34 | OUT L ^LA(T,"O") D SCHK,RSEND:LAKERR,NEXT:'LAKERR L Q ;Download
|
|---|
| 35 | SCHK I LAKTYPE="N" S LAKERR=1 Q ;If a NAK, call resend.
|
|---|
| 36 | I ^LA(T,"P2")="Z",LAKTYPE="Y" S ^LA(T,"P2")="" K ^LA(T,"P3") Q ;end of file
|
|---|
| 37 | I ^LA(T,"P2")="B",LAKTYPE="Y" S ^LA(T,"P")="KERMIT^QUIT" Q ;end of session
|
|---|
| 38 | S O=^LA(T,"O",0)+1 I '$D(^(O)) S LAKSPK=$C(LAKRSEQ+33)_"E0000" D SPACK S OUT=LAKSPK Q
|
|---|
| 39 | Q
|
|---|
| 40 | RSEND S O=^LA(T,"O",0)-1 S:O'<0 ^(0)=O ;Resend last packet, Fall into Next
|
|---|
| 41 | NEXT S O=^LA(T,"O",0)+1 I '$D(^(O)) K:'$D(^LA("LOCK",T)) ^LA(T) Q
|
|---|
| 42 | S ^LA(T,"O",0)=O,OUT=^(O),^LA(T,"P1")=$A(OUT,3)-32,^("P2")=$E(OUT,4)
|
|---|
| 43 | I $E(OUT,4)="S" S ^LA(T,"P3")=O-1 ;Set restart point.
|
|---|
| 44 | I $D(^LA("KR",0)) D DEBUG
|
|---|
| 45 | Q
|
|---|
| 46 | DEBUG L ^LA("KR") S (OUT1,^(0))=^LA("KR",0)+1,^(OUT1)=$E(T_"^Sent:"_OUT_"%^%"_$H,1,200)
|
|---|
| 47 | K OUT1 L Q
|
|---|
| 48 | KICK ;Start a download after an upload. (done async)
|
|---|
| 49 | Q:'$D(^LA(T,"O",0)) Q:^LA(T,"O")'>^LA(T,"O",0) S:$D(^LA(T,"P3")) ^LA(T,"O",0)=^LA(T,"P3") S ^LA(T,"P3")=^LA(T,"O",0)
|
|---|
| 50 | L ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T L Q
|
|---|
