MCPFTP4 ;WISC/TJK-PFT REPORT-SPECIAL STUDIES (PT 1) ;7/19/96 15:35
;;2.3;Medicine;;09/13/1996
S CI95="" G INT:'$D(^MCAR(700,MCARGDA,"S")),INT:'$O(^("S",0)) S MCX=0
W !! X MCFF Q:$D(MCOUT) S CI95="",HEAD1="SPECIAL STUDIES",MCSP="" D HEAD1^MCPFTP2,HEAD2^MCPFTP2 Q:$D(MCOUT)
SPEC1 S MCX=$O(^MCAR(700,MCARGDA,"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^MCPFTP2
W !!,?5,$S(TYPE="E":"EXERCISE",TYPE="M":"MECHANICS",TYPE="S":"SMALL AIRWAY",1:"MAXIMUM PRESSURES") D PREVDATE^MCPFTP2
I MCREC2'="",$P(MCREC2,U,8)'="" W !,?5,"(NOTES): ",$P(MCREC2,U,8) X MCFF Q:$D(MCOUT)
I TYPE="P" W ! S ND=MCREC2,PC=7,MEAS="PiMAX",UNITS="cmH2O",MCP1=MCP1S2,MCP2=MCP2S2 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT) G SPEC1
G ^MCPFTP5:TYPE="E" S ND=MCREC G SMAIR:TYPE="S"
S MEAS="Raw",UNITS="cmH20/L/S",PC=2,MCP1=MCP1S0,MCP2=MCP2S0 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="SGaw",UNITS="L/S/cmH20",PC=3 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="Cst",UNITS="4cmH20",PC=4 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
G SPEC1
SMAIR S MEAS="Cdyn",UNITS="L/cmH20",PC=5 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="FEF50 He-Air",UNITS="L/Sec",PC=6,MCP1=MCP1S0,MCP2=MCP2S0 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="VISOV",UNITS="L",PC=7 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 Q:$D(MCOUT)
S MEAS="CV",PC=8 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2
S MEAS="CC",PC=9 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2
S CV=$P(MCREC,U,8),(CVVC,CVTL)=""
I CV'="" S:MCVCN'="" CVVC=CV/MCVCN S:MCTLCN'="" CVTL=CV/MCTLCN
W !,?5,"CV/VC"
S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MCPFTP2 W ?18,"%",?25,$S(PRED:$J(PRED,5,2),1:""),?35,$J(CVVC,5,2),?45,$S(PRED:$J(CVVC/PRED*100,5,1),1:"") X MCFF Q:$D(MCOUT)
W !,?5,"CV/TLC",?18,"%",?35,$J(CVTL,5,2) X MCFF Q:$D(MCOUT)
S VISOV=$P(MCREC,U,7) W !,?5,"VISOV/CV"
I VISOV'="",+CV'=0 W ?18,"%",?35,$J(VISOV/CV,5,2)
X MCFF
K CV,CVTL,CVVC,VISOV Q:$D(MCOUT) G SPEC1
INT K MCSP G INT^MCPFTP5
EXIT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPFTP4 2238 printed Dec 13, 2024@02:16:07 Page 2
MCPFTP4 ;WISC/TJK-PFT REPORT-SPECIAL STUDIES (PT 1) ;7/19/96 15:35
+1 ;;2.3;Medicine;;09/13/1996
+2 SET CI95=""
if '$DATA(^MCAR(700,MCARGDA,"S"))
GOTO INT
if '$ORDER(^("S",0))
GOTO INT
SET MCX=0
+3 WRITE !!
XECUTE MCFF
if $DATA(MCOUT)
QUIT
SET CI95=""
SET HEAD1="SPECIAL STUDIES"
SET MCSP=""
DO HEAD1^MCPFTP2
DO HEAD2^MCPFTP2
if $DATA(MCOUT)
QUIT
SPEC1 SET MCX=$ORDER(^MCAR(700,MCARGDA,"S",MCX))
if MCX'?1N.N
GOTO INT
SET MCREC=^(MCX,0)
SET TYPE=$PIECE(MCREC,U)
SET (MCREC1,MCREC2)=""
if $DATA(^(1))
SET MCREC1=^(1)
if $DATA(^(2))
SET MCREC2=^(2)
+1 SET ND="AS"
SET ND1="S"
DO PRETEST^MCPFTP2
+2 WRITE !!,?5,$SELECT(TYPE="E":"EXERCISE",TYPE="M":"MECHANICS",TYPE="S":"SMALL AIRWAY",1:"MAXIMUM PRESSURES")
DO PREVDATE^MCPFTP2
+3 IF MCREC2'=""
IF $PIECE(MCREC2,U,8)'=""
WRITE !,?5,"(NOTES): ",$PIECE(MCREC2,U,8)
XECUTE MCFF
if $DATA(MCOUT)
QUIT
+4 IF TYPE="P"
WRITE !
SET ND=MCREC2
SET PC=7
SET MEAS="PiMAX"
SET UNITS="cmH2O"
SET MCP1=MCP1S2
SET MCP2=MCP2S2
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
GOTO SPEC1
+5 if TYPE="E"
GOTO ^MCPFTP5
SET ND=MCREC
if TYPE="S"
GOTO SMAIR
+6 SET MEAS="Raw"
SET UNITS="cmH20/L/S"
SET PC=2
SET MCP1=MCP1S0
SET MCP2=MCP2S0
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+7 SET MEAS="SGaw"
SET UNITS="L/S/cmH20"
SET PC=3
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+8 SET MEAS="Cst"
SET UNITS="4cmH20"
SET PC=4
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+9 GOTO SPEC1
SMAIR SET MEAS="Cdyn"
SET UNITS="L/cmH20"
SET PC=5
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+1 SET MEAS="FEF50 He-Air"
SET UNITS="L/Sec"
SET PC=6
SET MCP1=MCP1S0
SET MCP2=MCP2S0
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+2 SET MEAS="VISOV"
SET UNITS="L"
SET PC=7
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
if $DATA(MCOUT)
QUIT
+3 SET MEAS="CV"
SET PC=8
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
+4 SET MEAS="CC"
SET PC=9
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
+5 SET CV=$PIECE(MCREC,U,8)
SET (CVVC,CVTL)=""
+6 IF CV'=""
if MCVCN'=""
SET CVVC=CV/MCVCN
if MCTLCN'=""
SET CVTL=CV/MCTLCN
+7 WRITE !,?5,"CV/VC"
+8 SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MCPFTP2
WRITE ?18,"%",?25,$SELECT(PRED:$JUSTIFY(PRED,5,2),1:""),?35,$JUSTIFY(CVVC,5,2),?45,$SELECT(PRED:$JUSTIFY(CVVC/PRED*100,5,1),1:"")
XECUTE MCFF
if $DATA(MCOUT)
QUIT
+9 WRITE !,?5,"CV/TLC",?18,"%",?35,$JUSTIFY(CVTL,5,2)
XECUTE MCFF
if $DATA(MCOUT)
QUIT
+10 SET VISOV=$PIECE(MCREC,U,7)
WRITE !,?5,"VISOV/CV"
+11 IF VISOV'=""
IF +CV'=0
WRITE ?18,"%",?35,$JUSTIFY(VISOV/CV,5,2)
+12 XECUTE MCFF
+13 KILL CV,CVTL,CVVC,VISOV
if $DATA(MCOUT)
QUIT
GOTO SPEC1
INT KILL MCSP
GOTO INT^MCPFTP5
EXIT QUIT
