MDHL7M1 ; HOIFO/WAA - Muse EKG ; [02-06-2002 16:13]
;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
OBX ; [Procedure] Process OBX
N MDATT,PROC
D ATT^MDHL7U(DEVIEN,.MDATT) Q:MDATT<1
S PROC=0
F S PROC=$O(MDATT(PROC)) Q:PROC<1 D
. N PROCESS
. S PROCESS=$P(MDATT(PROC),";",5)
. I PROCESS="UUEN^MDHL7U1" D ENCODE Q
. D @PROCESS
. Q
Q:'MDIEN
D REX^MDHL7U1(MDIEN)
D GENACK^MDHL7X
Q
;
ENCODE ; [Procedure] Process to the correct format
N CNT,FTYPE,LINE,LINE2
K ^TMP($J,"MDHL7M1")
S CNT=0
F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
. N LCNT,CNT2
. S LCNT=0
. Q:$E(^TMP($J,"MDHL7A",CNT),1)'="Z"
. S FTYPE=".PDF",LINE2=""
. S LINE=$P(^TMP($J,"MDHL7A",CNT),"|",4)
. S LINE=$E(LINE,$L($P(LINE,"\X0D\\X0A\"))+11,$L(LINE))
. S CNT2=0
. D TR(.LINE,.LINE2)
. Q
M ^TMP($J,"MDHL7","UUENCODE")=^TMP($J,"MDHL7M1")
D @PROCESS
K ^TMP($J,"MDHL7M1")
Q
;
TR(LINE,LINE2) ; [Procedure] PARCE out the line and save the new file format
N LLEN,I,X
S I=0
TR2 D INC Q:LINE=""
S X=$E(LINE,I)
I X="\" D TRANS
S LINE2=LINE2_X
G TR2
Q
INC ; INCREMENT I
I (I+1)>$L(LINE) D
. S I=0,CNT2=CNT2+1
. S LINE=$G(^TMP($J,"MDHL7A",CNT,CNT2))
. Q
Q:LINE=""
S I=I+1
Q
TRANS ; TRANSLATE X TO THE CORRECT VALUE
D INC Q:LINE=""
S X=$E(LINE,I)
I X="F" S X="|" D INC Q
I X="S" S X="^" D INC Q
I X="T" S X="&" D INC Q
I X="E" S X="\" D INC Q
I X="R" S X="~" D INC Q
I X="X" D
. D INC Q:LINE=""
. D INC Q:LINE=""
. S X=$E(LINE,I)
. I X="D" D INC S LCNT=LCNT+1 D
.. I LINE2'="end",LINE2'="" S ^TMP($J,"MDHL7M1",LCNT)=LINE2,X=""
.. N Y
.. F Y=1:1:5 D INC Q:LINE=""
.. S LINE2=""
.. Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDHL7M1 1668 printed Oct 16, 2024@17:43:41 Page 2
MDHL7M1 ; HOIFO/WAA - Muse EKG ; [02-06-2002 16:13]
+1 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
OBX ; [Procedure] Process OBX
+1 NEW MDATT,PROC
+2 DO ATT^MDHL7U(DEVIEN,.MDATT)
if MDATT<1
QUIT
+3 SET PROC=0
+4 FOR
SET PROC=$ORDER(MDATT(PROC))
if PROC<1
QUIT
Begin DoDot:1
+5 NEW PROCESS
+6 SET PROCESS=$PIECE(MDATT(PROC),";",5)
+7 IF PROCESS="UUEN^MDHL7U1"
DO ENCODE
QUIT
+8 DO @PROCESS
+9 QUIT
End DoDot:1
+10 if 'MDIEN
QUIT
+11 DO REX^MDHL7U1(MDIEN)
+12 DO GENACK^MDHL7X
+13 QUIT
+14 ;
ENCODE ; [Procedure] Process to the correct format
+1 NEW CNT,FTYPE,LINE,LINE2
+2 KILL ^TMP($JOB,"MDHL7M1")
+3 SET CNT=0
+4 FOR
SET CNT=$ORDER(^TMP($JOB,"MDHL7A",CNT))
if CNT<1
QUIT
Begin DoDot:1
+5 NEW LCNT,CNT2
+6 SET LCNT=0
+7 if $EXTRACT(^TMP($JOB,"MDHL7A",CNT),1)'="Z"
QUIT
+8 SET FTYPE=".PDF"
SET LINE2=""
+9 SET LINE=$PIECE(^TMP($JOB,"MDHL7A",CNT),"|",4)
+10 SET LINE=$EXTRACT(LINE,$LENGTH($PIECE(LINE,"\X0D\\X0A\"))+11,$LENGTH(LINE))
+11 SET CNT2=0
+12 DO TR(.LINE,.LINE2)
+13 QUIT
End DoDot:1
+14 MERGE ^TMP($JOB,"MDHL7","UUENCODE")=^TMP($JOB,"MDHL7M1")
+15 DO @PROCESS
+16 KILL ^TMP($JOB,"MDHL7M1")
+17 QUIT
+18 ;
TR(LINE,LINE2) ; [Procedure] PARCE out the line and save the new file format
+1 NEW LLEN,I,X
+2 SET I=0
TR2 DO INC
if LINE=""
QUIT
+1 SET X=$EXTRACT(LINE,I)
+2 IF X="\"
DO TRANS
+3 SET LINE2=LINE2_X
+4 GOTO TR2
+5 QUIT
INC ; INCREMENT I
+1 IF (I+1)>$LENGTH(LINE)
Begin DoDot:1
+2 SET I=0
SET CNT2=CNT2+1
+3 SET LINE=$GET(^TMP($JOB,"MDHL7A",CNT,CNT2))
+4 QUIT
End DoDot:1
+5 if LINE=""
QUIT
+6 SET I=I+1
+7 QUIT
TRANS ; TRANSLATE X TO THE CORRECT VALUE
+1 DO INC
if LINE=""
QUIT
+2 SET X=$EXTRACT(LINE,I)
+3 IF X="F"
SET X="|"
DO INC
QUIT
+4 IF X="S"
SET X="^"
DO INC
QUIT
+5 IF X="T"
SET X="&"
DO INC
QUIT
+6 IF X="E"
SET X="\"
DO INC
QUIT
+7 IF X="R"
SET X="~"
DO INC
QUIT
+8 IF X="X"
Begin DoDot:1
+9 DO INC
if LINE=""
QUIT
+10 DO INC
if LINE=""
QUIT
+11 SET X=$EXTRACT(LINE,I)
+12 IF X="D"
DO INC
SET LCNT=LCNT+1
Begin DoDot:2
+13 IF LINE2'="end"
IF LINE2'=""
SET ^TMP($JOB,"MDHL7M1",LCNT)=LINE2
SET X=""
+14 NEW Y
+15 FOR Y=1:1:5
DO INC
if LINE=""
QUIT
+16 SET LINE2=""
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 QUIT
