GMRCHL7E ;AV/MKN - HL7 ENCODE/DECODE SPECIAL CHARACTERS ;06/02/2020
;;3.0;CONSULT/REQUEST TRACKING;**154**;JUNE 2, 2020;Build 135
;
Q
;
DECODE(INSTR,TCH,WDAT,INSTR1) ;
; INSTR - Input string
; TCH - translation array
; WDAT - Output in a Vista compliant "Free Text" array
; INSTR1 - Remainder of text when last or
; second to last INSTR char = "\"
;Development Note:
;\.br\ - removed and new node created
;\E\.br\E\ = \.br\ - (no further translation)
;non-printable character translation not supported
;Output Array nodes will contain no more than 200 characters each
;
N II,CH
S INSTR1="",WDAT=$G(WDAT)
F II=1:1:$L(INSTR) S CH=$E(INSTR,II) D:CH="\" S WDAT=WDAT_CH I $L(WDAT)>199 D NWNODE(.WDAT)
. ;
. ; Partial TCH string, if \.br\ (CR-LF) translation allowed
. I $L($E(INSTR,II,II+2))<3,$G(TCH("\.br\")) D Q
.. S INSTR1=$E(INSTR,II,II+2),II=$L(INSTR),CH=""
. ;
. I '$D(TCH($E(INSTR,II,II+2))) Q ; not one we're interested in
. I +$G(TCH($E(INSTR,II,II+2))) D Q ; \.br\ to <CR-LF> conversion
.. I (II+4)>$L(INSTR) S INSTR1=$E(INSTR,II,$L(INSTR)),II=$L(INSTR),CH="" Q
.. I +$G(TCH($E(INSTR,II,II+4))) S II=II+4,CH="" D NWNODE(.WDAT)
. ;
. S CH=TCH($E(INSTR,II,II+2)),II=II+2 ; std conversion
Q WDAT ; Return top node of WDAT - for strings less than 200 characters
;
NWNODE(FREERAY) ; build free text array
N CNT
S CNT=1+$O(FREERAY(""),-1),FREERAY(CNT)=FREERAY,FREERAY=""
Q
;
ENCODE(INSTR,TCH) ; Encode data
N X,WCHR,OSTR
S OSTR=""
I $G(INSTR)]"" F X=1:1:$L(INSTR) D S OSTR=OSTR_WCHR
. S WCHR=$E(INSTR,X) I $D(TCH(WCHR)) S WCHR=TCH(WCHR)
Q OSTR
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCHL7E 1658 printed Dec 13, 2024@01:45:48 Page 2
GMRCHL7E ;AV/MKN - HL7 ENCODE/DECODE SPECIAL CHARACTERS ;06/02/2020
+1 ;;3.0;CONSULT/REQUEST TRACKING;**154**;JUNE 2, 2020;Build 135
+2 ;
+3 QUIT
+4 ;
DECODE(INSTR,TCH,WDAT,INSTR1) ;
+1 ; INSTR - Input string
+2 ; TCH - translation array
+3 ; WDAT - Output in a Vista compliant "Free Text" array
+4 ; INSTR1 - Remainder of text when last or
+5 ; second to last INSTR char = "\"
+6 ;Development Note:
+7 ;\.br\ - removed and new node created
+8 ;\E\.br\E\ = \.br\ - (no further translation)
+9 ;non-printable character translation not supported
+10 ;Output Array nodes will contain no more than 200 characters each
+11 ;
+12 NEW II,CH
+13 SET INSTR1=""
SET WDAT=$GET(WDAT)
+14 FOR II=1:1:$LENGTH(INSTR)
SET CH=$EXTRACT(INSTR,II)
if CH="\"
Begin DoDot:1
+15 ;
+16 ; Partial TCH string, if \.br\ (CR-LF) translation allowed
+17 IF $LENGTH($EXTRACT(INSTR,II,II+2))<3
IF $GET(TCH("\.br\"))
Begin DoDot:2
+18 SET INSTR1=$EXTRACT(INSTR,II,II+2)
SET II=$LENGTH(INSTR)
SET CH=""
End DoDot:2
QUIT
+19 ;
+20 ; not one we're interested in
IF '$DATA(TCH($EXTRACT(INSTR,II,II+2)))
QUIT
+21 ; \.br\ to <CR-LF> conversion
IF +$GET(TCH($EXTRACT(INSTR,II,II+2)))
Begin DoDot:2
+22 IF (II+4)>$LENGTH(INSTR)
SET INSTR1=$EXTRACT(INSTR,II,$LENGTH(INSTR))
SET II=$LENGTH(INSTR)
SET CH=""
QUIT
+23 IF +$GET(TCH($EXTRACT(INSTR,II,II+4)))
SET II=II+4
SET CH=""
DO NWNODE(.WDAT)
End DoDot:2
QUIT
+24 ;
+25 ; std conversion
SET CH=TCH($EXTRACT(INSTR,II,II+2))
SET II=II+2
End DoDot:1
SET WDAT=WDAT_CH
IF $LENGTH(WDAT)>199
DO NWNODE(.WDAT)
+26 ; Return top node of WDAT - for strings less than 200 characters
QUIT WDAT
+27 ;
NWNODE(FREERAY) ; build free text array
+1 NEW CNT
+2 SET CNT=1+$ORDER(FREERAY(""),-1)
SET FREERAY(CNT)=FREERAY
SET FREERAY=""
+3 QUIT
+4 ;
ENCODE(INSTR,TCH) ; Encode data
+1 NEW X,WCHR,OSTR
+2 SET OSTR=""
+3 IF $GET(INSTR)]""
FOR X=1:1:$LENGTH(INSTR)
Begin DoDot:1
+4 SET WCHR=$EXTRACT(INSTR,X)
IF $DATA(TCH(WCHR))
SET WCHR=TCH(WCHR)
End DoDot:1
SET OSTR=OSTR_WCHR
+5 QUIT OSTR
+6 ;
