source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCRPEC.m@ 1147

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