CIAUUU.m

CIAUUU ;MSC/IND/DKM - UUEncode and UUDecode functions.;04-May-2006 08:19;DKM

 ;;1.2;CIA UTILITIES;;Mar 20, 2007

 ;;Copyright 2000-2006, Medsphere Systems Corporation

 ;=================================================================

ENCODE(X) ;

 N CIAZ,CIAZ1,CIAZ2,CIAZ3,CIAZ4,CIAZ5,CIAZ6

 S CIAZ=$$INIT,CIAZ1=""

 F CIAZ2=1:3:$L(X) D

 .S CIAZ3=0,CIAZ6=""

 .F CIAZ4=0:1:2 D

 ..S CIAZ5=$A(X,CIAZ2+CIAZ4),CIAZ3=CIAZ3*256+$S(CIAZ5<0:0,1:CIAZ5)

 .F CIAZ4=1:1:4 S CIAZ6=$E(CIAZ,CIAZ3#64+2)_CIAZ6,CIAZ3=CIAZ3\64

 .S CIAZ1=CIAZ1_CIAZ6

 S CIAZ2=$L(X)#3

 S:CIAZ2 CIAZ3=$L(CIAZ1),$E(CIAZ1,CIAZ3-2+CIAZ2,CIAZ3)=$E("==",CIAZ2,2)

 Q CIAZ1

DECODE(X) ;

 N CIAZ,CIAZ1,CIAZ2,CIAZ3,CIAZ4,CIAZ5,CIAZ6

 S CIAZ=$$INIT,CIAZ1=""

 F CIAZ2=1:4:$L(X) D

 .S CIAZ3=0,CIAZ6=""

 .F CIAZ4=0:1:3 D

 ..S CIAZ5=$F(CIAZ,$E(X,CIAZ2+CIAZ4))-3

 ..S CIAZ3=CIAZ3*64+$S(CIAZ5<0:0,1:CIAZ5)

 .F CIAZ4=0:1:2 S CIAZ6=$C(CIAZ3#256)_CIAZ6,CIAZ3=CIAZ3\256

 .S CIAZ1=CIAZ1_CIAZ6

 Q $E(CIAZ1,1,$L(CIAZ1)-$L(X,"=")+1)

INIT() Q "=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

CIAUUU    ;MSC/IND/DKM - UUEncode and UUDecode functions.;04-May-2006 08:19;DKM

 +1       ;;1.2;CIA UTILITIES;;Mar 20, 2007

 +2       ;;Copyright 2000-2006, Medsphere Systems Corporation

 +3       ;=================================================================

ENCODE(X) ;

 +1        NEW CIAZ,CIAZ1,CIAZ2,CIAZ3,CIAZ4,CIAZ5,CIAZ6

 +2        SET CIAZ=$$INIT

           SET CIAZ1=""

 +3        FOR CIAZ2=1:3:$LENGTH(X)

               Begin DoDot:1

 +4                SET CIAZ3=0

                   SET CIAZ6=""

 +5                FOR CIAZ4=0:1:2

                       Begin DoDot:2

 +6                        SET CIAZ5=$ASCII(X,CIAZ2+CIAZ4)

                           SET CIAZ3=CIAZ3*256+$SELECT(CIAZ5<0:0,1:CIAZ5)

                       End DoDot:2

 +7                FOR CIAZ4=1:1:4

                       SET CIAZ6=$EXTRACT(CIAZ,CIAZ3#64+2)_CIAZ6

                       SET CIAZ3=CIAZ3\64

 +8                SET CIAZ1=CIAZ1_CIAZ6

               End DoDot:1

 +9        SET CIAZ2=$LENGTH(X)#3

 +10       IF CIAZ2

               SET CIAZ3=$LENGTH(CIAZ1)

               SET $EXTRACT(CIAZ1,CIAZ3-2+CIAZ2,CIAZ3)=$EXTRACT("==",CIAZ2,2)

 +11       QUIT CIAZ1

DECODE(X) ;

 +1        NEW CIAZ,CIAZ1,CIAZ2,CIAZ3,CIAZ4,CIAZ5,CIAZ6

 +2        SET CIAZ=$$INIT

           SET CIAZ1=""

 +3        FOR CIAZ2=1:4:$LENGTH(X)

               Begin DoDot:1

 +4                SET CIAZ3=0

                   SET CIAZ6=""

 +5                FOR CIAZ4=0:1:3

                       Begin DoDot:2

 +6                        SET CIAZ5=$FIND(CIAZ,$EXTRACT(X,CIAZ2+CIAZ4))-3

 +7                        SET CIAZ3=CIAZ3*64+$SELECT(CIAZ5<0:0,1:CIAZ5)

                       End DoDot:2

 +8                FOR CIAZ4=0:1:2

                       SET CIAZ6=$CHAR(CIAZ3#256)_CIAZ6

                       SET CIAZ3=CIAZ3\256

 +9                SET CIAZ1=CIAZ1_CIAZ6

               End DoDot:1

 +10       QUIT $EXTRACT(CIAZ1,1,$LENGTH(CIAZ1)-$LENGTH(X,"=")+1)

INIT()     QUIT "=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"