Routine: MDHL7M1

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

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")

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDHL7M1   1668     printed  Mar 13, 2025@20:47:29                                                                                                                                                                                                     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

MDHL7M1.m