MCBPFTP5 ;WISC/TJK,ALG-PFT BRIEF REPORT-SPECIAL STUDIES (PT 1) ;5/14/92 13:30
;;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^MCBPFTP2,HEAD2^MCBPFTP2 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^MCBPFTP2
W !!,?5,$S(TYPE="E":"EXERCISE",TYPE="M":"MECHANICS",TYPE="S":"SMALL AIRWAY",1:"MAXIMUM PRESSURES") D PREVDATE^MCBPFTP2
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 D PIMAX^MCBPFTP6 Q:$D(MCOUT) G SPEC1
G ^MCBPFTP7:TYPE="E" S ND=MCREC G SMAIR:TYPE="S"
S MEAS="Raw",UNITS="cmH20/L/S",PC=2,MCP1=MCP1S0,MCP2=MCP2S0 D RAW^MCBPFTP6 Q:$D(MCOUT)
S MEAS="SGaw",UNITS="L/S/cmH20",PC=3 D SGAW^MCBPFTP6 Q:$D(MCOUT)
S MEAS="Cst",UNITS="4cmH20",PC=4 D CST^MCBPFTP6 Q:$D(MCOUT)
G SPEC1
SMAIR S MEAS="Cdyn",UNITS="L/cmH20",PC=5 D SETNULL^MCBPFTP6 Q:$D(MCOUT)
S MEAS="FEF50 He-Air",UNITS="L/Sec",PC=6,MCP1=MCP1S0,MCP2=MCP2S0 D FEF50^MCBPFTP6 Q:$D(MCOUT)
S MEAS="VISOV",UNITS="L",PC=7 D VISOV^MCBPFTP6 Q:$D(MCOUT)
S MEAS="CV",PC=8 D SETNULL^MCBPFTP6
S MEAS="CC",PC=9 D SETNULL^MCBPFTP6
S CV=$P(MCREC,U,8),(CVVC,CVTL)=""
I CV'="" S:MCVCN'="" CVVC=CV/MCVCN S:MCTLCN'="" CVTL=CV/MCTLCN
W !,?5,"CV/VC"
D CVVC^MCBPFTP6 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^MCBPFTP7
EXIT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCBPFTP5 1905 printed Apr 09, 2024@21:17:50 Page 2
MCBPFTP5 ;WISC/TJK,ALG-PFT BRIEF REPORT-SPECIAL STUDIES (PT 1) ;5/14/92 13:30
+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^MCBPFTP2
DO HEAD2^MCBPFTP2
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^MCBPFTP2
+2 WRITE !!,?5,$SELECT(TYPE="E":"EXERCISE",TYPE="M":"MECHANICS",TYPE="S":"SMALL AIRWAY",1:"MAXIMUM PRESSURES")
DO PREVDATE^MCBPFTP2
+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
DO PIMAX^MCBPFTP6
if $DATA(MCOUT)
QUIT
GOTO SPEC1
+5 if TYPE="E"
GOTO ^MCBPFTP7
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
DO RAW^MCBPFTP6
if $DATA(MCOUT)
QUIT
+7 SET MEAS="SGaw"
SET UNITS="L/S/cmH20"
SET PC=3
DO SGAW^MCBPFTP6
if $DATA(MCOUT)
QUIT
+8 SET MEAS="Cst"
SET UNITS="4cmH20"
SET PC=4
DO CST^MCBPFTP6
if $DATA(MCOUT)
QUIT
+9 GOTO SPEC1
SMAIR SET MEAS="Cdyn"
SET UNITS="L/cmH20"
SET PC=5
DO SETNULL^MCBPFTP6
if $DATA(MCOUT)
QUIT
+1 SET MEAS="FEF50 He-Air"
SET UNITS="L/Sec"
SET PC=6
SET MCP1=MCP1S0
SET MCP2=MCP2S0
DO FEF50^MCBPFTP6
if $DATA(MCOUT)
QUIT
+2 SET MEAS="VISOV"
SET UNITS="L"
SET PC=7
DO VISOV^MCBPFTP6
if $DATA(MCOUT)
QUIT
+3 SET MEAS="CV"
SET PC=8
DO SETNULL^MCBPFTP6
+4 SET MEAS="CC"
SET PC=9
DO SETNULL^MCBPFTP6
+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 DO CVVC^MCBPFTP6
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^MCBPFTP7
EXIT QUIT
