IBCNRHLU ;DAOU/DMK - e-Pharmacy HL7 Utilities ;24-MAY-2004
;;2.0;INTEGRATED BILLING;**251,550**;21-MAR-94;Build 25
;;Per VA Directive 6402, this routine should not be modified.
;
; Description
;
; e-Pharmacy HL7 Utilities
;
; Entry points:
; TRAN1 - Convert HL7 special characters (specific)
; TRAN2 - Convert HL7 special characters (general)
; ERR - Process HL7 Errors
; HLT - Receive HL7 e-Pharmacy MFN Message
; MFK - Send HL7 e-Pharmacy MFK Message
;
Q
;
TRAN1(VALUE) ; Convert HL7 special characters
;
; Specific to the following standard VistA HL7 application definition
; HL7 FIELD SEPARATOR = |
; HL7 ENCODING CHARACTERS = ^~\&
;
; Input parameter:
; VALUE = HL7 message field, component, or subcomponent value
; Invoked if value contains escape character (\)
;
; Output parameter:
; NEWVALUE = Converted HL7 message field, component, or subcomponent value
;
N CONVERT,I,LAST,NEWVALUE,S,S3
;
; Initialize last string position involing converted special character
S LAST=0
;
; Initialize scratch string varaible
S S=""
;
; Initialize conversion array
;
; | = field separator
; Transferred as \F\ and converted to |
S CONVERT("\F\")="|"
;
; ^ = component separator
; Transferred as \S\ and NOT converted to ^ (FileMan delimiter)
;
; ~ = repetitive separator
; Transferred as \R\ and converted to ~
S CONVERT("\R\")="~"
;
; \ = escape character
; Transferred as \E\ and converted to \
S CONVERT("\E\")="\"
;
; & = subcomponent separator
; Transferred as \T\ and converted to &
S CONVERT("\T\")="&"
;
; Check and covert
F I=1:1:$L(VALUE) D
. S S=S_$E(VALUE,I)
. I (I-3)'<LAST D
.. ;
.. ; Check last 3 characters and convert if necessary
.. S S3=$E(S,$L(S)-2,$L(S))
.. I $D(CONVERT(S3)) D
... S LAST=I
... S S=$E(S,1,$L(S)-3)_CONVERT(S3)
S NEWVALUE=S
Q NEWVALUE
;
TRAN2(VALUE,HLFS,HLECH) ; Convert HL7 special characters
;
; General to the following:
;
; HL7 Component Separator = $E(HLECH,1)
; HL7 Repetition Separator = $E(HLECH,2) = $E(HL("ECH"),2)
; HL7 Escape Character = $E(HLECH,3) = $E(HL("ECH"),3)
; HL7 Subcomponent = $E(HLECH,4)
;
; Invoked if value contains escape character (VALUE[$E(HL("ECH"),3)
;
; Expected variable
; U = "^"
;
; Input parameters:
; VALUE = HL7 message field, component, or subcomponent value
; HLFS = HL7 field separator = HL7 variable HL("FS")
; HLECH = HL7 encoding characters = HL7 variable HL("ECH")
;
; Output parameter:
; NEWVALUE = Converted HL7 message field, component, or subcomponent value
; Quit if any input parameters undefined
I '$D(VALUE)!'$D(HLFS)!'$D(HLECH) Q
;
N CONVERT,HLEC,I,LAST,NEWVALUE,S,S3
;
; Initialize HL7 escape character variable
S HLEC=$E(HLECH,3)
;
; Initialize last string position involing converted special character
S LAST=0
;
; Initialize scratch string varaible
S S=""
;
; Initialize conversion array
; Do not covert to caret (^) (FileMan delimiter)
;
; Field separator
; Transferred as HLEC_"F"_HLEC and converted to HLFS
S CONVERT(HLEC_"F"_HLEC)=HLFS
;
; Component separator
; Transferred as HLEC_"S"_HLEC and converted to $E(HLECH,1)
I $E(HLECH,1)'=U S CONVERT(HLEC_"S"_HLEC)=$E(HLECH,1)
;
; Repetitive separator
; Transferred as HLEC_"R"_HLEC and converted to $E(HLECH,2)
I $E(HLECH,2)'=U S CONVERT(HLEC_"R"_HLEC)=$E(HLECH,2)
;
; Escape character
; Transferred as HLEC_"E"_HLEC and converted to $E(HLECH,3)
I $E(HLECH,3)'=U S CONVERT(HLEC_"E"_HLEC)=$E(HLECH,3)
;
; Subcomponent separator
; Transferred as HLEC_"T"_HLEC and converted to $E(HLECH,4)
I $E(HLECH,4)'=U S CONVERT(HLEC_"T"_HLEC)=$E(HLECH,4)
;
; Check and covert
F I=1:1:$L(VALUE) D
. S S=S_$E(VALUE,I)
. I (I-3)'<LAST D
.. ;
.. ; Check last 3 characters and convert if necessary
.. S S3=$E(S,$L(S)-2,$L(S))
.. I $D(CONVERT(S3)) D
... S LAST=I
... S S=$E(S,1,$L(S)-3)_CONVERT(S3)
S NEWVALUE=S
Q NEWVALUE
;
ERR ; Process HL7 Errors
D ERR^IBCNEHLI
Q
;
HLT ; Receive HL7 e-Pharmacy MFN Message
D ^IBCNRHLT
Q
;
MFK ; Send HL7 e-Pharmacy MFK Message
D ^IBCNRMFK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRHLU 4201 printed Sep 23, 2025@19:52:31 Page 2
IBCNRHLU ;DAOU/DMK - e-Pharmacy HL7 Utilities ;24-MAY-2004
+1 ;;2.0;INTEGRATED BILLING;**251,550**;21-MAR-94;Build 25
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Description
+5 ;
+6 ; e-Pharmacy HL7 Utilities
+7 ;
+8 ; Entry points:
+9 ; TRAN1 - Convert HL7 special characters (specific)
+10 ; TRAN2 - Convert HL7 special characters (general)
+11 ; ERR - Process HL7 Errors
+12 ; HLT - Receive HL7 e-Pharmacy MFN Message
+13 ; MFK - Send HL7 e-Pharmacy MFK Message
+14 ;
+15 QUIT
+16 ;
TRAN1(VALUE) ; Convert HL7 special characters
+1 ;
+2 ; Specific to the following standard VistA HL7 application definition
+3 ; HL7 FIELD SEPARATOR = |
+4 ; HL7 ENCODING CHARACTERS = ^~\&
+5 ;
+6 ; Input parameter:
+7 ; VALUE = HL7 message field, component, or subcomponent value
+8 ; Invoked if value contains escape character (\)
+9 ;
+10 ; Output parameter:
+11 ; NEWVALUE = Converted HL7 message field, component, or subcomponent value
+12 ;
+13 NEW CONVERT,I,LAST,NEWVALUE,S,S3
+14 ;
+15 ; Initialize last string position involing converted special character
+16 SET LAST=0
+17 ;
+18 ; Initialize scratch string varaible
+19 SET S=""
+20 ;
+21 ; Initialize conversion array
+22 ;
+23 ; | = field separator
+24 ; Transferred as \F\ and converted to |
+25 SET CONVERT("\F\")="|"
+26 ;
+27 ; ^ = component separator
+28 ; Transferred as \S\ and NOT converted to ^ (FileMan delimiter)
+29 ;
+30 ; ~ = repetitive separator
+31 ; Transferred as \R\ and converted to ~
+32 SET CONVERT("\R\")="~"
+33 ;
+34 ; \ = escape character
+35 ; Transferred as \E\ and converted to \
+36 SET CONVERT("\E\")="\"
+37 ;
+38 ; & = subcomponent separator
+39 ; Transferred as \T\ and converted to &
+40 SET CONVERT("\T\")="&"
+41 ;
+42 ; Check and covert
+43 FOR I=1:1:$LENGTH(VALUE)
Begin DoDot:1
+44 SET S=S_$EXTRACT(VALUE,I)
+45 IF (I-3)'<LAST
Begin DoDot:2
+46 ;
+47 ; Check last 3 characters and convert if necessary
+48 SET S3=$EXTRACT(S,$LENGTH(S)-2,$LENGTH(S))
+49 IF $DATA(CONVERT(S3))
Begin DoDot:3
+50 SET LAST=I
+51 SET S=$EXTRACT(S,1,$LENGTH(S)-3)_CONVERT(S3)
End DoDot:3
End DoDot:2
End DoDot:1
+52 SET NEWVALUE=S
+53 QUIT NEWVALUE
+54 ;
TRAN2(VALUE,HLFS,HLECH) ; Convert HL7 special characters
+1 ;
+2 ; General to the following:
+3 ;
+4 ; HL7 Component Separator = $E(HLECH,1)
+5 ; HL7 Repetition Separator = $E(HLECH,2) = $E(HL("ECH"),2)
+6 ; HL7 Escape Character = $E(HLECH,3) = $E(HL("ECH"),3)
+7 ; HL7 Subcomponent = $E(HLECH,4)
+8 ;
+9 ; Invoked if value contains escape character (VALUE[$E(HL("ECH"),3)
+10 ;
+11 ; Expected variable
+12 ; U = "^"
+13 ;
+14 ; Input parameters:
+15 ; VALUE = HL7 message field, component, or subcomponent value
+16 ; HLFS = HL7 field separator = HL7 variable HL("FS")
+17 ; HLECH = HL7 encoding characters = HL7 variable HL("ECH")
+18 ;
+19 ; Output parameter:
+20 ; NEWVALUE = Converted HL7 message field, component, or subcomponent value
+21 ; Quit if any input parameters undefined
+22 IF '$DATA(VALUE)!'$DATA(HLFS)!'$DATA(HLECH)
QUIT
+23 ;
+24 NEW CONVERT,HLEC,I,LAST,NEWVALUE,S,S3
+25 ;
+26 ; Initialize HL7 escape character variable
+27 SET HLEC=$EXTRACT(HLECH,3)
+28 ;
+29 ; Initialize last string position involing converted special character
+30 SET LAST=0
+31 ;
+32 ; Initialize scratch string varaible
+33 SET S=""
+34 ;
+35 ; Initialize conversion array
+36 ; Do not covert to caret (^) (FileMan delimiter)
+37 ;
+38 ; Field separator
+39 ; Transferred as HLEC_"F"_HLEC and converted to HLFS
+40 SET CONVERT(HLEC_"F"_HLEC)=HLFS
+41 ;
+42 ; Component separator
+43 ; Transferred as HLEC_"S"_HLEC and converted to $E(HLECH,1)
+44 IF $EXTRACT(HLECH,1)'=U
SET CONVERT(HLEC_"S"_HLEC)=$EXTRACT(HLECH,1)
+45 ;
+46 ; Repetitive separator
+47 ; Transferred as HLEC_"R"_HLEC and converted to $E(HLECH,2)
+48 IF $EXTRACT(HLECH,2)'=U
SET CONVERT(HLEC_"R"_HLEC)=$EXTRACT(HLECH,2)
+49 ;
+50 ; Escape character
+51 ; Transferred as HLEC_"E"_HLEC and converted to $E(HLECH,3)
+52 IF $EXTRACT(HLECH,3)'=U
SET CONVERT(HLEC_"E"_HLEC)=$EXTRACT(HLECH,3)
+53 ;
+54 ; Subcomponent separator
+55 ; Transferred as HLEC_"T"_HLEC and converted to $E(HLECH,4)
+56 IF $EXTRACT(HLECH,4)'=U
SET CONVERT(HLEC_"T"_HLEC)=$EXTRACT(HLECH,4)
+57 ;
+58 ; Check and covert
+59 FOR I=1:1:$LENGTH(VALUE)
Begin DoDot:1
+60 SET S=S_$EXTRACT(VALUE,I)
+61 IF (I-3)'<LAST
Begin DoDot:2
+62 ;
+63 ; Check last 3 characters and convert if necessary
+64 SET S3=$EXTRACT(S,$LENGTH(S)-2,$LENGTH(S))
+65 IF $DATA(CONVERT(S3))
Begin DoDot:3
+66 SET LAST=I
+67 SET S=$EXTRACT(S,1,$LENGTH(S)-3)_CONVERT(S3)
End DoDot:3
End DoDot:2
End DoDot:1
+68 SET NEWVALUE=S
+69 QUIT NEWVALUE
+70 ;
ERR ; Process HL7 Errors
+1 DO ERR^IBCNEHLI
+2 QUIT
+3 ;
HLT ; Receive HL7 e-Pharmacy MFN Message
+1 DO ^IBCNRHLT
+2 QUIT
+3 ;
MFK ; Send HL7 e-Pharmacy MFK Message
+1 DO ^IBCNRMFK
+2 QUIT
