- ORHLESC ;SLC/JMH - HL7 UTILITY ;11:26 AM 2 Apr 2001
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
- ;
- ; VAL = COMPONENT_REPETITION_ESCAPE_SUBCOMPONENT_FIELD
- ;
- ESC(ORSTR,VAL) ; REPLACE HL7 DELIMITER CHAR
- N SEPC,SEPR,SEPS,SEPF,SEPE,REPSEPC,REPSEPR,REPSEPS,REPSEPF,REPSEPE,I,HL7DEL
- I '$L($G(VAL)) S VAL="~|\&^"
- I $G(ORSTR)="" Q ""
- I $TR(ORSTR,$G(VAL))=ORSTR Q ORSTR
- N X,Y,Z,RES
- S SEPE=$E(VAL,3),REPSEPE=SEPE_"E"_SEPE
- S SEPC=$E(VAL,1),REPSEPC=SEPE_"S"_SEPE
- S SEPR=$E(VAL,2),REPSEPR=SEPE_"R"_SEPE
- S SEPS=$E(VAL,4),REPSEPS=SEPE_"T"_SEPE
- S SEPF=$E(VAL,5),REPSEPF=SEPE_"F"_SEPE
- S RES=ORSTR
- I $F(ORSTR,SEPE) S X=RES D
- . S Z=$P(X,SEPE,2,9999),Y=$P(X,SEPE)_REPSEPE_Z,RES=Y,X=Z I '$F(Z,SEPE) Q
- . F I=2:1 S Z=$P(X,SEPE,2,9999),Y=$P(RES,REPSEPE,1,I-1)_REPSEPE_$P(X,SEPE)_REPSEPE_Z,RES=Y,X=Z I '$F(Z,SEPE) Q
- ;
- I $F(RES,SEPC) F I=1:1 S Y=$P(RES,SEPC)_REPSEPC_$P(RES,SEPC,2,9999),RES=Y I '$F(RES,SEPC) Q
- I $F(RES,SEPR) F I=1:1 S Y=$P(RES,SEPR)_REPSEPR_$P(RES,SEPR,2,9999),RES=Y I '$F(RES,SEPR) Q
- I $F(RES,SEPS) F I=1:1 S Y=$P(RES,SEPS)_REPSEPS_$P(RES,SEPS,2,9999),RES=Y I '$F(RES,SEPS) Q
- I $F(RES,SEPF) F I=1:1 S Y=$P(RES,SEPF)_REPSEPF_$P(RES,SEPF,2,9999),RES=Y I '$F(RES,SEPF) Q
- Q RES
- UNESC(ORSTR,VAL) ;
- ; Remove Escape Characters from HL7 Message Text
- ; Escape Sequence codes:
- ; F = field separator (ORFS)
- ; S = component separator (ORCS)
- ; R = repetition separator (ORRS)
- ; E = escape character (ORES)
- ; T = subcomponent separator (ORSS)
- N ORFS,ORCS,ORRS,ORES,ORSS
- I '$L($G(VAL)) S VAL="~|\&^"
- S ORFS=$E(VAL,5)
- S ORCS=$E(VAL,1)
- S ORRS=$E(VAL,2)
- S ORES=$E(VAL,3)
- S ORSS=$E(VAL,4)
- N ORCHR,ORREP,I1,I2,J1,J2,K,VALUE
- F ORCHR="F","S","R","E","T" S ORREP(ORES_ORCHR_ORES)=$S(ORCHR="F":ORFS,ORCHR="S":ORCS,ORCHR="R":ORRS,ORCHR="E":ORES,ORCHR="T":ORSS)
- S ORSTR=$$REPLACE^XLFSTR(ORSTR,.ORREP)
- F S I1=$P(ORSTR,ORES_"X") Q:$L(I1)=$L(ORSTR) D
- .S I2=$P(ORSTR,ORES_"X",2,99)
- .S J1=$P(I2,ORES) Q:'$L(J1)
- .S J2=$P(I2,ORES,2,99)
- .S VALUE=$$BASE^XLFUTL($$UP^XLFSTR(J1),16,10)
- .S K=$S(VALUE>255:"?",VALUE<32!(VALUE>127&(VALUE<160)):"",1:$C(VALUE))
- .S ORSTR=I1_K_J2
- Q ORSTR
- REPLACE(X,Y,Z) ;
- ; X is initial string
- ; Y is string to be replaced
- ; Z is string to replace
- N RET
- I X'[Y Q X
- S I=1,RET=$P(X,Y) F S I=I+1,RET=RET_Z_$P(X,Y,I) Q:I=$L(X,Y)
- Q RET
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORHLESC 2395 printed Feb 18, 2025@23:57:29 Page 2
- ORHLESC ;SLC/JMH - HL7 UTILITY ;11:26 AM 2 Apr 2001
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
- +2 ;
- +3 ; VAL = COMPONENT_REPETITION_ESCAPE_SUBCOMPONENT_FIELD
- +4 ;
- ESC(ORSTR,VAL) ; REPLACE HL7 DELIMITER CHAR
- +1 NEW SEPC,SEPR,SEPS,SEPF,SEPE,REPSEPC,REPSEPR,REPSEPS,REPSEPF,REPSEPE,I,HL7DEL
- +2 IF '$LENGTH($GET(VAL))
- SET VAL="~|\&^"
- +3 IF $GET(ORSTR)=""
- QUIT ""
- +4 IF $TRANSLATE(ORSTR,$GET(VAL))=ORSTR
- QUIT ORSTR
- +5 NEW X,Y,Z,RES
- +6 SET SEPE=$EXTRACT(VAL,3)
- SET REPSEPE=SEPE_"E"_SEPE
- +7 SET SEPC=$EXTRACT(VAL,1)
- SET REPSEPC=SEPE_"S"_SEPE
- +8 SET SEPR=$EXTRACT(VAL,2)
- SET REPSEPR=SEPE_"R"_SEPE
- +9 SET SEPS=$EXTRACT(VAL,4)
- SET REPSEPS=SEPE_"T"_SEPE
- +10 SET SEPF=$EXTRACT(VAL,5)
- SET REPSEPF=SEPE_"F"_SEPE
- +11 SET RES=ORSTR
- +12 IF $FIND(ORSTR,SEPE)
- SET X=RES
- Begin DoDot:1
- +13 SET Z=$PIECE(X,SEPE,2,9999)
- SET Y=$PIECE(X,SEPE)_REPSEPE_Z
- SET RES=Y
- SET X=Z
- IF '$FIND(Z,SEPE)
- QUIT
- +14 FOR I=2:1
- SET Z=$PIECE(X,SEPE,2,9999)
- SET Y=$PIECE(RES,REPSEPE,1,I-1)_REPSEPE_$PIECE(X,SEPE)_REPSEPE_Z
- SET RES=Y
- SET X=Z
- IF '$FIND(Z,SEPE)
- QUIT
- End DoDot:1
- +15 ;
- +16 IF $FIND(RES,SEPC)
- FOR I=1:1
- SET Y=$PIECE(RES,SEPC)_REPSEPC_$PIECE(RES,SEPC,2,9999)
- SET RES=Y
- IF '$FIND(RES,SEPC)
- QUIT
- +17 IF $FIND(RES,SEPR)
- FOR I=1:1
- SET Y=$PIECE(RES,SEPR)_REPSEPR_$PIECE(RES,SEPR,2,9999)
- SET RES=Y
- IF '$FIND(RES,SEPR)
- QUIT
- +18 IF $FIND(RES,SEPS)
- FOR I=1:1
- SET Y=$PIECE(RES,SEPS)_REPSEPS_$PIECE(RES,SEPS,2,9999)
- SET RES=Y
- IF '$FIND(RES,SEPS)
- QUIT
- +19 IF $FIND(RES,SEPF)
- FOR I=1:1
- SET Y=$PIECE(RES,SEPF)_REPSEPF_$PIECE(RES,SEPF,2,9999)
- SET RES=Y
- IF '$FIND(RES,SEPF)
- QUIT
- +20 QUIT RES
- UNESC(ORSTR,VAL) ;
- +1 ; Remove Escape Characters from HL7 Message Text
- +2 ; Escape Sequence codes:
- +3 ; F = field separator (ORFS)
- +4 ; S = component separator (ORCS)
- +5 ; R = repetition separator (ORRS)
- +6 ; E = escape character (ORES)
- +7 ; T = subcomponent separator (ORSS)
- +8 NEW ORFS,ORCS,ORRS,ORES,ORSS
- +9 IF '$LENGTH($GET(VAL))
- SET VAL="~|\&^"
- +10 SET ORFS=$EXTRACT(VAL,5)
- +11 SET ORCS=$EXTRACT(VAL,1)
- +12 SET ORRS=$EXTRACT(VAL,2)
- +13 SET ORES=$EXTRACT(VAL,3)
- +14 SET ORSS=$EXTRACT(VAL,4)
- +15 NEW ORCHR,ORREP,I1,I2,J1,J2,K,VALUE
- +16 FOR ORCHR="F","S","R","E","T"
- SET ORREP(ORES_ORCHR_ORES)=$SELECT(ORCHR="F":ORFS,ORCHR="S":ORCS,ORCHR="R":ORRS,ORCHR="E":ORES,ORCHR="T":ORSS)
- +17 SET ORSTR=$$REPLACE^XLFSTR(ORSTR,.ORREP)
- +18 FOR
- SET I1=$PIECE(ORSTR,ORES_"X")
- if $LENGTH(I1)=$LENGTH(ORSTR)
- QUIT
- Begin DoDot:1
- +19 SET I2=$PIECE(ORSTR,ORES_"X",2,99)
- +20 SET J1=$PIECE(I2,ORES)
- if '$LENGTH(J1)
- QUIT
- +21 SET J2=$PIECE(I2,ORES,2,99)
- +22 SET VALUE=$$BASE^XLFUTL($$UP^XLFSTR(J1),16,10)
- +23 SET K=$SELECT(VALUE>255:"?",VALUE<32!(VALUE>127&(VALUE<160)):"",1:$CHAR(VALUE))
- +24 SET ORSTR=I1_K_J2
- End DoDot:1
- +25 QUIT ORSTR
- REPLACE(X,Y,Z) ;
- +1 ; X is initial string
- +2 ; Y is string to be replaced
- +3 ; Z is string to replace
- +4 NEW RET
- +5 IF X'[Y
- QUIT X
- +6 SET I=1
- SET RET=$PIECE(X,Y)
- FOR
- SET I=I+1
- SET RET=RET_Z_$PIECE(X,Y,I)
- if I=$LENGTH(X,Y)
- QUIT
- +7 QUIT RET