- 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 Feb 18, 2025@23:09:10 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