source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCPFTP2A.m@ 1432

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1MCPFTP2A ;WISC/TJK-PFT REPORT-FLOWS ;6/29/99 11:06
2 ;;2.3;Medicine;**25**;09/13/1996
3FLOW G DIF:'$D(^MCAR(700,MCARGDA,4)),DIF:'$O(^(4,0)) S MCX=0
4 ;I '$D(HEAD1) S HEAD1="FLOWS" D HEAD1^MCPFTP2,HEAD2^MCPFTP2
5 ;E S HEAD1="FLOWS" D @$S(($Y>(IOSL-5)):"MCFF1",1:"HEAD2^MCPFTP2") Q:$D(MCOUT)
6 X:$Y>(IOSL-5) MCFF
7 S HEAD1="FLOWS" D HEAD1^MCPFTP2,HEAD2^MCPFTP2
8 Q:$D(MCOUT)
9 I MC17'="" S MC17A=$P(MC17,U,2) W ?3,"MACHINE: ",$S(MC17A="F":"FLOW TURBINE",MC17A="P":"PNEUMOTACH",MC17A="A":"ANEMOMETER",MC17A="DS":"DRY WATER SEAL",MC17A="WS":"WATER SEAL",MC17A="W":"WEDGE",1:"") X MCFF K MC17A Q:$D(MCOUT)
10FLOW1 S MCX=$O(^MCAR(700,MCARGDA,4,MCX)) G DIF:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U)
11 W !! X MCFF Q:$D(MCOUT)
12 S ND="AF",ND1=4 D PRETEST^MCPFTP2
13 W ?5,$S(TYPE="S":"STANDARD STUDY",TYPE="B":"AFTER BRONCHODILATOR",TYPE="I":"AFTER INHALATION CHALLENGE",1:"AFTER EXERCISE") X MCFF Q:$D(MCOUT) D PREVDATE^MCPFTP2
14 I $P(MCREC,U,6)'="" W !,?5,"(NOTES): ",$P(MCREC,U,6) X MCFF Q:$D(MCOUT)
15 S ACT=$P(MCREC,U,2) I ACT S MEAS="FVC",UNITS="L",PRED=FVC X:$D(MCRC1) MCRC1 S PC=2,CI95=$S(PRED:PRED-CFVC,1:"") D PRTLINE S:TYPE="S" MCIFA=ACT,MCIFL=CI95 Q:$D(MCOUT)
16 S ACT=$P(MCREC,U,3) I ACT S MEAS="FEV1",UNITS="L",PRED=FEV1 X:$D(MCRC1) MCRC1 S PC=3,CI95=$S(PRED:PRED-CFEV1,1:"") D PRTLINE S:TYPE="S" MCIFE=ACT Q:$D(MCOUT)
17 S MCDL=3,MCLNG=6,ACT=$P(MCREC,U,4) I ACT S MEAS="PF",UNITS="L/SEC",PRED=PF,PC=4,CI95=$S(PRED:PRED-CPF,1:"") D PRTLINE Q:$D(MCOUT)
18 S ACT=$P(MCREC,U,5) I ACT S MEAS="FEF25-75",UNITS="L/SEC",PRED=FEF2575 X:$D(MCRC4) MCRC4 S PC=5,CI95=$S(PRED:PRED-CFEF2575,1:"") D PRTLINE Q:$D(MCOUT)
19 S MCDL=2,MCLNG=5,ACT=$P(MCREC,U,7) I ACT S MEAS="MVV",UNITS="L/MIN",PRED=MVV X:$D(MCRC5) MCRC5 S PC=7,CI95=$S(PRED:PRED-CMVV,1:"") S:TYPE="S" MCMVVN=ACT D PRTLINE Q:$D(MCOUT)
20 I $P(MCREC,U,2),$P(MCREC,U,3) W !,?5,"FEV1/FVC",?17,"%" S ACT=$P(MCREC,U,3)/$P(MCREC,U,2) W ?35,$J(ACT*100,5,0) S:TYPE="S" MCIFV=ACT X MCFF Q:$D(MCOUT)
21 G FLOW1
22DIF K CFVC,CFEV1,CPF,CFEF2575,CMVV G ABG:'$D(^MCAR(700,MCARGDA,5)) S (ACT,MCIDA)=^(5) G ABG:'ACT
23 I '$D(HEAD1) S HEAD1="DIFFUSION" D HEAD1^MCPFTP2,HEAD2^MCPFTP2
24 E S HEAD1="DIFFUSION" W ! D HEAD2^MCPFTP2
25 Q:$D(MCOUT) I MC17'="" S MC17A=$P(MC17,U,4) W ?3,"METHOD: ",$S(MC17A=1:"SINGLE BREATH",MC17A=2:"STEADY STATE",1:"") X MCFF K MC17A Q:$D(MCOUT)
26DIF0 S (MCIDP,PRED)=DLCOSB,UNITS="L",MEAS="DLCO-SB",PC=1
27 S (P1,P2)="" S RDATE1=$O(^MCAR(700,"ADI",DFN,RDATE)) I RDATE1 S P1=$O(^(RDATE1,0))
28 G DIF1:'P1 S MCP1=$G(^MCAR(700,P1,5))
29 S RDATE2=$O(^MCAR(700,"ADI",DFN,RDATE1)) I RDATE2 S P2=$O(^(RDATE2,0)) I P2 S MCP2=$G(^MCAR(700,P2,5))
30DIF1 D:P1 PREVDATE^MCPFTP2 S (MCIDL,CI95)=$S(PRED:PRED-CDLCOSB,1:"") D PRTLINE Q:$D(MCOUT)
31 G ABG:'$D(^MCAR(700,MCARGDA,6))
32 I $G(MCPV)<1 S MCPV=$$MCPV^MCPFTP1(MCARGDA)
33 S MCHB=$G(^MCAR(700.1,MCPV,"HB")),MCCOHB=$G(^("COHB"))
34 I MCHB="",MCCOHB="" G ABG
35 G HB:$P(MCCOHB,U)="" S MCCOHB=$G(^MCAR(700.2,MCCOHB,0)) G HB:MCCOHB="" S COHB=""
36 S I=0 F S I=$O(^MCAR(700,MCARGDA,6,I)) Q:I'?1N.N I $D(^(I,0)),$P(^(0),U,7) S COHB=$P(^(0),U,7)
37 G HB:COHB="" X "S MCCOHB="_$P(MCCOHB,U)
38 ;W !,"Corrected DLCO for COHB: ",$J(MCCOHB,6,2)
39HB G ABG:$P(MCHB,U)="" S MCHB=$G(^MCAR(700.2,MCHB,0)) G ABG:MCHB=""
40 S HB="",I=0 F S I=$O(^MCAR(700,MCARGDA,6,I)) Q:I'?1N.N I $D(^(I,0)),$P(^(0),U,2) S HB=$P(^(0),U,2)
41 ;G ABG:HB'<11,ABG:'HB X "S MCHB="_$P(MCHB,U)
42 G ABG:'HB X "S MCHB="_$P(MCHB,U)
43 ;W !,"Corrected DLCO for HB: ",$J(MCHB,8,2)
44 W !,"Corr DLCO for HB & COHB:",?19,$J(MCIDL,6,2),?32,$J(MCHB,8,2),?42,$S(MCIDL'=0:$J(MCHB/MCIDL*100,8,1),1:"")
45ABG K HB,COHB,MCHB,MCCOHB G ^MCPFTP3
46PRTLINE S MCP1=$G(MCP1),MCP2=$G(MCP2)
47 W !,?5,MEAS,?15,UNITS,?25,$S(PRED:$J(PRED,MCLNG,MCDL),1:""),?35,$J(ACT,MCLNG,MCDL),?45,$S(PRED:$J(ACT/PRED*100,5,1),1:"") W:$P(MCP1,U,PC) ?55,$J($P(MCP1,U,PC),MCLNG,MCDL) W:$P(MCP2,U,PC) ?65,$J($P(MCP2,U,PC),MCLNG,MCDL)
48 W:(CI95)&(CI95'=PRED) ?72,$J(CI95,6,2) X MCFF Q
49MCFF1 X MCFF Q
Note: See TracBrowser for help on using the repository browser.