MCRPEC ;HCIOFO/JCC-ECHO Report Print ;4/28/97 10:55
;;2.3;Medicine;**6,32**;09/13/1996
;;This routine references DBIA 10060
Q:'$D(MCARGDA)
S DN=1
N D1,MCDISP,MCIEN,MCPAT,MCAGE,MCSEX,MCWAR,MCLBS,MCHTS,MCBSA,MCN13,MCP1,MCP12,MCP14,MCP2,MCP3,MCP6,MCP6,MCP7,MCP8
S MCIEN=MCARGDA
S MCPAT=$P($G(^MCAR(691,MCIEN,0)),U,2) Q:MCPAT=""
S MCAGE=$$RPTAGE^MCARUTL4(691,MCIEN)
S MCSEX=$P($G(^DPT(MCPAT,0)),U,2),MCWAR=$P($G(^MCAR(691,MCIEN,11)),U,2) I MCWAR'="" S MCWAR=$$GET1^DIQ(44,MCWAR,.01)
W !,"AGE: ",MCAGE,?25,"SEX: ",$S(MCSEX="M":"MALE",1:"FEMALE"),?50,"WARD/CLINIC: ",MCWAR
D PAGE Q:$G(MCOUT)
S MCN13=$G(^MCAR(691,MCIEN,13))
S MCLBS=$P(MCN13,U,1),MCHTS=$P(MCN13,U,2),MCBSA=$P(MCN13,U,3)
W !,"HEIGHT (INCH): ",MCHTS,?25,"WEIGHT (POUND): ",MCLBS,?50,"BSA: ",MCBSA
D PAGE Q:$G(MCOUT)
W !!,"TEST RESULTS:"
D PAGE Q:$G(MCOUT)
N MCN4,MCP19,MCP328
S MCN4=$G(^MCAR(691,MCIEN,4)) S MCDISP=0
F I=1:1:9 N @("MCP"_I) S @("MCP"_I)=$P(MCN4,U,I) I @("MCP"_I)'="" S MCDISP=1
S MCP19=$$GET1^DIQ(691,MCIEN,19) I MCP19'="" S MCDISP=1
S MCP328=$$GET1^DIQ(691,MCIEN,32.8) I MCP328'="" S MCDISP=1
I MCDISP W !!,"M-MODE MEASUREMENTS" D Q:$G(MCOUT) ;
.D PAGE Q:$G(MCOUT)
.W !," LV DIASTOLE:" I MCP7'="" W ?20,$J(MCP7,4)," (40-55mm)"
.W ?40,"E PNT SEP SPN:" I MCP9'="" W ?60,$J(MCP9,4)," (0-10mm)"
.D PAGE Q:$G(MCOUT)
.W !," LV SYSTOLE:" I MCP8'="" W ?20,$J(MCP8,4)," (25-30mm)"
.W ?40,"LT ATRIUM:" I MCP3'="" W ?60,$J(MCP3,4)," (25-35mm)"
.D PAGE Q:$G(MCOUT)
.W !," % FRACT SHORT:" I MCP19'="" W ?20,$J(MCP19,4)," (25-45%)"
.W ?40,"AORTIC ROOT:" I MCP4'="" W ?60,$J(MCP4,4)," (20-35mm)"
.D PAGE Q:$G(MCOUT)
.W !," SEPTUM:" I MCP1'="" W ?20,$J(MCP1,4)," (8-11mm)"
.W ?40,"RV DIASTOLE:" I MCP5'="" W ?60,$J(MCP5,4)," (10-25mm)"
.D PAGE Q:$G(MCOUT)
.W !," POST LV WALL:" I MCP2'="" W ?20,$J(MCP2,4)," (8-11mm)"
.W ?40,"ANT RV WALL:" I MCP6'="" W ?60,$J(MCP6,4)," (2-4mm)"
.D PAGE Q:$G(MCOUT)
.W !," LV MASS:" I MCP328'="" W ?20,$J(MCP328,4,0)
.D PAGE Q:$G(MCOUT)
N MCP4,MCP11,MCP10,MCP5,MCP32
S MCP4=$P($G(^MCAR(691,MCIEN,13)),U,4),MCP11=$P($G(^MCAR(691,MCIEN,5)),U,11),MCP10=$P($G(^MCAR(691,MCIEN,5)),U,10),MCP5=$$GET1^DIQ(691,MCIEN,31.1)
S MCP32=$$GET1^DIQ(691,MCIEN,32)
S MCDISP=0 I (MCP4'="")!(MCP11'="")!(MCP10'="")!(MCP5'="")!(MCP32'="")!($$GET1^DIQ(691.04,"1,"_MCIEN_",",.01)'="") S MCDISP=1
I MCDISP W !!,"2-D ECHO MEASUREMENTS" D Q:$G(MCOUT) ;
.D PAGE Q:$G(MCOUT)
.W !," CALCULATED EF:" I MCP32'="" W ?19,$J(MCP32,5,0),"%"
.W ?40,"ESV:" I MCP11'="" W $J(MCP11,4)," ml"
.W ?55,"EDV:" I MCP10'="" W $J(MCP10,4)," ml"
.D PAGE Q:$G(MCOUT)
.W !,?40,"CARDIAC OUTPUT:" I MCP5'="" W ?20,$J(MCP5,5,0)," ml/min"
.D PAGE Q:$G(MCOUT)
.W !," ESTIMATED EF:" I MCP4'="" W ?19,$J(MCP4,5,0),"%"
.D PAGE Q:$G(MCOUT)
.W !," EF DESCRIPTOR: ",$$GET1^DIQ(691,MCIEN,32.2)
.D PAGE Q:$G(MCOUT)
.W !," REGIONAL WALL MOTION:"
.D PAGE Q:$G(MCOUT)
.S D1=0 F S D1=$O(^MCAR(691,MCIEN,6,D1)) Q:D1="" W !,?4,$$GET1^DIQ(691.04,D1_","_MCIEN_",",.01),", ",$$GET1^DIQ(691.04,D1_","_MCIEN_",",1) D PAGE Q:$G(MCOUT)
.Q
Q:$G(MCOUT)
N MC34,MC347,MC353,MCN8,MC3565,MCP9
S MC34=$$GET1^DIQ(691.05,"1,"_MCIEN_",",.01)
S MC347=$$GET1^DIQ(691,MCIEN,34.7)
S MC353=$$GET1^DIQ(691,MCIEN,35.3)
S MCN8=$G(^MCAR(691,MCIEN,8))
F I=7,12,8,14 N @("MCP"_I) S @("MCP"_I)=$P(MCN8,U,I)
S MC3565=$$GET1^DIQ(691,MCIEN,35.65)
S MCP9=$P($G(^MCAR(691,MCIEN,12)),U,9)
S MCDISP=0 I (MC34'="")!(MC347'?." ")!(MC353'?." ")!(MCP7'="")!(MCP12'="")!(MCP8'="")!(MC3565'="")!(MCP9'="")!(MCP14'="") S MCDISP=1
I MCDISP D Q:$G(MCOUT) ;
.W !!,"DOPPLER MEASUREMENTS" ;
.D PAGE Q:$G(MCOUT)
.S D1=0 F S D1=$O(^MCAR(691,MCIEN,7,D1)) Q:D1="" W !,?4,$$GET1^DIQ(691.05,D1_","_MCIEN_",",.01),", ",$$GET1^DIQ(691.05,D1_","_MCIEN_",",1) D PAGE Q:$G(MCOUT)
.Q:$G(MCOUT)
.W !," AORTIC MAX GRAD:" I MC347'="" W ?20,$J(MC347,5)," mm Hg"
.W ?40,"MITRAL MAX GRAD:" I MC353'="" W ?65,$J(MC353,5)," mm Hg"
.D PAGE Q:$G(MCOUT)
.W !," AORTIC MEAN GRAD:" I MCP7'="" W ?20,$J(MCP7,5,0)," mm Hg"
.W ?40,"MITRAL MEAN GRAD:" I MCP12'="" W ?65,$J(MCP12,5,0)," mm Hg"
.D PAGE Q:$G(MCOUT)
.W !," AORTIC VALVE AREA:" I MCP8'="" W ?20,$J(MCP8,5,1)," cm-sq"
.W ?40,"MITRAL VALVE AREA(Dopp):" I MC3565'="" W ?65,$J(MC3565,5,1)," cm-sq"
.D PAGE Q:$G(MCOUT)
.W !," PA SYSTOLIC:" I MCP9'="" W ?20,$J(MCP9,5,0)," mm Hg"
.W ?40,"MITRAL VALVE AREA(Echo):" I MCP14'="" W ?65,$J(MCP14,5,1)," cm-sq"
.D PAGE Q:$G(MCOUT)
W !!,"FINDINGS:"
D PAGE Q:$G(MCOUT)
S D1=0 F S D1=$O(^MCAR(691,MCIEN,9,D1)) Q:D1="" W !,?4,$$GET1^DIQ(691.06,D1_","_MCIEN_",",.01) D PAGE Q:$G(MCOUT)
Q:$G(MCOUT)
W !!,"DIAGNOSIS:"
D PAGE Q:$G(MCOUT)
S D1=0 F S D1=$O(^MCAR(691,MCIEN,14,D1)) Q:D1="" W !,?4,$$GET1^DIQ(691.15,D1_","_MCIEN_",",.01) D PAGE Q:$G(MCOUT)
Q:$G(MCOUT)
W !!,"OTHER CONCLUSION:"
D PAGE Q:$G(MCOUT)
S D1=0 F S D1=$O(^MCAR(691,MCIEN,10,D1)) Q:D1="" W !,?4,$$GET1^DIQ(691.07,D1_","_MCIEN_",",.01) D PAGE Q:$G(MCOUT)
Q:$G(MCOUT)
S MCPAT=$P($G(^MCAR(691,MCIEN,11)),U) I MCPAT'="" S MCPAT=$$GET1^DIQ(200,MCPAT,.01,"I")
W !!,"CARDIOLOGY ATTENDING:",?26,MCPAT
D PAGE Q:$G(MCOUT)
S MCPAT=$P($G(^MCAR(691,MCIEN,15)),U) I MCPAT'="" S MCPAT=$$GET1^DIQ(200,MCPAT,.01,"I")
W !!,"CARDIOLOGY FELLOW:",?26,MCPAT
D PAGE Q:$G(MCOUT)
W !!,"SUMMARY:",!,?4,$$GET1^DIQ(691,MCIEN,.03)
D PAGE Q:$G(MCOUT)
W !!,"PROCEDURE SUMMARY:",!,?4,$P($G(^MCAR(691,MCIEN,.2)),U,2)
Q
PAGE ;
I $Y>(IOSL-3) D
. N DIR,MCY
. S MCY=1
. I $E($G(IOST),1,2)="C-" S DIR(0)="E" D ^DIR S MCY=+Y
. S MCY=$S(MCY'>0:U,1:"")
. I MCY=U S DN=0,MCOUT=1
. I DN D HEAD^MCARP
. Q
Q
MCRPEC ;HCIOFO/JCC-ECHO Report Print ;4/28/97 10:55
+1 ;;2.3;Medicine;**6,32**;09/13/1996
+2 ;;This routine references DBIA 10060
+3 IF '$DATA(MCARGDA)
QUIT
+4 SET DN=1
+5 NEW D1,MCDISP,MCIEN,MCPAT,MCAGE,MCSEX,MCWAR,MCLBS,MCHTS,MCBSA,MCN13,MCP1,MCP12,MCP14,MCP2,MCP3,MCP6,MCP6,MCP7,MCP8
+6 SET MCIEN=MCARGDA
+7 SET MCPAT=$PIECE($GET(^MCAR(691,MCIEN,0)),U,2)
IF MCPAT=""
QUIT
+8 SET MCAGE=$$RPTAGE^MCARUTL4(691,MCIEN)
+9 SET MCSEX=$PIECE($GET(^DPT(MCPAT,0)),U,2)
SET MCWAR=$PIECE($GET(^MCAR(691,MCIEN,11)),U,2)
IF MCWAR'=""
SET MCWAR=$$GET1^DIQ(44,MCWAR,.01)
+10 WRITE !,"AGE: ",MCAGE,?25,"SEX: ",$SELECT(MCSEX="M":"MALE",1:"FEMALE"),?50,"WARD/CLINIC: ",MCWAR
+11 DO PAGE
IF $GET(MCOUT)
QUIT
+12 SET MCN13=$GET(^MCAR(691,MCIEN,13))
+13 SET MCLBS=$PIECE(MCN13,U,1)
SET MCHTS=$PIECE(MCN13,U,2)
SET MCBSA=$PIECE(MCN13,U,3)
+14 WRITE !,"HEIGHT (INCH): ",MCHTS,?25,"WEIGHT (POUND): ",MCLBS,?50,"BSA: ",MCBSA
+15 DO PAGE
IF $GET(MCOUT)
QUIT
+16 WRITE !!,"TEST RESULTS:"
+17 DO PAGE
IF $GET(MCOUT)
QUIT
+18 NEW MCN4,MCP19,MCP328
+19 SET MCN4=$GET(^MCAR(691,MCIEN,4))
SET MCDISP=0
+20 FOR I=1:1:9
NEW @("MCP"_I)
SET @("MCP"_I)=$PIECE(MCN4,U,I)
IF @("MCP"_I)'=""
SET MCDISP=1
+21 SET MCP19=$$GET1^DIQ(691,MCIEN,19)
IF MCP19'=""
SET MCDISP=1
+22 SET MCP328=$$GET1^DIQ(691,MCIEN,32.8)
IF MCP328'=""
SET MCDISP=1
+23 ;
IF MCDISP
WRITE !!,"M-MODE MEASUREMENTS"
Begin DoDot:1
+24 DO PAGE
IF $GET(MCOUT)
QUIT
+25 WRITE !," LV DIASTOLE:"
IF MCP7'=""
WRITE ?20,$JUSTIFY(MCP7,4)," (40-55mm)"
+26 WRITE ?40,"E PNT SEP SPN:"
IF MCP9'=""
WRITE ?60,$JUSTIFY(MCP9,4)," (0-10mm)"
+27 DO PAGE
IF $GET(MCOUT)
QUIT
+28 WRITE !," LV SYSTOLE:"
IF MCP8'=""
WRITE ?20,$JUSTIFY(MCP8,4)," (25-30mm)"
+29 WRITE ?40,"LT ATRIUM:"
IF MCP3'=""
WRITE ?60,$JUSTIFY(MCP3,4)," (25-35mm)"
+30 DO PAGE
IF $GET(MCOUT)
QUIT
+31 WRITE !," % FRACT SHORT:"
IF MCP19'=""
WRITE ?20,$JUSTIFY(MCP19,4)," (25-45%)"
+32 WRITE ?40,"AORTIC ROOT:"
IF MCP4'=""
WRITE ?60,$JUSTIFY(MCP4,4)," (20-35mm)"
+33 DO PAGE
IF $GET(MCOUT)
QUIT
+34 WRITE !," SEPTUM:"
IF MCP1'=""
WRITE ?20,$JUSTIFY(MCP1,4)," (8-11mm)"
+35 WRITE ?40,"RV DIASTOLE:"
IF MCP5'=""
WRITE ?60,$JUSTIFY(MCP5,4)," (10-25mm)"
+36 DO PAGE
IF $GET(MCOUT)
QUIT
+37 WRITE !," POST LV WALL:"
IF MCP2'=""
WRITE ?20,$JUSTIFY(MCP2,4)," (8-11mm)"
+38 WRITE ?40,"ANT RV WALL:"
IF MCP6'=""
WRITE ?60,$JUSTIFY(MCP6,4)," (2-4mm)"
+39 DO PAGE
IF $GET(MCOUT)
QUIT
+40 WRITE !," LV MASS:"
IF MCP328'=""
WRITE ?20,$JUSTIFY(MCP328,4,0)
+41 DO PAGE
IF $GET(MCOUT)
QUIT
End DoDot:1
IF $GET(MCOUT)
QUIT
+42 NEW MCP4,MCP11,MCP10,MCP5,MCP32
+43 SET MCP4=$PIECE($GET(^MCAR(691,MCIEN,13)),U,4)
SET MCP11=$PIECE($GET(^MCAR(691,MCIEN,5)),U,11)
SET MCP10=$PIECE($GET(^MCAR(691,MCIEN,5)),U,10)
SET MCP5=$$GET1^DIQ(691,MCIEN,31.1)
+44 SET MCP32=$$GET1^DIQ(691,MCIEN,32)
+45 SET MCDISP=0
IF (MCP4'="")!(MCP11'="")!(MCP10'="")!(MCP5'="")!(MCP32'="")!($$GET1^DIQ(691.04,"1,"_MCIEN_",",.01)'="")
SET MCDISP=1
+46 ;
IF MCDISP
WRITE !!,"2-D ECHO MEASUREMENTS"
Begin DoDot:1
+47 DO PAGE
IF $GET(MCOUT)
QUIT
+48 WRITE !," CALCULATED EF:"
IF MCP32'=""
WRITE ?19,$JUSTIFY(MCP32,5,0),"%"
+49 WRITE ?40,"ESV:"
IF MCP11'=""
WRITE $JUSTIFY(MCP11,4)," ml"
+50 WRITE ?55,"EDV:"
IF MCP10'=""
WRITE $JUSTIFY(MCP10,4)," ml"
+51 DO PAGE
IF $GET(MCOUT)
QUIT
+52 WRITE !,?40,"CARDIAC OUTPUT:"
IF MCP5'=""
WRITE ?20,$JUSTIFY(MCP5,5,0)," ml/min"
+53 DO PAGE
IF $GET(MCOUT)
QUIT
+54 WRITE !," ESTIMATED EF:"
IF MCP4'=""
WRITE ?19,$JUSTIFY(MCP4,5,0),"%"
+55 DO PAGE
IF $GET(MCOUT)
QUIT
+56 WRITE !," EF DESCRIPTOR: ",$$GET1^DIQ(691,MCIEN,32.2)
+57 DO PAGE
IF $GET(MCOUT)
QUIT
+58 WRITE !," REGIONAL WALL MOTION:"
+59 DO PAGE
IF $GET(MCOUT)
QUIT
+60 SET D1=0
FOR
SET D1=$ORDER(^MCAR(691,MCIEN,6,D1))
IF D1=""
QUIT
WRITE !,?4,$$GET1^DIQ(691.04,D1_","_MCIEN_",",.01),", ",$$GET1^DIQ(691.04,D1_","_MCIEN_",",1)
DO PAGE
IF $GET(MCOUT)
QUIT
+61 QUIT
End DoDot:1
IF $GET(MCOUT)
QUIT
+62 IF $GET(MCOUT)
QUIT
+63 NEW MC34,MC347,MC353,MCN8,MC3565,MCP9
+64 SET MC34=$$GET1^DIQ(691.05,"1,"_MCIEN_",",.01)
+65 SET MC347=$$GET1^DIQ(691,MCIEN,34.7)
+66 SET MC353=$$GET1^DIQ(691,MCIEN,35.3)
+67 SET MCN8=$GET(^MCAR(691,MCIEN,8))
+68 FOR I=7,12,8,14
NEW @("MCP"_I)
SET @("MCP"_I)=$PIECE(MCN8,U,I)
+69 SET MC3565=$$GET1^DIQ(691,MCIEN,35.65)
+70 SET MCP9=$PIECE($GET(^MCAR(691,MCIEN,12)),U,9)
+71 SET MCDISP=0
IF (MC34'="")!(MC347'?." ")!(MC353'?." ")!(MCP7'="")!(MCP12'="")!(MCP8'="")!(MC3565'="")!(MCP9'="")!(MCP14'="")
SET MCDISP=1
+72 ;
IF MCDISP
Begin DoDot:1
+73 ;
WRITE !!,"DOPPLER MEASUREMENTS"
+74 DO PAGE
IF $GET(MCOUT)
QUIT
+75 SET D1=0
FOR
SET D1=$ORDER(^MCAR(691,MCIEN,7,D1))
IF D1=""
QUIT
WRITE !,?4,$$GET1^DIQ(691.05,D1_","_MCIEN_",",.01),", ",$$GET1^DIQ(691.05,D1_","_MCIEN_",",1)
DO PAGE
IF $GET(MCOUT)
QUIT
+76 IF $GET(MCOUT)
QUIT
+77 WRITE !," AORTIC MAX GRAD:"
IF MC347'=""
WRITE ?20,$JUSTIFY(MC347,5)," mm Hg"
+78 WRITE ?40,"MITRAL MAX GRAD:"
IF MC353'=""
WRITE ?65,$JUSTIFY(MC353,5)," mm Hg"
+79 DO PAGE
IF $GET(MCOUT)
QUIT
+80 WRITE !," AORTIC MEAN GRAD:"
IF MCP7'=""
WRITE ?20,$JUSTIFY(MCP7,5,0)," mm Hg"
+81 WRITE ?40,"MITRAL MEAN GRAD:"
IF MCP12'=""
WRITE ?65,$JUSTIFY(MCP12,5,0)," mm Hg"
+82 DO PAGE
IF $GET(MCOUT)
QUIT
+83 WRITE !," AORTIC VALVE AREA:"
IF MCP8'=""
WRITE ?20,$JUSTIFY(MCP8,5,1)," cm-sq"
+84 WRITE ?40,"MITRAL VALVE AREA(Dopp):"
IF MC3565'=""
WRITE ?65,$JUSTIFY(MC3565,5,1)," cm-sq"
+85 DO PAGE
IF $GET(MCOUT)
QUIT
+86 WRITE !," PA SYSTOLIC:"
IF MCP9'=""
WRITE ?20,$JUSTIFY(MCP9,5,0)," mm Hg"
+87 WRITE ?40,"MITRAL VALVE AREA(Echo):"
IF MCP14'=""
WRITE ?65,$JUSTIFY(MCP14,5,1)," cm-sq"
+88 DO PAGE
IF $GET(MCOUT)
QUIT
End DoDot:1
IF $GET(MCOUT)
QUIT
+89 WRITE !!,"FINDINGS:"
+90 DO PAGE
IF $GET(MCOUT)
QUIT
+91 SET D1=0
FOR
SET D1=$ORDER(^MCAR(691,MCIEN,9,D1))
IF D1=""
QUIT
WRITE !,?4,$$GET1^DIQ(691.06,D1_","_MCIEN_",",.01)
DO PAGE
IF $GET(MCOUT)
QUIT
+92 IF $GET(MCOUT)
QUIT
+93 WRITE !!,"DIAGNOSIS:"
+94 DO PAGE
IF $GET(MCOUT)
QUIT
+95 SET D1=0
FOR
SET D1=$ORDER(^MCAR(691,MCIEN,14,D1))
IF D1=""
QUIT
WRITE !,?4,$$GET1^DIQ(691.15,D1_","_MCIEN_",",.01)
DO PAGE
IF $GET(MCOUT)
QUIT
+96 IF $GET(MCOUT)
QUIT
+97 WRITE !!,"OTHER CONCLUSION:"
+98 DO PAGE
IF $GET(MCOUT)
QUIT
+99 SET D1=0
FOR
SET D1=$ORDER(^MCAR(691,MCIEN,10,D1))
IF D1=""
QUIT
WRITE !,?4,$$GET1^DIQ(691.07,D1_","_MCIEN_",",.01)
DO PAGE
IF $GET(MCOUT)
QUIT
+100 IF $GET(MCOUT)
QUIT
+101 SET MCPAT=$PIECE($GET(^MCAR(691,MCIEN,11)),U)
IF MCPAT'=""
SET MCPAT=$$GET1^DIQ(200,MCPAT,.01,"I")
+102 WRITE !!,"CARDIOLOGY ATTENDING:",?26,MCPAT
+103 DO PAGE
IF $GET(MCOUT)
QUIT
+104 SET MCPAT=$PIECE($GET(^MCAR(691,MCIEN,15)),U)
IF MCPAT'=""
SET MCPAT=$$GET1^DIQ(200,MCPAT,.01,"I")
+105 WRITE !!,"CARDIOLOGY FELLOW:",?26,MCPAT
+106 DO PAGE
IF $GET(MCOUT)
QUIT
+107 WRITE !!,"SUMMARY:",!,?4,$$GET1^DIQ(691,MCIEN,.03)
+108 DO PAGE
IF $GET(MCOUT)
QUIT
+109 WRITE !!,"PROCEDURE SUMMARY:",!,?4,$PIECE($GET(^MCAR(691,MCIEN,.2)),U,2)
+110 QUIT
PAGE ;
+1 IF $Y>(IOSL-3)
Begin DoDot:1
+2 NEW DIR,MCY
+3 SET MCY=1
+4 IF $EXTRACT($GET(IOST),1,2)="C-"
SET DIR(0)="E"
DO ^DIR
SET MCY=+Y
+5 SET MCY=$SELECT(MCY'>0:U,1:"")
+6 IF MCY=U
SET DN=0
SET MCOUT=1
+7 IF DN
DO HEAD^MCARP
+8 QUIT
End DoDot:1
+9 QUIT
