- XTKERM2 ;SF/RWF - Kermit Receive a file. ;11/8/93 11:50 ;
- ;;7.3;TOOLKIT;**122**;Apr 25, 1995;Build 4
- ;Per VHA Directive 2004-038, this routine should not be modified.
- R I '$D(ZTQUEUED) U IO(0) D
- . I IO=IO(0) W !,"Now start a KERMIT send from your system.",!,"Starting [REMOTE] KERMIT receive.",!
- . E W !,"Starting a [LOCAL] KERMIT receive.",!
- . Q
- U IO S XTKET=$H
- F XTKERR=0:0 D GET,@("R"_XTKR("PT")):'XTKERR Q:XTKERR!(XTKR("PT")="B")
- D:XTKERR RB
- S %=$H,XTKET=$H-XTKET*86400+$P(%,",",2)-$P(XTKET,",",2)
- I '$D(ZTQUEUED) U IO(0) D
- . W !,"Done with ",$S(IO=IO(0):"[REMOTE]",1:"[LOCAL]")," receive, File transfer ",$S('XTKERR:"was successful. ("_XTKR("CCNT")_" bytes)",1:"failed. ("_XTKERR_")")
- W:'XTKERR !,?10,"Bytes: ",XTKR("CCNT")," Sec: ",XTKET," cps: ",$J($S(XTKET>0:XTKR("CCNT")/XTKET,1:""),3,1)
- Q
- RS S XTKS("PN")=XTKR("PN") D RPAR^XTKERM4,BSPAR^XTKERM4 S XTKS("PT")="Y" D SPACK,BUMP Q
- RF D SEQ Q:X S X=XTKRDAT D FILE,ACK,BUMP Q
- RD D SEQ Q:X D STORE,ACK,BUMP Q
- RZ D SEQ G:X ABORT S XTKRDAT="" D STORE:XTKR("SA")]"",ACK,BUMP,CLOSE Q
- RB D SEQ Q:X D ACK Q
- RY ;
- RN ;
- RE G ABORT
- SEQ S X=(XTKR("PN")'=XTKS("PN")) Q:'X D NAK S X=1 Q
- Q
- GET S XTKR("TRY")=XTKR("TRY")+1 I XTKR("TRY")>XTKR("MAXTRY") G ABORT
- D RPACK^XTKERM3
- I XTKERR D DEBUG("E:"_XTKERR):$D(XTKDEBUG),NAK G GET
- I "SFEDNZYB"'[XTKR("PT") S XTKERR="6 Unknown packet type" Q
- Q
- ABORT S:'XTKERR XTKERR="5 Aborting receive operation" Q
- BUMP S XTKR("TRY")=0,XTKS("PN")=XTKS("PN")+1#64 Q
- PREV S XTKS("PN")=$S(XTKS("PN"):XTKS("PN")-1,1:63) Q
- NAK S XTKS("PT")="N",XTKSDAT="" D SPACK Q
- ACK S XTKS("PT")="Y",XTKSDAT="" D SPACK S XTKR("TRY")=0 Q
- SPACK G SPACK^XTKERM3
- RPACK G RPACK^XTKERM3
- DEBUG(MSG) ;
- S XTKDEBUG=XTKDEBUG+1,^TMP("XTKERM",$J,XTKDEBUG)=MSG
- Q
- FILE ;See if need to change file name.
- I XTKDIC["DIZ(8980,",XTKR("RFN")="y" S XTKFILE(0)=XTKFILE,XTKFILE=X
- ;Other wise toss file name we don't need it.
- Q
- STORE ;Store the data (XTKRDAT) in file.
- I 'XTKMODE S X=XTKRDAT D PDATA Q
- 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
- 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")
- D:X]"" PDATA Q
- ;Y=M end of line, L form feed, J line feed, other make into control
- TEXT I "L"[Y D TX2 S X="|TOP|" D PDATA Q
- 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
- TX2 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)
- D PDATA S X="" G TX2:$L(XTKR("SA")) S XTKRDAT=$E(XTKRDAT,I+1,999),I=0 Q
- PDATA ;Put data in global
- S DWLC=DWLC+1,@(XTKDIC_"DWLC,0)")=X,XTKR("CCNT")=XTKR("CCNT")+$L(X) Q
- Q
- REPLACE 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
- Q
- CLOSE ;Close and update the filename if file 8980
- 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)
- S @("X=$S($D("_XTKDIC_"0)):^(0),1:"""")"),^(0)=$P(X_"^^",U,1,2)_U_DWLC_U_DWLC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTKERM2 3218 printed Jan 18, 2025@03:42:21 Page 2
- XTKERM2 ;SF/RWF - Kermit Receive a file. ;11/8/93 11:50 ;
- +1 ;;7.3;TOOLKIT;**122**;Apr 25, 1995;Build 4
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- R IF '$DATA(ZTQUEUED)
- USE IO(0)
- Begin DoDot:1
- +1 IF IO=IO(0)
- WRITE !,"Now start a KERMIT send from your system.",!,"Starting [REMOTE] KERMIT receive.",!
- +2 IF '$TEST
- WRITE !,"Starting a [LOCAL] KERMIT receive.",!
- +3 QUIT
- End DoDot:1
- +4 USE IO
- SET XTKET=$HOROLOG
- +5 FOR XTKERR=0:0
- DO GET
- if 'XTKERR
- DO @("R"_XTKR("PT"))
- if XTKERR!(XTKR("PT")="B")
- QUIT
- +6 if XTKERR
- DO RB
- +7 SET %=$HOROLOG
- SET XTKET=$HOROLOG-XTKET*86400+$PIECE(%,",",2)-$PIECE(XTKET,",",2)
- +8 IF '$DATA(ZTQUEUED)
- USE IO(0)
- Begin DoDot:1
- +9 WRITE !,"Done with ",$SELECT(IO=IO(0):"[REMOTE]",1:"[LOCAL]")," receive, File transfer ",$SELECT('XTKERR:"was successful. ("_XTKR("CCNT")_" bytes)",1:"failed. ("_XTKERR_")")
- End DoDot:1
- +10 if 'XTKERR
- WRITE !,?10,"Bytes: ",XTKR("CCNT")," Sec: ",XTKET," cps: ",$JUSTIFY($SELECT(XTKET>0:XTKR("CCNT")/XTKET,1:""),3,1)
- +11 QUIT
- RS SET XTKS("PN")=XTKR("PN")
- DO RPAR^XTKERM4
- DO BSPAR^XTKERM4
- SET XTKS("PT")="Y"
- DO SPACK
- DO BUMP
- QUIT
- RF DO SEQ
- if X
- QUIT
- SET X=XTKRDAT
- DO FILE
- DO ACK
- DO BUMP
- QUIT
- RD DO SEQ
- if X
- QUIT
- DO STORE
- DO ACK
- DO BUMP
- QUIT
- RZ DO SEQ
- if X
- GOTO ABORT
- SET XTKRDAT=""
- if XTKR("SA")]""
- DO STORE
- DO ACK
- DO BUMP
- DO CLOSE
- QUIT
- RB DO SEQ
- if X
- QUIT
- DO ACK
- QUIT
- RY ;
- RN ;
- RE GOTO ABORT
- SEQ SET X=(XTKR("PN")'=XTKS("PN"))
- if 'X
- QUIT
- DO NAK
- SET X=1
- QUIT
- +1 QUIT
- GET SET XTKR("TRY")=XTKR("TRY")+1
- IF XTKR("TRY")>XTKR("MAXTRY")
- GOTO ABORT
- +1 DO RPACK^XTKERM3
- +2 IF XTKERR
- if $DATA(XTKDEBUG)
- DO DEBUG("E:"_XTKERR)
- DO NAK
- GOTO GET
- +3 IF "SFEDNZYB"'[XTKR("PT")
- SET XTKERR="6 Unknown packet type"
- QUIT
- +4 QUIT
- ABORT if 'XTKERR
- SET XTKERR="5 Aborting receive operation"
- QUIT
- BUMP SET XTKR("TRY")=0
- SET XTKS("PN")=XTKS("PN")+1#64
- QUIT
- PREV SET XTKS("PN")=$SELECT(XTKS("PN"):XTKS("PN")-1,1:63)
- QUIT
- NAK SET XTKS("PT")="N"
- SET XTKSDAT=""
- DO SPACK
- QUIT
- ACK SET XTKS("PT")="Y"
- SET XTKSDAT=""
- DO SPACK
- SET XTKR("TRY")=0
- QUIT
- SPACK GOTO SPACK^XTKERM3
- RPACK GOTO RPACK^XTKERM3
- DEBUG(MSG) ;
- +1 SET XTKDEBUG=XTKDEBUG+1
- SET ^TMP("XTKERM",$JOB,XTKDEBUG)=MSG
- +2 QUIT
- FILE ;See if need to change file name.
- +1 IF XTKDIC["DIZ(8980,"
- IF XTKR("RFN")="y"
- SET XTKFILE(0)=XTKFILE
- SET XTKFILE=X
- +2 ;Other wise toss file name we don't need it.
- +3 QUIT
- STORE ;Store the data (XTKRDAT) in file.
- +1 IF 'XTKMODE
- SET X=XTKRDAT
- DO PDATA
- QUIT
- +2 FOR I=0:0
- SET I=$FIND(XTKRDAT,XTKR("QA"),I)
- if I<1
- QUIT
- SET X=$EXTRACT(XTKRDAT,1,I-2)
- SET Y=$EXTRACT(XTKRDAT,I)
- if XTKMODE=2
- DO TEXT
- if XTKMODE=1
- DO REPLACE
- +3 SET X=""
- if $LENGTH(XTKRDAT)+$LENGTH(XTKR("SA"))'>245
- SET XTKR("SA")=XTKR("SA")_XTKRDAT
- SET XTKRDAT=""
- if $LENGTH(XTKRDAT)+$LENGTH(XTKR("SA"))>245
- SET X=XTKR("SA")
- SET XTKR("SA")=XTKRDAT
- SET XTKRDAT=""
- if XTKR("PT")="Z"
- SET X=XTKR("SA")
- +4 if X]""
- DO PDATA
- QUIT
- +5 ;Y=M end of line, L form feed, J line feed, other make into control
- TEXT IF "L"[Y
- DO TX2
- SET X="|TOP|"
- DO PDATA
- QUIT
- +1 IF "M"'[Y
- SET XTKRDAT=X_$SELECT(Y=XTKR("QA"):Y,"J"[Y:"",1:$CHAR($ASCII(Y)-64))_$EXTRACT(XTKRDAT,I+1,999)
- SET I=I-(Y'=XTKR("QA"))
- QUIT
- TX2 IF $LENGTH(XTKR("SA"))
- SET X1=XTKR("SA")
- SET X2=X
- SET Z=245-$LENGTH(X1)
- SET X=X1_$EXTRACT(X2,1,Z)
- SET XTKR("SA")=$EXTRACT(X2,Z+1,999)
- +1 DO PDATA
- SET X=""
- if $LENGTH(XTKR("SA"))
- GOTO TX2
- SET XTKRDAT=$EXTRACT(XTKRDAT,I+1,999)
- SET I=0
- QUIT
- PDATA ;Put data in global
- +1 SET DWLC=DWLC+1
- SET @(XTKDIC_"DWLC,0)")=X
- SET XTKR("CCNT")=XTKR("CCNT")+$LENGTH(X)
- QUIT
- +2 QUIT
- REPLACE SET XTKRDAT=X_$SELECT(Y=XTKR("QA"):Y,1:$CHAR($ASCII(Y)-64))_$EXTRACT(XTKRDAT,I+1,999)
- SET I=$LENGTH(X)+(Y=XTKR("QA"))
- QUIT
- +1 QUIT
- CLOSE ;Close and update the filename if file 8980
- +1 IF XTKDIC["DIZ(8980,"
- IF XTKR("RFN")="y"
- SET $PIECE(^DIZ(8980,XTKDA,0),"^",1)=XTKFILE
- SET ^DIZ(8980,"B",$EXTRACT(XTKFILE,1,30),XTKDA)=""
- KILL ^DIZ(8980,"B",XTKFILE(0),XTKDA)
- +2 SET @("X=$S($D("_XTKDIC_"0)):^(0),1:"""")")
- SET ^(0)=$PIECE(X_"^^",U,1,2)_U_DWLC_U_DWLC
- +3 QUIT