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 ---[H[J[2J[HMDHL7E 880 printed Dec 13, 2024@01:42:47 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
