LRSRVR4 ;DALOI/JMC -LAB DATA SERVER, CONT'D - UUENCODE UTILITY ; Dec 14, 2004
;;5.2;LAB SERVICE;**303**;Sep 27, 1994
;
;
UUEN(STR) ; Uuencode string passed in.
N J,K,LEN,LRI,LRX,S,TMP,X,Y
S TMP="",LEN=$L(STR)
F LRI=1:3:LEN D
. S LRX=$E(STR,LRI,LRI+2)
. I $L(LRX)<3 S LRX=LRX_$E(" ",1,3-$L(LRX))
. S S=$A(LRX,1)*256+$A(LRX,2)*256+$A(LRX,3),Y=""
. F K=0:1:23 S Y=(S\(2**K)#2)_Y
. F K=1:6:24 D
. . S J=$$DEC^XLFUTL($E(Y,K,K+5),2)
. . S TMP=TMP_$C(J+32)
S TMP=$C(LEN+32)_TMP
Q TMP
;
;
ENCODE(LRSTR) ; Encode a string, keep remainder for next line
; Call with LRSTR by reference, Remainder returned in LRSTR
;
S LRQUIT=0,LRLEN=$L(LRSTR)
F D Q:LRQUIT
. I $L(LRSTR)<45 S LRQUIT=1 Q
. S LRX=$E(LRSTR,1,45)
. S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=$$UUEN(LRX)
. S LRSTR=$E(LRSTR,46,LRLEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSRVR4 845 printed Oct 16, 2024@18:21:35 Page 2
LRSRVR4 ;DALOI/JMC -LAB DATA SERVER, CONT'D - UUENCODE UTILITY ; Dec 14, 2004
+1 ;;5.2;LAB SERVICE;**303**;Sep 27, 1994
+2 ;
+3 ;
UUEN(STR) ; Uuencode string passed in.
+1 NEW J,K,LEN,LRI,LRX,S,TMP,X,Y
+2 SET TMP=""
SET LEN=$LENGTH(STR)
+3 FOR LRI=1:3:LEN
Begin DoDot:1
+4 SET LRX=$EXTRACT(STR,LRI,LRI+2)
+5 IF $LENGTH(LRX)<3
SET LRX=LRX_$EXTRACT(" ",1,3-$LENGTH(LRX))
+6 SET S=$ASCII(LRX,1)*256+$ASCII(LRX,2)*256+$ASCII(LRX,3)
SET Y=""
+7 FOR K=0:1:23
SET Y=(S\(2**K)#2)_Y
+8 FOR K=1:6:24
Begin DoDot:2
+9 SET J=$$DEC^XLFUTL($EXTRACT(Y,K,K+5),2)
+10 SET TMP=TMP_$CHAR(J+32)
End DoDot:2
End DoDot:1
+11 SET TMP=$CHAR(LEN+32)_TMP
+12 QUIT TMP
+13 ;
+14 ;
ENCODE(LRSTR) ; Encode a string, keep remainder for next line
+1 ; Call with LRSTR by reference, Remainder returned in LRSTR
+2 ;
+3 SET LRQUIT=0
SET LRLEN=$LENGTH(LRSTR)
+4 FOR
Begin DoDot:1
+5 IF $LENGTH(LRSTR)<45
SET LRQUIT=1
QUIT
+6 SET LRX=$EXTRACT(LRSTR,1,45)
+7 SET LRNODE=LRNODE+1
SET ^TMP($JOB,"LRDATA",LRNODE)=$$UUEN(LRX)
+8 SET LRSTR=$EXTRACT(LRSTR,46,LRLEN)
End DoDot:1
if LRQUIT
QUIT
+9 QUIT
