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 ---[H[J[2J[HXTHCUTL 1306 printed Dec 13, 2024@02:41:04 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
