MDHL7E.m

MDHL7E ; HOIFO/WAA -Olympus/CMore/Pentax Endoscopy ; 06/08/00

 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004

 ;S (TCNT,ICNT,LN)=0

OBX ; Process OBX

 N MDATT,PROC

 S MDAPP=$$GET1^DIQ(702.09,DEVIEN,.16,"I")

 I MDAPP="OLYMPUS" S SEP="^"

 I MDAPP="PENTAX" S SEP="^" D PENTAX

 I MDAPP="CMore"  S SEP="~"

 I MDAPP="ENDOSOFT"  S SEP="~"

 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="TEXT^MDHL7U2" D TXT^MDHL7K2

 . D @PROCESS

 . Q

 Q:'MDIEN

 D REX^MDHL7U1(MDIEN)

 D GENACK^MDHL7X

 Q

PENTAX ; This will convert the FT lines to TX lines

 N CNT,LINE

 S CNT=0

 F  S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1  D

 . S LINE=^TMP($J,"MDHL7A",CNT)

 . I $P(LINE,"|",1)'="OBX" Q

 . I $P(LINE,"|",3)'="FT" Q

 . S $P(LINE,"|",3)="TX"

 . S ^TMP($J,"MDHL7A",CNT)=LINE

 . Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MDHL7E   880     printed  Apr 09, 2024@20:48:34                                                                                                                                                                                                       Page 2

MDHL7E    ; HOIFO/WAA -Olympus/CMore/Pentax Endoscopy ; 06/08/00

 +1       ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004

 +2       ;S (TCNT,ICNT,LN)=0

OBX       ; Process OBX

 +1        NEW MDATT,PROC

 +2        SET MDAPP=$$GET1^DIQ(702.09,DEVIEN,.16,"I")

 +3        IF MDAPP="OLYMPUS"

               SET SEP="^"

 +4        IF MDAPP="PENTAX"

               SET SEP="^"

               DO PENTAX

 +5        IF MDAPP="CMore"

               SET SEP="~"

 +6        IF MDAPP="ENDOSOFT"

               SET SEP="~"

 +7        DO ATT^MDHL7U(DEVIEN,.MDATT)

           if MDATT<1

               QUIT 

 +8        SET PROC=0

 +9        FOR 

               SET PROC=$ORDER(MDATT(PROC))

               if PROC<1

                   QUIT 

               Begin DoDot:1

 +10               NEW PROCESS

 +11               SET PROCESS=$PIECE(MDATT(PROC),";",5)

 +12               IF PROCESS="TEXT^MDHL7U2"

                       DO TXT^MDHL7K2

 +13               DO @PROCESS

 +14               QUIT 

               End DoDot:1

 +15       if 'MDIEN

               QUIT 

 +16       DO REX^MDHL7U1(MDIEN)

 +17       DO GENACK^MDHL7X

 +18       QUIT 

PENTAX    ; This will convert the FT lines to TX lines

 +1        NEW CNT,LINE

 +2        SET CNT=0

 +3        FOR 

               SET CNT=$ORDER(^TMP($JOB,"MDHL7A",CNT))

               if CNT<1

                   QUIT 

               Begin DoDot:1

 +4                SET LINE=^TMP($JOB,"MDHL7A",CNT)

 +5                IF $PIECE(LINE,"|",1)'="OBX"

                       QUIT 

 +6                IF $PIECE(LINE,"|",3)'="FT"

                       QUIT 

 +7                SET $PIECE(LINE,"|",3)="TX"

 +8                SET ^TMP($JOB,"MDHL7A",CNT)=LINE

 +9                QUIT 

               End DoDot:1

 +10       QUIT