HDIZRT ;PBB/ - GENERIC UTILITY FOR MFN MD5 and Discovery processing
;;1.0;HEALTH DATA & INFORMATICS;**19,21**;Feb 22, 2005;Build 9
;
Q
DESC ; Discovery coding to get conversion to escape characters..
N II,CNT,CNT1,VAL,VAL1
S CNT=0,(VAL,VAL1)=""
F S CNT=$O(^TMP("HLA",$J,CNT)) Q:'CNT S II=$G(^TMP("HLA",$J,CNT)) Q:'$L(II) Q:$G(ERROR) D:$P(II,HLFS)="ZRT"
.S VAL=$P(II,HLFS,3)
.Q:'$L(VAL)
.S VAL=$$ESC(VAL,.HL)
.S $P(II,HLFS,3)=VAL
.S ^TMP("HLA",$J,CNT)=II
.D:$O(^TMP("HLA",$J,CNT,0))
..S CNT1=0 F S CNT1=$O(^TMP("HLA",$J,CNT,CNT1)) Q:'CNT1 D
...S VAL=$G(^TMP("HLA",$J,CNT,CNT1))
...S ^TMP("HLA",$J,CNT,CNT1)=$$ESC(VAL,.HL)
Q
ESC(VALUE,HL) ;Escape value
N ESC,ESCFS,ESCCMP,ESCSUB,ESCREP,ESCESC,ESCSEQ,CVRT
S ESC=$E(HL("ECH"),3)
S ESCFS=ESC_"F"_ESC S CVRT("ESCFS")=HL("FS")
S ESCCMP=ESC_"S"_ESC S CVRT("ESCCMP")=$E(HL("ECH"),1)
S ESCREP=ESC_"R"_ESC S CVRT("ESCREP")=$E(HL("ECH"),2)
S ESCESC=ESC_"E"_ESC S CVRT("ESCESC")=ESC
S ESCSUB=ESC_"T"_ESC S CVRT("ESCSUB")=$E(HL("ECH"),4)
;F ESCSEQ="ESCFS","ESCCMP","ESCSUB","ESCREP","ESCESC" D
F ESCSEQ="ESCFS","ESCCMP","ESCSUB","ESCREP" D
.F Q:VALUE'[CVRT(ESCSEQ) D
..S VALUE=$P(VALUE,CVRT(ESCSEQ))_@ESCSEQ_$P(VALUE,CVRT(ESCSEQ),2,9999)
Q VALUE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDIZRT 1251 printed Oct 16, 2024@17:57:58 Page 2
HDIZRT ;PBB/ - GENERIC UTILITY FOR MFN MD5 and Discovery processing
+1 ;;1.0;HEALTH DATA & INFORMATICS;**19,21**;Feb 22, 2005;Build 9
+2 ;
+3 QUIT
DESC ; Discovery coding to get conversion to escape characters..
+1 NEW II,CNT,CNT1,VAL,VAL1
+2 SET CNT=0
SET (VAL,VAL1)=""
+3 FOR
SET CNT=$ORDER(^TMP("HLA",$JOB,CNT))
if 'CNT
QUIT
SET II=$GET(^TMP("HLA",$JOB,CNT))
if '$LENGTH(II)
QUIT
if $GET(ERROR)
QUIT
if $PIECE(II,HLFS)="ZRT"
Begin DoDot:1
+4 SET VAL=$PIECE(II,HLFS,3)
+5 if '$LENGTH(VAL)
QUIT
+6 SET VAL=$$ESC(VAL,.HL)
+7 SET $PIECE(II,HLFS,3)=VAL
+8 SET ^TMP("HLA",$JOB,CNT)=II
+9 if $ORDER(^TMP("HLA",$JOB,CNT,0))
Begin DoDot:2
+10 SET CNT1=0
FOR
SET CNT1=$ORDER(^TMP("HLA",$JOB,CNT,CNT1))
if 'CNT1
QUIT
Begin DoDot:3
+11 SET VAL=$GET(^TMP("HLA",$JOB,CNT,CNT1))
+12 SET ^TMP("HLA",$JOB,CNT,CNT1)=$$ESC(VAL,.HL)
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
ESC(VALUE,HL) ;Escape value
+1 NEW ESC,ESCFS,ESCCMP,ESCSUB,ESCREP,ESCESC,ESCSEQ,CVRT
+2 SET ESC=$EXTRACT(HL("ECH"),3)
+3 SET ESCFS=ESC_"F"_ESC
SET CVRT("ESCFS")=HL("FS")
+4 SET ESCCMP=ESC_"S"_ESC
SET CVRT("ESCCMP")=$EXTRACT(HL("ECH"),1)
+5 SET ESCREP=ESC_"R"_ESC
SET CVRT("ESCREP")=$EXTRACT(HL("ECH"),2)
+6 SET ESCESC=ESC_"E"_ESC
SET CVRT("ESCESC")=ESC
+7 SET ESCSUB=ESC_"T"_ESC
SET CVRT("ESCSUB")=$EXTRACT(HL("ECH"),4)
+8 ;F ESCSEQ="ESCFS","ESCCMP","ESCSUB","ESCREP","ESCESC" D
+9 FOR ESCSEQ="ESCFS","ESCCMP","ESCSUB","ESCREP"
Begin DoDot:1
+10 FOR
if VALUE'[CVRT(ESCSEQ)
QUIT
Begin DoDot:2
+11 SET VALUE=$PIECE(VALUE,CVRT(ESCSEQ))_@ESCSEQ_$PIECE(VALUE,CVRT(ESCSEQ),2,9999)
End DoDot:2
End DoDot:1
+12 QUIT VALUE
