- 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 Feb 18, 2025@23:42:35 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
