XTHCUTL.m

XTHCUTL ;ISF/RWF - HTTP 1.0 CLIENT Utilities ;11/10/09  15:12

 ;;7.3;TOOLKIT;**123**;;Build 4

 Q

 ;<LI>  <A HREF="#Payroll_&_Personnel" TITLE="Payroll & Personnel Links">Payroll &  Personnel</A> </LI>

 ;

DECODE(STR) ;DeCode a string  =" ", <=<, >=>,  =" "

 N I,J

 S I=0

 F  S I=$F(STR,"&",I) Q:'I  S J=$P($E(STR,I,I+5),";"),J=$$LOW^XLFSTR(J),K=$S(J="nbsp":" ",J="lt":"<",J="gt":">",J="amp":"&",J="apos":"'",J="quot":"""",$E(J)="#":$E(J,2,4),1:"") D:$L(K)

 . I +K S K=$C(+K) ;A The decimal value in ISO-latin-1 for A

 . S STR=$E(STR,1,I-2)_K_$E(STR,I+$L(J)+1,$L(STR))

 Q STR

 ;

UNHEX(HH) ;function - decode one pair of hex digits to ASCII char

 S HH=$TR(HH,"abcdef","ABCDEF")

 I $TR(HH,"0123456789ABCDEF")'="" Q "???" ;-- error - bad hex code --;

 S HH=$TR(HH,"ABCDEF",":;<=>?")

 Q $C($$UNHEXD($E(HH,1))*16+$$UNHEXD($E(HH,2)))

 ;

UNHEXD(X) ;function - convert hex digit back to decimal

 Q $A(X)-48

 ;

QUOTE ;

 F I=I+1:1 S CH=$E(STR,I) Q:CH=""!(CH=Q)

 I $E(STR,I+1)=Q S I=I+1 G QUOTE

 Q

 ;

TEST ;Unit Tests

 S STR="[ <&"'> ]m" I $$DECODE(STR)'="[ <&""'> ]m" W !,"Fail: ",STR

 S STR="0123456789ABCDEF" I $$DECODE(STR)'="0123456789ABCDEF" W !,"Fail: ",STR

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XTHCUTL   1306     printed  Apr 09, 2024@21:43:21                                                                                                                                                                                                     Page 2

XTHCUTL   ;ISF/RWF - HTTP 1.0 CLIENT Utilities ;11/10/09  15:12

 +1       ;;7.3;TOOLKIT;**123**;;Build 4

 +2        QUIT 

 +3       ;<LI>  <A HREF="#Payroll_&_Personnel" TITLE="Payroll & Personnel Links">Payroll &  Personnel</A> </LI>

 +4       ;

DECODE(STR) ;DeCode a string  =" ", <=<, >=>,  =" "

 +1        NEW I,J

 +2        SET I=0

 +3        FOR 

               SET I=$FIND(STR,"&",I)

               if 'I

                   QUIT 

               SET J=$PIECE($EXTRACT(STR,I,I+5),";")

               SET J=$$LOW^XLFSTR(J)

               SET K=$SELECT(J="nbsp":" ",J="lt":"<",J="gt":">",J="amp":"&",J="apos":"'",J="quot":"""",$EXTRACT(J)="#":$EXTRACT(J,2,4),1:"")

               if $LENGTH(K)

                   Begin DoDot:1

 +4       ;A The decimal value in ISO-latin-1 for A

                       IF +K

                           SET K=$CHAR(+K)

 +5                    SET STR=$EXTRACT(STR,1,I-2)_K_$EXTRACT(STR,I+$LENGTH(J)+1,$LENGTH(STR))

                   End DoDot:1

 +6        QUIT STR

 +7       ;

UNHEX(HH) ;function - decode one pair of hex digits to ASCII char

 +1        SET HH=$TRANSLATE(HH,"abcdef","ABCDEF")

 +2       ;-- error - bad hex code --;

           IF $TRANSLATE(HH,"0123456789ABCDEF")'=""

               QUIT "???"

 +3        SET HH=$TRANSLATE(HH,"ABCDEF",":;<=>?")

 +4        QUIT $CHAR($$UNHEXD($EXTRACT(HH,1))*16+$$UNHEXD($EXTRACT(HH,2)))

 +5       ;

UNHEXD(X) ;function - convert hex digit back to decimal

 +1        QUIT $ASCII(X)-48

 +2       ;

QUOTE     ;

 +1        FOR I=I+1:1

               SET CH=$EXTRACT(STR,I)

               if CH=""!(CH=Q)

                   QUIT 

 +2        IF $EXTRACT(STR,I+1)=Q

               SET I=I+1

               GOTO QUOTE

 +3        QUIT 

 +4       ;

TEST      ;Unit Tests

 +1        SET STR="[ <&"'> ]m"

           IF $$DECODE(STR)'="[ <&""'> ]m"

               WRITE !,"Fail: ",STR

 +2        SET STR="0123456789ABCDEF"

           IF $$DECODE(STR)'="0123456789ABCDEF"

               WRITE !,"Fail: ",STR

 +3        QUIT