MCPFTP5 ;WISC/TJK-PFT REPORT-SPECIAL STUDIES (PT 2) ;8/30/99 10:15
;;2.3;Medicine;**18,25**;09/13/1996
EX S ND=MCREC1,MCP1=MCP1S1,MCP2=MCP2S1,VE=$P(MCREC1,U,1),MCEX=$P(MCREC2,U,9)
S MEAS="VEmax(BTPS)",UNITS="L",PC=1 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="BR",PC=2 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="VD/VT REST",PC=14 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="VD/VT MAX",PC=15 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="VE/VCO2, AT",PC=16 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="VErest(BTPS)",UNITS="ml/beat",PC=5 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
K VE S MEAS="VO2rest",UNITS="L/min",PC=6 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="VO2max",UNITS="L/min",PC=7 I MCEX=1 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2
D:(MCEX=3)!(MCEX=2) VO2MAX Q:$D(MCOUT)
S MEAS="AT",UNITS="L",PC=3 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="HRrest",UNITS="BPM",PC=8 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="HRmax",PC=9 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="VO2/HR",PC=11,UNITS="ML" S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="BP MAX",PC=12,UNITS="" S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="EKG",PC=13 S ACT=$P(ND,U,PC) W !,?5,MEAS,?35,$S(ACT="N":"NORMAL",ACT="A":"ABNORMAL",1:"") X MCFF Q:$D(MCOUT)
S MEAS="RRrest",UNITS="brths/m",PC=10 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S ND=MCREC2,MCP1=MCP1S2,MCP2=MCP2S2,MEAS="RRmax",PC=1 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="Wmax",UNITS="wrpm/min",PC=2 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="WRI/WRT",UNITS="watts/min",PC=6 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="Max Speed",UNITS="mph",PC=4 S ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="Max Grade",UNITS="%",PC=5 S ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S PRED="",MEAS="TOTAL TIME",UNITS="min",PC=3 S ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="HCO3 Change",UNITS="mg/dl",PC=10 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
W !,?5,"Exercise Testing Mode: ",$S(MCEX=1:"TREADMILL",MCEX=2:"BIKE ERGOMETER",MCEX=3:"HAND ERGOMETER",1:"") X MCFF Q:$D(MCOUT) K MCEX
W !,?5,"REASON(S) FOR STOPPING:"
S MCX(1)=0 F S MCX(1)=$O(^MCAR(700,MCARGDA,"S",MCX,3,MCX(1))) Q:MCX(1)'?1N.N S MCX(2)=$G(^(MCX(1),0)) I MCX(2) W ?32,$P($G(^MCAR(695.8,MCX(2),0)),U),! K MCX(2) X MCFF Q:$D(MCOUT)
Q:$D(MCOUT) K ^UTILITY($J,"W") S MCX(1)=0 F S MCX(1)=$O(^MCAR(700,MCARGDA,"S",MCX,4,MCX(1))) Q:MCX(1)'?1N.N S X=$G(^(MCX(1),0)),DIWL=33,DIWR=75,DIWF="W" D ^DIWP
D ^DIWW
EXEND G SPEC1^MCPFTP4
INT K HEAD1 Q:$E(MCDOT,1)=" "
W !! X MCFF Q:$D(MCOUT) W "INTERPRETATION",$E(MCDOT,1,66) X MCFF Q:$D(MCOUT)
K DXS,DIOT(2),^UTILITY($J) S ^UTILITY($J,1)=MCFF,D0=MCARGDA D ^MCAROPF K ^UTILITY($J,1)
EXIT Q:$E(MCDOT)=" " D CONT Q:$D(MCOUT) D PV Q
PV ;
I $G(MCPV)<1 S MCPV=$$MCPV^MCPFTP1(MCARGDA)
Q:'$D(MCPV) Q:'$D(^MCAR(700.1,MCPV))
D HEAD^MCARP
PV1 ;
I $G(MCPV)<1 S MCPV=$$MCPV^MCPFTP1(MCARGDA)
Q:'$D(MCPV)
W !!?25,"PREDICTED VALUE FORMULAS USED",!
F J="TLC","VC","FRC","RV","FVC","FEV1","PF","FEF2575","MVV","DLCOSB","COHB","HB" D
.S I=$G(^MCAR(700.1,MCPV,J)) Q:'I
.Q:'$D(^MCAR(700.2,I,0)) S I=$G(^(0))
.W !,?5,$S(J="DLCOSB":"DLCO-SB",J="FEF2575":"FEF25-75",J="COHB":"COHB CORR.",J="HB":"HB CORR.",1:J)
.D PVW
.K J Q
G PVEXIT:'$D(MCRC1)
W !!?25,"RACE CORRECTION FORMULAS USED",!
;I $D(MCRC2) S I=$P($G(^MCAR(700.1,MCPV,"RC")),U,2) I I,$D(^MCAR(700.2,I,0)) S I=$G(^(0)) W !,?5,"TLC,VC,FVC,FEV1" D PVW G PVEXIT
I $D(MCRC2) D G PVEXIT
. F J=2,6 S I=$P($G(^MCAR(700.1,MCPV,"RC")),U,J) I I,$D(^MCAR(700.2,I,0)) S I=$G(^(0)) W !,?5,$S(J=2:"TLC,VC,FVC,FEV1",J=6:"MVV",1:"") D PVW
. Q
F J=1,3,4,5 S I=$P($G(^MCAR(700.1,MCPV,"RC")),U,J) I I,$D(^MCAR(700.2,I,0)) S I=$G(^(0)) W !,?5,$S(J=1:"TLC,VC,FVC,FEV1",J=3:"FRC,RV",J=4:"FEF25-75",J=5:"MVV",1:"") D PVW
PVEXIT W !,"NOTE: HT=height,WT=weight,ACT=actual measurement value" D CONT Q
PVW W ?21,$P(I,U),?50,$P(I,U,3) Q
CONT Q:($E(IOST,1,2)'="C-")!($D(MCOUT)) R !!,"Press Return to Continue, '^' to escape: ",MCY:DTIME S:'$T MCY=U S:MCY=U MCOUT=1 Q
COMP S I=0 F S I=$O(^MCAR(700,MCARGDA,24,I)) Q:I'?1N.N I $D(^(I,0)),$P(^(0),U,2)="Y" S J=$P(^(0),U,1) W:$D(^MCAR(693.2,J,0)) ?17,$P(^(0),U,1),!
Q
VO2ER1(MCSEX) ;
Q $S(MCSEX="F":(42.8+WT)*(22.78-(.17*AGE)),1:(.79*HT-60.7))
VO2ER2(MCSEX) ;
Q $S(MCSEX="F":HT*(14.81-(.11*AGE)),1:50.72-(0.372*AGE))
VO2MAX ;
S ER1=$$VO2ER1(MCSEX),ER2=$$VO2ER2(MCSEX),PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPFTP5 4941 printed Dec 13, 2024@02:16:09 Page 2
MCPFTP5 ;WISC/TJK-PFT REPORT-SPECIAL STUDIES (PT 2) ;8/30/99 10:15
+1 ;;2.3;Medicine;**18,25**;09/13/1996
EX SET ND=MCREC1
SET MCP1=MCP1S1
SET MCP2=MCP2S1
SET VE=$PIECE(MCREC1,U,1)
SET MCEX=$PIECE(MCREC2,U,9)
+1 SET MEAS="VEmax(BTPS)"
SET UNITS="L"
SET PC=1
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+2 SET MEAS="BR"
SET PC=2
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+3 SET MEAS="VD/VT REST"
SET PC=14
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+4 SET MEAS="VD/VT MAX"
SET PC=15
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+5 SET MEAS="VE/VCO2, AT"
SET PC=16
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+6 SET MEAS="VErest(BTPS)"
SET UNITS="ml/beat"
SET PC=5
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+7 KILL VE
SET MEAS="VO2rest"
SET UNITS="L/min"
SET PC=6
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+8 SET MEAS="VO2max"
SET UNITS="L/min"
SET PC=7
IF MCEX=1
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
+9 if (MCEX=3)!(MCEX=2)
DO VO2MAX
if $DATA(MCOUT)
QUIT
+10 SET MEAS="AT"
SET UNITS="L"
SET PC=3
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+11 SET MEAS="HRrest"
SET UNITS="BPM"
SET PC=8
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+12 SET MEAS="HRmax"
SET PC=9
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+13 SET MEAS="VO2/HR"
SET PC=11
SET UNITS="ML"
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+14 SET MEAS="BP MAX"
SET PC=12
SET UNITS=""
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+15 SET MEAS="EKG"
SET PC=13
SET ACT=$PIECE(ND,U,PC)
WRITE !,?5,MEAS,?35,$SELECT(ACT="N":"NORMAL",ACT="A":"ABNORMAL",1:"")
XECUTE MCFF
if $DATA(MCOUT)
QUIT
+16 SET MEAS="RRrest"
SET UNITS="brths/m"
SET PC=10
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+17 SET ND=MCREC2
SET MCP1=MCP1S2
SET MCP2=MCP2S2
SET MEAS="RRmax"
SET PC=1
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+18 SET MEAS="Wmax"
SET UNITS="wrpm/min"
SET PC=2
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+19 SET MEAS="WRI/WRT"
SET UNITS="watts/min"
SET PC=6
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+20 SET MEAS="Max Speed"
SET UNITS="mph"
SET PC=4
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+21 SET MEAS="Max Grade"
SET UNITS="%"
SET PC=5
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+22 SET PRED=""
SET MEAS="TOTAL TIME"
SET UNITS="min"
SET PC=3
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+23 SET MEAS="HCO3 Change"
SET UNITS="mg/dl"
SET PC=10
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+24 WRITE !,?5,"Exercise Testing Mode: ",$SELECT(MCEX=1:"TREADMILL",MCEX=2:"BIKE ERGOMETER",MCEX=3:"HAND ERGOMETER",1:"")
XECUTE MCFF
if $DATA(MCOUT)
QUIT
KILL MCEX
+25 WRITE !,?5,"REASON(S) FOR STOPPING:"
+26 SET MCX(1)=0
FOR
SET MCX(1)=$ORDER(^MCAR(700,MCARGDA,"S",MCX,3,MCX(1)))
if MCX(1)'?1N.N
QUIT
SET MCX(2)=$GET(^(MCX(1),0))
IF MCX(2)
WRITE ?32,$PIECE($GET(^MCAR(695.8,MCX(2),0)),U),!
KILL MCX(2)
XECUTE MCFF
if $DATA(MCOUT)
QUIT
+27 if $DATA(MCOUT)
QUIT
KILL ^UTILITY($JOB,"W")
SET MCX(1)=0
FOR
SET MCX(1)=$ORDER(^MCAR(700,MCARGDA,"S",MCX,4,MCX(1)))
if MCX(1)'?1N.N
QUIT
SET X=$GET(^(MCX(1),0))
SET DIWL=33
SET DIWR=75
SET DIWF="W"
DO ^DIWP
+28 DO ^DIWW
EXEND GOTO SPEC1^MCPFTP4
INT KILL HEAD1
if $EXTRACT(MCDOT,1)=" "
QUIT
+1 WRITE !!
XECUTE MCFF
if $DATA(MCOUT)
QUIT
WRITE "INTERPRETATION",$EXTRACT(MCDOT,1,66)
XECUTE MCFF
if $DATA(MCOUT)
QUIT
+2 KILL DXS,DIOT(2),^UTILITY($JOB)
SET ^UTILITY($JOB,1)=MCFF
SET D0=MCARGDA
DO ^MCAROPF
KILL ^UTILITY($JOB,1)
EXIT if $EXTRACT(MCDOT)=" "
QUIT
DO CONT
if $DATA(MCOUT)
QUIT
DO PV
QUIT
PV ;
+1 IF $GET(MCPV)<1
SET MCPV=$$MCPV^MCPFTP1(MCARGDA)
+2 if '$DATA(MCPV)
QUIT
if '$DATA(^MCAR(700.1,MCPV))
QUIT
+3 DO HEAD^MCARP
PV1 ;
+1 IF $GET(MCPV)<1
SET MCPV=$$MCPV^MCPFTP1(MCARGDA)
+2 if '$DATA(MCPV)
QUIT
+3 WRITE !!?25,"PREDICTED VALUE FORMULAS USED",!
+4 FOR J="TLC","VC","FRC","RV","FVC","FEV1","PF","FEF2575","MVV","DLCOSB","COHB","HB"
Begin DoDot:1
+5 SET I=$GET(^MCAR(700.1,MCPV,J))
if 'I
QUIT
+6 if '$DATA(^MCAR(700.2,I,0))
QUIT
SET I=$GET(^(0))
+7 WRITE !,?5,$SELECT(J="DLCOSB":"DLCO-SB",J="FEF2575":"FEF25-75",J="COHB":"COHB CORR.",J="HB":"HB CORR.",1:J)
+8 DO PVW
+9 KILL J
QUIT
End DoDot:1
+10 if '$DATA(MCRC1)
GOTO PVEXIT
+11 WRITE !!?25,"RACE CORRECTION FORMULAS USED",!
+12 ;I $D(MCRC2) S I=$P($G(^MCAR(700.1,MCPV,"RC")),U,2) I I,$D(^MCAR(700.2,I,0)) S I=$G(^(0)) W !,?5,"TLC,VC,FVC,FEV1" D PVW G PVEXIT
+13 IF $DATA(MCRC2)
Begin DoDot:1
+14 FOR J=2,6
SET I=$PIECE($GET(^MCAR(700.1,MCPV,"RC")),U,J)
IF I
IF $DATA(^MCAR(700.2,I,0))
SET I=$GET(^(0))
WRITE !,?5,$SELECT(J=2:"TLC,VC,FVC,FEV1",J=6:"MVV",1:"")
DO PVW
+15 QUIT
End DoDot:1
GOTO PVEXIT
+16 FOR J=1,3,4,5
SET I=$PIECE($GET(^MCAR(700.1,MCPV,"RC")),U,J)
IF I
IF $DATA(^MCAR(700.2,I,0))
SET I=$GET(^(0))
WRITE !,?5,$SELECT(J=1:"TLC,VC,FVC,FEV1",J=3:"FRC,RV",J=4:"FEF25-75",J=5:"MVV",1:"")
DO PVW
PVEXIT WRITE !,"NOTE: HT=height,WT=weight,ACT=actual measurement value"
DO CONT
QUIT
PVW WRITE ?21,$PIECE(I,U),?50,$PIECE(I,U,3)
QUIT
CONT if ($EXTRACT(IOST,1,2)'="C-")!($DATA(MCOUT))
QUIT
READ !!,"Press Return to Continue, '^' to escape: ",MCY:DTIME
if '$TEST
SET MCY=U
if MCY=U
SET MCOUT=1
QUIT
COMP SET I=0
FOR
SET I=$ORDER(^MCAR(700,MCARGDA,24,I))
if I'?1N.N
QUIT
IF $DATA(^(I,0))
IF $PIECE(^(0),U,2)="Y"
SET J=$PIECE(^(0),U,1)
if $DATA(^MCAR(693.2,J,0))
WRITE ?17,$PIECE(^(0),U,1),!
+1 QUIT
VO2ER1(MCSEX) ;
+1 QUIT $SELECT(MCSEX="F":(42.8+WT)*(22.78-(.17*AGE)),1:(.79*HT-60.7))
VO2ER2(MCSEX) ;
+1 QUIT $SELECT(MCSEX="F":HT*(14.81-(.11*AGE)),1:50.72-(0.372*AGE))
VO2MAX ;
+1 SET ER1=$$VO2ER1(MCSEX)
SET ER2=$$VO2ER2(MCSEX)
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
QUIT
