- MCBPFTP3 ;WISC/TJK,ALG-PFT BRIEF REPORT-FLOWS ;6/24/99 08:58
- ;;2.3;Medicine;**17,25**;09/13/1996
- FLOW G ABG:'$D(^MCAR(700,MCARGDA,4)),ABG:'$O(^(4,0)) S MCX=0
- I '$D(HEAD1) S HEAD1="FLOWS" D HEAD1^MCBPFTP2,HEAD2^MCBPFTP2
- E S HEAD1="FLOWS" D HEAD2^MCBPFTP2
- 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 ABG:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U)
- W !! X MCFF Q:$D(MCOUT)
- S ND="AF",ND1=4 D PRETEST^MCBPFTP2
- 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^MCBPFTP2
- 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=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)
- ;write out actual FEV1/FVC*100 from elements in MCREC
- 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
- ABG G ^MCBPFTP4
- 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
- MCBPFTP3 ;WISC/TJK,ALG-PFT BRIEF REPORT-FLOWS ;6/24/99 08:58
- +1 ;;2.3;Medicine;**17,25**;09/13/1996
- FLOW IF '$DATA(^MCAR(700,MCARGDA,4))
- GOTO ABG
- IF '$ORDER(^(4,0))
- GOTO ABG
- SET MCX=0
- +1 IF '$DATA(HEAD1)
- SET HEAD1="FLOWS"
- DO HEAD1^MCBPFTP2
- DO HEAD2^MCBPFTP2
- +2 IF '$TEST
- SET HEAD1="FLOWS"
- DO HEAD2^MCBPFTP2
- +3 IF $DATA(MCOUT)
- QUIT
- +4 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 ABG
- 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^MCBPFTP2
- +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^MCBPFTP2
- +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=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
- +8 ;write out actual FEV1/FVC*100 from elements in MCREC
- +9 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
- +10 GOTO FLOW1
- ABG GOTO ^MCBPFTP4
- 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
