MDHL7M3 ; HOIFO/WAA-GE IMAGE VAULT INTERFACE ; 08/08/07
;;1.0;CLINICAL PROCEDURES;**37**;Apr 15, 2003;Build 4
N TCNT,ICNT,LN
S (TCNT,ICNT,LN)=0
OBX ; 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="TEXT^MDHL7U2" D TXT
. D @PROCESS
. Q
Q:'MDIEN
D REX^MDHL7U1(MDIEN)
D GENACK^MDHL7X
Q
TXT ;
N MDHLD,CNT,CNT2,LINE,TMPCNT,P,HDR1,HDR2
S P="|",HDR1=" ",HDR2=""
S (CNT,CNT2)=0
S CNT2=CNT2+1,^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||Interpretation:"
F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
. S LINE=^TMP($J,"MDHL7A",CNT)
. I $P(LINE,P,1)'="OBX" Q
. I $P(LINE,P,3)="ST" D
. . S $P(LINE,P,6)=$P(LINE,P,4)_"="_$P(LINE,P,6)_$P(LINE,P,7)
. . S TMPCNT=""
. . S TMPCNT=$O(^TMP($J,"MDHL7A",CNT))
. . I $P(^TMP($J,"MDHL7A",TMPCNT),P,3)'="ST" D BLANK
. . Q
. S $P(LINE,P,3)="TX"
. S HDR1=$P(LINE,P,5) I HDR1="" S HDR1=HDR2
. I HDR1'=HDR2 D
. . ;UPDATE HEADER
. . D BLANK
. . S CNT2=CNT2+1,^TMP($J,"MDHL7","TEXT",CNT2)=LINE
. . S $P(^TMP($J,"MDHL7","TEXT",CNT2),P,6)="["_HDR1_"]",HDR2=HDR1
. . Q
. S CNT2=CNT2+1,^TMP($J,"MDHL7","TEXT",CNT2)=LINE
. Q
Q
BLANK ;CREAT A BLANK LINE IN THE REPORT
S CNT2=CNT2+1,^TMP($J,"MDHL7","TEXT",CNT2)=LINE
S $P(^TMP($J,"MDHL7","TEXT",CNT2),P,6)=" "
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDHL7M3 1382 printed Apr 09, 2024@20:47:47 Page 2
MDHL7M3 ; HOIFO/WAA-GE IMAGE VAULT INTERFACE ; 08/08/07
+1 ;;1.0;CLINICAL PROCEDURES;**37**;Apr 15, 2003;Build 4
+2 NEW TCNT,ICNT,LN
+3 SET (TCNT,ICNT,LN)=0
OBX ; 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="TEXT^MDHL7U2"
DO TXT
+8 DO @PROCESS
+9 QUIT
End DoDot:1
+10 if 'MDIEN
QUIT
+11 DO REX^MDHL7U1(MDIEN)
+12 DO GENACK^MDHL7X
+13 QUIT
TXT ;
+1 NEW MDHLD,CNT,CNT2,LINE,TMPCNT,P,HDR1,HDR2
+2 SET P="|"
SET HDR1=" "
SET HDR2=""
+3 SET (CNT,CNT2)=0
+4 SET CNT2=CNT2+1
SET ^TMP($JOB,"MDHL7","TEXT",CNT2)="OBX||TX|||Interpretation:"
+5 FOR
SET CNT=$ORDER(^TMP($JOB,"MDHL7A",CNT))
if CNT<1
QUIT
Begin DoDot:1
+6 SET LINE=^TMP($JOB,"MDHL7A",CNT)
+7 IF $PIECE(LINE,P,1)'="OBX"
QUIT
+8 IF $PIECE(LINE,P,3)="ST"
Begin DoDot:2
+9 SET $PIECE(LINE,P,6)=$PIECE(LINE,P,4)_"="_$PIECE(LINE,P,6)_$PIECE(LINE,P,7)
+10 SET TMPCNT=""
+11 SET TMPCNT=$ORDER(^TMP($JOB,"MDHL7A",CNT))
+12 IF $PIECE(^TMP($JOB,"MDHL7A",TMPCNT),P,3)'="ST"
DO BLANK
+13 QUIT
End DoDot:2
+14 SET $PIECE(LINE,P,3)="TX"
+15 SET HDR1=$PIECE(LINE,P,5)
IF HDR1=""
SET HDR1=HDR2
+16 IF HDR1'=HDR2
Begin DoDot:2
+17 ;UPDATE HEADER
+18 DO BLANK
+19 SET CNT2=CNT2+1
SET ^TMP($JOB,"MDHL7","TEXT",CNT2)=LINE
+20 SET $PIECE(^TMP($JOB,"MDHL7","TEXT",CNT2),P,6)="["_HDR1_"]"
SET HDR2=HDR1
+21 QUIT
End DoDot:2
+22 SET CNT2=CNT2+1
SET ^TMP($JOB,"MDHL7","TEXT",CNT2)=LINE
+23 QUIT
End DoDot:1
+24 QUIT
BLANK ;CREAT A BLANK LINE IN THE REPORT
+1 SET CNT2=CNT2+1
SET ^TMP($JOB,"MDHL7","TEXT",CNT2)=LINE
+2 SET $PIECE(^TMP($JOB,"MDHL7","TEXT",CNT2),P,6)=" "
+3 QUIT
