VistA-WorldVistAEHR/r/MEDICINE-MC/MCRPEC.m

122 lines
5.4 KiB
Mathematica

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