Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCHL7E

GMRCHL7E.m

Go to the documentation of this file.
  1. GMRCHL7E ;AV/MKN - HL7 ENCODE/DECODE SPECIAL CHARACTERS ;06/02/2020
  1. ;;3.0;CONSULT/REQUEST TRACKING;**154**;JUNE 2, 2020;Build 135
  1. ;
  1. Q
  1. ;
  1. DECODE(INSTR,TCH,WDAT,INSTR1) ;
  1. ; INSTR - Input string
  1. ; TCH - translation array
  1. ; WDAT - Output in a Vista compliant "Free Text" array
  1. ; INSTR1 - Remainder of text when last or
  1. ; second to last INSTR char = "\"
  1. ;Development Note:
  1. ;\.br\ - removed and new node created
  1. ;\E\.br\E\ = \.br\ - (no further translation)
  1. ;non-printable character translation not supported
  1. ;Output Array nodes will contain no more than 200 characters each
  1. ;
  1. N II,CH
  1. S INSTR1="",WDAT=$G(WDAT)
  1. F II=1:1:$L(INSTR) S CH=$E(INSTR,II) D:CH="\" S WDAT=WDAT_CH I $L(WDAT)>199 D NWNODE(.WDAT)
  1. . ;
  1. . ; Partial TCH string, if \.br\ (CR-LF) translation allowed
  1. . I $L($E(INSTR,II,II+2))<3,$G(TCH("\.br\")) D Q
  1. .. S INSTR1=$E(INSTR,II,II+2),II=$L(INSTR),CH=""
  1. . ;
  1. . I '$D(TCH($E(INSTR,II,II+2))) Q ; not one we're interested in
  1. . I +$G(TCH($E(INSTR,II,II+2))) D Q ; \.br\ to <CR-LF> conversion
  1. .. I (II+4)>$L(INSTR) S INSTR1=$E(INSTR,II,$L(INSTR)),II=$L(INSTR),CH="" Q
  1. .. I +$G(TCH($E(INSTR,II,II+4))) S II=II+4,CH="" D NWNODE(.WDAT)
  1. . ;
  1. . S CH=TCH($E(INSTR,II,II+2)),II=II+2 ; std conversion
  1. Q WDAT ; Return top node of WDAT - for strings less than 200 characters
  1. ;
  1. NWNODE(FREERAY) ; build free text array
  1. N CNT
  1. S CNT=1+$O(FREERAY(""),-1),FREERAY(CNT)=FREERAY,FREERAY=""
  1. Q
  1. ;
  1. ENCODE(INSTR,TCH) ; Encode data
  1. N X,WCHR,OSTR
  1. S OSTR=""
  1. I $G(INSTR)]"" F X=1:1:$L(INSTR) D S OSTR=OSTR_WCHR
  1. . S WCHR=$E(INSTR,X) I $D(TCH(WCHR)) S WCHR=TCH(WCHR)
  1. Q OSTR
  1. ;