MCPFTP2A ;WISC/TJK-PFT REPORT-FLOWS ; 17 Jan 2017 4:41 PM
;;2.3;Medicine;**25,46**;09/13/1996;Build 1
FLOW G DIF:'$D(^MCAR(700,MCARGDA,4)),DIF:'$O(^(4,0)) S MCX=0
;I '$D(HEAD1) S HEAD1="FLOWS" D HEAD1^MCPFTP2,HEAD2^MCPFTP2
;E S HEAD1="FLOWS" D @$S(($Y>(IOSL-5)):"MCFF1",1:"HEAD2^MCPFTP2") Q:$D(MCOUT)
X:$Y>(IOSL-5) MCFF
S HEAD1="FLOWS" D HEAD1^MCPFTP2,HEAD2^MCPFTP2
Q:$D(MCOUT)
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)
FLOW1 S MCX=$O(^MCAR(700,MCARGDA,4,MCX)) G DIF:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U)
W !! X MCFF Q:$D(MCOUT)
S ND="AF",ND1=4 D PRETEST^MCPFTP2
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
I $P(MCREC,U,6)'="" W !,?5,"(NOTES): ",$P(MCREC,U,6) X MCFF Q:$D(MCOUT)
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)
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)
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)
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)
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)
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)
G FLOW1
DIF K CFVC,CFEV1,CPF,CFEF2575,CMVV G ABG:'$D(^MCAR(700,MCARGDA,5)) S (ACT,MCIDA)=^(5) G ABG:'ACT
I '$D(HEAD1) S HEAD1="DIFFUSION" D HEAD1^MCPFTP2,HEAD2^MCPFTP2
E S HEAD1="DIFFUSION" W ! D HEAD2^MCPFTP2
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)
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^MCPFTP2 S (MCIDL,CI95)=$S(PRED:PRED-CDLCOSB,1:"") D PRTLINE Q:$D(MCOUT)
G ABG:'$D(^MCAR(700,MCARGDA,6))
I $G(MCPV)<1 S MCPV=$$MCPV^MCPFTP1(MCARGDA)
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,MCARGDA,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)
;W !,"Corrected DLCO for COHB: ",$J(MCCOHB,6,2)
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,MCARGDA,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 !,"Corr DLCO for HB & COHB:",?19,$J(PRED,6,2),?32,$J(MCHB,8,2),?42,$S(+PRED'=0:$J(MCHB/PRED*100,8,1),1:"")
ABG K HB,COHB,MCHB,MCCOHB G ^MCPFTP3
PRTLINE S MCP1=$G(MCP1),MCP2=$G(MCP2)
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)
W:(CI95)&(CI95'=PRED) ?72,$J(CI95,6,2) X MCFF Q
MCFF1 X MCFF Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPFTP2A 3825 printed Apr 09, 2024@21:15:36 Page 2
MCPFTP2A ;WISC/TJK-PFT REPORT-FLOWS ; 17 Jan 2017 4:41 PM
+1 ;;2.3;Medicine;**25,46**;09/13/1996;Build 1
FLOW if '$DATA(^MCAR(700,MCARGDA,4))
GOTO DIF
if '$ORDER(^(4,0))
GOTO DIF
SET MCX=0
+1 ;I '$D(HEAD1) S HEAD1="FLOWS" D HEAD1^MCPFTP2,HEAD2^MCPFTP2
+2 ;E S HEAD1="FLOWS" D @$S(($Y>(IOSL-5)):"MCFF1",1:"HEAD2^MCPFTP2") Q:$D(MCOUT)
+3 if $Y>(IOSL-5)
XECUTE MCFF
+4 SET HEAD1="FLOWS"
DO HEAD1^MCPFTP2
DO HEAD2^MCPFTP2
+5 if $DATA(MCOUT)
QUIT
+6 IF MC17'=""
SET MC17A=$PIECE(MC17,U,2)
WRITE ?3,"MACHINE: ",$SELECT(MC17A="F":"FLOW TURBINE",MC17A="P":"PNEUMOTACH",MC17A="A":"ANEMOMETER",MC17A="DS":"DRY WATER SEAL",MC17A="WS":"WATER SEAL",MC17A="W":"WEDGE",1:"")
XECUTE MCFF
KILL MC17A
if $DATA(MCOUT)
QUIT
FLOW1 SET MCX=$ORDER(^MCAR(700,MCARGDA,4,MCX))
if MCX'?1N.N
GOTO DIF
SET MCREC=^(MCX,0)
SET TYPE=$PIECE(MCREC,U)
+1 WRITE !!
XECUTE MCFF
if $DATA(MCOUT)
QUIT
+2 SET ND="AF"
SET ND1=4
DO PRETEST^MCPFTP2
+3 WRITE ?5,$SELECT(TYPE="S":"STANDARD STUDY",TYPE="B":"AFTER BRONCHODILATOR",TYPE="I":"AFTER INHALATION CHALLENGE",1:"AFTER EXERCISE")
XECUTE MCFF
if $DATA(MCOUT)
QUIT
DO PREVDATE^MCPFTP2
+4 IF $PIECE(MCREC,U,6)'=""
WRITE !,?5,"(NOTES): ",$PIECE(MCREC,U,6)
XECUTE MCFF
if $DATA(MCOUT)
QUIT
+5 SET ACT=$PIECE(MCREC,U,2)
IF ACT
SET MEAS="FVC"
SET UNITS="L"
SET PRED=FVC
if $DATA(MCRC1)
XECUTE MCRC1
SET PC=2
SET CI95=$SELECT(PRED:PRED-CFVC,1:"")
DO PRTLINE
if TYPE="S"
SET MCIFA=ACT
SET MCIFL=CI95
if $DATA(MCOUT)
QUIT
+6 SET ACT=$PIECE(MCREC,U,3)
IF ACT
SET MEAS="FEV1"
SET UNITS="L"
SET PRED=FEV1
if $DATA(MCRC1)
XECUTE MCRC1
SET PC=3
SET CI95=$SELECT(PRED:PRED-CFEV1,1:"")
DO PRTLINE
if TYPE="S"
SET MCIFE=ACT
if $DATA(MCOUT)
QUIT
+7 SET MCDL=3
SET MCLNG=6
SET ACT=$PIECE(MCREC,U,4)
IF ACT
SET MEAS="PF"
SET UNITS="L/SEC"
SET PRED=PF
SET PC=4
SET CI95=$SELECT(PRED:PRED-CPF,1:"")
DO PRTLINE
if $DATA(MCOUT)
QUIT
+8 SET ACT=$PIECE(MCREC,U,5)
IF ACT
SET MEAS="FEF25-75"
SET UNITS="L/SEC"
SET PRED=FEF2575
if $DATA(MCRC4)
XECUTE MCRC4
SET PC=5
SET CI95=$SELECT(PRED:PRED-CFEF2575,1:"")
DO PRTLINE
if $DATA(MCOUT)
QUIT
+9 SET MCDL=2
SET MCLNG=5
SET ACT=$PIECE(MCREC,U,7)
IF ACT
SET MEAS="MVV"
SET UNITS="L/MIN"
SET PRED=MVV
if $DATA(MCRC5)
XECUTE MCRC5
SET PC=7
SET CI95=$SELECT(PRED:PRED-CMVV,1:"")
if TYPE="S"
SET MCMVVN=ACT
DO PRTLINE
if $DATA(MCOUT)
QUIT
+10 IF $PIECE(MCREC,U,2)
IF $PIECE(MCREC,U,3)
WRITE !,?5,"FEV1/FVC",?17,"%"
SET ACT=$PIECE(MCREC,U,3)/$PIECE(MCREC,U,2)
WRITE ?35,$JUSTIFY(ACT*100,5,0)
if TYPE="S"
SET MCIFV=ACT
XECUTE MCFF
if $DATA(MCOUT)
QUIT
+11 GOTO FLOW1
DIF KILL CFVC,CFEV1,CPF,CFEF2575,CMVV
if '$DATA(^MCAR(700,MCARGDA,5))
GOTO ABG
SET (ACT,MCIDA)=^(5)
if 'ACT
GOTO ABG
+1 IF '$DATA(HEAD1)
SET HEAD1="DIFFUSION"
DO HEAD1^MCPFTP2
DO HEAD2^MCPFTP2
+2 IF '$TEST
SET HEAD1="DIFFUSION"
WRITE !
DO HEAD2^MCPFTP2
+3 if $DATA(MCOUT)
QUIT
IF MC17'=""
SET MC17A=$PIECE(MC17,U,4)
WRITE ?3,"METHOD: ",$SELECT(MC17A=1:"SINGLE BREATH",MC17A=2:"STEADY STATE",1:"")
XECUTE MCFF
KILL MC17A
if $DATA(MCOUT)
QUIT
DIF0 SET (MCIDP,PRED)=DLCOSB
SET UNITS="L"
SET MEAS="DLCO-SB"
SET PC=1
+1 SET (P1,P2)=""
SET RDATE1=$ORDER(^MCAR(700,"ADI",DFN,RDATE))
IF RDATE1
SET P1=$ORDER(^(RDATE1,0))
+2 if 'P1
GOTO DIF1
SET MCP1=$GET(^MCAR(700,P1,5))
+3 SET RDATE2=$ORDER(^MCAR(700,"ADI",DFN,RDATE1))
IF RDATE2
SET P2=$ORDER(^(RDATE2,0))
IF P2
SET MCP2=$GET(^MCAR(700,P2,5))
DIF1 if P1
DO PREVDATE^MCPFTP2
SET (MCIDL,CI95)=$SELECT(PRED:PRED-CDLCOSB,1:"")
DO PRTLINE
if $DATA(MCOUT)
QUIT
+1 if '$DATA(^MCAR(700,MCARGDA,6))
GOTO ABG
+2 IF $GET(MCPV)<1
SET MCPV=$$MCPV^MCPFTP1(MCARGDA)
+3 SET MCHB=$GET(^MCAR(700.1,MCPV,"HB"))
SET MCCOHB=$GET(^("COHB"))
+4 IF MCHB=""
IF MCCOHB=""
GOTO ABG
+5 if $PIECE(MCCOHB,U)=""
GOTO HB
SET MCCOHB=$GET(^MCAR(700.2,MCCOHB,0))
if MCCOHB=""
GOTO HB
SET COHB=""
+6 SET I=0
FOR
SET I=$ORDER(^MCAR(700,MCARGDA,6,I))
if I'?1N.N
QUIT
IF $DATA(^(I,0))
IF $PIECE(^(0),U,7)
SET COHB=$PIECE(^(0),U,7)
+7 if COHB=""
GOTO HB
XECUTE "S MCCOHB="_$PIECE(MCCOHB,U)
+8 ;W !,"Corrected DLCO for COHB: ",$J(MCCOHB,6,2)
HB if $PIECE(MCHB,U)=""
GOTO ABG
SET MCHB=$GET(^MCAR(700.2,MCHB,0))
if MCHB=""
GOTO ABG
+1 SET HB=""
SET I=0
FOR
SET I=$ORDER(^MCAR(700,MCARGDA,6,I))
if I'?1N.N
QUIT
IF $DATA(^(I,0))
IF $PIECE(^(0),U,2)
SET HB=$PIECE(^(0),U,2)
+2 if 'HB
GOTO ABG
XECUTE "S MCHB="_$PIECE(MCHB,U)
+3 WRITE !,"Corr DLCO for HB & COHB:",?19,$JUSTIFY(PRED,6,2),?32,$JUSTIFY(MCHB,8,2),?42,$SELECT(+PRED'=0:$JUSTIFY(MCHB/PRED*100,8,1),1:"")
ABG KILL HB,COHB,MCHB,MCCOHB
GOTO ^MCPFTP3
PRTLINE SET MCP1=$GET(MCP1)
SET MCP2=$GET(MCP2)
+1 WRITE !,?5,MEAS,?15,UNITS,?25,$SELECT(PRED:$JUSTIFY(PRED,MCLNG,MCDL),1:""),?35,$JUSTIFY(ACT,MCLNG,MCDL),?45,$SELECT(PRED:$JUSTIFY(ACT/PRED*100,5,1),1:"")
if $PIECE(MCP1,U,PC)
WRITE ?55,$JUSTIFY($PIECE(MCP1,U,PC),MCLNG,MCDL)
if $PIECE(MCP2,U,PC)
WRITE ?65,$JUSTIFY($PIECE(MCP2,U,PC),MCLNG,MCDL)
+2 if (CI95)&(CI95'=PRED)
WRITE ?72,$JUSTIFY(CI95,6,2)
XECUTE MCFF
QUIT
MCFF1 XECUTE MCFF
QUIT
