105 lines
7.8 KiB
Mathematica
105 lines
7.8 KiB
Mathematica
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
|