GMRCHL7P ;DSS/MS - HL7 Message Utilities for HCP ;4/29/14
;;3.0;CONSULT/REQUEST TRACKING;**75**;DEC 27, 1997;Build 22
;
;DBIA# Supported Reference
;----- --------------------------------
;10106 HLPHONE^HLFNC
;
ADDR(PROVIEN,HL) ;get address data for Referring Provider
N HL7STRG,COMP,ADD,STATEIEN S COMP=$E(HL("ECH")),ADD=""
S HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.111) D HL7TXT(.HL7STRG,.HL,"\")
S $P(ADD,COMP)=HL7STRG
S HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.112) D HL7TXT(.HL7STRG,.HL,"\")
S $P(ADD,COMP,2)=HL7STRG
S HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.114) D HL7TXT(.HL7STRG,.HL,"\")
S $P(ADD,COMP,3)=HL7STRG
S STATEIEN=$$GET1^DIQ(200,PROVIEN_",",.115,"I") S $P(ADD,COMP,4)=$$GET1^DIQ(5,+STATEIEN_",",1)
S HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.116) D HL7TXT(.HL7STRG,.HL,"\")
S $P(ADD,COMP,5)=HL7STRG
Q ADD
PH(PROVIEN,HL) ;get contact information
N HL7STRG,COMP,PH S COMP=$E(HL("ECH")),PH=""
S HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.151) D HL7TXT(.HL7STRG,.HL,"\")
S $P(PH,COMP,4)=HL7STRG
S HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.132),HL7STRG=$$HLPHONE^HLFNC(HL7STRG)
I HL7STRG["(" S $P(PH,COMP,6)=$E(HL7STRG,2,4),$P(PH,COMP,7)=$P(HL7STRG,")",2)
E S $P(PH,COMP,7)=HL7STRG
Q PH
HL7TXT(HL7STRG,HL,HLES) ; Replace occurrences of embedded HL7 delimiters with
; HL7 escape sequence
; copied from VAFCQRY1
;
; Inputs: HL7STRG - Data string to be checked
; HL("ECH") - HL7 delimiter string
; Delimiters MUST be in the following order,
; Escape, Field, Component, Repeat, Subcomponent
; Example: \|^~&
;
; Output: HL7XTRG - Data string with escape sequence added (if needed)
;
N OCHR,RCHR,RCHRI,TYPE,I,HLES2
;
I $G(HL("COMP"))="" S HL("COMP")=$E(HL("ECH"),1),HL("REP")=$E(HL("ECH"),2),HL("SUBCOMP")=$E(HL("ECH"),4)
; Set HL7 escape char
S HLES2=HLES_HL("FS")_HL("COMP")_HL("REP")_HL("SUBCOMP")
;
; Search for occurrence of each delimiter and replace it with "\<type>\"
F TYPE="E","F","C","R","S" D
. S RCHRI=$S(TYPE="E":1,TYPE="F":2,TYPE="C":3,TYPE="R":4,TYPE="S":5)
. ;
. ; OCHR=original char, RCHR=replacement char
. S OCHR=$E(HLES2,RCHRI),RCHR=$E("EFSRT",RCHRI) Q:'$F(HL7STRG,OCHR)
. F I=1:1 Q:$E(HL7STRG,I)="" I $E(HL7STRG,I)=OCHR S HL7STRG=$E(HL7STRG,1,I-1)_HLES_RCHR_HLES_$E(HL7STRG,I+1,999),I=I+2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCHL7P 2338 printed Sep 23, 2025@19:21:51 Page 2
GMRCHL7P ;DSS/MS - HL7 Message Utilities for HCP ;4/29/14
+1 ;;3.0;CONSULT/REQUEST TRACKING;**75**;DEC 27, 1997;Build 22
+2 ;
+3 ;DBIA# Supported Reference
+4 ;----- --------------------------------
+5 ;10106 HLPHONE^HLFNC
+6 ;
ADDR(PROVIEN,HL) ;get address data for Referring Provider
+1 NEW HL7STRG,COMP,ADD,STATEIEN
SET COMP=$EXTRACT(HL("ECH"))
SET ADD=""
+2 SET HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.111)
DO HL7TXT(.HL7STRG,.HL,"\")
+3 SET $PIECE(ADD,COMP)=HL7STRG
+4 SET HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.112)
DO HL7TXT(.HL7STRG,.HL,"\")
+5 SET $PIECE(ADD,COMP,2)=HL7STRG
+6 SET HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.114)
DO HL7TXT(.HL7STRG,.HL,"\")
+7 SET $PIECE(ADD,COMP,3)=HL7STRG
+8 SET STATEIEN=$$GET1^DIQ(200,PROVIEN_",",.115,"I")
SET $PIECE(ADD,COMP,4)=$$GET1^DIQ(5,+STATEIEN_",",1)
+9 SET HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.116)
DO HL7TXT(.HL7STRG,.HL,"\")
+10 SET $PIECE(ADD,COMP,5)=HL7STRG
+11 QUIT ADD
PH(PROVIEN,HL) ;get contact information
+1 NEW HL7STRG,COMP,PH
SET COMP=$EXTRACT(HL("ECH"))
SET PH=""
+2 SET HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.151)
DO HL7TXT(.HL7STRG,.HL,"\")
+3 SET $PIECE(PH,COMP,4)=HL7STRG
+4 SET HL7STRG=$$GET1^DIQ(200,PROVIEN_",",.132)
SET HL7STRG=$$HLPHONE^HLFNC(HL7STRG)
+5 IF HL7STRG["("
SET $PIECE(PH,COMP,6)=$EXTRACT(HL7STRG,2,4)
SET $PIECE(PH,COMP,7)=$PIECE(HL7STRG,")",2)
+6 IF '$TEST
SET $PIECE(PH,COMP,7)=HL7STRG
+7 QUIT PH
HL7TXT(HL7STRG,HL,HLES) ; Replace occurrences of embedded HL7 delimiters with
+1 ; HL7 escape sequence
+2 ; copied from VAFCQRY1
+3 ;
+4 ; Inputs: HL7STRG - Data string to be checked
+5 ; HL("ECH") - HL7 delimiter string
+6 ; Delimiters MUST be in the following order,
+7 ; Escape, Field, Component, Repeat, Subcomponent
+8 ; Example: \|^~&
+9 ;
+10 ; Output: HL7XTRG - Data string with escape sequence added (if needed)
+11 ;
+12 NEW OCHR,RCHR,RCHRI,TYPE,I,HLES2
+13 ;
+14 IF $GET(HL("COMP"))=""
SET HL("COMP")=$EXTRACT(HL("ECH"),1)
SET HL("REP")=$EXTRACT(HL("ECH"),2)
SET HL("SUBCOMP")=$EXTRACT(HL("ECH"),4)
+15 ; Set HL7 escape char
+16 SET HLES2=HLES_HL("FS")_HL("COMP")_HL("REP")_HL("SUBCOMP")
+17 ;
+18 ; Search for occurrence of each delimiter and replace it with "\<type>\"
+19 FOR TYPE="E","F","C","R","S"
Begin DoDot:1
+20 SET RCHRI=$SELECT(TYPE="E":1,TYPE="F":2,TYPE="C":3,TYPE="R":4,TYPE="S":5)
+21 ;
+22 ; OCHR=original char, RCHR=replacement char
+23 SET OCHR=$EXTRACT(HLES2,RCHRI)
SET RCHR=$EXTRACT("EFSRT",RCHRI)
if '$FIND(HL7STRG,OCHR)
QUIT
+24 FOR I=1:1
if $EXTRACT(HL7STRG,I)=""
QUIT
IF $EXTRACT(HL7STRG,I)=OCHR
SET HL7STRG=$EXTRACT(HL7STRG,1,I-1)_HLES_RCHR_HLES_$EXTRACT(HL7STRG,I+1,999)
SET I=I+2
End DoDot:1
+25 QUIT
