- 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
- 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
