source: WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDPFTP2A.m@ 1766

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

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1MDPFTP2A ; HOIFO/NCA - PFT REPORT-FLOWS ;3/17/04 08:22
2 ;;1.0;CLINICAL PROCEDURES;**2**;Apr 01, 2004
3FLOW G DIF:'$D(^MCAR(700,+MDR,4)),DIF:'$O(^(4,0)) S MCX=0
4 S HEAD1="FLOWS" D HEAD1^MDPFTP2,HEAD2^MDPFTP2,SETNODE(MDGRS," ")
5 I MC17'="" S MC17A=$P(MC17,U,2),SS="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:"") K MC17A D SETNODE(MDGRS,SS) S SS=""
6FLOW1 S MCX=$O(^MCAR(700,MDR,4,MCX)) G DIF:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U)
7 D SETNODE(MDGRS," ")
8 S ND="AF",ND1=4 D PRETEST^MDPFTP2 S SS=""
9 S SS=" "_$S(TYPE="S":"STANDARD STUDY",TYPE="B":"AFTER BRONCHODILATOR",TYPE="I":"AFTER INHALATION CHALLENGE",1:"AFTER EXERCISE") D PREVDATE^MDPFTP2
10 I $P(MCREC,U,6)'="" D SETNODE(MDGRS," "_"(NOTES): "_$P(MCREC,U,6))
11 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
12 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
13 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
14 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
15 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
16 I $P(MCREC,U,2),$P(MCREC,U,3) S SS=" FEV1/FVC %" S ACT=$P(MCREC,U,3)/$P(MCREC,U,2) S SS=SS_$J(" ",35-$L(SS))_$J(ACT*100,5,0) S:TYPE="S" MCIFV=ACT D SETNODE(MDGRS,SS) S SS=""
17 G FLOW1
18DIF K CFVC,CFEV1,CPF,CFEF2575,CMVV G ABG:'$D(^MCAR(700,MDR,5)) S (ACT,MCIDA)=^(5) G ABG:'ACT
19 I '$D(HEAD1) S HEAD1="DIFFUSION" D HEAD1^MDPFTP2,HEAD2^MDPFTP2
20 E S HEAD1="DIFFUSION" D SETNODE(MDGRS," "),HEAD2^MDPFTP2
21 I MC17'="" S MC17A=$P(MC17,U,4) D SETNODE(MDGRS," METHOD: "_$S(MC17A=1:"SINGLE BREATH",MC17A=2:"STEADY STATE",1:"")) K MC17A
22DIF0 S (MCIDP,PRED)=DLCOSB,UNITS="L",MEAS="DLCO-SB",PC=1
23 S (P1,P2)="" S RDATE1=$O(^MCAR(700,"ADI",DFN,RDATE)) I RDATE1 S P1=$O(^(RDATE1,0))
24 G DIF1:'P1 S MCP1=$G(^MCAR(700,P1,5))
25 S RDATE2=$O(^MCAR(700,"ADI",DFN,RDATE1)) I RDATE2 S P2=$O(^(RDATE2,0)) I P2 S MCP2=$G(^MCAR(700,P2,5))
26DIF1 D:P1 PREVDATE^MDPFTP2 S (MCIDL,CI95)=$S(PRED:PRED-CDLCOSB,1:"") D PRTLINE
27 G ABG:'$D(^MCAR(700,MDR,6))
28 I $G(MCPV)<1 S MCPV=$$MCPV^MDPFTP1(MDR)
29 S MCHB=$G(^MCAR(700.1,MCPV,"HB")),MCCOHB=$G(^("COHB"))
30 I MCHB="",MCCOHB="" G ABG
31 G HB:$P(MCCOHB,U)="" S MCCOHB=$G(^MCAR(700.2,MCCOHB,0)) G HB:MCCOHB="" S COHB=""
32 S I=0 F S I=$O(^MCAR(700,MDR,6,I)) Q:I'?1N.N I $D(^(I,0)),$P(^(0),U,7) S COHB=$P(^(0),U,7)
33 G HB:COHB="" X "S MCCOHB="_$P(MCCOHB,U)
34HB G ABG:$P(MCHB,U)="" S MCHB=$G(^MCAR(700.2,MCHB,0)) G ABG:MCHB=""
35 S HB="",I=0 F S I=$O(^MCAR(700,MDR,6,I)) Q:I'?1N.N I $D(^(I,0)),$P(^(0),U,2) S HB=$P(^(0),U,2)
36 G ABG:'HB X "S MCHB="_$P(MCHB,U)
37 ;W !,"Corrected DLCO for HB: ",$J(MCHB,8,2)
38 ; Actual Line of Code below before Mod for Washington on Over-Correction
39 ; of the DLCO for HB & COHB
40 ;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:"")
41 S SS="Corr DLCO for HB & COHB:"_$S(PRED:$J(PRED,6,2),1:" ")_" "_$J(MCHB,8,2)_" "_$S(MCIDL'=0:$J(MCHB/PRED*100,8,1),1:"") D SETNODE(MDGRS,SS) S SS=""
42ABG K HB,COHB,MCHB,MCCOHB
43 K HEAD1 G SPEC:'$D(^MCAR(700,+MDR,6)),SPEC:'$D(^(6,0))
44 D SETNODE(MDGRS," "),SETNODE(MDGRS," ")
45 D SETNODE(MDGRS,"BLOOD GASES"_$E(MCDOT,1,69))
46ABG0 D SETNODE(MDGRS," "),SETNODE(MDGRS," ") S SS=""
47 S SS="STUDY TYPE"_" pH pCO2 pO2 O2HB COHB MHB HB FiO2 A-aO2 QS/QT" D SETNODE(MDGRS,SS) S SS=""
48 S SS=" (NORMAL) 7.36-7.44 36-44 80-100 >88% <3% <2% <22" D SETNODE(MDGRS,SS) S SS="",MCX=0
49ABG1 S MCX=$O(^MCAR(700,+MDR,6,MCX)) G SPEC:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U)
50 S MCTYPEP=$S(TYPE="R":"ROOM AIR",TYPE="O":"100% O2 STUDY",TYPE="X":"POST EXERCISE",TYPE="M":"MAX EXERCISE",TYPE="P":"PRE EXERCISE",1:"SUPPLEMENTAL O2 STUDY")
51 S HB=$P(MCREC,U,2),PH=$P(MCREC,U,3),PACO2=$P(MCREC,U,4),PAO2=$P(MCREC,U,5),O2HB=$P(MCREC,U,6),COHB=$P(MCREC,U,7),FIO2=$P(MCREC,U,8),MHB=$P(MCREC,U,9)
52 S (PAAO2,QSQT)=0 G ABG2:FIO2="" S PAAO2=($P(MCPFT0,U,7)-47)*FIO2-(PACO2/.8)-PAO2 S:PAAO2<0 PAAO2=0
53 G ABG2:PAO2="" S CAO2=(.003*650)+(1.36*HB),CAO2(1)=(.003*PAO2)+(1.36*HB*(O2HB/100)),CVO2=CAO2(1)-5
54 I FIO2=1 S QSQT=CAO2-CAO2(1)/(CAO2-CVO2)
55ABG2 S SS=$E(MCTYPEP,1,13)_$J(" ",14-$L($E(MCTYPEP,1,13)))_$J(PH,6,3)_" "_$J(PACO2,5,1)_" "
56 S SS=SS_$J(PAO2,5,1)_" "_$J(O2HB,5,1)_"% "_$J(COHB,4,1)_"%"_$J(MHB,4,1)_"% "_$J(HB,5,1)_" "_$J(FIO2,5,3)_$S(PAAO2:$J(PAAO2,5,0),1:" ")_" "_$S(QSQT:$J(QSQT,6,2),1:"")
57 D SETNODE(MDGRS,SS) S SS=""
58 S:TYPE="R" MCIAO2=PAO2,MCIAO1=PAAO2
59 D SETNODE(MDGRS,"PATIENT TEMPERATURE (C): "_$P(MCREC,U,11))
60 D:$P(MCREC,U,10)'="" SETNODE(MDGRS,"(NOTES): "_$P(MCREC,U,10)) G ABG1
61SPEC K HB,PH,PACO2,PAO2,O2HB,COHB,FIO2,MHB,PAAO2,QSQT,CAO2,CVO2
62 S CI95="" G INT:'$D(^MCAR(700,MDR,"S")),INT:'$O(^("S",0)) S MCX=0
63 D SETNODE(MDGRS," "),SETNODE(MDGRS," ")
64 S CI95="",HEAD1="SPECIAL STUDIES",MCSP="" D HEAD1^MDPFTP2,HEAD2^MDPFTP2
65SPEC1 S MCX=$O(^MCAR(700,MDR,"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)
66 S ND="AS",ND1="S" D PRETEST^MDPFTP2
67 D SETNODE(MDGRS," ") S SS=" "_$S(TYPE="E":"EXERCISE",TYPE="M":"MECHANICS",TYPE="S":"SMALL AIRWAY",1:"MAXIMUM PRESSURES") D PREVDATE^MDPFTP2
68 I MCREC2'="",$P(MCREC2,U,8)'="" D SETNODE(MDGRS," (NOTES): "_$P(MCREC2,U,8))
69 I TYPE="P" S ND=MCREC2,PC=7,MEAS="PiMAX",UNITS="cmH2O",MCP1=MCP1S2,MCP2=MCP2S2 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2 Q:$D(MCOUT) G SPEC1
70 G:TYPE="E" ^MDPFTP3 S ND=MCREC G:TYPE="S" SMAIR
71 S MEAS="Raw",UNITS="cmH20/L/S",PC=2,MCP1=MCP1S0,MCP2=MCP2S0 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
72 S MEAS="SGaw",UNITS="L/S/cmH20",PC=3 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
73 S MEAS="Cst",UNITS="4cmH20",PC=4 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
74 G SPEC1
75SMAIR S MEAS="Cdyn",UNITS="L/cmH20",PC=5 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
76 S MEAS="FEF50 He-Air",UNITS="L/Sec",PC=6,MCP1=MCP1S0,MCP2=MCP2S0 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
77 S MEAS="VISOV",UNITS="L",PC=7 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
78 S MEAS="CV",PC=8 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
79 S MEAS="CC",PC=9 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
80 S CV=$P(MCREC,U,8),(CVVC,CVTL)=""
81 I CV'="" S:MCVCN'="" CVVC=CV/MCVCN S:MCTLCN'="" CVTL=CV/MCTLCN
82 S SS=" CV/VC"
83 S PRED="",ACT=$P(ND,U,PC) I ACT'="" N MDSKIP S MDSKIP=1 D SETNODE(MDGRS,SS),PRTLINE^MDPFTP2
84 S SS=SS_$S(ACT'="":"",1:$J(" ",18-$L(SS)))_"%",SS=SS_$S(ACT'="":" ",1:$J(" ",25-$L(SS)))_$S(PRED:$J(PRED,5,2),1:"")
85 S SS=SS_$S(ACT'="":" ",1:$J(" ",35-$L(SS)))_$J(CVVC,5,2),SS=SS_$S(ACT'="":" ",1:$J(" ",45-$L(SS)))_$S(PRED:$J(CVVC/PRED*100,5,1),1:"") D SETNODE(MDGRS,SS) S SS=""
86 D SETNODE(MDGRS," CV/TLC % "_$J(CVTL,5,2))
87 S VISOV=$P(MCREC,U,7)
88 I VISOV'="",+CV'=0 D SETNODE(MDGRS," VISOV/CV %"_$J(" ",16)_$J(VISOV/CV,5,2))
89 K CV,CVTL,CVVC,VISOV G SPEC1
90INT K MCSP G INT^MDPFTP3
91EXIT Q
92PRTLINE S MCP1=$G(MCP1),MCP2=$G(MCP2),SS=""
93 S SS=" "_MEAS,SS=SS_$J(" ",15-$L(SS))_UNITS,SS=SS_$J(" ",25-$L(SS))_$S(PRED:$J(PRED,MCLNG,MCDL),1:""),SS=SS_$J(" ",35-$L(SS))_$J(ACT,MCLNG,MCDL)
94 S SS=SS_$J(" ",45-$L(SS))_$S(PRED:$J(ACT/PRED*100,5,1),1:"")
95 S:$P(MCP1,U,PC) SS=SS_$J(" ",55-$L(SS))_$J($P(MCP1,U,PC),MCLNG,MCDL)
96 S:$P(MCP2,U,PC) SS=SS_$J(" ",65-$L(SS))_$J($P(MCP2,U,PC),MCLNG,MCDL)
97 S:(CI95)&(CI95'=PRED) SS=SS_$J(" ",72-$L(SS))_$J(CI95,6,2)
98 Q:+$G(MDSKIP)
99 D SETNODE(MDGRS,SS) S SS=""
100 Q
101SETNODE(NODE,VALUE) ;Set the node with the string
102 S MDLNE=MDLNE+1,@NODE@(MDLNE,0)=VALUE
103 Q
104MCFF1 Q
Note: See TracBrowser for help on using the repository browser.