source: FOIAVistA/trunk/r/MEDICINE-MC/MCRPEC.m@ 800

Last change on this file since 800 was 628, checked in by George Lilly, 16 years ago

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