source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDPFTP2A.m@ 1169

MDPFTP2A ; HOIFO/NCA - PFT REPORT-FLOWS ;3/17/04  08:22
 ;;1.0;CLINICAL PROCEDURES;**2**;Apr 01, 2004
FLOW G DIF:'$D(^MCAR(700,+MDR,4)),DIF:'$O(^(4,0)) S MCX=0
 S HEAD1="FLOWS" D HEAD1^MDPFTP2,HEAD2^MDPFTP2,SETNODE(MDGRS," ")
 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=""
FLOW1 S MCX=$O(^MCAR(700,MDR,4,MCX)) G DIF:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U)
 D SETNODE(MDGRS," ")
 S ND="AF",ND1=4 D PRETEST^MDPFTP2 S SS=""
 S SS="    "_$S(TYPE="S":"STANDARD STUDY",TYPE="B":"AFTER BRONCHODILATOR",TYPE="I":"AFTER INHALATION CHALLENGE",1:"AFTER EXERCISE") D PREVDATE^MDPFTP2
 I $P(MCREC,U,6)'="" D SETNODE(MDGRS,"    "_"(NOTES): "_$P(MCREC,U,6))
 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
 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
 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
 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
 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
 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=""
 G FLOW1
DIF K CFVC,CFEV1,CPF,CFEF2575,CMVV G ABG:'$D(^MCAR(700,MDR,5)) S (ACT,MCIDA)=^(5) G ABG:'ACT
 I '$D(HEAD1) S HEAD1="DIFFUSION" D HEAD1^MDPFTP2,HEAD2^MDPFTP2
 E  S HEAD1="DIFFUSION" D SETNODE(MDGRS," "),HEAD2^MDPFTP2
 I MC17'="" S MC17A=$P(MC17,U,4) D SETNODE(MDGRS,"  METHOD: "_$S(MC17A=1:"SINGLE BREATH",MC17A=2:"STEADY STATE",1:"")) K MC17A
DIF0 S (MCIDP,PRED)=DLCOSB,UNITS="L",MEAS="DLCO-SB",PC=1
 S (P1,P2)="" S RDATE1=$O(^MCAR(700,"ADI",DFN,RDATE)) I RDATE1 S P1=$O(^(RDATE1,0))
 G DIF1:'P1 S MCP1=$G(^MCAR(700,P1,5))
 S RDATE2=$O(^MCAR(700,"ADI",DFN,RDATE1)) I RDATE2 S P2=$O(^(RDATE2,0)) I P2 S MCP2=$G(^MCAR(700,P2,5))
DIF1 D:P1 PREVDATE^MDPFTP2 S (MCIDL,CI95)=$S(PRED:PRED-CDLCOSB,1:"") D PRTLINE
 G ABG:'$D(^MCAR(700,MDR,6))
 I $G(MCPV)<1 S MCPV=$$MCPV^MDPFTP1(MDR)
 S MCHB=$G(^MCAR(700.1,MCPV,"HB")),MCCOHB=$G(^("COHB"))
 I MCHB="",MCCOHB="" G ABG
 G HB:$P(MCCOHB,U)="" S MCCOHB=$G(^MCAR(700.2,MCCOHB,0)) G HB:MCCOHB="" S COHB=""
 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)
 G HB:COHB="" X "S MCCOHB="_$P(MCCOHB,U)
HB G ABG:$P(MCHB,U)="" S MCHB=$G(^MCAR(700.2,MCHB,0)) G ABG:MCHB=""
 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)
 G ABG:'HB X "S MCHB="_$P(MCHB,U)
 ;W !,"Corrected DLCO for HB: ",$J(MCHB,8,2)
 ; Actual Line of Code below before Mod for Washington on Over-Correction
 ; of the DLCO for HB & COHB
 ;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:"")
 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=""
ABG K HB,COHB,MCHB,MCCOHB
 K HEAD1 G SPEC:'$D(^MCAR(700,+MDR,6)),SPEC:'$D(^(6,0))
 D SETNODE(MDGRS," "),SETNODE(MDGRS," ")
 D SETNODE(MDGRS,"BLOOD GASES"_$E(MCDOT,1,69))
ABG0 D SETNODE(MDGRS," "),SETNODE(MDGRS," ") S SS=""
 S SS="STUDY TYPE"_"      pH    pCO2  pO2     O2HB   COHB MHB    HB   FiO2 A-aO2  QS/QT" D SETNODE(MDGRS,SS) S SS=""
 S SS="  (NORMAL)  7.36-7.44 36-44 80-100 >88%    <3%  <2%              <22" D SETNODE(MDGRS,SS) S SS="",MCX=0
ABG1 S MCX=$O(^MCAR(700,+MDR,6,MCX)) G SPEC:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U)
 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")
 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)
 S (PAAO2,QSQT)=0 G ABG2:FIO2="" S PAAO2=($P(MCPFT0,U,7)-47)*FIO2-(PACO2/.8)-PAO2 S:PAAO2<0 PAAO2=0
 G ABG2:PAO2="" S CAO2=(.003*650)+(1.36*HB),CAO2(1)=(.003*PAO2)+(1.36*HB*(O2HB/100)),CVO2=CAO2(1)-5
 I FIO2=1 S QSQT=CAO2-CAO2(1)/(CAO2-CVO2)
ABG2 S SS=$E(MCTYPEP,1,13)_$J(" ",14-$L($E(MCTYPEP,1,13)))_$J(PH,6,3)_" "_$J(PACO2,5,1)_" "
 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:"")
 D SETNODE(MDGRS,SS) S SS=""
 S:TYPE="R" MCIAO2=PAO2,MCIAO1=PAAO2
 D SETNODE(MDGRS,"PATIENT TEMPERATURE (C): "_$P(MCREC,U,11))
 D:$P(MCREC,U,10)'="" SETNODE(MDGRS,"(NOTES): "_$P(MCREC,U,10)) G ABG1
SPEC K HB,PH,PACO2,PAO2,O2HB,COHB,FIO2,MHB,PAAO2,QSQT,CAO2,CVO2
 S CI95="" G INT:'$D(^MCAR(700,MDR,"S")),INT:'$O(^("S",0)) S MCX=0
 D SETNODE(MDGRS," "),SETNODE(MDGRS," ")
 S CI95="",HEAD1="SPECIAL STUDIES",MCSP="" D HEAD1^MDPFTP2,HEAD2^MDPFTP2
SPEC1 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)
 S ND="AS",ND1="S" D PRETEST^MDPFTP2
 D SETNODE(MDGRS," ") S SS="     "_$S(TYPE="E":"EXERCISE",TYPE="M":"MECHANICS",TYPE="S":"SMALL AIRWAY",1:"MAXIMUM PRESSURES") D PREVDATE^MDPFTP2
 I MCREC2'="",$P(MCREC2,U,8)'="" D SETNODE(MDGRS,"    (NOTES): "_$P(MCREC2,U,8))
 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
 G:TYPE="E" ^MDPFTP3 S ND=MCREC G:TYPE="S" SMAIR
 S MEAS="Raw",UNITS="cmH20/L/S",PC=2,MCP1=MCP1S0,MCP2=MCP2S0 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
 S MEAS="SGaw",UNITS="L/S/cmH20",PC=3 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
 S MEAS="Cst",UNITS="4cmH20",PC=4 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
 G SPEC1
SMAIR S MEAS="Cdyn",UNITS="L/cmH20",PC=5 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
 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
 S MEAS="VISOV",UNITS="L",PC=7 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
 S MEAS="CV",PC=8 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
 S MEAS="CC",PC=9 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
 S CV=$P(MCREC,U,8),(CVVC,CVTL)=""
 I CV'="" S:MCVCN'="" CVVC=CV/MCVCN S:MCTLCN'="" CVTL=CV/MCTLCN
 S SS="     CV/VC"
 S PRED="",ACT=$P(ND,U,PC) I ACT'="" N MDSKIP S MDSKIP=1 D SETNODE(MDGRS,SS),PRTLINE^MDPFTP2
 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:"")
 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=""
 D SETNODE(MDGRS,"     CV/TLC       %                "_$J(CVTL,5,2))
 S VISOV=$P(MCREC,U,7)
 I VISOV'="",+CV'=0 D SETNODE(MDGRS,"     VISOV/CV     %"_$J(" ",16)_$J(VISOV/CV,5,2))
 K CV,CVTL,CVVC,VISOV G SPEC1
INT K MCSP G INT^MDPFTP3
EXIT Q
PRTLINE S MCP1=$G(MCP1),MCP2=$G(MCP2),SS=""
 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)
 S SS=SS_$J(" ",45-$L(SS))_$S(PRED:$J(ACT/PRED*100,5,1),1:"")
 S:$P(MCP1,U,PC) SS=SS_$J(" ",55-$L(SS))_$J($P(MCP1,U,PC),MCLNG,MCDL)
 S:$P(MCP2,U,PC) SS=SS_$J(" ",65-$L(SS))_$J($P(MCP2,U,PC),MCLNG,MCDL)
 S:(CI95)&(CI95'=PRED) SS=SS_$J(" ",72-$L(SS))_$J(CI95,6,2)
 Q:+$G(MDSKIP)
 D SETNODE(MDGRS,SS) S SS=""
 Q
SETNODE(NODE,VALUE) ;Set the node with the string
 S MDLNE=MDLNE+1,@NODE@(MDLNE,0)=VALUE
 Q
MCFF1 Q