source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCBPFTP5.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1MCBPFTP5 ;WISC/TJK,ALG-PFT BRIEF REPORT-SPECIAL STUDIES (PT 1) ;5/14/92 13:30
2 ;;2.3;Medicine;;09/13/1996
3 S CI95="" G INT:'$D(^MCAR(700,MCARGDA,"S")),INT:'$O(^("S",0)) S MCX=0
4 W !! X MCFF Q:$D(MCOUT) S CI95="",HEAD1="SPECIAL STUDIES",MCSP="" D HEAD1^MCBPFTP2,HEAD2^MCBPFTP2 Q:$D(MCOUT)
5SPEC1 S MCX=$O(^MCAR(700,MCARGDA,"S",MCX)) G INT:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U),(MCREC1,MCREC2)="" S:$D(^(1)) MCREC1=^(1) S:$D(^(2)) MCREC2=^(2)
6 S ND="AS",ND1="S" D PRETEST^MCBPFTP2
7 W !!,?5,$S(TYPE="E":"EXERCISE",TYPE="M":"MECHANICS",TYPE="S":"SMALL AIRWAY",1:"MAXIMUM PRESSURES") D PREVDATE^MCBPFTP2
8 I MCREC2'="",$P(MCREC2,U,8)'="" W !,?5,"(NOTES): ",$P(MCREC2,U,8) X MCFF Q:$D(MCOUT)
9 I TYPE="P" W ! S ND=MCREC2,PC=7,MEAS="PiMAX",UNITS="cmH2O",MCP1=MCP1S2,MCP2=MCP2S2 D PIMAX^MCBPFTP6 Q:$D(MCOUT) G SPEC1
10 G ^MCBPFTP7:TYPE="E" S ND=MCREC G SMAIR:TYPE="S"
11 S MEAS="Raw",UNITS="cmH20/L/S",PC=2,MCP1=MCP1S0,MCP2=MCP2S0 D RAW^MCBPFTP6 Q:$D(MCOUT)
12 S MEAS="SGaw",UNITS="L/S/cmH20",PC=3 D SGAW^MCBPFTP6 Q:$D(MCOUT)
13 S MEAS="Cst",UNITS="4cmH20",PC=4 D CST^MCBPFTP6 Q:$D(MCOUT)
14 G SPEC1
15SMAIR S MEAS="Cdyn",UNITS="L/cmH20",PC=5 D SETNULL^MCBPFTP6 Q:$D(MCOUT)
16 S MEAS="FEF50 He-Air",UNITS="L/Sec",PC=6,MCP1=MCP1S0,MCP2=MCP2S0 D FEF50^MCBPFTP6 Q:$D(MCOUT)
17 S MEAS="VISOV",UNITS="L",PC=7 D VISOV^MCBPFTP6 Q:$D(MCOUT)
18 S MEAS="CV",PC=8 D SETNULL^MCBPFTP6
19 S MEAS="CC",PC=9 D SETNULL^MCBPFTP6
20 S CV=$P(MCREC,U,8),(CVVC,CVTL)=""
21 I CV'="" S:MCVCN'="" CVVC=CV/MCVCN S:MCTLCN'="" CVTL=CV/MCTLCN
22 W !,?5,"CV/VC"
23 D CVVC^MCBPFTP6 W ?18,"%",?25,$S(PRED:$J(PRED,5,2),1:""),?35,$J(CVVC,5,2),?45,$S(PRED:$J(CVVC/PRED*100,5,1),1:"") X MCFF Q:$D(MCOUT)
24 W !,?5,"CV/TLC",?18,"%",?35,$J(CVTL,5,2) X MCFF Q:$D(MCOUT)
25 S VISOV=$P(MCREC,U,7) W !,?5,"VISOV/CV"
26 I VISOV'="",+CV'=0 W ?18,"%",?35,$J(VISOV/CV,5,2)
27 X MCFF
28 K CV,CVTL,CVVC,VISOV Q:$D(MCOUT) G SPEC1
29INT K MCSP G INT^MCBPFTP7
30EXIT Q
Note: See TracBrowser for help on using the repository browser.