- 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 Feb 18, 2025@23:12:11 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 ;